Commit 47887f01 authored by Stephane Glondu's avatar Stephane Glondu

Add Import trustees from another election

parent 1f85121d
......@@ -146,6 +146,12 @@ let get_passwords uuid =
) SMap.empty csv in
return @@ Some res
let get_public_keys uuid =
try%lwt
let lines = Lwt_io.lines_of_file (!spool_dir / uuid / "public_keys.jsons") in
let%lwt lines = Lwt_stream.to_list lines in
return @@ Some lines
with _ -> return_none
module Ballots = Map.Make (String)
......
......@@ -50,6 +50,7 @@ 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_public_keys : string -> string list 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
......@@ -63,6 +63,8 @@ let election_setup_auth_genpwd = post_coservice ~fallback:election_setup ~post_p
let election_setup_import = service ~path:["setup"; "import"] ~get_params:(uuid "uuid") ()
let election_setup_import_post = post_coservice ~fallback:election_setup_import ~post_params:(uuid "from") ()
let election_setup_import_trustees = service ~path:["setup"; "import-trustees"] ~get_params:(uuid "uuid") ()
let election_setup_import_trustees_post = post_coservice ~fallback:election_setup_import_trustees ~post_params:(uuid "from") ()
let election_home = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "")) ()
let set_cookie_disclaimer = coservice' ~get_params:unit ()
......
......@@ -907,6 +907,56 @@ let () =
from_s)
() >>= Html5.send)))
let () =
Html5.register ~service:election_setup_import_trustees
(fun uuid () ->
let%lwt site_user = Web_state.get_site_user () in
match site_user with
| None -> forbidden ()
| Some u ->
let%lwt se = get_setup_election (Uuidm.to_string uuid) in
let%lwt elections = get_finalized_elections_by_owner u in
T.election_setup_import_trustees uuid se elections ())
exception TrusteeImportError of string
let () =
Any.register ~service:election_setup_import_trustees_post
(handle_setup
(fun se from _ uuid ->
let from_s = Uuidm.to_string from in
let%lwt metadata = Web_persist.get_election_metadata from_s in
let%lwt public_keys = Web_persist.get_public_keys from_s in
try%lwt
match metadata.e_trustees, public_keys with
| Some ts, Some pks when List.length ts = List.length pks ->
let%lwt trustees =
List.combine ts pks
|> Lwt_list.map_p
(fun (st_id, st_public_key) ->
let%lwt st_token = generate_token () in
return {st_id; st_token; st_public_key})
in
let () =
(* check that imported keys are valid *)
let module G = (val Group.of_string se.se_group : GROUP) in
let module KG = Election.MakeSimpleDistKeyGen (G) (LwtRandom) in
if not @@ List.for_all (fun t ->
let pk = t.st_public_key in
let pk = trustee_public_key_of_string G.read pk in
KG.check pk) trustees then
raise (TrusteeImportError "Imported keys are invalid for this election!")
in
se.se_public_keys <- se.se_public_keys @ trustees;
return (redir_preapply election_setup_trustees uuid)
| _, _ ->
[%lwt raise (TrusteeImportError "Could not retrieve trustees from selected election!")]
with
| TrusteeImportError msg ->
return (fun () ->
T.generic_page ~title:"Error"
~service:(preapply election_setup_trustees uuid)
msg () >>= Html5.send)))
let () =
Any.register
......
......@@ -615,12 +615,18 @@ let election_setup_trustees uuid se () =
form_trustees_add;
]
in
let import_link = div [
a ~service:Web_services.election_setup_import_trustees
[pcdata "Import trustees from another election"] uuid
]
in
let back_link = div [
a ~service:Web_services.election_setup
[pcdata "Go back to election setup"] uuid;
] in
let content = [
div_content;
import_link;
back_link;
] in
let%lwt login_box = site_login_box () in
......@@ -917,14 +923,12 @@ let election_setup_trustee token se () =
] in
base ~title ~content ()
let election_setup_import uuid se (elections, tallied, archived) () =
let title = "Election " ^ se.se_questions.t_name ^ " — Import voters from another election" in
let election_setup_importer ~service ~title uuid (elections, tallied, archived) () =
let format_election election =
let module W = (val election : ELECTION_DATA) in
let name = W.election.e_params.e_name in
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
let form = post_form
~service:election_setup_import_post
let form = post_form ~service
(fun from ->
[
div [pcdata name; pcdata " ("; pcdata uuid_s; pcdata ")"];
......@@ -955,6 +959,16 @@ let election_setup_import uuid se (elections, tallied, archived) () =
let%lwt login_box = site_login_box () in
base ~title ?login_box ~content ()
let election_setup_import uuid se elections =
let title = "Election " ^ se.se_questions.t_name ^ " — Import voters from another election" in
let service = election_setup_import_post in
election_setup_importer ~service ~title uuid elections
let election_setup_import_trustees uuid se elections =
let title = "Election " ^ se.se_questions.t_name ^ " — Import trustees from another election" in
let service = election_setup_import_trustees_post in
election_setup_importer ~service ~title uuid elections
let election_setup_confirm uuid se () =
let title = "Election " ^ se.se_questions.t_name ^ " — Finalize creation" in
let voters = Printf.sprintf "%d voter(s)" (List.length se.se_voters) in
......
......@@ -46,6 +46,7 @@ val election_setup_credentials : string -> string -> setup_election -> unit -> [
val election_setup_trustees : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustee : string -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_import : Uuidm.t -> setup_election -> (module ELECTION_DATA) list * (module ELECTION_DATA) list * (module ELECTION_DATA) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_import_trustees : Uuidm.t -> setup_election -> (module ELECTION_DATA) list * (module ELECTION_DATA) list * (module ELECTION_DATA) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_confirm : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : (module 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