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 e17fa8d0 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Less passing WEB_ELECTION around

 - introduce sub-module D with signature WEB_ELECTION_DATA
 - Web_templates functions now take WEB_ELECTION_DATA

Rationale: sub-modules E and B are seldom used, eventually we want to
create them on demand and get rid of election_table. D can be directly
created from database. Long-term goal: get rid of register_election
and election_table, and have a constant server startup time.
parent 40d4add4
......@@ -32,12 +32,12 @@ open Web_services
let ( / ) = Filename.concat
module Make (D : ELECTION_DATA) (P : WEB_PARAMS) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION = struct
module Make (D : WEB_ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION = struct
let uuid = Uuidm.to_string D.election.e_params.e_uuid
module D = D
include D
include P
module E = Election.MakeElection(G)(M)
module B : WEB_BALLOT_BOX = struct
......
......@@ -25,4 +25,4 @@ open Signatures
open Web_serializable_t
open Web_signatures
module Make (D : ELECTION_DATA) (P : WEB_PARAMS) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION
module Make (D : WEB_ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION
......@@ -85,10 +85,14 @@ module type WEB_PARAMS = sig
val dir : string
end
module type WEB_ELECTION = sig
module type WEB_ELECTION_DATA = sig
include ELECTION_DATA
include WEB_PARAMS
module E : ELECTION with type elt = G.t and type 'a m = 'a Lwt.t
end
module type WEB_ELECTION = sig
module D : WEB_ELECTION_DATA
module E : ELECTION with type elt = D.G.t and type 'a m = 'a Lwt.t
module B : WEB_BALLOT_BOX
end
......
......@@ -88,9 +88,9 @@ let register_election params web_params =
e_pks = None;
e_fingerprint = P.fingerprint;
}
include (val web_params : WEB_PARAMS)
end in
let module P = (val web_params : WEB_PARAMS) in
let module W = Web_election.Make (D) (P) (LwtRandom) in
let module W = Web_election.Make (D) (LwtRandom) in
let election = (module W : WEB_ELECTION) in
fun () ->
(* starting from here, we do side-effects on the running server *)
......@@ -192,7 +192,7 @@ let import_election f =
let election = do_register () in
let module W = (val election : WEB_ELECTION) in
lwt () =
match W.metadata.e_auth_config with
match W.D.metadata.e_auth_config with
| None -> return ()
| Some xs ->
let auth_config =
......@@ -239,6 +239,7 @@ lwt () =
let do_register = register_election params web_params in
let election = do_register () in
let module W = (val election : WEB_ELECTION) in
let module W = W.D in
assert (uuid = Uuidm.to_string W.election.e_params.e_uuid);
Ocsigen_messages.debug (fun () ->
Printf.sprintf "Initialized election %s from persistent store" uuid
......@@ -264,6 +265,8 @@ let () = Html5.register ~service:admin
lwt elections, tallied =
SMap.fold (fun _ w accu ->
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
let w = (module W : WEB_ELECTION_DATA) in
if W.metadata.e_owner = Some u then (
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
lwt state = Web_persist.get_election_state uuid_s in
......@@ -538,6 +541,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
lwt site_user = Web_auth_state.get_site_user () in
match site_user with
| Some u when W.metadata.e_owner = Some u ->
......@@ -952,7 +956,7 @@ let () =
match private_key with
| None -> return ()
| Some x ->
let fname = W.dir / "private_key.json" in
let fname = W.D.dir / "private_key.json" in
create_file fname string_of_number [x]
in
(* clean up temporary files *)
......@@ -970,7 +974,7 @@ let () =
Ocsipersist.remove election_stable uuid_s >>
Web_persist.set_election_date uuid_s (now ()) >>
Redirection.send
(preapply election_admin (W.election.e_params.e_uuid, ()))
(preapply election_admin (W.D.election.e_params.e_uuid, ()))
end
)
with e ->
......@@ -986,6 +990,7 @@ let () =
try
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
Eliom_reference.unset Web_services.ballot >>
let cont () =
Redirection.send
......@@ -1013,6 +1018,7 @@ let () =
let w = SMap.find uuid_s !election_table in
lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
let uuid = Uuidm.to_string W.election.e_params.e_uuid in
match site_user with
| Some u when W.metadata.e_owner = Some u ->
......@@ -1025,6 +1031,7 @@ let election_set_state state (uuid, ()) () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
lwt () =
match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
......@@ -1050,6 +1057,7 @@ let () =
let w = SMap.find uuid_s !election_table in
lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
match site_user with
| Some u ->
if W.metadata.e_owner = Some u then (
......@@ -1067,11 +1075,13 @@ let () =
let w = SMap.find uuid_s !election_table in
lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in
let module B = W.B in
let module W = W.D in
match site_user with
| Some u ->
if W.metadata.e_owner = Some u then (
try_lwt
W.B.update_cred ~old ~new_ >>
B.update_cred ~old ~new_ >>
String.send ("OK", "text/plain")
with Error e ->
String.send ("Error: " ^ explain_error e, "text/plain")
......@@ -1103,6 +1113,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
let cont () =
Redirection.send
(Eliom_service.preapply
......@@ -1110,8 +1121,8 @@ let () =
in
Eliom_reference.set Web_auth_state.cont [cont] >>
match_lwt Eliom_reference.get Web_services.ballot with
| Some b -> T.cast_confirmation w (sha256_b64 b) () >>= Html5.send
| None -> T.cast_raw w () >>= Html5.send)
| Some b -> T.cast_confirmation (module W) (sha256_b64 b) () >>= Html5.send
| None -> T.cast_raw (module W) () >>= Html5.send)
let () =
Any.register
......@@ -1120,6 +1131,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
lwt user = Web_auth_state.get_election_user uuid in
lwt the_ballot = match ballot_raw, ballot_file with
| Some ballot, None -> return ballot
......@@ -1150,6 +1162,8 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module B = W.B in
let module W = W.D in
match_lwt Eliom_reference.get Web_services.ballot with
| Some the_ballot ->
begin
......@@ -1159,7 +1173,7 @@ let () =
let record = string_of_user u, now () in
lwt result =
try_lwt
lwt hash = W.B.cast the_ballot record in
lwt hash = B.cast the_ballot record in
return (`Valid hash)
with Error e -> return (`Error e)
in
......@@ -1178,8 +1192,10 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module B = W.B in
let module W = W.D in
lwt res, _ =
W.B.Ballots.fold
B.Ballots.fold
(fun h _ (accu, i) ->
if i >= start && i < start+1000 then
return (h :: accu, i+1)
......@@ -1214,6 +1230,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
lwt () =
match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
......@@ -1248,6 +1265,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
lwt () =
match_lwt Web_persist.get_election_state uuid_s with
| `EncryptedTally _ -> return ()
......@@ -1259,7 +1277,7 @@ let () =
"Your partial decryption has already been received and checked!"
() >>= Html5.send
) else (
T.tally_trustees w trustee_id () >>= Html5.send
T.tally_trustees (module W) trustee_id () >>= Html5.send
))
let () =
......@@ -1281,6 +1299,8 @@ let () =
in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module E = W.E in
let module W = W.D in
let pks = W.dir / string_of_election_file ESKeys in
let pks = Lwt_io.lines_of_file pks in
lwt () = Lwt_stream.njunk (trustee_id-1) pks in
......@@ -1297,7 +1317,7 @@ let () =
let et = W.dir / string_of_election_file ESETally in
lwt et = Lwt_io.chars_of_file et |> Lwt_stream.to_string in
let et = encrypted_tally_of_string W.G.read et in
if W.E.check_factor et pk pd then (
if E.check_factor et pk pd then (
let pds = (trustee_id, partial_decryption) :: pds in
lwt () = Web_persist.set_partial_decryptions uuid_s pds in
T.generic_page ~title:"Success"
......@@ -1313,6 +1333,8 @@ let handle_election_tally_release (uuid, ()) () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w) in
let module E = W.E in
let module W = W.D in
lwt () =
match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
......@@ -1336,7 +1358,7 @@ let handle_election_tally_release (uuid, ()) () =
Lwt_io.chars_of_file |> Lwt_stream.to_string >>=
wrap1 (encrypted_tally_of_string W.G.read)
in
let result = W.E.combine_factors ntallied et pds in
let result = E.combine_factors ntallied et pds in
lwt () =
let open Lwt_io in
with_file
......@@ -1359,6 +1381,7 @@ let content_type_of_file = function
let handle_pseudo_file w u f site_user =
let module W = (val w : WEB_ELECTION) in
let module W = W.D in
let confidential =
match f with
| ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false
......@@ -1391,6 +1414,9 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let module E = W.E in
let module B = W.B in
let module W = W.D in
lwt () =
match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
......@@ -1401,7 +1427,7 @@ let () =
| `Closed -> return ()
| _ -> forbidden ()
in
lwt nb, hash, tally = W.B.compute_encrypted_tally () in
lwt nb, hash, tally = B.compute_encrypted_tally () in
let pks = W.dir / string_of_election_file ESKeys in
let pks = Lwt_io.lines_of_file pks in
let npks = ref 0 in
......@@ -1417,7 +1443,7 @@ let () =
| _ -> failwith "several private keys are available"
in
let tally = encrypted_tally_of_string W.G.read tally in
lwt pd = W.E.compute_factor tally sk in
lwt pd = E.compute_factor tally sk in
let pd = string_of_partial_decryption W.G.write pd in
Web_persist.set_partial_decryptions uuid_s [1, pd] >>
handle_election_tally_release (uuid, ()) ()
......
......@@ -135,7 +135,7 @@ let base ~title ~login_box ~content ?(footer = div []) () =
]))
let format_election kind election =
let module W = (val election : WEB_ELECTION) in
let module W = (val election : WEB_ELECTION_DATA) in
let e = W.election.e_params in
let service =
match kind with
......@@ -725,7 +725,7 @@ let election_setup_trustee token uuid se () =
let election_login_box w =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
let module A = struct
let get_user () =
Web_auth_state.get_election_user W.election.e_params.e_uuid
......@@ -746,13 +746,13 @@ let election_login_box w =
fun () -> make_login_box ~show_login:false "" auth links
let file w x =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
Eliom_service.preapply
election_dir
(W.election.e_params.e_uuid, x)
let election_home w state () =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
let params = W.election.e_params in
let state_ =
match state with
......@@ -870,7 +870,7 @@ let election_home w state () =
base ~title:params.e_name ~login_box ~content ~footer ()
let election_admin w state () =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
let title = W.election.e_params.e_name ^ " — Administration" in
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
let state_form checked =
......@@ -1005,7 +1005,7 @@ let election_admin w state () =
base ~title ~login_box ~content ()
let update_credential w () =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
let params = W.election.e_params in
let form = post_form ~service:election_update_credential_post
(fun (old, new_) ->
......@@ -1063,7 +1063,7 @@ let regenpwd uuid () =
base ~title ~login_box ~content ()
let cast_raw w () =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
let params = W.election.e_params in
let form_rawballot = post_form ~service:election_cast_post
(fun (name, _) ->
......@@ -1096,7 +1096,7 @@ let cast_raw w () =
base ~title:params.e_name ~login_box ~content ()
let cast_confirmation w hash () =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
lwt user = Web_auth_state.get_election_user W.election.e_params.e_uuid in
let params = W.election.e_params in
let name = params.e_name in
......@@ -1154,7 +1154,7 @@ let cast_confirmation w hash () =
base ~title:name ~login_box ~content ()
let cast_confirmed w ~result () =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
let params = W.election.e_params in
let name = params.e_name in
let progress = div ~a:[a_style "text-align:center;margin-bottom:20px;"] [
......@@ -1196,7 +1196,7 @@ let cast_confirmed w ~result () =
base ~title:name ~login_box ~content ()
let pretty_ballots w hashes () =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
let params = W.election.e_params in
let title = params.e_name ^ " — Accepted ballots" in
let nballots = ref 0 in
......@@ -1230,7 +1230,7 @@ let pretty_ballots w hashes () =
base ~title ~login_box ~content ()
let tally_trustees w trustee_id () =
let module W = (val w : WEB_ELECTION) in
let module W = (val w : WEB_ELECTION_DATA) in
let params = W.election.e_params in
let title =
params.e_name ^ " — Partial decryption #" ^ string_of_int trustee_id
......
......@@ -22,7 +22,7 @@
open Web_signatures
val home : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin : elections:((module WEB_ELECTION) list * (module WEB_ELECTION) list * (Uuidm.t * string) list) option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin : elections:((module WEB_ELECTION_DATA) list * (module WEB_ELECTION_DATA) list * (Uuidm.t * string) list) option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val new_election_failure : [ `Exists | `Exception of exn ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......@@ -36,16 +36,16 @@ val election_setup_credentials : string -> string -> Web_common.setup_election -
val election_setup_trustees : Uuidm.t -> 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
val election_home : (module WEB_ELECTION) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module WEB_ELECTION) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : (module WEB_ELECTION_DATA) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION_DATA) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module WEB_ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val regenpwd : Uuidm.t -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_raw : (module WEB_ELECTION) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmation : (module WEB_ELECTION) -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmed : (module WEB_ELECTION) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_ballots : (module WEB_ELECTION) -> string list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_raw : (module WEB_ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmation : (module WEB_ELECTION_DATA) -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmed : (module WEB_ELECTION_DATA) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_ballots : (module WEB_ELECTION_DATA) -> string list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val tally_trustees : (module WEB_ELECTION) -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val tally_trustees : (module WEB_ELECTION_DATA) -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val already_logged_in :
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