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
39674d25
Commit
39674d25
authored
Feb 22, 2016
by
Stephane Glondu
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add new "archived" state
parent
9f314163
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
42 additions
and
22 deletions
+42
-22
src/web/web_persist.ml
src/web/web_persist.ml
+2
-4
src/web/web_persist.mli
src/web/web_persist.mli
+1
-0
src/web/web_site.ml
src/web/web_site.ml
+10
-8
src/web/web_templates.ml
src/web/web_templates.ml
+27
-8
src/web/web_templates.mli
src/web/web_templates.mli
+2
-2
No files found.
src/web/web_persist.ml
View file @
39674d25
...
...
@@ -39,16 +39,14 @@ type election_state =
|
`Closed
|
`EncryptedTally
of
int
*
int
*
string
|
`Tallied
of
plaintext
|
`Archived
]
let
election_states
=
Ocsipersist
.
open_table
"election_states"
let
get_election_state
x
=
try_lwt
Ocsipersist
.
find
election_states
x
with
Not_found
->
match_lwt
get_election_result
x
with
|
Some
r
->
return
(
`Tallied
r
.
result
)
|
None
->
return
`Open
with
Not_found
->
return
`Archived
let
set_election_state
x
s
=
Ocsipersist
.
add
election_states
x
s
...
...
src/web/web_persist.mli
View file @
39674d25
...
...
@@ -28,6 +28,7 @@ type election_state =
|
`Closed
|
`EncryptedTally
of
int
*
int
*
string
|
`Tallied
of
plaintext
|
`Archived
]
val
get_election_state
:
string
->
election_state
Lwt
.
t
val
set_election_state
:
string
->
election_state
->
unit
Lwt
.
t
...
...
src/web/web_site.ml
View file @
39674d25
...
...
@@ -211,6 +211,7 @@ let finalize_election uuid se =
dump_passwords
W
.
D
.
dir
table
|
_
->
return_unit
)
>>
(* finish *)
Web_persist
.
set_election_state
uuid_s
`Open
>>
Web_persist
.
set_election_date
uuid_s
(
now
()
)
let
()
=
Any
.
register
~
service
:
home
...
...
@@ -220,23 +221,24 @@ let () = Any.register ~service:home
)
let
get_finalized_elections_by_owner
u
=
lwt
elections
,
tallied
=
lwt
elections
,
tallied
,
archived
=
Web_persist
.
get_elections_by_owner
u
>>=
Lwt_list
.
fold_left_s
(
fun
accu
uuid_s
->
lwt
w
=
find_election
uuid_s
in
lwt
state
=
Web_persist
.
get_election_state
uuid_s
in
lwt
date
=
Web_persist
.
get_election_date
uuid_s
in
let
elections
,
tallied
=
accu
in
let
elections
,
tallied
,
archived
=
accu
in
match
state
with
|
`Tallied
_
->
return
(
elections
,
(
date
,
w
)
::
tallied
)
|
_
->
return
((
date
,
w
)
::
elections
,
tallied
)
)
([]
,
[]
)
|
`Tallied
_
->
return
(
elections
,
(
date
,
w
)
::
tallied
,
archived
)
|
`Archived
->
return
(
elections
,
tallied
,
(
date
,
w
)
::
archived
)
|
_
->
return
((
date
,
w
)
::
elections
,
tallied
,
archived
)
)
([]
,
[]
,
[]
)
in
let
sort
l
=
List
.
sort
(
fun
(
x
,
_
)
(
y
,
_
)
->
datetime_compare
x
y
)
l
|>
List
.
map
(
fun
(
_
,
x
)
->
x
)
in
return
(
sort
elections
,
sort
tallied
)
return
(
sort
elections
,
sort
tallied
,
sort
archived
)
let
()
=
Html5
.
register
~
service
:
admin
(
fun
()
()
->
...
...
@@ -247,7 +249,7 @@ let () = Html5.register ~service:admin
match
site_user
with
|
None
->
return
None
|
Some
u
->
lwt
elections
,
tallied
=
get_finalized_elections_by_owner
u
in
lwt
elections
,
tallied
,
archived
=
get_finalized_elections_by_owner
u
in
lwt
setup_elections
=
Ocsipersist
.
fold_step
(
fun
k
v
accu
->
if
v
.
se_owner
=
u
...
...
@@ -255,7 +257,7 @@ let () = Html5.register ~service:admin
else
return
accu
)
election_stable
[]
in
return
@@
Some
(
elections
,
tallied
,
setup_elections
)
return
@@
Some
(
elections
,
tallied
,
archived
,
setup_elections
)
in
T
.
admin
~
elections
()
)
...
...
src/web/web_templates.ml
View file @
39674d25
...
...
@@ -202,7 +202,7 @@ let admin ~elections () =
]
in
lwt
login_box
=
site_login_box
()
in
base
~
title
~
login_box
~
content
()
|
Some
(
elections
,
tallied
,
setup_elections
)
->
|
Some
(
elections
,
tallied
,
archived
,
setup_elections
)
->
let
elections
=
match
elections
with
|
[]
->
p
[
pcdata
"You own no such elections!"
]
...
...
@@ -213,6 +213,11 @@ let admin ~elections () =
|
[]
->
p
[
pcdata
"You own no such elections!"
]
|
_
->
ul
@@
List
.
map
(
format_election
`Admin
)
tallied
in
let
archived
=
match
archived
with
|
[]
->
p
[
pcdata
"You own no such elections!"
]
|
_
->
ul
@@
List
.
map
(
format_election
`Admin
)
archived
in
let
setup_elections
=
match
setup_elections
with
|
[]
->
p
[
pcdata
"You own no such elections!"
]
...
...
@@ -237,6 +242,8 @@ let admin ~elections () =
div
[
br
()
];
h2
[
pcdata
"Tallied elections"
];
tallied
;
h2
[
pcdata
"Archived elections"
];
archived
;
];
]
in
lwt
login_box
=
site_login_box
()
in
...
...
@@ -811,7 +818,7 @@ let election_setup_trustee token se () =
let
login_box
=
pcdata
""
in
base
~
title
~
login_box
~
content
()
let
election_setup_import
uuid
se
(
elections
,
tallied
)
()
=
let
election_setup_import
uuid
se
(
elections
,
tallied
,
archived
)
()
=
let
title
=
"Election "
^
se
.
se_questions
.
t_name
^
" — Import voters from another election"
in
let
format_election
election
=
let
module
W
=
(
val
election
:
WEB_ELECTION_DATA
)
in
...
...
@@ -843,6 +850,8 @@ let election_setup_import uuid se (elections, tallied) () =
itemize
elections
;
h2
[
pcdata
"Tallied elections"
];
itemize
tallied
;
h2
[
pcdata
"Archived elections"
];
itemize
archived
;
]
in
lwt
login_box
=
site_login_box
()
in
base
~
title
~
login_box
~
content
()
...
...
@@ -932,12 +941,11 @@ let election_home w state () =
[
pcdata
" "
;
b
[
pcdata
"This election has been tallied."
];
pcdata
" The result with "
;
a
~
service
:
election_dir
[
pcdata
"cryptographic proofs"
]
(
W
.
election
.
e_params
.
e_uuid
,
ESResult
);
pcdata
" is available."
]
|
`Archived
->
[
pcdata
" "
;
b
[
pcdata
"This election is archived."
];
]
in
let
ballots_link
=
...
...
@@ -992,6 +1000,13 @@ let election_home w state () =
pcdata
"Number of accepted ballots: "
;
pcdata
(
string_of_int
r
.
num_tallied
);
];
div
[
pcdata
"You can also download the "
;
a
~
service
:
election_dir
[
pcdata
"result with cryptographic proofs"
]
(
W
.
election
.
e_params
.
e_uuid
,
ESResult
);
pcdata
"."
;
];
]
|
None
->
return
go_to_the_booth
in
...
...
@@ -1107,6 +1122,10 @@ let election_admin w state () =
return
@@
div
[
pcdata
"This election has been tallied."
;
]
|
`Archived
->
return
@@
div
[
pcdata
"This election is archived."
;
]
in
let
uuid
=
W
.
election
.
e_params
.
e_uuid
in
let
update_credential
=
...
...
src/web/web_templates.mli
View file @
39674d25
...
...
@@ -23,7 +23,7 @@ open Serializable_t
open
Web_signatures
val
home
:
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
admin
:
elections
:
((
module
WEB_ELECTION_DATA
)
list
*
(
module
WEB_ELECTION_DATA
)
list
*
(
Uuidm
.
t
*
string
)
list
)
option
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
admin
:
elections
:
((
module
WEB_ELECTION_DATA
)
list
*
(
module
WEB_ELECTION_DATA
)
list
*
(
module
WEB_ELECTION_DATA
)
list
*
(
Uuidm
.
t
*
string
)
list
)
option
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
new_election_failure
:
[
`Exists
|
`Exception
of
exn
]
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
...
...
@@ -37,7 +37,7 @@ val election_setup_credential_authority : Uuidm.t -> Web_common.setup_election -
val
election_setup_credentials
:
string
->
string
->
Web_common
.
setup_election
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_trustees
:
Uuidm
.
t
->
Web_common
.
setup_election
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_trustee
:
string
->
Web_common
.
setup_election
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_import
:
Uuidm
.
t
->
Web_common
.
setup_election
->
(
module
WEB_ELECTION_DATA
)
list
*
(
module
WEB_ELECTION_DATA
)
list
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_import
:
Uuidm
.
t
->
Web_common
.
setup_election
->
(
module
WEB_ELECTION_DATA
)
list
*
(
module
WEB_ELECTION_DATA
)
list
*
(
module
WEB_ELECTION_DATA
)
list
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_home
:
(
module
WEB_ELECTION_DATA
)
->
Web_persist
.
election_state
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_admin
:
(
module
WEB_ELECTION_DATA
)
->
Web_persist
.
election_state
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
...
...
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