Une nouvelle version du portail de gestion des comptes externes sera mise en production lundi 09 août. Elle permettra d'allonger la validité d'un compte externe jusqu'à 3 ans. Pour plus de détails sur cette version consulter : https://doc-si.inria.fr/x/FCeS

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

Templates don't need groups

parent cad131a8
...@@ -61,12 +61,12 @@ let raw_find_election uuid = ...@@ -61,12 +61,12 @@ let raw_find_election uuid =
let%lwt raw_election = Web_persist.get_raw_election uuid in let%lwt raw_election = Web_persist.get_raw_election uuid in
match raw_election with match raw_election with
| Some raw_election -> | Some raw_election ->
return Election.(get_group (of_string raw_election)) return (Election.of_string raw_election)
| _ -> Lwt.fail Not_found | _ -> Lwt.fail Not_found
module WCacheTypes = struct module WCacheTypes = struct
type key = uuid type key = uuid
type value = (module ELECTION_DATA) type value = Yojson.Safe.json election
end end
module WCache = Ocsigen_cache.Make (WCacheTypes) module WCache = Ocsigen_cache.Make (WCacheTypes)
...@@ -570,13 +570,12 @@ let () = ...@@ -570,13 +570,12 @@ let () =
Any.register ~service:election_regenpwd_post Any.register ~service:election_regenpwd_post
(fun (uuid, ()) user -> (fun (uuid, ()) user ->
with_site_user (fun u -> with_site_user (fun u ->
let%lwt w = find_election uuid in let%lwt election = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in let%lwt metadata = Web_persist.get_election_metadata uuid in
let module W = (val w) in
if metadata.e_owner = Some u then ( if metadata.e_owner = Some u then (
let table = "password_" ^ underscorize uuid in let table = "password_" ^ underscorize uuid in
let table = Ocsipersist.open_table table in let table = Ocsipersist.open_table table in
let title = W.election.e_params.e_name in let title = election.e_params.e_name in
let url = Eliom_uri.make_string_uri let url = Eliom_uri.make_string_uri
~absolute:true ~service:election_home ~absolute:true ~service:election_home
(uuid, ()) |> rewrite_prefix (uuid, ()) |> rewrite_prefix
...@@ -1170,9 +1169,9 @@ let () = ...@@ -1170,9 +1169,9 @@ let () =
Any.register ~service:election_update_credential_post Any.register ~service:election_update_credential_post
(fun (uuid, ()) (old, new_) -> (fun (uuid, ()) (old, new_) ->
with_site_user (fun u -> with_site_user (fun u ->
let%lwt w = find_election uuid in let%lwt election = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in let%lwt metadata = Web_persist.get_election_metadata uuid in
let module W = (val w) in let module W = (val Election.get_group election) in
let module WE = Web_election.Make (W) (LwtRandom) in let module WE = Web_election.Make (W) (LwtRandom) in
if metadata.e_owner = Some u then ( if metadata.e_owner = Some u then (
try%lwt try%lwt
...@@ -1222,8 +1221,8 @@ let () = ...@@ -1222,8 +1221,8 @@ let () =
let () = let () =
Any.register ~service:election_cast_confirm Any.register ~service:election_cast_confirm
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let%lwt w = find_election uuid in let%lwt election = find_election uuid in
let module W = (val w) in let module W = (val Election.get_group election) in
let module WE = Web_election.Make (W) (LwtRandom) in let module WE = Web_election.Make (W) (LwtRandom) in
match%lwt Eliom_reference.get Web_state.ballot with match%lwt Eliom_reference.get Web_state.ballot with
| Some the_ballot -> | Some the_ballot ->
...@@ -1363,8 +1362,8 @@ let () = ...@@ -1363,8 +1362,8 @@ let () =
let%lwt () = let%lwt () =
if trustee_id > 0 then return () else fail_http 404 if trustee_id > 0 then return () else fail_http 404
in in
let%lwt w = find_election uuid in let%lwt election = find_election uuid in
let module W = (val w) in let module W = (val Election.get_group election) in
let module E = Election.MakeElection (W.G) (LwtRandom) in let module E = Election.MakeElection (W.G) (LwtRandom) in
let%lwt pks = let%lwt pks =
match%lwt Web_persist.get_threshold uuid with match%lwt Web_persist.get_threshold uuid with
...@@ -1400,9 +1399,9 @@ let () = ...@@ -1400,9 +1399,9 @@ let () =
let handle_election_tally_release (uuid, ()) () = let handle_election_tally_release (uuid, ()) () =
with_site_user (fun u -> with_site_user (fun u ->
let uuid_s = raw_string_of_uuid uuid in let uuid_s = raw_string_of_uuid uuid in
let%lwt w = find_election uuid in let%lwt election = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in let%lwt metadata = Web_persist.get_election_metadata uuid in
let module W = (val w) in let module W = (val Election.get_group election) in
let module E = Election.MakeElection (W.G) (LwtRandom) in let module E = Election.MakeElection (W.G) (LwtRandom) in
if metadata.e_owner = Some u then ( if metadata.e_owner = Some u then (
let%lwt npks, ntallied = let%lwt npks, ntallied =
...@@ -1503,9 +1502,9 @@ let () = ...@@ -1503,9 +1502,9 @@ let () =
Any.register ~service:election_compute_encrypted_tally Any.register ~service:election_compute_encrypted_tally
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
with_site_user (fun u -> with_site_user (fun u ->
let%lwt w = find_election uuid in let%lwt election = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in let%lwt metadata = Web_persist.get_election_metadata uuid in
let module W = (val w) in let module W = (val Election.get_group election) in
let module WE = Web_election.Make (W) (LwtRandom) in let module WE = Web_election.Make (W) (LwtRandom) in
if metadata.e_owner = Some u then ( if metadata.e_owner = Some u then (
let%lwt () = let%lwt () =
......
...@@ -160,8 +160,7 @@ let base ~title ?login_box ~content ?(footer = div []) ?uuid () = ...@@ -160,8 +160,7 @@ let base ~title ?login_box ~content ?(footer = div []) ?uuid () =
])) ]))
let format_election election = let format_election election =
let module W = (val election : ELECTION_DATA) in let e = election.e_params in
let e = W.election.e_params in
let service = election_admin in let service = election_admin in
li [ li [
a ~service [pcdata e.e_name] (e.e_uuid, ()); a ~service [pcdata e.e_name] (e.e_uuid, ());
...@@ -1183,9 +1182,8 @@ let election_setup_threshold_trustee token uuid se () = ...@@ -1183,9 +1182,8 @@ let election_setup_threshold_trustee token uuid se () =
let election_setup_importer ~service ~title uuid (elections, tallied, archived) () = let election_setup_importer ~service ~title uuid (elections, tallied, archived) () =
let format_election election = let format_election election =
let module W = (val election : ELECTION_DATA) in let name = election.e_params.e_name in
let name = W.election.e_params.e_name in let uuid_s = raw_string_of_uuid election.e_params.e_uuid in
let uuid_s = raw_string_of_uuid W.election.e_params.e_uuid in
let form = post_form ~service let form = post_form ~service
(fun from -> (fun from ->
[ [
...@@ -1194,7 +1192,7 @@ let election_setup_importer ~service ~title uuid (elections, tallied, archived) ...@@ -1194,7 +1192,7 @@ let election_setup_importer ~service ~title uuid (elections, tallied, archived)
user_type_input raw_string_of_uuid user_type_input raw_string_of_uuid
~input_type:`Hidden ~input_type:`Hidden
~name:from ~name:from
~value:W.election.e_params.e_uuid (); ~value:election.e_params.e_uuid ();
string_input ~input_type:`Submit ~value:"Import from this election" (); string_input ~input_type:`Submit ~value:"Import from this election" ();
] ]
] ]
...@@ -1316,45 +1314,38 @@ let election_setup_confirm uuid se () = ...@@ -1316,45 +1314,38 @@ let election_setup_confirm uuid se () =
let%lwt login_box = site_login_box () in let%lwt login_box = site_login_box () in
base ~title ?login_box ~content () base ~title ?login_box ~content ()
let election_login_box w = let election_login_box uuid =
let module W = (val w : ELECTION_DATA) in
let module A = struct let module A = struct
let get_user () = let get_user () =
Web_state.get_election_user W.election.e_params.e_uuid Web_state.get_election_user uuid
let get_auth_systems () = let get_auth_systems () =
let%lwt l = Web_persist.get_auth_config (Some W.election.e_params.e_uuid) in let%lwt l = Web_persist.get_auth_config (Some uuid) in
return @@ List.map fst l return @@ List.map fst l
end in end in
let auth = (module A : AUTH_SERVICES) in let auth = (module A : AUTH_SERVICES) in
let module L = struct let module L = struct
let login x = let login x =
Eliom_service.preapply Eliom_service.preapply election_login ((uuid, ()), x)
election_login
((W.election.e_params.e_uuid, ()), x)
let logout = let logout =
Eliom_service.preapply logout () Eliom_service.preapply logout ()
end in end in
let links = (module L : AUTH_LINKS) in let links = (module L : AUTH_LINKS) in
fun () -> make_login_box ~site:false auth links fun () -> make_login_box ~site:false auth links
let file w x = let file uuid x = Eliom_service.preapply election_dir (uuid, x)
let module W = (val w : ELECTION_DATA) in
Eliom_service.preapply
election_dir
(W.election.e_params.e_uuid, x)
let audit_footer w = let audit_footer election =
let uuid = election.e_params.e_uuid in
let%lwt language = Eliom_reference.get Web_state.language in let%lwt language = Eliom_reference.get Web_state.language in
let module L = (val Web_i18n.get_lang language) in let module L = (val Web_i18n.get_lang language) in
let module W = (val w : ELECTION_DATA) in
let%lwt pk_or_tp = let%lwt pk_or_tp =
match%lwt Web_persist.get_threshold W.election.e_params.e_uuid with match%lwt Web_persist.get_threshold election.e_params.e_uuid with
| None -> | None ->
return (a ~service:(file w ESKeys) [ return (a ~service:(file uuid ESKeys) [
pcdata L.trustee_public_keys pcdata L.trustee_public_keys
] ()) ] ())
| Some _ -> | Some _ ->
return (a ~service:(file w ESTParams) [ return (a ~service:(file uuid ESTParams) [
pcdata "threshold parameters" pcdata "threshold parameters"
] ()) ] ())
in in
...@@ -1362,21 +1353,21 @@ let audit_footer w = ...@@ -1362,21 +1353,21 @@ let audit_footer w =
div [ div [
div [ div [
pcdata L.election_fingerprint; pcdata L.election_fingerprint;
code [ pcdata W.election.e_fingerprint ]; code [ pcdata election.e_fingerprint ];
]; ];
div [ div [
pcdata L.audit_data; pcdata L.audit_data;
a ~service:(file w ESRaw) [ a ~service:(file uuid ESRaw) [
pcdata L.parameters pcdata L.parameters
] (); ] ();
pcdata ", "; pcdata ", ";
pk_or_tp; pk_or_tp;
pcdata ", "; pcdata ", ";
a ~service:(file w ESCreds) [ a ~service:(file uuid ESCreds) [
pcdata L.public_credentials pcdata L.public_credentials
] (); ] ();
pcdata ", "; pcdata ", ";
a ~service:(file w ESBallots) [ a ~service:(file uuid ESBallots) [
pcdata L.ballots pcdata L.ballots
] (); ] ();
pcdata "."; pcdata ".";
...@@ -1388,11 +1379,11 @@ let rec list_concat elt = function ...@@ -1388,11 +1379,11 @@ let rec list_concat elt = function
| x :: ((_ :: _) as xs) -> x :: elt :: (list_concat elt xs) | x :: ((_ :: _) as xs) -> x :: elt :: (list_concat elt xs)
| ([_] | []) as xs -> xs | ([_] | []) as xs -> xs
let election_home w state () = let election_home election state () =
let%lwt language = Eliom_reference.get Web_state.language in let%lwt language = Eliom_reference.get Web_state.language in
let module L = (val Web_i18n.get_lang language) in let module L = (val Web_i18n.get_lang language) in
let module W = (val w : ELECTION_DATA) in let params = election.e_params in
let params = W.election.e_params in let uuid = params.e_uuid in
let state_ = let state_ =
match state with match state with
| `Closed -> | `Closed ->
...@@ -1409,7 +1400,7 @@ let election_home w state () = ...@@ -1409,7 +1400,7 @@ let election_home w state () =
a a
~service:election_dir ~service:election_dir
[pcdata L.encrypted_tally] [pcdata L.encrypted_tally]
(W.election.e_params.e_uuid, ESETally); (uuid, ESETally);
pcdata L.hash_is; pcdata L.hash_is;
b [pcdata hash]; b [pcdata hash];
pcdata "."; pcdata ".";
...@@ -1431,10 +1422,10 @@ let election_home w state () = ...@@ -1431,10 +1422,10 @@ let election_home w state () =
~a:[a_style "font-size:25px;"] ~a:[a_style "font-size:25px;"]
~service:election_pretty_ballots [ ~service:election_pretty_ballots [
pcdata L.see_accepted_ballots pcdata L.see_accepted_ballots
] (params.e_uuid, ()) ] (uuid, ())
] ]
in in
let%lwt footer = audit_footer w in let%lwt footer = audit_footer election in
let go_to_the_booth = let go_to_the_booth =
let disabled = match state with let disabled = match state with
| `Open -> false | `Open -> false
...@@ -1443,22 +1434,22 @@ let election_home w state () = ...@@ -1443,22 +1434,22 @@ let election_home w state () =
div ~a:[a_style "text-align:center;"] [ div ~a:[a_style "text-align:center;"] [
div [ div [
make_button make_button
~service:(Eliom_service.preapply election_vote (params.e_uuid, ())) ~service:(Eliom_service.preapply election_vote (uuid, ()))
~disabled L.start; ~disabled L.start;
]; ];
div [ div [
a a
~service:(Eliom_service.preapply election_cast (params.e_uuid, ())) ~service:(Eliom_service.preapply election_cast (uuid, ()))
[pcdata L.advanced_mode] (); [pcdata L.advanced_mode] ();
]; ];
] ]
in in
let%lwt middle = let%lwt middle =
let%lwt result = Web_persist.get_election_result params.e_uuid in let%lwt result = Web_persist.get_election_result uuid in
match result with match result with
| Some r -> | Some r ->
let result = r.result in let result = r.result in
let questions = Array.to_list W.election.e_params.e_questions in let questions = Array.to_list election.e_params.e_questions in
return @@ div [ return @@ div [
ul (List.mapi (fun i x -> ul (List.mapi (fun i x ->
let answers = Array.to_list x.q_answers in let answers = Array.to_list x.q_answers in
...@@ -1490,7 +1481,7 @@ let election_home w state () = ...@@ -1490,7 +1481,7 @@ let election_home w state () =
pcdata L.you_can_also_download; pcdata L.you_can_also_download;
a ~service:election_dir a ~service:election_dir
[pcdata L.result_with_crypto_proofs] [pcdata L.result_with_crypto_proofs]
(W.election.e_params.e_uuid, ESResult); (uuid, ESResult);
pcdata "."; pcdata ".";
]; ];
] ]
...@@ -1522,8 +1513,7 @@ let election_home w state () = ...@@ -1522,8 +1513,7 @@ let election_home w state () =
br (); br ();
ballots_link; ballots_link;
] in ] in
let%lwt login_box = election_login_box w () in let%lwt login_box = election_login_box uuid () in
let uuid = params.e_uuid in
base ~title:params.e_name ?login_box ~content ~footer ~uuid () base ~title:params.e_name ?login_box ~content ~footer ~uuid ()
let mail_trustee_tally : ('a, 'b, 'c, 'd, 'e, 'f) format6 = let mail_trustee_tally : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
...@@ -1544,9 +1534,9 @@ Thank you again for your help, ...@@ -1544,9 +1534,9 @@ Thank you again for your help,
-- \nThe election administrator." -- \nThe election administrator."
let election_admin w metadata state get_tokens_decrypt () = let election_admin election metadata state get_tokens_decrypt () =
let module W = (val w : ELECTION_DATA) in let uuid = election.e_params.e_uuid in
let title = W.election.e_params.e_name ^ " — Administration" in let title = election.e_params.e_name ^ " — Administration" in
let state_form checked = let state_form checked =
let service, value, msg = let service, value, msg =
if checked then if checked then
...@@ -1562,7 +1552,7 @@ let election_admin w metadata state get_tokens_decrypt () = ...@@ -1562,7 +1552,7 @@ let election_admin w metadata state get_tokens_decrypt () =
[ [
pcdata msg; pcdata msg;
string_input ~input_type:`Submit ~value (); string_input ~input_type:`Submit ~value ();
]) (W.election.e_params.e_uuid, ()) ]) (uuid, ())
in in
let%lwt state_div = let%lwt state_div =
match state with match state with
...@@ -1582,15 +1572,15 @@ let election_admin w metadata state get_tokens_decrypt () = ...@@ -1582,15 +1572,15 @@ let election_admin w metadata state get_tokens_decrypt () =
~value:"Tally election" ~value:"Tally election"
(); ();
pcdata " Warning: this action is irreversible; the election will be definitively closed."; pcdata " Warning: this action is irreversible; the election will be definitively closed.";
]) (W.election.e_params.e_uuid, ()); ]) (uuid, ());
] ]
| `EncryptedTally (npks, _, hash) -> | `EncryptedTally (npks, _, hash) ->
let%lwt pds = Web_persist.get_partial_decryptions W.election.e_params.e_uuid in let%lwt pds = Web_persist.get_partial_decryptions uuid in
let%lwt tp = Web_persist.get_threshold W.election.e_params.e_uuid in let%lwt tp = Web_persist.get_threshold uuid in
let tp = let tp =
match tp with match tp with
| None -> None | None -> None
| Some tp -> Some (threshold_parameters_of_string W.G.read tp) | Some tp -> Some (threshold_parameters_of_string Yojson.Safe.read_json tp)
in in
let threshold_or_not = let threshold_or_not =
match tp with match tp with
...@@ -1620,7 +1610,7 @@ let election_admin w metadata state get_tokens_decrypt () = ...@@ -1620,7 +1610,7 @@ let election_admin w metadata state get_tokens_decrypt () =
List.map List.map
(fun ((name, trustee_id), token) -> (fun ((name, trustee_id), token) ->
let service = election_tally_trustees in let service = election_tally_trustees in
let x = (W.election.e_params.e_uuid, ((), token)) in let x = (uuid, ((), token)) in
let uri = rewrite_prefix @@ Eliom_uri.make_string_uri let uri = rewrite_prefix @@ Eliom_uri.make_string_uri
~absolute:true ~service x ~absolute:true ~service x
in in
...@@ -1652,7 +1642,7 @@ let election_admin w metadata state get_tokens_decrypt () = ...@@ -1652,7 +1642,7 @@ let election_admin w metadata state get_tokens_decrypt () =
~input_type:`Submit ~input_type:`Submit
~value:"Compute the result" ~value:"Compute the result"
() ()
]) (W.election.e_params.e_uuid, ()) ]) (uuid, ())
in in
return @@ div [ return @@ div [
div [ div [
...@@ -1660,7 +1650,7 @@ let election_admin w metadata state get_tokens_decrypt () = ...@@ -1660,7 +1650,7 @@ let election_admin w metadata state get_tokens_decrypt () =
a a
~service:election_dir ~service:election_dir
[pcdata "encrypted tally"] [pcdata "encrypted tally"]
(W.election.e_params.e_uuid, ESETally); (uuid, ESETally);
pcdata " has been computed. Its hash is "; pcdata " has been computed. Its hash is ";
b [pcdata hash]; b [pcdata hash];
pcdata "."; pcdata ".";
...@@ -1696,10 +1686,9 @@ let election_admin w metadata state get_tokens_decrypt () = ...@@ -1696,10 +1686,9 @@ let election_admin w metadata state get_tokens_decrypt () =
string_input ~input_type:`Submit ~value:"Archive election" (); string_input ~input_type:`Submit ~value:"Archive election" ();
pcdata " Warning: this action is irreversible. Archiving an election makes it read-only; in particular, the election will be definitively closed (no vote submission, no tally)."; pcdata " Warning: this action is irreversible. Archiving an election makes it read-only; in particular, the election will be definitively closed (no vote submission, no tally).";
] ]
) (W.election.e_params.e_uuid, ()); ) (uuid, ());
] ]
in in
let uuid = W.election.e_params.e_uuid in
let update_credential = let update_credential =
match metadata.e_cred_authority with match metadata.e_cred_authority with
| Some "server" -> | Some "server" ->
...@@ -1732,9 +1721,9 @@ let election_admin w metadata state get_tokens_decrypt () = ...@@ -1732,9 +1721,9 @@ let election_admin w metadata state get_tokens_decrypt () =
let%lwt login_box = site_login_box () in let%lwt login_box = site_login_box () in
base ~title ?login_box ~content () base ~title ?login_box ~content ()
let update_credential w () = let update_credential election () =
let module W = (val w : ELECTION_DATA) in let params = election.e_params in
let params = W.election.e_params in let uuid = params.e_uuid in
let form = post_form ~service:election_update_credential_post let form = post_form ~service:election_update_credential_post
(fun (old, new_) -> (fun (old, new_) ->
[ [
...@@ -1765,13 +1754,12 @@ let update_credential w () = ...@@ -1765,13 +1754,12 @@ let update_credential w () =
]; ];
p [string_input ~input_type:`Submit ~value:"Submit" ()]; p [string_input ~input_type:`Submit ~value:"Submit" ()];
] ]
) (params.e_uuid, ()) ) (uuid, ())
in in
let content = [ let content = [
form; form;
] in ] in
let%lwt login_box = site_login_box () in let%lwt login_box = site_login_box () in
let uuid = W.election.e_params.e_uuid in
base ~title:params.e_name ?login_box ~content ~uuid () base ~title:params.e_name ?login_box ~content ~uuid ()
let regenpwd uuid () = let regenpwd uuid () =
...@@ -1791,9 +1779,9 @@ let regenpwd uuid () = ...@@ -1791,9 +1779,9 @@ let regenpwd uuid () =
let%lwt login_box = site_login_box () in let%lwt login_box = site_login_box () in
base ~title ?login_box ~content ~uuid () base ~title ?login_box ~content ~uuid ()
let cast_raw w () = let cast_raw election () =
let module W = (val w : ELECTION_DATA) in let params = election.e_params in
let params = W.election.e_params in let uuid = params.e_uuid in
let form_rawballot = post_form ~service:election_cast_post let form_rawballot = post_form ~service:election_cast_post
(fun (name, _) -> (fun (name, _) ->
[ [
...@@ -1801,7 +1789,7 @@ let cast_raw w () = ...@@ -1801,7 +1789,7 @@ let cast_raw w () =
div [textarea ~a:[a_rows 10; a_cols 40] ~name ()]; div [textarea ~a:[a_rows 10; a_cols 40] ~name ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()]; div [string_input ~input_type:`Submit ~value:"Submit" ()];
] ]
) (params.e_uuid, ()) ) (uuid, ())
in in
let form_upload = post_form ~service:election_cast_post let form_upload = post_form ~service:election_cast_post
(fun (_, name) -> (fun (_, name) ->
...@@ -1813,7 +1801,7 @@ let cast_raw w () = ...@@ -1813,7 +1801,7 @@ let cast_raw w () =
]; ];
div [string_input ~input_type:`Submit ~value:"Submit" ()];