Commit 3eb71872 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Pretty interface for removing voters

parent 91a07230
......@@ -201,10 +201,16 @@ let uuid =
and to_string x = Uuidm.to_string x
in Eliom_parameter.user_type ~of_string ~to_string
type setup_voter = {
sv_id : string;
mutable sv_credential : bool;
mutable sv_password : bool;
}
type setup_election = {
mutable se_owner : user;
mutable se_group : string;
mutable se_voters : string list;
mutable se_voters : setup_voter list;
mutable se_questions : template;
mutable se_public_keys : (string * string ref) list;
mutable se_metadata : metadata;
......
......@@ -96,10 +96,16 @@ val uuid :
[ `One of Uuidm.t ] Eliom_parameter.param_name)
Eliom_parameter.params_type
type setup_voter = {
sv_id : string;
mutable sv_credential : bool;
mutable sv_password : bool;
}
type setup_election = {
mutable se_owner : user;
mutable se_group : string;
mutable se_voters : string list;
mutable se_voters : setup_voter list;
mutable se_questions : template;
mutable se_public_keys : (string * string ref) list;
mutable se_metadata : metadata;
......
......@@ -43,7 +43,8 @@ let election_setup_questions = service ~path:["setup"; "questions"] ~get_params:
let election_setup_questions_post = post_coservice ~fallback:election_setup_questions ~post_params:(string "questions") ()
let election_setup_description = post_coservice ~fallback:election_setup ~post_params:(string "name" ** string "description") ()
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_voters_add = post_service ~fallback:election_setup_voters ~post_params:(string "voters") ()
let election_setup_voters_remove = post_service ~fallback:election_setup_voters ~post_params:(string "voter") ()
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_credential_authority = service ~path:["setup"; "credential-authority"] ~get_params:(uuid "uuid") ()
......
......@@ -521,7 +521,10 @@ let () =
(uuid, ()) |> rewrite_prefix
in
let table = Ocsipersist.open_table table in
Lwt_list.iter_s (generate_password table title url) se.se_voters >>
Lwt_list.iter_s (fun id ->
generate_password table title url id.sv_id >>
return (id.sv_password <- true)
) se.se_voters >>
return (fun () ->
T.generic_page ~title:"Success"
"Passwords have been generated and mailed!" () >>= Html5.send)))
......@@ -611,7 +614,7 @@ let is_email x =
let () =
Any.register
~service:election_setup_voters_post
~service:election_setup_voters_add
(handle_setup
(fun se x _ uuid ->
let xs = Pcre.split x in
......@@ -621,8 +624,20 @@ let () =
Printf.ksprintf failwith "%S is not a valid address" bad
with Not_found -> ()
in
se.se_voters <- xs;
return (redir_preapply election_setup uuid)))
se.se_voters <- se.se_voters @ List.map (fun sv_id ->
{sv_id; sv_credential=false; sv_password=false}
) xs;
return (redir_preapply election_setup_voters uuid)))
let () =
Any.register
~service:election_setup_voters_remove
(handle_setup
(fun se voter _ uuid ->
se.se_voters <- List.filter (fun v ->
v.sv_id <> voter
) se.se_voters;
return (redir_preapply election_setup_voters uuid)))
let () =
Redirection.register
......@@ -816,8 +831,8 @@ let () =
let module S = Set.Make (PString) in
let module G = (val Group.of_string se.se_group : GROUP) in
lwt creds =
Lwt_list.fold_left_s (fun accu identity ->
let email, login = split_identity identity in
Lwt_list.fold_left_s (fun accu v ->
let email, login = split_identity v.sv_id in
lwt cred = Credgen.generate () in
let priv_cred = derive_cred uuid cred in
let pub_cred =
......@@ -828,6 +843,7 @@ 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
......@@ -940,7 +956,7 @@ let () =
in
create_file files.f_election (string_of_params (write_wrapped_pubkey G.write_group G.write)) [params] >>
create_file files.f_metadata string_of_metadata [se.se_metadata] >>
create_file files.f_voters (fun x -> x) se.se_voters >>
create_file files.f_voters (fun x -> x.sv_id) se.se_voters >>
create_file files.f_public_keys (string_of_trustee_public_key G.write) public_keys >>
(* actually create the election *)
begin match_lwt import_election files with
......
......@@ -587,17 +587,61 @@ let election_setup_voters uuid se () =
let title = "Voters for election " ^ se.se_questions.t_name in
let form =
post_form
~service:election_setup_voters_post
~service:election_setup_voters_add
(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" ()]])
div [textarea ~a:[a_rows 20; a_cols 50] ~name ()];
div [string_input ~input_type:`Submit ~value:"Add" ()]])
uuid
in
let mk_remove_button id =
post_form
~service:election_setup_voters_remove
(fun name ->
[
string_input ~input_type:`Hidden ~name ~value:id ();
string_input ~input_type:`Submit ~value:"Remove" ();
]
) uuid
in
let to_string x = if x then "Yes" else "No" in
let voters =
List.map (fun v ->
tr [
td [pcdata v.sv_id];
td [pcdata (to_string v.sv_credential)];
td [pcdata (to_string v.sv_password)];
td [mk_remove_button v.sv_id];
]
) se.se_voters
in
let voters =
match voters with
| [] -> div [pcdata "No voters"]
| _ :: _ ->
table
(tr [
th [pcdata "Identity"];
th [pcdata "Credential"];
th [pcdata "Password"];
th [pcdata "Remove"];
])
voters
in
let back = div [
a ~service:Web_services.election_setup [pcdata "Return to setup page"] uuid;
] in
let content = [
div [pcdata "Please enter the email addresses of the voters, one per line."];
voters;
back;
div [pcdata "Please enter the identities of voters to add, one per line:"];
form;
div [
b [pcdata "Note:"];
pcdata " An identity is either an e-mail address, or \"address,login\",";
pcdata " where \"address\" is an e-mail address and \"login\" the";
pcdata " associated login for authentication.";
];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
......@@ -651,7 +695,7 @@ let election_setup_credentials token uuid se () =
in
let voters =
let name : 'a Eliom_parameter.param_name = Obj.magic "voters" in
let value = String.concat "\n" se.se_voters in
let value = String.concat "\n" (List.map (fun x -> x.sv_id) se.se_voters) in
div [
div [pcdata "List of voters:"];
div [textarea ~a:[a_id "voters"; a_rows 5; a_cols 40; a_readonly `ReadOnly] ~name ~value ()];
......
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