Add Import trustees from another election

src/web/web_persist.ml

@@ -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)
 

src/web/web_persist.mli

@@ -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

src/web/web_services.ml

@@ -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 ()

src/web/web_site.ml

@@ -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

src/web/web_templates.ml

@@ -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

src/web/web_templates.mli

@@ -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