Commit 024e2bc6 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Add election_archive service

parent 6a31dc0b
......@@ -73,6 +73,7 @@ let election_regenpwd_post = post_coservice ~fallback:election_regenpwd ~post_pa
let election_login = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "login") (opt (string "service"))) ()
let election_open = post_coservice ~fallback:election_admin ~post_params:unit ()
let election_close = post_coservice ~fallback:election_admin ~post_params:unit ()
let election_archive = post_coservice ~fallback:election_admin ~post_params:unit ()
let election_update_credential = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "update-cred")) ()
let election_update_credential_post = post_service ~fallback:election_update_credential ~post_params:(string "old_credential" ** string "new_credential") ()
let election_vote = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "vote")) ()
......
......@@ -217,6 +217,32 @@ let finalize_election uuid se =
Web_persist.set_election_state uuid_s `Open >>
Web_persist.set_election_date uuid_s (now ())
let cleanup_table ?uuid_s table =
let table = Ocsipersist.open_table table in
match uuid_s with
| None ->
lwt indexes = Ocsipersist.fold_step (fun k _ accu ->
return (k :: accu)) table []
in
Lwt_list.iter_s (Ocsipersist.remove table) indexes
| Some u -> Ocsipersist.remove table u
let cleanup_file f =
try_lwt Lwt_unix.unlink f
with _ -> return_unit
let archive_election uuid_s =
let uuid_u = underscorize uuid_s in
lwt () = cleanup_table ~uuid_s "election_states" in
lwt () = cleanup_table ~uuid_s "election_pds" in
lwt () = cleanup_table ~uuid_s "auth_configs" in
lwt () = cleanup_table ("password_" ^ uuid_u) in
lwt () = cleanup_table ("records_" ^ uuid_u) in
lwt () = cleanup_table ("creds_" ^ uuid_u) in
lwt () = cleanup_table ("ballots_" ^ uuid_u) in
lwt () = cleanup_file (!spool_dir / uuid_s / "private_key.json") in
return_unit
let () = Any.register ~service:home
(fun () () ->
Eliom_reference.unset Web_auth_state.cont >>
......@@ -1064,6 +1090,18 @@ let election_set_state state (uuid, ()) () =
let () = Any.register ~service:election_open (election_set_state true)
let () = Any.register ~service:election_close (election_set_state false)
let () = Any.register ~service:election_archive (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
lwt w = find_election uuid_s in
lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w) in
match site_user with
| Some u when W.metadata.e_owner = Some u ->
archive_election uuid_s >>
Redirection.send (Eliom_service.preapply election_admin (uuid, ()))
| _ -> forbidden ()
)
let () =
Any.register
~service:election_update_credential
......
......@@ -1159,6 +1159,17 @@ let election_admin w state () =
pcdata "This election is archived.";
]
in
let div_archive = match state with
| `Archived -> pcdata ""
| _ -> div [
post_form ~service:election_archive (fun () ->
[
string_input ~input_type:`Submit ~value:"Archive this election" ();
pcdata " (Warning: this action is irreversible!)";
]
) (W.election.e_params.e_uuid, ())
]
in
let uuid = W.election.e_params.e_uuid in
let update_credential =
match W.metadata.e_cred_authority with
......@@ -1187,6 +1198,7 @@ let election_admin w state () =
a ~service:election_regenpwd [pcdata "Regenerate and mail a password"] (uuid, ());
];
div [state_div];
div_archive;
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
......
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