Add possibility to add the server itself as a (non-threshold) trustee

src/web/web_persist.ml

@@ -146,6 +146,11 @@ let get_passwords uuid =
 let get_public_keys uuid =
   read_file ~uuid "public_keys.jsons"
 
+let get_private_key uuid =
+  match%lwt read_file ~uuid "private_key.json" with
+  | Some [x] -> return (Some (number_of_string x))
+  | _ -> return_none
+
 let get_private_keys uuid =
   read_file ~uuid "private_keys.jsons"
 

src/web/web_persist.mli

@@ -51,6 +51,7 @@ val get_elections_by_owner : user -> uuid list Lwt.t
 val get_voters : uuid -> string list option Lwt.t
 val get_passwords : uuid -> (string * string) SMap.t option Lwt.t
 val get_public_keys : uuid -> string list option Lwt.t
+val get_private_key : uuid -> number option Lwt.t
 val get_private_keys : uuid -> string list option Lwt.t
 val get_threshold : uuid -> string option Lwt.t
 

src/web/web_serializable.atd

@@ -23,6 +23,7 @@
 
 (** {1 Predefined types} *)
 
+type number <ocaml predef from="Serializable_builtin"> = abstract
 type uuid <ocaml predef from="Serializable_builtin"> = abstract
 type string_set <ocaml predef from="Serializable_builtin"> = abstract
 type datetime <ocaml predef from="Web_serializable_builtin"> = abstract
@@ -67,6 +68,7 @@ type setup_trustee = {
   id : string;
   token : string;
   public_key <ocaml mutable> : string;
+  ?private_key : number option;
 } <ocaml field_prefix="st_">
 
 type setup_threshold_trustee = {

src/web/web_services.ml

@@ -45,6 +45,7 @@ let election_setup_voters_add = post_service ~fallback:election_setup_voters ~po
 let election_setup_voters_remove = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") ()
 let election_setup_voters_passwd = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") ()
 let election_setup_trustee_add = post_coservice ~fallback:election_setup ~post_params:(string "id") ()
+let election_setup_trustee_add_server = post_coservice ~fallback:election_setup ~post_params:unit ()
 let election_setup_trustee_del = post_coservice ~fallback:election_setup ~post_params:(int "index") ()
 let election_setup_credential_authority = service ~path:["setup"; "credential-authority"] ~get_params:(uuid "uuid") ()
 let election_setup_credentials = service ~path:["setup"; "credentials"] ~get_params:(string "token") ()

src/web/web_site.ml

@@ -122,6 +122,18 @@ let finalize_election uuid se =
             let%lwt public_key = KG.prove private_key in
             return (None, [public_key], `KEY private_key)
          | _ :: _ ->
+            let private_key =
+              List.fold_left (fun accu {st_private_key; _} ->
+                  match st_private_key with
+                  | Some x -> x :: accu
+                  | None -> accu
+                ) [] se.se_public_keys
+            in
+            let private_key = match private_key with
+              | [] -> `None
+              | [x] -> `KEY x
+              | _ -> failwith "multiple private keys"
+            in
             return (
                 Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys),
                 (List.map
@@ -129,7 +141,7 @@ let finalize_election uuid se =
                      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)
+                private_key)
        in
        let y = KG.combine (Array.of_list public_keys) in
        return (y, trustees, `PK public_keys, private_key)
@@ -223,7 +235,10 @@ let finalize_election uuid se =
   Ocsipersist.remove election_credtokens se.se_public_creds >>
   Lwt_list.iter_s
     (fun {st_token; _} ->
-      Ocsipersist.remove election_pktokens st_token)
+      if st_token <> "" then (
+        Ocsipersist.remove election_pktokens st_token
+      ) else return_unit
+    )
     se.se_public_keys >>
   (match se.se_threshold_trustees with
    | None -> return_unit
@@ -697,7 +712,7 @@ let () =
       with_setup_election uuid (fun se ->
           if is_email st_id then (
             let%lwt st_token = generate_token () in
-            let trustee = {st_id; st_token; st_public_key = ""} in
+            let trustee = {st_id; st_token; st_public_key = ""; st_private_key = None} in
             se.se_public_keys <- se.se_public_keys @ [trustee];
             let%lwt () = Ocsipersist.add election_pktokens st_token (raw_string_of_uuid uuid) in
             redir_preapply election_setup_trustees uuid ()
@@ -709,6 +724,23 @@ let () =
         )
     )
 
+let () =
+  Any.register ~service:election_setup_trustee_add_server
+    (fun uuid () ->
+      with_setup_election uuid (fun se ->
+          let st_id = "server" and st_token = "" in
+          let module G = (val Group.of_string se.se_group) in
+          let module K = Trustees.MakeSimple (G) (LwtRandom) in
+          let%lwt private_key = K.generate () in
+          let%lwt public_key = K.prove private_key in
+          let st_public_key = string_of_trustee_public_key G.write public_key in
+          let st_private_key = Some private_key in
+          let trustee = {st_id; st_token; st_public_key; st_private_key} in
+          se.se_public_keys <- se.se_public_keys @ [trustee];
+          redir_preapply election_setup_trustees uuid ()
+        )
+    )
+
 let () =
   Any.register ~service:election_setup_trustee_del
     (fun uuid index ->
@@ -722,7 +754,9 @@ let () =
           se.se_public_keys <- trustees;
           let%lwt () =
             Lwt_list.iter_s (fun {st_token; _} ->
-                Ocsipersist.remove election_pktokens st_token
+                if st_token <> "" then (
+                  Ocsipersist.remove election_pktokens st_token
+                ) else return_unit
               ) old
           in
           redir_preapply election_setup_trustees uuid ()
@@ -1022,17 +1056,27 @@ let () =
                     ) se_threshold_trustees >>
                   redir_preapply election_setup_threshold_trustees uuid ()
                | Some ts, None, Some pks when List.length ts = List.length pks ->
+                  let module G = (val Group.of_string se.se_group) in
+                  let module KG = Trustees.MakeSimple (G) (LwtRandom) in
                   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})
+                           let%lwt st_token, st_private_key, st_public_key =
+                             if st_id = "server" then (
+                               let%lwt private_key = KG.generate () in
+                               let%lwt public_key = KG.prove private_key in
+                               let public_key = string_of_trustee_public_key G.write public_key in
+                               return ("", Some private_key, public_key)
+                             ) else (
+                               let%lwt st_token = generate_token () in
+                               return (st_token, None, st_public_key)
+                             )
+                           in
+                           return {st_id; st_token; st_public_key; st_private_key})
                   in
                   let () =
                     (* check that imported keys are valid *)
-                    let module G = (val Group.of_string se.se_group : GROUP) in
-                    let module KG = Trustees.MakeSimple (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
@@ -1041,7 +1085,9 @@ let () =
                   in
                   se.se_public_keys <- se.se_public_keys @ trustees;
                   Lwt_list.iter_s (fun {st_token; _} ->
-                      Ocsipersist.add election_pktokens st_token uuid_s
+                      if st_token <> "" then (
+                        Ocsipersist.add election_pktokens st_token uuid_s
+                      ) else return_unit
                     ) trustees >>
                   redir_preapply election_setup_trustees uuid ()
                | _, _, _ ->
@@ -1532,21 +1578,31 @@ let () =
                  | None -> failwith "missing public keys and threshold parameters"
             in
             Web_persist.set_election_state uuid (`EncryptedTally (npks, nb, hash)) >>
-              (* compute partial decryption and release tally
-                 if the (single) key is known *)
-              let skfile = !spool_dir / raw_string_of_uuid uuid / "private_key.json" in
-              if npks = 1 && Sys.file_exists skfile then (
-                let%lwt sk = read_file skfile in
-                let sk = match sk with
-                  | Some [sk] -> number_of_string sk
-                  | _ -> failwith "several private keys are available"
-                in
-                let tally = encrypted_tally_of_string W.G.read tally in
-                let%lwt pd = E.compute_factor tally sk in
-                let pd = string_of_partial_decryption W.G.write pd in
-                Web_persist.set_partial_decryptions uuid [1, pd] >>
-                  handle_election_tally_release (uuid, ()) ()
-              ) else redir_preapply election_admin (uuid, ()) ()
+              let tally = encrypted_tally_of_string W.G.read tally in
+              let%lwt sk = Web_persist.get_private_key uuid in
+              match metadata.e_trustees with
+              | None ->
+                 (* no trustees: compute decryption and release tally *)
+                 let sk = match sk with
+                   | Some x -> x
+                   | None -> failwith "missing private key"
+                 in
+                 let%lwt pd = E.compute_factor tally sk in
+                 let pd = string_of_partial_decryption W.G.write pd in
+                 Web_persist.set_partial_decryptions uuid [1, pd]
+                 >> handle_election_tally_release (uuid, ()) ()
+              | Some ts ->
+                 Lwt_list.iteri_s (fun i t ->
+                     if t = "server" then (
+                       match%lwt Web_persist.get_private_key uuid with
+                       | Some k ->
+                          let%lwt pd = E.compute_factor tally k in
+                          let pd = string_of_partial_decryption W.G.write pd in
+                          Web_persist.set_partial_decryptions uuid [i+1, pd]
+                       | None -> return_unit (* dead end *)
+                     ) else return_unit
+                   ) ts
+                 >> redir_preapply election_admin (uuid, ()) ()
           ) else forbidden ()
         )
     )

src/web/web_templates.ml

@@ -540,6 +540,18 @@ let election_setup_trustees uuid se () =
         ]
       ) uuid
   in
+  let form_trustees_add_server =
+    match List.filter (fun {st_id; _} -> st_id = "server") se.se_public_keys with
+    | [] ->
+       post_form
+         ~service:election_setup_trustee_add_server
+         (fun () ->
+           [
+             string_input ~input_type:`Submit ~value:"Add the server" ()
+           ]
+         ) uuid
+    | _ -> pcdata ""
+  in
   let mk_form_trustee_del value =
     post_form
       ~service:election_setup_trustee_del
@@ -566,15 +578,23 @@ let election_setup_trustees uuid se () =
                  pcdata t.st_id;
                ];
                td [
+                   if t.st_token <> "" then (
                  let uri = rewrite_prefix @@ Eliom_uri.make_string_uri
                    ~absolute:true ~service:election_setup_trustee t.st_token
                  in
                  let body = Printf.sprintf mail_trustee_generation uri in
                  let subject = "Link to generate the decryption key" in
                  a_mailto ~dest:t.st_id ~subject ~body "Mail"
+                   ) else (
+                     pcdata "(server)"
+                   )
                ];
                td [
+                   if t.st_token <> "" then (
                    a ~service:election_setup_trustee [pcdata "Link"] t.st_token;
+                   ) else (
+                     pcdata "(server)"
+                   )
                ];
                td [
                  pcdata (if t.st_public_key = "" then "No" else "Yes");
@@ -601,6 +621,7 @@ let election_setup_trustees uuid se () =
                ]
            else pcdata "");
           form_trustees_add;
+          form_trustees_add_server;
         ]
     else pcdata ""
   in
@@ -1618,16 +1639,21 @@ let election_admin election metadata state get_tokens_decrypt () =
                | None -> uri, !server_mail
                | Some name -> name, name
              in
-             tr [
-               td [pcdata link_content];
-               td [
+             let mail, link =
+               if link_content = "server" then (
+                 pcdata "(server)",
+                 pcdata "(server)"
+               ) else (
                  let body = Printf.sprintf mail_trustee_tally uri in
                  let subject = "Link to tally the election" in
-                 a_mailto ~dest ~subject ~body "Mail"
-               ];
-               td [
-                   a ~service [pcdata "Link"] x;
-               ];
+                 a_mailto ~dest ~subject ~body "Mail",
+                 a ~service [pcdata "Link"] x
+               )
+             in
+             tr [
+               td [pcdata link_content];
+               td [mail];
+               td [link];
                td [
                  pcdata (if List.mem_assoc trustee_id pds then "Yes" else "No")
                ];