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

Split election_config into ELECTION_DATA and WEB_PARAMS

SITE.register_election takes only parsed stuff.
parent 5e2fb88f
......@@ -156,6 +156,12 @@ type 'a election = {
(** Fingerprint of the election. *)
}
(** Election data bundled with a group. *)
module type ELECTION_DATA = sig
module G : GROUP
val election : G.t election
end
(** Cryptographic primitives for an election with homomorphic tally. *)
module type ELECTION = sig
......
......@@ -49,16 +49,9 @@ module type REGISTRATION = sig
module Register (S : SITE) (T : TEMPLATES) : EMPTY
end
let make config =
module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRATION = struct
let params = Group.election_params_of_string config.raw_election in
let module P = (val params : ELECTION_PARAMS) in
let e_fingerprint = P.fingerprint in
let e_params = P.params in
let module R : REGISTRATION = struct
let uuid = Uuidm.to_string e_params.e_uuid
let uuid = Uuidm.to_string D.election.e_params.e_uuid
let base_path = ["elections"; uuid]
module N = struct
......@@ -66,7 +59,7 @@ let make config =
let path = base_path
let auth_config =
match config.metadata.e_auth_config with
match P.metadata.e_auth_config with
| None -> []
| Some xs -> xs
end
......@@ -74,18 +67,12 @@ let make config =
module Auth = Web_auth.Make (N)
module W : WEB_ELECTION = struct
module G = P.G
include D
include P
module M = MakeLwtRandom(struct let rng = make_rng () end)
module E = Election.MakeElection(G)(M)
module H = Auth.Handlers
let election = {e_params; e_pks = None; e_fingerprint}
let metadata = config.metadata
let public_keys_fname = config.public_keys_fname
let params_fname = config.params_fname
let featured = config.featured
module B : WEB_BALLOT_BOX = struct
let suffix = "_" ^ String.map (function
......@@ -299,7 +286,7 @@ let make config =
let if_eligible acl f () x =
lwt user = W.S.get_user () in
if acl config.metadata user then
if acl W.metadata user then
f user x
else
forbidden ()
......@@ -511,6 +498,4 @@ let make config =
end
end in
(module R : REGISTRATION)
end
......@@ -30,4 +30,4 @@ module type REGISTRATION = sig
module Register (S : SITE) (T : TEMPLATES) : EMPTY
end
val make : election_config -> (module REGISTRATION)
module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRATION
......@@ -120,10 +120,9 @@ let import_election_dir accu dir =
| Some e -> return e
| None -> failwith "election.json is invalid")
in
let uuid =
(election_uuid_of_string raw_election).election_uuid |>
Uuidm.to_string
in
let params = Group.election_params_of_string raw_election in
let module P = (val params : ELECTION_PARAMS) in
let uuid = Uuidm.to_string P.params.e_uuid in
lwt exists =
try_lwt
lwt _ = Ocsipersist.find election_table uuid in
......@@ -149,14 +148,14 @@ let import_election_dir accu dir =
) else return empty_metadata
in
let public_creds_fname = path/"public_creds.txt" in
let config = Web_election.({
raw_election;
metadata;
featured = item.datadir_featured;
params_fname;
public_keys_fname;
}) in
Ocsipersist.add election_table uuid config >>
let module X = struct
let metadata = metadata
let featured = item.datadir_featured
let params_fname = params_fname
let public_keys_fname = public_keys_fname
end in
let web_params = (module X : WEB_PARAMS) in
Ocsipersist.add election_table uuid (raw_election, web_params) >>
return @@ SMap.add uuid public_creds_fname accu
)
) accu index
......@@ -187,8 +186,19 @@ end
module Site = Web_site.Make (Site_config)
lwt () =
Ocsipersist.iter_step (fun uuid config ->
lwt election = Site.register_election config in
Ocsipersist.iter_step (fun uuid (raw_election, web_params) ->
let params = Group.election_params_of_string raw_election in
let module P = (val params : ELECTION_PARAMS) in
let module D = struct
module G = P.G
let election = {
e_params = P.params;
e_pks = None;
e_fingerprint = P.fingerprint;
}
end in
let election_data = (module D : ELECTION_DATA) in
lwt election = Site.register_election election_data web_params in
let module W = (val election : WEB_ELECTION) in
(match !main_election_uuid with
| Some u when u = uuid -> Site.set_main_election election
......
......@@ -25,14 +25,6 @@ open Signatures
open Common
open Web_serializable_t
type election_config = {
raw_election : string;
metadata : metadata;
featured : bool;
params_fname : string;
public_keys_fname : string;
}
module type AUTH_SERVICES = sig
val auth_realm : string
......@@ -234,16 +226,17 @@ module type ELECTION_TEMPLATES = sig
end
module type WEB_ELECTION_RO = sig
module G : GROUP
module E : ELECTION with type elt = G.t
val election : G.t election
module type WEB_PARAMS = sig
val metadata : metadata
val featured : bool
val params_fname : string
val public_keys_fname : string
end
module type WEB_ELECTION_RO = sig
include ELECTION_DATA
include WEB_PARAMS
module E : ELECTION with type elt = G.t
module S : ELECTION_SERVICES
end
......@@ -261,7 +254,11 @@ end
module type SITE = sig
include SITE_SERVICES
include AUTH_HANDLERS_PUBLIC
val register_election : election_config -> (module WEB_ELECTION) Lwt.t
val register_election :
(module ELECTION_DATA) -> (module WEB_PARAMS) ->
(module WEB_ELECTION) Lwt.t
val set_main_election : (module WEB_ELECTION) -> unit
val unset_main_election : unit -> unit
val cont : (unit -> service_handler) Eliom_reference.eref
......
......@@ -91,9 +91,10 @@ module Make (C : CONFIG) : SITE = struct
module T = Web_templates.Make (S)
let () = register_election_ref := fun config ->
let registration = Web_election.make config in
let module R = (val registration : Web_election.REGISTRATION) in
let () = register_election_ref := fun election_data web_params ->
let module D = (val election_data : ELECTION_DATA) in
let module P = (val web_params : WEB_PARAMS) in
let module R = Web_election.Make (D) (P) in
let module W = R.W in
let module X : EMPTY = R.Register (S) (T) in
let election = (module W : WEB_ELECTION) in
......
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