Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
B
belenios
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
belenios
belenios
Commits
7db23601
Commit
7db23601
authored
Mar 17, 2016
by
Stephane Glondu
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Pretty ballots for archived elections
parent
9f29982e
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
50 additions
and
22 deletions
+50
-22
src/web/web_persist.ml
src/web/web_persist.ml
+44
-0
src/web/web_persist.mli
src/web/web_persist.mli
+3
-0
src/web/web_site.ml
src/web/web_site.ml
+3
-13
src/web/web_templates.ml
src/web/web_templates.ml
+0
-9
No files found.
src/web/web_persist.ml
View file @
7db23601
...
...
@@ -20,6 +20,7 @@
(**************************************************************************)
open
Lwt
open
Platform
open
Serializable_j
open
Common
open
Web_serializable_j
...
...
@@ -133,3 +134,46 @@ let get_passwords uuid =
|
_
->
accu
)
SMap
.
empty
csv
in
return
@@
Some
res
module
Ballots
=
Map
.
Make
(
String
)
module
BallotsCacheTypes
=
struct
type
key
=
string
type
value
=
string
Ballots
.
t
end
module
BallotsCache
=
Ocsigen_cache
.
Make
(
BallotsCacheTypes
)
let
raw_get_ballots_archived
uuid
=
try_lwt
let
ballots
=
Lwt_io
.
lines_of_file
(
!
spool_dir
/
uuid
/
"ballots.jsons"
)
in
Lwt_stream
.
fold
(
fun
b
accu
->
let
hash
=
sha256_b64
b
in
Ballots
.
add
hash
b
accu
)
ballots
Ballots
.
empty
with
_
->
return
Ballots
.
empty
let
archived_ballots_cache
=
new
BallotsCache
.
cache
raw_get_ballots_archived
10
let
get_ballot_hashes
~
uuid
=
match_lwt
get_election_state
uuid
with
|
`Archived
->
lwt
ballots
=
archived_ballots_cache
#
find
uuid
in
Ballots
.
bindings
ballots
|>
List
.
map
fst
|>
return
|
_
->
let
table
=
Ocsipersist
.
open_table
(
"ballots_"
^
underscorize
uuid
)
in
Ocsipersist
.
fold_step
(
fun
hash
_
accu
->
return
(
hash
::
accu
)
)
table
[]
>>=
(
fun
x
->
return
@@
List
.
rev
x
)
let
get_ballot_by_hash
~
uuid
~
hash
=
match_lwt
get_election_state
uuid
with
|
`Archived
->
lwt
ballots
=
archived_ballots_cache
#
find
uuid
in
(
try
Some
(
Ballots
.
find
hash
ballots
)
with
Not_found
->
None
)
|>
return
|
_
->
let
table
=
Ocsipersist
.
open_table
(
"ballots_"
^
underscorize
uuid
)
in
try_lwt
Ocsipersist
.
find
table
hash
>>=
(
fun
x
->
return
@@
Some
x
)
with
Not_found
->
return_none
src/web/web_persist.mli
View file @
7db23601
...
...
@@ -50,3 +50,6 @@ val get_elections_by_owner : user -> string list Lwt.t
val
get_voters
:
string
->
string
list
option
Lwt
.
t
val
get_passwords
:
string
->
(
string
*
string
)
SMap
.
t
option
Lwt
.
t
val
get_ballot_hashes
:
uuid
:
string
->
string
list
Lwt
.
t
val
get_ballot_by_hash
:
uuid
:
string
->
hash
:
string
->
string
option
Lwt
.
t
src/web/web_site.ml
View file @
7db23601
...
...
@@ -1241,26 +1241,16 @@ let () =
(
fun
(
uuid
,
()
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
lwt
w
=
find_election
uuid_s
in
let
module
W
=
Web_election
.
Make
((
val
w
))
(
LwtRandom
)
in
let
module
B
=
W
.
B
in
let
module
W
=
W
.
D
in
lwt
ballots
=
B
.
Ballots
.
fold
(
fun
h
_
accu
->
return
(
h
::
accu
))
[]
in
lwt
ballots
=
Web_persist
.
get_ballot_hashes
uuid_s
in
lwt
result
=
Web_persist
.
get_election_result
uuid_s
in
T
.
pretty_ballots
(
module
W
)
ballots
result
()
>>=
Html5
.
send
)
T
.
pretty_ballots
w
ballots
result
()
>>=
Html5
.
send
)
let
()
=
Any
.
register
~
service
:
election_pretty_ballot
(
fun
((
uuid
,
()
)
,
hash
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
lwt
w
=
find_election
uuid_s
in
let
module
W
=
Web_election
.
Make
((
val
w
))
(
LwtRandom
)
in
lwt
ballot
=
W
.
B
.
Ballots
.
fold
(
fun
h
b
accu
->
if
h
=
hash
then
return
(
Some
b
)
else
return
accu
)
None
in
lwt
ballot
=
Web_persist
.
get_ballot_by_hash
~
uuid
:
uuid_s
~
hash
in
match
ballot
with
|
None
->
fail_http
404
|
Some
b
->
...
...
src/web/web_templates.ml
View file @
7db23601
...
...
@@ -1452,15 +1452,6 @@ let pretty_ballots w hashes result () =
(
params
.
e_uuid
,
()
)]
in
let
number
=
match
!
nballots
,
result
with
|
0
,
Some
r
->
div
[
pcdata
(
string_of_int
r
.
num_tallied
);
pcdata
" ballot(s) have been accepted."
;
pcdata
" Ballot details are no longer available for this election,"
;
pcdata
" but you can still download the whole "
;
a
~
service
:
(
file
w
ESBallots
)
[
pcdata
"ballot list"
]
()
;
pcdata
"."
;
]
|
n
,
None
->
div
[
pcdata
(
string_of_int
n
);
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment