Allow only one submission of public credentials

src/web/web_common.ml

@@ -203,7 +203,6 @@ let uuid =
 
 type setup_voter = {
   sv_id : string;
-  mutable sv_credential : bool;
   mutable sv_password : bool;
 }
 
@@ -215,6 +214,7 @@ type setup_election = {
   mutable se_public_keys : (string * string ref) list;
   mutable se_metadata : metadata;
   mutable se_public_creds : string;
+  mutable se_public_creds_received : bool;
 }
 
 let b58_digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"

src/web/web_common.mli

@@ -98,7 +98,6 @@ val uuid :
 
 type setup_voter = {
   sv_id : string;
-  mutable sv_credential : bool;
   mutable sv_password : bool;
 }
 
@@ -110,6 +109,7 @@ type setup_election = {
   mutable se_public_keys : (string * string ref) list;
   mutable se_metadata : metadata;
   mutable se_public_creds : string;
+  mutable se_public_creds_received : bool;
 }
 
 val generate_token : unit -> string Lwt.t

src/web/web_site.ml

@@ -361,6 +361,7 @@ let create_new_election owner cred auth =
     se_public_keys = [];
     se_metadata;
     se_public_creds = token;
+    se_public_creds_received = false;
   } in
   lwt () = Ocsipersist.add election_stable uuid_s se in
   lwt () = Ocsipersist.add election_credtokens token uuid_s in
@@ -650,7 +651,7 @@ let () =
            with Not_found -> ()
          in
          se.se_voters <- se.se_voters @ List.map (fun sv_id ->
-           {sv_id; sv_credential=false; sv_password=false}
+           {sv_id; sv_password=false}
          ) xs;
          return (redir_preapply election_setup_voters uuid)))
 
@@ -734,6 +735,7 @@ let wrap_handler f =
 let handle_credentials_post token creds =
   lwt uuid = Ocsipersist.find election_credtokens token in
   lwt se = Ocsipersist.find election_stable uuid in
+  if se.se_public_creds_received then forbidden () else
   let module G = (val Group.of_string se.se_group : GROUP) in
   let fname = !spool_dir / uuid ^ ".public_creds.txt" in
   Lwt_mutex.with_lock
@@ -757,6 +759,8 @@ let handle_credentials_post token creds =
       (Lwt_io.lines_of_file fname)
   in
   let () = se.se_metadata <- {se.se_metadata with e_cred_authority = None} in
+  let () = se.se_public_creds_received <- true in
+  Ocsipersist.add election_stable uuid se >>
   T.generic_page ~title:"Success"
     "Credentials have been received and checked!" () >>= Html5.send
 
@@ -843,6 +847,7 @@ let () =
   Any.register
     ~service:election_setup_credentials_server
     (handle_setup (fun se () _ uuid ->
+      if se.se_public_creds_received then forbidden () else
       let () = se.se_metadata <- {se.se_metadata with
         e_cred_authority = Some "server"
       } in
@@ -868,7 +873,6 @@ let () =
           let body = Printf.sprintf template_credential title login cred url in
           let subject = "Your credential for election " ^ title in
           lwt () = send_email "noreply@belenios.org" email subject body in
-          v.sv_credential <- true;
           return @@ S.add pub_cred accu
         ) S.empty se.se_voters
       in
@@ -881,6 +885,7 @@ let () =
             (fun oc ->
               Lwt_list.iter_s (Lwt_io.write_line oc) creds)
       in
+      se.se_public_creds_received <- true;
       return (fun () ->
         T.generic_page ~title:"Success"
           "Credentials have been generated and mailed!" () >>= Html5.send)))

src/web/web_templates.ml

@@ -438,15 +438,21 @@ let election_setup uuid se () =
   let div_credentials =
     div [
       h2 [pcdata "Credentials"];
-      if has_credentials then (
-        post_form ~service:election_setup_credentials_server
-          (fun () ->
-            [string_input ~input_type:`Submit ~value:"Generate on server" ()]
-          ) uuid
-      ) else (
+      if se.se_public_creds_received then (
         div [
-          a ~service:election_setup_credential_authority [pcdata "Credential management"] uuid;
+          pcdata "Credentials have already been generated!"
         ]
+      ) else (
+        if has_credentials then (
+          post_form ~service:election_setup_credentials_server
+            (fun () ->
+              [string_input ~input_type:`Submit ~value:"Generate on server" ()]
+            ) uuid
+        ) else (
+          div [
+            a ~service:election_setup_credential_authority [pcdata "Credential management"] uuid;
+          ]
+        )
       )
     ]
   in
@@ -608,10 +614,6 @@ let election_setup_voters uuid se () =
         ]
       ) uuid
   in
-  let has_credentials = match se.se_metadata.e_cred_authority with
-    | None -> false
-    | Some _ -> true
-  in
   let has_passwords = match se.se_metadata.e_auth_config with
     | Some [{auth_system = "password"; _}] -> true
     | _ -> false
@@ -621,7 +623,6 @@ let election_setup_voters uuid se () =
     List.map (fun v ->
       tr (
         [td [pcdata v.sv_id]] @
-        (if has_credentials then [td [pcdata (to_string v.sv_credential)]] else []) @
         (if has_passwords then [td [pcdata (to_string v.sv_password)]] else []) @
         [td [mk_remove_button v.sv_id]]
       )
@@ -634,7 +635,6 @@ let election_setup_voters uuid se () =
        table
          (tr (
            [th [pcdata "Identity"]] @
-           (if has_credentials then [th [pcdata "Credential"]] else []) @
            (if has_passwords then [th [pcdata "Password"]] else []) @
            [th [pcdata "Remove"]]
          ))
@@ -725,11 +725,18 @@ let election_setup_credentials token uuid se () =
       ]
   in
   let div_textarea = div [group; voters; interactivity; form_textarea; disclaimer] in
-  let content = [
-    div_download;
-    div_textarea;
-    form_file;
-  ] in
+  let content =
+    if se.se_public_creds_received then (
+      [
+        div [pcdata "Credentials have already been generated!"];
+      ]
+    ) else (
+      [
+        div_download;
+        div_textarea;
+        form_file;
+      ]
+    ) in
   let login_box = pcdata "" in
   base ~title ~login_box ~content ()