Commit 83942945 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Setup mode: add a voter list

parent 2fe96be8
......@@ -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;
......
......@@ -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;
......
......@@ -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") ()
......
......@@ -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
......
......@@ -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 =
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment