Threshold: election finalization + running

src/web/web_common.ml

@@ -127,6 +127,7 @@ let set_rewrite_prefix ~src ~dst =
 type election_file =
   | ESRaw
   | ESKeys
+  | ESTParams
   | ESCreds
   | ESBallots
   | ESVoters
@@ -137,6 +138,7 @@ type election_file =
 let election_file_of_string = function
   | "election.json" -> ESRaw
   | "public_keys.jsons" -> ESKeys
+  | "threshold.json" -> ESTParams
   | "public_creds.txt" -> ESCreds
   | "ballots.jsons" -> ESBallots
   | "records" -> ESRecords
@@ -148,6 +150,7 @@ let election_file_of_string = function
 let string_of_election_file = function
   | ESRaw -> "election.json"
   | ESKeys -> "public_keys.jsons"
+  | ESTParams -> "threshold.json"
   | ESCreds -> "public_creds.txt"
   | ESBallots -> "ballots.jsons"
   | ESRecords -> "records"

src/web/web_common.mli

@@ -61,6 +61,7 @@ val set_rewrite_prefix : src:string -> dst:string -> unit
 type election_file =
   | ESRaw
   | ESKeys
+  | ESTParams
   | ESCreds
   | ESBallots
   | ESVoters

src/web/web_persist.ml

@@ -153,6 +153,13 @@ let get_public_keys uuid =
     return @@ Some lines
   with _ -> return_none
 
+let get_threshold uuid =
+  try%lwt
+    Lwt_io.chars_of_file (!spool_dir / uuid / "threshold.json") |>
+    Lwt_stream.to_string >>= fun x ->
+    return (Some x)
+  with _ -> return_none
+
 module Ballots = Map.Make (String)
 
 module BallotsCacheTypes = struct

src/web/web_persist.mli

@@ -51,6 +51,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_threshold : string -> string 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_site.ml

@@ -107,24 +107,49 @@ let finalize_election uuid se =
   (* trustees *)
   let group = Group.of_string se.se_group in
   let module G = (val group : GROUP) in
-  let module KG = Trustees.MakeSimple (G) (LwtRandom) in
-  let%lwt trustees, public_keys, private_key =
-    match se.se_public_keys with
-    | [] ->
-       let%lwt private_key = KG.generate () in
-       let%lwt public_key = KG.prove private_key in
-       return (None, [public_key], Some private_key)
-    | _ :: _ ->
-       return (
-         Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys),
-         (List.map
-            (fun {st_public_key; _} ->
-              if st_public_key = "" then failwith "some public keys are missing";
-              trustee_public_key_of_string G.read st_public_key
-            ) se.se_public_keys),
-         None)
+  let%lwt y, trustees, pk_or_tp, private_keys =
+    match se.se_threshold_trustees with
+    | None ->
+       let module KG = Trustees.MakeSimple (G) (LwtRandom) in
+       let%lwt trustees, public_keys, private_key =
+         match se.se_public_keys with
+         | [] ->
+            let%lwt private_key = KG.generate () in
+            let%lwt public_key = KG.prove private_key in
+            return (None, [public_key], `KEY private_key)
+         | _ :: _ ->
+            return (
+                Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys),
+                (List.map
+                   (fun {st_public_key; _} ->
+                     if st_public_key = "" then failwith "some public keys are missing";
+                     trustee_public_key_of_string G.read st_public_key
+                   ) se.se_public_keys),
+                `None)
+       in
+       let y = KG.combine (Array.of_list public_keys) in
+       return (y, trustees, `PK public_keys, private_key)
+    | Some ts ->
+       match se.se_threshold_parameters with
+       | None -> failwith "key establishment not finished"
+       | Some tp ->
+          let tp = threshold_parameters_of_string G.read tp in
+          let module P = Trustees.MakePKI (G) (LwtRandom) in
+          let module C = Trustees.MakeChannels (G) (LwtRandom) (P) in
+          let module K = Trustees.MakePedersen (G) (LwtRandom) (P) (C) in
+          let trustees = List.map (fun {stt_id; _} -> stt_id) ts in
+          let private_keys =
+            List.map (fun {stt_voutput; _} ->
+                match stt_voutput with
+                | Some v ->
+                   let voutput = voutput_of_string G.read v in
+                   voutput.vo_private_key
+                | None -> failwith "inconsistent state"
+              ) ts
+          in
+          let y = K.combine tp in
+          return (y, Some trustees, `TP tp, `KEYS private_keys)
   in
-  let y = KG.combine (Array.of_list public_keys) in
   (* election parameters *)
   let metadata = { se.se_metadata with e_trustees = trustees } in
   let template = se.se_questions in
@@ -149,7 +174,10 @@ let finalize_election uuid se =
               Lwt_io.write oc "\n") xs)
   in
   Lwt_unix.mkdir dir 0o700 >>
-  create_file "public_keys.jsons" (string_of_trustee_public_key G.write) public_keys >>
+  (match pk_or_tp with
+   | `PK pk -> create_file "public_keys.jsons" (string_of_trustee_public_key G.write) pk
+   | `TP tp -> create_file "threshold.json" (string_of_threshold_parameters G.write) [tp]
+  ) >>
   create_file "voters.txt" (fun x -> x.sv_id) se.se_voters >>
   create_file "metadata.json" string_of_metadata [metadata] >>
   create_file "election.json" (fun x -> x) [raw_election] >>
@@ -176,11 +204,12 @@ let finalize_election uuid se =
     W.B.update_files () >>
     Lwt_unix.unlink fname
   in
-  (* create file with private key, if any *)
+  (* create file with private keys, if any *)
   let%lwt () =
-    match private_key with
-    | None -> return_unit
-    | Some x -> create_file "private_key.json" string_of_number [x]
+    match private_keys with
+    | `None -> return_unit
+    | `KEY x -> create_file "private_key.json" string_of_number [x]
+    | `KEYS x -> create_file "private_keys.jsons" (fun x -> x) x
   in
   (* clean up setup database *)
   Ocsipersist.remove election_credtokens se.se_public_creds >>
@@ -188,6 +217,13 @@ let finalize_election uuid se =
     (fun {st_token; _} ->
       Ocsipersist.remove election_pktokens st_token)
     se.se_public_keys >>
+  (match se.se_threshold_trustees with
+   | None -> return_unit
+   | Some ts ->
+      Lwt_list.iter_s
+        (fun x -> Ocsipersist.remove election_tpktokens x.stt_token)
+        ts
+  ) >>
   Ocsipersist.remove election_stable uuid_s >>
   (* inject passwords *)
   (match metadata.e_auth_config with
@@ -1442,14 +1478,14 @@ let () =
 
 let content_type_of_file = function
   | ESRaw -> "application/json; charset=utf-8"
-  | ESKeys | ESBallots | ESETally | ESResult -> "application/json"
+  | ESKeys | ESTParams | ESBallots | ESETally | ESResult -> "application/json"
   | ESCreds | ESRecords | ESVoters -> "text/plain"
 
 let handle_pseudo_file uuid_s w f site_user =
   let module W = (val w : ELECTION_DATA) in
   let confidential =
     match f with
-    | ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false
+    | ESRaw | ESKeys | ESTParams | ESBallots | ESETally | ESResult | ESCreds -> false
     | ESRecords | ESVoters -> true
   in
   let%lwt () =

src/web/web_templates.ml

@@ -584,6 +584,27 @@ let election_setup_trustees uuid se () =
            ) ts
        )
   in
+  let import_link = div [
+                        a ~service:Web_services.election_setup_import_trustees
+                          [pcdata "Import trustees from another election"] uuid
+                      ]
+  in
+  let div_trustees =
+    if se.se_threshold_trustees = None then
+      div [
+          trustees;
+          (if se.se_public_keys <> [] then
+             div [
+                 pcdata "There is one link per trustee. Send each trustee her link.";
+                 br ();
+                 br ();
+               ]
+           else pcdata "");
+          form_trustees_add;
+          import_link;
+        ]
+    else pcdata ""
+  in
   let div_content =
     div [
       div [pcdata "If you do not wish the server to store any keys, you may nominate trustees. In that case, each trustee will create her own secret key. Be careful, once the election is over, you will need the contribution of each trustee to compute the result!"];
@@ -593,29 +614,15 @@ let election_setup_trustees uuid se () =
           pcdata " of trustees is needed to perform the decryption.";
         ];
       br ();
-      trustees;
-      (if se.se_public_keys <> [] then
-          div [
-            pcdata "There is one link per trustee. Send each trustee her link.";
-            br ();
-            br ();
-          ]
-       else pcdata "");
-      form_trustees_add;
+      div_trustees;
     ]
   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
@@ -1191,9 +1198,13 @@ let election_setup_confirm uuid se () =
     match se.se_public_keys with
     | [] -> ready, "OK"
     | _ :: _ ->
-       if List.for_all (fun {st_public_key; _} ->
-         st_public_key <> ""
-       ) se.se_public_keys then ready, "OK" else false, "Missing"
+       match se.se_threshold_trustees with
+       | None -> if List.for_all (fun {st_public_key; _} ->
+                        st_public_key <> ""
+                      ) se.se_public_keys then ready, "OK" else false, "Missing"
+       | Some _ ->
+          if se.se_threshold_parameters <> None then ready, "OK"
+          else false, "Missing"
   in
   let div_trustee_warning =
     match se.se_public_keys with
@@ -1283,6 +1294,18 @@ let audit_footer w =
   let%lwt language = Eliom_reference.get Web_state.language in
   let module L = (val Web_i18n.get_lang language) in
   let module W = (val w : ELECTION_DATA) in
+  let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
+  let%lwt pk_or_tp =
+    match%lwt Web_persist.get_threshold uuid_s with
+    | None ->
+       return (a ~service:(file w ESKeys) [
+                   pcdata L.trustee_public_keys
+                 ] ())
+    | Some _ ->
+       return (a ~service:(file w ESTParams) [
+                   pcdata "threshold parameters"
+                 ] ())
+  in
   return @@ div ~a:[a_style "line-height:1.5em;"] [
     div [
       div [
@@ -1295,9 +1318,7 @@ let audit_footer w =
           pcdata L.parameters
         ] ();
         pcdata ", ";
-        a ~service:(file w ESKeys) [
-          pcdata L.trustee_public_keys
-        ] ();
+        pk_or_tp;
         pcdata ", ";
         a ~service:(file w ESCreds) [
           pcdata L.public_credentials