Commit 39674d25 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Add new "archived" state

parent 9f314163
......@@ -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
......
......@@ -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
......
......@@ -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 ()
)
......
......@@ -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 =
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment