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

Change the way the server is initialized

Side-effect: public_key is not used during an election. We make it
lazy for now.
parent 1ed55ee2
......@@ -54,7 +54,7 @@ let check_election p =
let open P in
let open G in
(* check public key *)
let computed = Array.fold_left ( *~ ) G.one public_keys in
let computed = Array.fold_left ( *~ ) G.one (Lazy.force public_keys) in
computed =~ params.e_public_key
(** Simple monad *)
......@@ -384,7 +384,7 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
let {encrypted_tally; partial_decryptions; result; num_tallied} = r in
check_ciphertext encrypted_tally &&
Array.forall2 (check_factor encrypted_tally)
public_keys partial_decryptions &&
(Lazy.force public_keys) partial_decryptions &&
let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in
let factors = Array.fold_left (fun a b ->
Array.mmap2 ( *~ ) a b.decryption_factors
......
......@@ -89,9 +89,12 @@ module type ELECTION_PARAMS = sig
module G : GROUP
(** The group used for cryptography. *)
val public_keys : G.t array
val public_keys : G.t array Lazy.t
(** Trustee public keys. *)
(* TODO: public_keys is not needed during election, remove from
here, or at least monadify. *)
val params : G.t Serializable_t.election
(** Other parameters. *)
......
......@@ -6,15 +6,25 @@ open Lwt
<maxrequestbodysize> doesn't work *)
let () = Ocsigen_config.set_maxrequestbodysizeinmemory 128000
let elections_table = Ocsipersist.open_table "elections"
let imported_table = Ocsipersist.open_table "imported"
module EMap = Map.Make(Uuidm)
let () =
let ( / ) = Filename.concat
let file_exists x =
try_lwt
Lwt_unix.(access x [R_OK]) >>
return true
with _ ->
return false
let populate accu f s = Lwt_stream.fold_s f s accu
lwt election_table =
let dir = ref None in
let open Ocsigen_extensions.Configuration in
Eliom_config.parse_config [
element
~name:"import"
~name:"data"
~obligatory:false
~attributes:[
attribute ~name:"dir" ~obligatory:true (fun s -> dir := Some s);
......@@ -23,50 +33,81 @@ let () =
];
match !dir with
| Some dir ->
Ocsigen_messages.debug
(fun () -> "Importing elections from " ^ dir ^ "...");
Web_common.load_elections_and_votes dir |>
Lwt_stream.iter_s (fun (e, ballots) ->
let uuid = Uuidm.to_string e.Web_common.election.e_uuid in
lwt b =
try_lwt Ocsipersist.find imported_table uuid
with Not_found -> return false
in
if not b then (
Ocsigen_messages.debug (fun () ->
Printf.sprintf "-- importing %s (%s)"
uuid e.Web_common.election.e_short_name
);
lwt () = Ocsipersist.add elections_table uuid e in
let uuid_underscored = String.map (function '-' -> '_' | c -> c) uuid in
let table = Ocsipersist.open_table ("ballots_" ^ uuid_underscored) in
Lwt_stream.iter_s (fun (r, v) ->
Ocsipersist.add table (sha256_b64 r) v
) ballots >>
Ocsipersist.add imported_table uuid true
Ocsigen_messages.debug (fun () ->
"Using data from " ^ dir ^ "..."
);
Lwt_unix.files_of_directory dir |>
populate EMap.empty (fun subdir accu ->
let path = dir/subdir in
lwt b = file_exists (path/"result.json") in
if b then (
(* result is available *)
(* TODO: if the election is featured, show it on the home page *)
return accu
) else (
Ocsigen_messages.debug (fun () ->
Printf.sprintf "-- skipping %s (%s)" uuid
e.Web_common.election.e_short_name
);
return ()
let fn_election = path/"election.json" in
let fn_public_keys = path/"public_keys.jsons" in
lwt b = file_exists fn_election in
if b then (
Ocsigen_messages.debug (fun () ->
"-- registering " ^ subdir
);
lwt raw =
Lwt_io.chars_of_file fn_election |>
Lwt_stream.to_string
in
let election = Serializable_j.election_of_string
Serializable_j.read_ff_pubkey raw
in
let fingerprint = sha256_b64 raw in
let election_data = Web_common.({
fn_election;
fingerprint;
election;
fn_public_keys;
author = { user_name = "admin"; user_type = Dummy };
featured_p = true;
can_read = Any;
can_vote = Any;
can_admin = Any;
}) in
let {g; p; q; y} = election.e_public_key in
let module G = (val
Election.finite_field ~p ~q ~g :
Signatures.GROUP with type t = Z.t
) in
let module P = struct
module G = G
let public_keys = lazy (assert false)
let params = { election with e_public_key = y }
let fingerprint = fingerprint
end in
let module X : Web_common.WEB_ELECTION = struct
module G = G
module M = Web_common.MakeLwtRandom(G)
module E = Election.MakeElection(P)(M)
module B = Web_common.MakeBallotBox(E)
let data = election_data
end in
let uuid = election.e_uuid in
return (EMap.add uuid (module X : Web_common.WEB_ELECTION) accu)
) else return accu
)
) |>
Lwt_main.run
| None -> ()
)
| None -> return EMap.empty
let get_election_by_uuid x =
try_lwt
Ocsipersist.find elections_table (Uuidm.to_string x)
EMap.find x election_table |> return
with Not_found ->
raise_lwt Eliom_common.Eliom_404
let get_featured_elections () =
(* FIXME: doesn't scale when there are a lot of unfeatured elections *)
Ocsipersist.fold_step (fun uuid e res ->
let res = if e.Web_common.featured_p then e::res else res in
return res
) elections_table []
EMap.fold (fun uuid e res ->
let module X = (val e : Web_common.WEB_ELECTION) in
let e = X.data in
if e.Web_common.featured_p then e::res else res
) election_table [] |> return
let fail_http status =
raise_lwt (
......@@ -78,10 +119,11 @@ let forbidden () = fail_http 403
let if_eligible acl f uuid x =
lwt election = get_election_by_uuid uuid in
let module X = (val election : Web_common.WEB_ELECTION) in
lwt user = Eliom_reference.get Services.user in
lwt () =
let open Web_common in
match acl election with
match acl X.data with
| Any -> return ()
| Restricted p ->
match user with
......@@ -177,11 +219,13 @@ let () = Eliom_registration.Redirection.register
let can_read x = x.Web_common.can_read
let can_vote x = x.Web_common.can_vote
let () = Eliom_registration.String.register
let () = Eliom_registration.File.register
~service:Services.election_raw
~content_type:"application/json"
(if_eligible can_read
(fun uuid election user () ->
return (election.Web_common.raw, "application/json")
let module X = (val election : Web_common.WEB_ELECTION) in
return X.data.Web_common.fn_election
)
)
......@@ -190,7 +234,8 @@ let () = Eliom_registration.File.register
~content_type:"application/json"
(if_eligible can_read
(fun uuid election user () ->
return election.Web_common.public_keys_file
let module X = (val election : Web_common.WEB_ELECTION) in
return X.data.Web_common.fn_public_keys
)
)
......@@ -223,7 +268,8 @@ let () = Eliom_registration.Html5.register
~service:Services.election_index
(if_eligible can_read
(fun uuid election user () ->
Templates.election_view ~election ~user
let module X = (val election : Web_common.WEB_ELECTION) in
Templates.election_view ~election:X.data ~user
)
)
......@@ -239,8 +285,9 @@ let () = Eliom_registration.Redirection.register
~service:Services.election_cast
(if_eligible can_vote
(fun uuid election user () ->
let module X = (val election : Web_common.WEB_ELECTION) in
return (
Services.(preapply_uuid election_index election)
Services.(preapply_uuid election_index X.data)
)
)
)
......@@ -249,27 +296,17 @@ let () = Eliom_registration.Html5.register
~service:Services.election_cast_post
(if_eligible can_vote
(fun uuid election user raw_ballot ->
let module X = (val election : Web_common.WEB_ELECTION) in
let result =
try
let ballot = Serializable_j.ballot_of_string Serializable_builtin_j.read_number raw_ballot in
let {g; p; q; y} = election.Web_common.election.e_public_key in
let module P = struct
module G = (val Election.finite_field ~p ~q ~g : Signatures.GROUP with type t = Z.t)
let public_keys = Array.map (fun x ->
x.trustee_public_key
) election.Web_common.public_keys
let params = { election.Web_common.election with e_public_key = y }
let fingerprint = election.Web_common.fingerprint
end in
let module M = Election.MakeSimpleMonad(P.G) in
let module E = Election.MakeElection(P)(M) in
if
Uuidm.equal uuid ballot.election_uuid &&
E.check_ballot ballot
X.E.check_ballot ballot
then `Valid (sha256_b64 raw_ballot)
else `Invalid
with e -> `Malformed e
in
Templates.cast_ballot ~election ~result
Templates.cast_ballot ~election:X.data ~result
)
)
......@@ -194,59 +194,29 @@ let election_view ~election ~user =
];
]
] in
let nquestions = Array.length election.Web_common.election.e_questions in
let content = [
h1 [ pcdata election.Web_common.election.e_name ];
p [
pcdata "This is an election created by ";
format_user election.Web_common.author;
pcdata " with ";
pcdata (string_of_int (Array.length election.Web_common.election.e_questions));
pcdata " question(s) and ";
pcdata (string_of_int (Array.length election.Web_common.public_keys));
pcdata " trustee(s).";
pcdata (string_of_int nquestions);
Printf.ksprintf pcdata " question%s."
(if nquestions > 1 then "s" else "");
];
p [pcdata election.Web_common.election.e_description];
p permissions;
(match election.Web_common.election_result with
| Some r ->
let result = format_election_result election.Web_common.election r in
let formatted_result =
List.map (fun question ->
div [
h3 [
pcdata question.question;
];
let table xs = match xs with
| x :: xs -> table x xs
| [] -> div [pcdata "Result is not available."]
in table (
List.map (fun answer ->
let style = if answer.winner then b else span in
tr [
td [style [pcdata answer.answer]];
td [style [pcdata (string_of_int answer.count)]];
]
) question.answers
);
]
) result
in div [
pcdata "This election is complete.";
h2 [pcdata "Tally"];
div formatted_result;
]
| None ->
div [
div [
div [
a ~service:(Services.(preapply_uuid election_vote election)) [
pcdata "Vote in this election";
] ();
];
div [
pcdata "This election ends at the administrator's discretion.";
];
]
);
a ~service:(Services.(preapply_uuid election_vote election)) [
pcdata "Vote in this election";
] ();
];
div [
pcdata "This election ends at the administrator's discretion.";
];
];
audit_info;
] in
base ~title:election.Web_common.election.e_name ~content
......
......@@ -18,12 +18,10 @@ type acl =
| Restricted of (user -> bool Lwt.t)
type election_data = {
raw : string;
fn_election : string;
fingerprint : string;
election : ff_pubkey election;
public_keys : Z.t trustee_public_key array;
public_keys_file : string;
election_result : Z.t result option;
fn_public_keys : string;
author : user;
featured_p : bool;
can_read : acl;
......@@ -46,69 +44,6 @@ let load_from_file read fname =
close_in i;
result
let load_elections_and_votes dirname =
Lwt_unix.files_of_directory dirname |>
Lwt_stream.filter_map_s (fun x ->
let n = String.length x in
if n = 38 && x.[0] = '{' && x.[n-1] = '}' then (
match Uuidm.of_string ~pos:1 x with
| Some uuid ->
let dirname = Filename.concat dirname x in
let data x = Filename.concat dirname x in
lwt raw =
data "election.json" |>
Lwt_io.lines_of_file |>
enforce_single_element
in
let election = Serializable_j.election_of_string
Serializable_j.read_ff_pubkey raw
in
(assert_lwt (Uuidm.equal uuid election.e_uuid)) >>
let public_keys_file = data "public_keys.jsons" in
lwt public_keys =
public_keys_file |>
Lwt_io.lines_of_file |>
Lwt_stream.map (fun x ->
Serializable_j.trustee_public_key_of_string Serializable_builtin_j.read_number x
) |>
Lwt_stream.to_list >>= wrap1 Array.of_list
in
let election_result =
try Some (
data "result.json" |>
load_from_file (Serializable_j.read_result Serializable_builtin_j.read_number)
) with Sys_error _ -> None
in
let fingerprint = sha256_b64 raw in
let ballots =
let file = data "ballots.json" in
if Sys.file_exists file then (
Lwt_io.lines_of_file file |>
Lwt_stream.map (fun x ->
let v = Serializable_j.ballot_of_string Serializable_builtin_j.read_number x in
assert (Uuidm.equal uuid v.election_uuid);
x, v
)
) else Lwt_stream.from_direct (fun () -> None)
in
let election_data = {
raw;
fingerprint;
election;
public_keys;
public_keys_file;
election_result;
author = { user_name = "admin"; user_type = Dummy };
featured_p = true;
can_read = Any;
can_vote = Any;
can_admin = Any;
} in
Lwt.return (Some (election_data, ballots))
| None -> assert false
) else Lwt.return None
)
module MakeLwtRandom (G : Signatures.GROUP) = struct
type 'a t = 'a Lwt.t
......@@ -135,6 +70,13 @@ module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
and type 'a m = 'a Lwt.t
module type WEB_BBOX = sig
include Signatures.BALLOT_BOX
with type 'a m := 'a Lwt.t
and type ballot = string
and type record = string * Serializable_builtin_t.datetime
end
module MakeBallotBox (E : LWT_ELECTION) = struct
let suffix = "_" ^ String.map (function
......@@ -171,3 +113,10 @@ module MakeBallotBox (E : LWT_ELECTION) = struct
let turnout = Ocsipersist.length ballot_table
end
module type WEB_ELECTION = sig
module G : Signatures.GROUP
module E : LWT_ELECTION
module B : WEB_BBOX
val data : election_data
end
......@@ -14,12 +14,10 @@ type acl =
| Restricted of (user -> bool Lwt.t)
type election_data = {
raw : string;
fn_election : string;
fingerprint : string;
election : ff_pubkey election;
public_keys : Z.t trustee_public_key array;
public_keys_file : string;
election_result : Z.t result option;
fn_public_keys : string;
author : user;
featured_p : bool;
can_read : acl;
......@@ -27,9 +25,6 @@ type election_data = {
can_admin : acl;
}
val load_elections_and_votes :
string -> (election_data * (string * Z.t ballot) Lwt_stream.t) Lwt_stream.t
module MakeLwtRandom (G : Signatures.GROUP) : sig
(** {2 Monadic definitions} *)
......@@ -51,13 +46,18 @@ module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
and type 'a m = 'a Lwt.t
module MakeBallotBox (E : LWT_ELECTION) : sig
(** {2 Ballot box management} *)
module type WEB_BBOX = sig
include Signatures.BALLOT_BOX
with type 'a m := 'a Lwt.t
and type ballot = string
and type record = string * Serializable_builtin_t.datetime
end
(** This ballot box stores ballots and records in Ocsipersist tables. *)
module MakeBallotBox (E : LWT_ELECTION) : WEB_BBOX
module type WEB_ELECTION = sig
module G : Signatures.GROUP
module E : LWT_ELECTION
module B : WEB_BBOX
val data : election_data
end
......@@ -108,10 +108,11 @@ let check_legacy e =
(val Election.finite_field ~g ~p ~q : Signatures.GROUP with type t = Z.t)
let params = Serializable_compat.election e.election
let fingerprint = e.fingerprint
let public_keys =
let public_keys = Lazy.lazy_from_val (
e.trustee_public_keys |>
List.map (fun x -> x.trustee_public_key.y) |>
Array.of_list
)
end in
let open P.G in
let ( / ) a b = a *~ (invert b) in
......@@ -172,10 +173,11 @@ let verbose_verify_election_test_data e =
(val Election.finite_field ~g ~p ~q : Signatures.GROUP with type t = Z.t)
let params = Serializable_compat.election e.election
let fingerprint = e.fingerprint
let public_keys =
let public_keys = Lazy.lazy_from_val (
e.trustee_public_keys |>
List.map (fun x -> x.trustee_public_key.y) |>
Array.of_list
)
end in
verbose_assert "election key" (fun () ->
Election.check_election (module P : Signatures.ELECTION_PARAMS)
......@@ -273,10 +275,11 @@ module P = struct
(val Election.finite_field ~g ~p ~q : Signatures.GROUP with type t = Z.t)
let params = Serializable_compat.election e.election
let fingerprint = e.fingerprint
let public_keys =
let public_keys = Lazy.lazy_from_val (
e.trustee_public_keys |>
List.map (fun x -> x.trustee_public_key.y) |>
Array.of_list
)
end
module M = Election.MakeSimpleMonad(P.G)
module E = Election.MakeElection(P)(M)
......
......@@ -30,7 +30,7 @@
<static dir="_SRCDIR_/media/booth" />
</site>
<eliom module="_build/src/web/server.cma">
<import dir="tests/data"/>
<data dir="tests/data"/>
</eliom>
</host>
......
......@@ -70,7 +70,9 @@ let election = {
module P = struct
module G = G
let params = election
let public_keys = public_keys |> Array.map (fun x -> x.trustee_public_key)
let public_keys = Lazy.lazy_from_val (
public_keys |> Array.map (fun x -> x.trustee_public_key)
)
let fingerprint =
election |>
Serializable_j.string_of_election Serializable_builtin_j.write_number |>
......@@ -108,7 +110,7 @@ let encrypted_tally = M.fold_ballots (fun b t ->
let factors = Array.map (fun x ->
E.compute_factor encrypted_tally x ()
) private_keys;;
assert (Array.forall2 (E.check_factor encrypted_tally) P.public_keys factors);;
assert (Array.forall2 (E.check_factor encrypted_tally) (Lazy.force P.public_keys) factors);;
let result = E.combine_factors (M.turnout ()) encrypted_tally factors;;
assert (E.check_result result);;
......
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