Setup mode: add a voter list

src/web/web_common.ml

@@ -204,6 +204,7 @@ let uuid =
 type setup_election = {
   mutable se_owner : user;
   mutable se_group : string;
+  mutable se_voters : string list;
   mutable se_questions : template;
   mutable se_public_keys : (string * string ref) list;
   mutable se_metadata : metadata;

src/web/web_common.mli

@@ -97,6 +97,7 @@ val uuid :
 type setup_election = {
   mutable se_owner : user;
   mutable se_group : string;
+  mutable se_voters : string list;
   mutable se_questions : template;
   mutable se_public_keys : (string * string ref) list;
   mutable se_metadata : metadata;

src/web/web_services.ml

@@ -44,6 +44,8 @@ let election_setup_group = post_coservice ~fallback:election_setup ~post_params:
 let election_setup_metadata = post_coservice ~fallback:election_setup ~post_params:(string "metadata") ()
 let election_setup_questions = service ~path:["setup"; "questions"] ~get_params:(uuid "uuid") ()
 let election_setup_questions_post = post_coservice ~fallback:election_setup_questions ~post_params:(string "questions") ()
+let election_setup_voters = service ~path:["setup"; "voters"] ~get_params:(uuid "uuid") ()
+let election_setup_voters_post = post_service ~fallback:election_setup_voters ~post_params:(string "voters") ()
 let election_setup_trustee_add = post_coservice ~fallback:election_setup ~post_params:unit ()
 let election_setup_trustee_del = post_coservice ~fallback:election_setup ~post_params:unit ()
 let election_setup_credentials = service ~path:["setup"; "credentials"] ~get_params:(string "token") ()

src/web/web_site.ml

@@ -355,6 +355,7 @@ let () = Redirection.register ~service:election_setup_new
       let se = {
         se_owner = u;
         se_group = "{\"g\":\"14887492224963187634282421537186040801304008017743492304481737382571933937568724473847106029915040150784031882206090286938661464458896494215273989547889201144857352611058572236578734319505128042602372864570426550855201448111746579871811249114781674309062693442442368697449970648232621880001709535143047913661432883287150003429802392229361583608686643243349727791976247247948618930423866180410558458272606627111270040091203073580238905303994472202930783207472394578498507764703191288249547659899997131166130259700604433891232298182348403175947450284433411265966789131024573629546048637848902243503970966798589660808533\",\"p\":\"16328632084933010002384055033805457329601614771185955389739167309086214800406465799038583634953752941675645562182498120750264980492381375579367675648771293800310370964745767014243638518442553823973482995267304044326777047662957480269391322789378384619428596446446984694306187644767462460965622580087564339212631775817895958409016676398975671266179637898557687317076177218843233150695157881061257053019133078545928983562221396313169622475509818442661047018436264806901023966236718367204710755935899013750306107738002364137917426595737403871114187750804346564731250609196846638183903982387884578266136503697493474682071\",\"q\":\"61329566248342901292543872769978950870633559608669337131139375508370458778917\"}";
+        se_voters = [];
         se_questions;
         se_public_keys = [];
         se_metadata;
@@ -436,6 +437,43 @@ let () =
        (fun se x _ ->
         se.se_questions <- template_of_string x) election_setup_questions)
 
+let () =
+  Html5.register
+    ~service:election_setup_voters
+    (fun uuid () ->
+      match_lwt Web_site_auth.get_user () with
+      | Some u ->
+         let uuid_s = Uuidm.to_string uuid in
+         lwt se = Ocsipersist.find election_stable uuid_s in
+         if se.se_owner = u
+         then T.election_setup_voters uuid se (module Web_site_auth : AUTH_SERVICES) ()
+         else forbidden ()
+      | None -> forbidden ()
+    )
+
+(* see http://www.regular-expressions.info/email.html *)
+let email_rex = Pcre.regexp
+  ~flags:[`CASELESS]
+  "^[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,7}$"
+
+let is_email x =
+  try ignore (Pcre.pcre_exec ~rex:email_rex x); true
+  with Not_found -> false
+
+let () =
+  Any.register
+    ~service:election_setup_voters_post
+    (handle_setup
+       (fun se x _ ->
+         let xs = Pcre.split x in
+         let () =
+           try
+             let bad = List.find (fun x -> not (is_email x)) xs in
+             Printf.ksprintf failwith "%S is not a valid address" bad
+           with Not_found -> ()
+         in
+         se.se_voters <- xs) election_setup)
+
 let () =
   Redirection.register
     ~service:election_setup_trustee_add

src/web/web_templates.ml

@@ -304,6 +304,18 @@ let election_setup uuid se auth () =
       (fun () ->
         [string_input ~input_type:`Submit ~value:"Delete" ()]) uuid
   in
+  let div_voters =
+    div [
+      h2 [pcdata "Voters"];
+      div [
+        pcdata @@ string_of_int @@ List.length se.se_voters;
+        pcdata " voter(s) registered";
+      ];
+      a ~service:election_setup_voters
+        [pcdata "Manage voters"]
+        uuid
+    ]
+  in
   let div_trustees =
     div [
       h2 [pcdata "Trustees"];
@@ -352,6 +364,7 @@ let election_setup uuid se auth () =
       ) uuid
   in
   let content = [
+    div_voters;
     div_trustees;
     div_credentials;
     form_group;
@@ -398,6 +411,24 @@ let election_setup_questions uuid se auth () =
   lwt login_box = site_login_box auth () in
   base ~title ~login_box ~content ()
 
+let election_setup_voters uuid se auth () =
+  let title = "Voters for election " ^ Uuidm.to_string uuid in
+  let form =
+    post_form
+      ~service:election_setup_voters_post
+      (fun name ->
+        let value = String.concat "\n" se.se_voters in
+        [
+          div [textarea ~a:[a_rows 20; a_cols 50] ~name ~value ()];
+          div [string_input ~input_type:`Submit ~value:"Submit" ()]])
+      uuid
+  in
+  let content = [
+    form
+  ] in
+  lwt login_box = site_login_box auth () in
+  base ~title ~login_box ~content ()
+
 let election_setup_credentials token uuid se () =
   let title = "Credentials for election " ^ uuid in
   let form_textarea =

src/web/web_templates.mli

@@ -30,6 +30,7 @@ val new_election_failure : [ `Exists | `Exception of exn ] -> (module AUTH_SERVI
 val generic_page : title:string -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 
 val election_setup : Uuidm.t -> Web_common.setup_election -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
+val election_setup_voters : Uuidm.t -> Web_common.setup_election -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 val election_setup_questions : Uuidm.t -> Web_common.setup_election -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 val election_setup_credentials : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 val election_setup_trustee : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t