Commit 90cf7109 authored by Stephane Glondu's avatar Stephane Glondu

Use Ocsipersist for storing elections and votes

 - new module: Common
 - one table for all elections, and one table per election for votes
 - for now, forget about election_shortcut service
 - in production, the server only uses Ocsipersist
 - "<load>" directive in configuration file to load the Ocsipersist
   database from the filesystem at initialization time
parent 19a1cce0
......@@ -110,7 +110,7 @@ type question = {
}
type election_extradata = {
xelection : Helios_services.election_data;
xelection : Common.election_data;
election : Z.t Helios_datatypes_t.election;
(* FIXME: datatypes should be revisited, election is xelection.election! *)
election_admin : Helios_services.user;
......@@ -126,8 +126,8 @@ let format_one_featured_election e =
div ~a:[a_class ["highlight-box-margin"]] ([
a
~service:(Eliom_service.preapply
Helios_services.election_shortcut
e.election.e_short_name)
Helios_services.election_view
e.election.e_uuid)
~a:[a_style "font-size: 1.4em;"]
[pcdata e.election.e_name] ();
pcdata " by ";
......@@ -254,7 +254,7 @@ let election_view ~election =
pcdata "Election Fingerprint:";
br ();
code ~a:[a_style "font-size: 1.3em; font-weight: bold;"] [
pcdata election.xelection.Helios_services.fingerprint;
pcdata election.xelection.Common.fingerprint;
];
br ();
br ();
......
open StdExtra
open Helios_datatypes_t
type election_data = {
raw : string;
fingerprint : string;
election : Z.t election;
public_data : Z.t election_public_data;
}
let enforce_single_element s =
let open Lwt_stream in
lwt t = next s in
lwt b = is_empty s in
(assert_lwt b) >>
Lwt.return t
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 = Helios_datatypes_j.election_of_string
Core_datatypes_j.read_number raw
in
(assert_lwt (Uuidm.equal uuid election.e_uuid)) >>
let public_data =
data "public.json" |>
load_from_file (Helios_datatypes_j.read_election_public_data Core_datatypes_j.read_number)
in
let fingerprint = hashB raw in
let votes =
let file = data "votes.json" in
if Sys.file_exists file then (
Lwt_io.lines_of_file file |>
Lwt_stream.map (fun x ->
let v = Helios_datatypes_j.vote_of_string Core_datatypes_j.read_number x in
assert (Uuidm.equal uuid v.election_uuid);
v
)
) else Lwt_stream.from_direct (fun () -> None)
in
let election_data = { raw; fingerprint; election; public_data } in
Lwt.return (Some (election_data, votes))
| None -> assert false
) else Lwt.return None
)
let concat s l f = String.concat s (List.map f (Array.to_list l))
let hash_vote v =
concat "//" v.answers (fun a ->
concat "|" a.choices (fun c ->
Printf.sprintf "%s,%s" (Z.to_string c.alpha) (Z.to_string c.beta)
) ^
"#" ^
concat "|" a.individual_proofs (fun p ->
concat "/" p (fun pi ->
Printf.sprintf "%a,%a,%a,%a"
Z.sprint pi.dp_commitment.a
Z.sprint pi.dp_commitment.b
Z.sprint pi.dp_challenge
Z.sprint pi.dp_response
)
) ^
"#" ^
concat "/" a.overall_proof (fun pi ->
Printf.sprintf "%a,%a,%a,%a"
Z.sprint pi.dp_commitment.a
Z.sprint pi.dp_commitment.b
Z.sprint pi.dp_challenge
Z.sprint pi.dp_response
)
) ^
"#" ^ v.election_hash ^
"#" ^ (Uuidm.to_string v.election_uuid) |>
hashB
open Helios_datatypes_t
type election_data = {
raw : string;
fingerprint : string;
election : Z.t election;
public_data : Z.t election_public_data;
}
val load_elections_and_votes :
string -> (election_data * Z.t vote Lwt_stream.t) Lwt_stream.t
val hash_vote : Z.t vote -> string
......@@ -2,81 +2,22 @@ open StdExtra
open Helios_datatypes_t
open Lwt
let election_index, election_library =
let index = ref None in
let library = ref None in
let open Ocsigen_extensions.Configuration in
Eliom_config.parse_config [
element
~name:"elections"
~obligatory:true
~attributes:[
attribute ~name:"index" ~obligatory:true (fun s -> index := Some s);
attribute ~name:"library" ~obligatory:true (fun s -> library := Some s);
]
()
];
match !index, !library with
| Some i, Some l -> i, l
| _ -> raise (Ocsigen_extensions.Error_in_config_file
"could not find index or library in configuration file")
let raw_elections =
Ocsigen_messages.debug
(fun () -> "Loading elections from " ^ election_index ^ "...");
Lwt_io.lines_of_file election_index |>
Lwt_stream.filter (fun s -> s <> "") |>
Lwt_stream.to_list |> Lwt_main.run
let load_election_data raw =
let election =
Helios_datatypes_j.election_of_string Core_datatypes_j.read_number raw
in
let fingerprint = hashB raw in
let dir = Filename.concat election_library
("{" ^ Uuidm.to_string election.e_uuid ^ "}")
in
let data x = Filename.concat dir x in
let public_data = load_from_file
(Helios_datatypes_j.read_election_public_data Core_datatypes_j.read_number)
(data "public.json")
in
let votes =
let file = data "votes.json" in
if Sys.file_exists file then (
non_empty_lines_of_file file |>
Lwt_main.run |>
List.map (Helios_datatypes_j.vote_of_string Core_datatypes_j.read_number) |>
List.rev
) else []
in
Helios_services.({ raw; fingerprint; election; votes; public_data })
let elections = List.map load_election_data raw_elections
let get_raw_election_by_uuid x =
let open Helios_services in
List.find (fun e -> Uuidm.equal e.election.e_uuid x) elections
let test_uuid =
match Uuidm.of_string "94c1a03e-1c48-11e2-8866-3cd92b7981b8" with
| Some u -> u
| None -> assert false
let elections_table = Ocsipersist.open_table "elections"
let format_election e =
let open Helios_services in
let open Helios_templates in
let election = e.Helios_services.election in
let election = e.Common.election in
let election_admin = {
user_name = "admin";
user_type = "dummy";
} in
let election_trustees =
e.public_data.public_keys |>
e.Common.public_data.public_keys |>
Array.map (fun k -> k.trustee_public_key.y |> Z.to_string |> hashB) |>
Array.to_list
in
let election_state = match e.public_data.election_result with
let election_state = match e.Common.public_data.election_result with
| Some r ->
Array.mapi (fun i q ->
let q' = election.e_questions.(i) in
......@@ -106,18 +47,42 @@ let format_election e =
in
{ election; xelection=e; election_admin; election_trustees; election_state }
let elections = List.map format_election elections
let get_featured_elections () =
return elections
let get_election_by_name x =
let open Helios_templates in
wrap2 List.find (fun e -> e.election.e_short_name = x) elections
let () =
let dir = ref None in
let open Ocsigen_extensions.Configuration in
Eliom_config.parse_config [
element
~name:"load"
~obligatory:false
~attributes:[
attribute ~name:"dir" ~obligatory:true (fun s -> dir := Some s);
]
()
];
match !dir with
| Some dir ->
Ocsigen_messages.debug
(fun () -> "Loading elections from " ^ dir ^ "...");
Common.load_elections_and_votes dir |>
Lwt_stream.iter_s (fun (e, votes) ->
let uuid = Uuidm.to_string e.Common.election.e_uuid in
Ocsigen_messages.debug
(fun () -> Printf.sprintf "-- loading %s (%s)" uuid e.Common.election.e_short_name);
lwt () = Ocsipersist.add elections_table uuid (format_election e) in
let uuid_underscored = String.map (function '-' -> '_' | c -> c) uuid in
let table = Ocsipersist.open_table ("votes_" ^ uuid_underscored) in
Lwt_stream.iter_s (fun v ->
Ocsipersist.add table (Common.hash_vote v) v
) votes
) |>
Lwt_main.run
| None -> ()
let get_election_by_uuid x =
let open Helios_templates in
wrap2 List.find (fun e -> Uuidm.equal e.election.e_uuid x) elections
Ocsipersist.find elections_table (Uuidm.to_string x)
let get_featured_elections () =
Ocsipersist.fold_step (fun uuid e res -> return (e :: res)) elections_table []
let () = Eliom_registration.Html5.register
~service:Helios_services.home
......@@ -135,17 +100,6 @@ let () = Eliom_registration.Html5.register
(fun () () ->
Helios_templates.not_implemented "Create election")
let () = Eliom_registration.Redirection.register
~service:Helios_services.election_shortcut
(fun name () ->
try_lwt
lwt e = get_election_by_name name in
return (Eliom_service.preapply
Helios_services.election_view
e.Helios_templates.election.e_uuid)
with Not_found ->
raise_lwt Eliom_common.Eliom_404)
let () = Eliom_registration.Html5.register
~service:Helios_services.login
(fun () () ->
......@@ -173,7 +127,7 @@ let () = Eliom_registration.String.register
(fun uuid () ->
try_lwt
lwt election = get_election_by_uuid uuid in
return (election.Helios_templates.xelection.Helios_services.raw, "application/json")
return (election.Helios_templates.xelection.Common.raw, "application/json")
with Not_found ->
raise_lwt Eliom_common.Eliom_404)
......
......@@ -23,11 +23,6 @@ let election_new = service
~get_params:unit
()
let election_shortcut = service
~path:["e"]
~get_params:(suffix (string "name"))
()
let login = service
~path:["login"]
~get_params:unit
......@@ -106,13 +101,3 @@ let election_trustees = service
~path:["elections"; "trustees"]
~get_params:uuid
()
(* FIXME: type declarations should be elsewhere *)
type election_data = {
raw : string;
fingerprint : string;
election : Z.t election;
mutable votes : Z.t vote list;
public_data : Z.t election_public_data;
}
......@@ -2,4 +2,5 @@ StdExtra
Core_datatypes_j
Helios_datatypes_t
Helios_datatypes_j
Common
ElGamal
StdExtra
Core_datatypes_j
Helios_datatypes_j
Common
Helios_services
Helios_templates
Helios_registration
......@@ -29,6 +29,16 @@ module List = struct
in List.flatten (loop 0 xs)
end
module String = struct
include String
let map f s =
let n = String.length s in
let res = String.create n in
for i = 0 to n-1 do res.[i] <- f s.[i] done;
res
end
let hashB x = Cryptokit.(x |>
hash_string (Hash.sha256 ()) |>
transform_string (Base64.encode_compact ())
......
......@@ -12,6 +12,11 @@ module Array : sig
val foralli : (int -> 'a -> bool) -> 'a array -> bool
end
module String : sig
include module type of String
val map : (char -> char) -> string -> string
end
val hashB : string -> string
val load_from_file : (Yojson.lexer_state -> Lexing.lexbuf -> 'a) -> string -> 'a
......
......@@ -33,7 +33,7 @@
<static dir="_SRCDIR_/helios/booth" />
</site>
<eliom module="_build/src/server.cma">
<elections index="_RUNDIR_/lib/elections.json" library="tests/data"/>
<load dir="tests/data"/>
</eliom>
</host>
......
......@@ -20,7 +20,4 @@ sed \
-e "s@_SRCDIR_@$PWD@g" \
tests/ocsigenserver.conf.in > $BELENIOS_RUNDIR/etc/ocsigenserver.conf
{ for u in tests/data/*/election.json; do cat "$u"; echo; done; } \
> $BELENIOS_RUNDIR/lib/elections.json
ocsigenserver -c $BELENIOS_RUNDIR/etc/ocsigenserver.conf "$@"
open StdExtra
open Helios_datatypes_t
open Common
module type TYPES = sig
type elt
......@@ -65,49 +66,16 @@ let load_and_check ?(verbose=false) typ fname =
Sys.remove tempfname;
thing
type 'a election_test_data = {
raw : string;
fingerprint : string;
election : 'a election;
votes : 'a vote array option;
public_data : 'a election_public_data;
private_data : 'a election_private_data;
}
let enforce_single_element s =
let open Lwt_stream in
lwt t = next s in
lwt b = is_empty s in
(assert_lwt b) >>
Lwt.return t
let load_election_test_data ?(verbose=false) dir =
let data x = Filename.concat dir x in
let raw =
Lwt_io.lines_of_file (data "election.json") |>
enforce_single_element |> Lwt_main.run
in
let election = Helios_datatypes_j.election_of_string Core_datatypes_j.read_number raw in
let public_data = load_and_check ~verbose Types.election_public_data (data "public.json") in
let private_data = load_and_check ~verbose Types.election_private_data (data "private.json") in
let fingerprint = hashB raw in
let votes =
let file = data "votes.json" in
if Sys.file_exists file then Some (
non_empty_lines_of_file file |>
Lwt_main.run |>
List.map (Helios_datatypes_j.vote_of_string Core_datatypes_j.read_number) |>
Array.of_list
) else None
in
{ raw; fingerprint; election; votes; public_data; private_data }
let load_election_private_data ?(verbose=false) dir uuid =
Printf.ksprintf (Filename.concat dir) "{%s}/private.json" uuid |>
load_and_check ~verbose Types.election_private_data
let verbose_assert msg it =
Printf.eprintf " %s...%!" msg;
let r = Lazy.force it in
Printf.eprintf " %s\n%!" (if r then "OK" else "failed!")
let verbose_verify_election_test_data e =
let verbose_verify_election_test_data (e, votes, private_data) =
Printf.eprintf "Verifying election %S:\n%!" e.election.e_short_name;
let {g; p; q; y} = e.election.e_public_key in
let module G = (val ElGamal.make_ff_msubgroup p q g : ElGamal.GROUP with type t = Z.t) in
......@@ -117,21 +85,21 @@ let verbose_verify_election_test_data e =
e.election.e_public_key.y
e.public_data.public_keys
));
(match e.votes with
| Some votes ->
verbose_assert "votes" (lazy (
Array.foralli
(fun _ x -> Crypto.verify_vote e.election e.fingerprint x)
votes
));
(match e.public_data.election_result with
| Some r ->
verbose_assert "encrypted tally" (lazy (
r.encrypted_tally = Crypto.compute_encrypted_tally e.election votes
))
| None -> ()
);
| None -> Printf.eprintf " no votes available\n%!"
if Array.length votes = 0 then (
Printf.eprintf " no votes available\n%!"
) else (
verbose_assert "votes" (lazy (
Array.foralli (fun _ x ->
Crypto.verify_vote e.election e.fingerprint x
) votes
));
(match e.public_data.election_result with
| Some r ->
verbose_assert "encrypted tally" (lazy (
r.encrypted_tally = Crypto.compute_encrypted_tally e.election votes
))
| None -> ()
);
);
(match e.public_data.election_result with
| Some r ->
......@@ -145,19 +113,17 @@ let verbose_verify_election_test_data e =
verbose_assert "private keys" (lazy (
Array.foralli
(fun _ k -> Crypto.verify_private_key k)
e.private_data.private_keys
private_data.private_keys
));;
let notdotfiles_of_directory dirname =
Lwt_unix.files_of_directory dirname |>
Lwt_stream.filter (fun x -> String.length x > 0 && x.[0] <> '.') |>
Lwt_stream.map (Filename.concat dirname) |>
Lwt_stream.to_list |>
Lwt_main.run
let load_election_and_verify_it_all dirname =
notdotfiles_of_directory dirname |>
List.map load_election_test_data |>
load_elections_and_votes dirname |>
Lwt_stream.to_list |> Lwt_main.run |>
List.map (fun (e, v) ->
let votes = Lwt_stream.to_list v |> Lwt_main.run |> Array.of_list in
let private_data = load_election_private_data dirname (Uuidm.to_string e.election.e_uuid) in
(e, votes, private_data)
) |>
List.iter verbose_verify_election_test_data;;
let () = load_election_and_verify_it_all "tests/data"
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