Commit 857da2e5 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Simplification of types

 * drop ELECTION_PARAMS signature
 * parameters are no longer implicit in ELECTION signature
 * redesign WEB_ELECTION signature
parent dbc13f50
open Signatures
open Util
open Serializable_t
......@@ -10,8 +11,8 @@ let hashB x = Cryptokit.(x |>
module G = Election.DefaultGroup;;
assert (Election.check_finite_field G.group);;
module M = Election.MakeSimpleMonad(G);;
module E = Election.MakeElection(G)(M);;
(* Setup trustees *)
......@@ -71,27 +72,24 @@ let metadata =
}
;;
module P = struct
module G = G
let params = params
let metadata = Some metadata
let public_keys = Lazy.lazy_from_val (
public_keys |> Array.map (fun x -> x.trustee_public_key)
)
let fingerprint =
let pks = public_keys |> Array.map (fun x -> x.trustee_public_key)
let e = {
e_params = params;
e_meta = Some metadata;
e_pks = Some pks;
e_fingerprint =
params |>
Serializable_j.string_of_params Serializable_builtin_j.write_number |>
hashB
end;;
module E = Election.MakeElection(P)(M);;
hashB;
};;
(* Vote *)
let vote b =
try
let b = E.create_ballot (E.make_randomness () ()) b () in
let ok = E.check_ballot b in
let b = E.create_ballot e (E.make_randomness e ()) b () in
let ok = E.check_ballot e b in
if ok then M.cast b "anonymous" ();
ok
with _ -> false
......@@ -110,15 +108,15 @@ assert (not (vote [|[| 1; 0; 0; 0; 0 |]; [| 0; 1; 0; 1; 0; 0 |]; [| 0; 1; 1 |]|]
let encrypted_tally = M.fold_ballots (fun b t ->
M.return (E.combine_ciphertexts (E.extract_ciphertext b) t)
) E.neutral_ciphertext ();;
) (E.neutral_ciphertext e) ();;
let factors = Array.map (fun x ->
E.compute_factor encrypted_tally x ()
) private_keys;;
assert (Array.forall2 (E.check_factor encrypted_tally) (Lazy.force P.public_keys) factors);;
assert (Array.forall2 (E.check_factor encrypted_tally) pks factors);;
let result = E.combine_factors (M.turnout ()) encrypted_tally factors;;
assert (E.check_result result);;
assert (E.check_result e result);;
let tally = E.extract_tally result;;
assert (tally = [|[| 1; 0; 1; 0; 0 |]; [|0; 4; 0; 4; 3; 0|]; [| 1; 1; 2 |]|]);;
......
open Signatures
open Util
open Serializable_t
......@@ -65,6 +66,7 @@ let () = assert (Election.check_finite_field group)
module G = (val Election.finite_field group : Election.FF_GROUP)
module M = Election.MakeSimpleMonad(G)
module E = Election.MakeElection(G)(M);;
(* Load and check trustee keys, if present *)
......@@ -96,19 +98,16 @@ let metadata =
| Some _ -> failwith "invalid metadata.json"
| None -> None
module P = struct
module G = G
let params = { params with e_public_key = y }
let metadata = metadata
let public_keys = lazy (
match public_keys with
| Some pks -> pks
| None -> failwith "missing public keys"
)
let fingerprint = election_fingerprint
end
let pks = match public_keys with
| Some pks -> pks
| None -> failwith "missing public keys"
module E = Election.MakeElection(P)(M);;
let e = {
e_params = { params with e_public_key = y };
e_meta = metadata;
e_pks = Some pks;
e_fingerprint = election_fingerprint;
}
(* Load ballots, if present *)
......@@ -138,7 +137,7 @@ let check_signature_present =
| None -> (fun _ -> true)
let vote (b, hash) =
if check_signature_present b && E.check_ballot b
if check_signature_present b && E.check_ballot e b
then M.cast b "anonymous" ()
else Printf.ksprintf failwith "ballot %s failed tests" hash
......@@ -150,7 +149,7 @@ let encrypted_tally = lazy (
| Some _ ->
M.fold_ballots (fun b t ->
M.return (E.combine_ciphertexts (E.extract_ciphertext b) t)
) E.neutral_ciphertext ()
) (E.neutral_ciphertext e) ()
)
let () =
......@@ -159,14 +158,9 @@ let () =
(match load_from_file (Serializable_builtin_j.number_of_string) fn with
| Some [sk] ->
let pk = G.(g **~ sk) in
let () =
match public_keys with
| Some pks ->
if Array.forall (fun x -> not (x =% pk)) pks then (
Printf.eprintf "Warning: your key is not present in public_keys.jsons!\n";
)
| None -> ()
in
if Array.forall (fun x -> not (x =% pk)) pks then (
Printf.eprintf "Warning: your key is not present in public_keys.jsons!\n";
);
let tally = Lazy.force encrypted_tally in
let factor =
E.compute_factor tally sk ()
......@@ -191,7 +185,7 @@ let result =
let () =
match result with
| Some [result] ->
assert (E.check_result result)
assert (E.check_result e result)
| Some _ ->
failwith "invalid result file"
| None ->
......@@ -201,9 +195,9 @@ let () =
match factors with
| Some factors ->
let tally = Lazy.force encrypted_tally in
assert (Array.forall2 (E.check_factor tally) (Lazy.force P.public_keys) factors);
assert (Array.forall2 (E.check_factor tally) pks factors);
let result = E.combine_factors (M.turnout ()) tally factors in
assert (E.check_result result);
assert (E.check_result e result);
save_to "result.json" (
Serializable_j.write_result Serializable_builtin_j.write_number
) result;
......
......@@ -63,13 +63,13 @@ module DefaultGroup = (val finite_field default_ff_params : FF_GROUP)
(** Parameters *)
let check_election p =
let module P = (val p : ELECTION_PARAMS) in
let open P in
let check_election_public_key (type t) g e =
let module G = (val g : GROUP with type t = t) in
let open G in
(* check public key *)
let computed = Array.fold_left ( *~ ) G.one (Lazy.force public_keys) in
computed =~ params.e_public_key
match e.e_pks with
| Some pks -> Array.fold_left ( *~ ) G.one pks =~ e.e_params.e_public_key
| None -> false
(** Simple monad *)
......@@ -139,8 +139,7 @@ end
(** Homomorphic elections *)
module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
open P
module MakeElection (G : GROUP) (M : RANDOM) = struct
open G
type 'a m = 'a M.t
......@@ -148,11 +147,11 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
let ( >>= ) = bind
type elt = G.t
type t = elt election
type private_key = Z.t
type public_key = elt
let election_params = params
let y = params.e_public_key
let ( / ) x y = x *~ invert y
type ciphertext = elt Serializable_t.ciphertext array array
......@@ -170,9 +169,9 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
beta = c1.beta *~ c2.beta;
}
let neutral_ciphertext = Array.map (fun q ->
let neutral_ciphertext e = Array.map (fun q ->
Array.make (Array.length q.q_answers) dummy_ciphertext
) params.e_questions
) e.e_params.e_questions
let combine_ciphertexts = Array.mmap2 eg_combine
......@@ -181,7 +180,7 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
type randomness = Z.t array array
(** ElGamal encryption. *)
let eg_encrypt r x =
let eg_encrypt y r x =
{
alpha = g **~ r;
beta = y **~ r *~ g **~ Z.of_int x;
......@@ -205,7 +204,7 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
(** ZKPs for disjunctions *)
let eg_disj_prove d zkp x r {alpha; beta} =
let eg_disj_prove y d zkp x r {alpha; beta} =
(* prove that alpha = g^r and beta = y^r/d_x *)
(* the size of d is the number of disjuncts *)
let n = Array.length d in
......@@ -243,7 +242,7 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
proofs.(x) <- p;
return proofs
let eg_disj_verify d zkp proofs {alpha; beta} =
let eg_disj_verify y d zkp proofs {alpha; beta} =
G.check alpha && G.check beta &&
let n = Array.length d in
n = Array.length proofs &&
......@@ -299,9 +298,9 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
) else return (Array.of_list accu)
in loop_outer (Array.length xs - 1) []
let create_answer zkp q r m =
let choices = Array.map2 eg_encrypt r m in
let individual_proofs = Array.map3 (eg_disj_prove d01 zkp) m r choices in
let create_answer y zkp q r m =
let choices = Array.map2 (eg_encrypt y) r m in
let individual_proofs = Array.map3 (eg_disj_prove y d01 zkp) m r choices in
(* create overall_proof from homomorphic combination of individual
weights *)
let sumr = Array.fold_left Z.(+) Z.zero r in
......@@ -309,36 +308,38 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
let sumc = Array.fold_left eg_combine dummy_ciphertext choices in
assert (q.q_min <= summ && summ <= q.q_max);
let d = make_d q.q_min q.q_max in
let overall_proof = eg_disj_prove d zkp (summ - q.q_min) sumr sumc in
let overall_proof = eg_disj_prove y d zkp (summ - q.q_min) sumr sumc in
swap individual_proofs >>= fun individual_proofs ->
overall_proof >>= fun overall_proof ->
return {choices; individual_proofs; overall_proof}
let make_randomness () =
let make_randomness e =
sswap (Array.map (fun q ->
Array.init (Array.length q.q_answers) (fun _ -> random G.q)
) params.e_questions)
) e.e_params.e_questions)
let create_ballot r m =
swap (Array.map3 (create_answer "") params.e_questions r m) >>= fun answers ->
let create_ballot e r m =
let p = e.e_params in
swap (Array.map3 (create_answer p.e_public_key "") p.e_questions r m) >>= fun answers ->
return {
answers;
election_hash = fingerprint;
election_uuid = params.e_uuid;
election_hash = e.e_fingerprint;
election_uuid = p.e_uuid;
signature = None;
}
(** Ballot verification *)
let verify_answer zkp q a =
Array.forall2 (eg_disj_verify d01 zkp) a.individual_proofs a.choices &&
let verify_answer y zkp q a =
Array.forall2 (eg_disj_verify y d01 zkp) a.individual_proofs a.choices &&
let sumc = Array.fold_left eg_combine dummy_ciphertext a.choices in
let d = make_d q.q_min q.q_max in
eg_disj_verify d zkp a.overall_proof sumc
eg_disj_verify y d zkp a.overall_proof sumc
let check_ballot b =
b.election_uuid = params.e_uuid &&
b.election_hash = P.fingerprint &&
let check_ballot e b =
let p = e.e_params in
b.election_uuid = p.e_uuid &&
b.election_hash = e.e_fingerprint &&
let ok, zkp = match b.signature with
| Some {s_public_key = y; s_challenge; s_response} ->
let ok =
......@@ -359,7 +360,7 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
in ok, G.to_string y
| None -> true, ""
in ok &&
Array.forall2 (verify_answer zkp) params.e_questions b.answers
Array.forall2 (verify_answer p.e_public_key zkp) p.e_questions b.answers
let extract_ciphertext b = Array.map (fun x -> x.choices) b.answers
......@@ -421,11 +422,13 @@ module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) = struct
let result = Array.mmap log results in
{num_tallied; encrypted_tally; partial_decryptions; result}
let check_result r =
let check_result e r =
let {encrypted_tally; partial_decryptions; result; num_tallied} = r in
check_ciphertext encrypted_tally &&
Array.forall2 (check_factor encrypted_tally)
(Lazy.force public_keys) partial_decryptions &&
(match e.e_pks with
| Some pks ->
Array.forall2 (check_factor encrypted_tally) pks partial_decryptions
| None -> false) &&
let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in
let factors = Array.fold_left (fun a b ->
Array.mmap2 ( *~ ) a b.decryption_factors
......
......@@ -17,8 +17,9 @@ val check_finite_field : Serializable_t.ff_params -> bool
module DefaultGroup : FF_GROUP
(** A sample group suitable for cryptography. *)
val check_election : (module ELECTION_PARAMS) -> bool
(** Check consistency of election parameters. *)
val check_election_public_key : (module GROUP with type t = 'a) ->
'a election -> bool
(** Check election public key. *)
module MakeSimpleMonad (G : GROUP) : sig
......@@ -64,6 +65,6 @@ module MakeSimpleDistKeyGen (G : GROUP) (M : RANDOM) : sig
end
(** Simple distributed generation of an election public key. *)
module MakeElection (P : ELECTION_PARAMS) (M : RANDOM) :
ELECTION with type elt = P.G.t and type 'a m = 'a M.t
module MakeElection (G : GROUP) (M : RANDOM) :
ELECTION with type elt = G.t and type 'a m = 'a M.t
(** Implementation of {!Signatures.ELECTION}. *)
open Signatures
open Util
open Serializable_compat_t
......@@ -51,11 +52,12 @@ let partial_decryption p =
let open Serializable_t in
{decryption_factors; decryption_proofs}
module MakeCompat (P : Signatures.ELECTION_PARAMS) = struct
module MakeCompat (G : GROUP) = struct
open Serializable_t
open P
open G
type election = G.t Signatures.election
(* The following duplicates parts of module Crypto, in order to
reconstruct commitments. *)
......@@ -79,7 +81,6 @@ module MakeCompat (P : Signatures.ELECTION_PARAMS) = struct
dp_response = Z.zero;
}
let y = params.e_public_key
let ( / ) x y = x *~ invert y
let invg = invert G.g
......@@ -93,7 +94,7 @@ module MakeCompat (P : Signatures.ELECTION_PARAMS) = struct
done;
d
let recommit d proofs {alpha; beta} =
let recommit y d proofs {alpha; beta} =
let n = Array.length d in
assert (n = Array.length proofs);
let result = Array.create n dummy_proof in
......@@ -112,25 +113,27 @@ module MakeCompat (P : Signatures.ELECTION_PARAMS) = struct
done;
result
let answer a q =
let answer y a q =
let {choices; individual_proofs; overall_proof} = a in
let individual_proofs =
Array.map2 (recommit d01) individual_proofs choices
Array.map2 (recommit y d01) individual_proofs choices
in
let sumc = Array.fold_left eg_combine dummy_ciphertext choices in
let overall_proof =
recommit (make_d q.q_min q.q_max) overall_proof sumc
recommit y (make_d q.q_min q.q_max) overall_proof sumc
in
let open Serializable_compat_t in
{choices; individual_proofs; overall_proof}
let ballot b =
let ballot e b =
let p = e.e_params in
let {answers; election_hash; election_uuid} = b in
let answers = Array.map2 answer answers params.e_questions in
let answers = Array.map2 (answer p.e_public_key) answers p.e_questions in
let open Serializable_compat_t in
{answers; election_hash; election_uuid}
let partial_decryption c p =
let partial_decryption e c p =
let y = e.e_params.e_public_key in
let {decryption_factors; decryption_proofs} = p in
let decryption_proofs =
Array.mmap3 (fun {alpha; _} f {challenge; response} ->
......
......@@ -7,8 +7,10 @@ val ballot : 'a ballot -> 'a Serializable_t.ballot
val partial_decryption :
'a partial_decryption -> 'a Serializable_t.partial_decryption
module MakeCompat (P : Signatures.ELECTION_PARAMS) : sig
val ballot : P.G.t Serializable_t.ballot -> P.G.t ballot
val partial_decryption : P.G.t Serializable_t.ciphertext array array ->
P.G.t Serializable_t.partial_decryption -> P.G.t partial_decryption
module MakeCompat (G : Signatures.GROUP) : sig
type election = G.t Signatures.election
val ballot : election -> G.t Serializable_t.ballot -> G.t ballot
val partial_decryption : election ->
G.t Serializable_t.ciphertext array array ->
G.t Serializable_t.partial_decryption -> G.t partial_decryption
end
......@@ -94,25 +94,19 @@ module type BALLOT_BOX = sig
end
(** Parameters for an election. *)
module type ELECTION_PARAMS = sig
module G : GROUP
(** The group used for cryptography. *)
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.params
type 'a election = {
e_params : 'a Serializable_t.params;
(** Parameters of the election. *)
val metadata : Serializable_t.metadata option
(** Other optional metadata. *)
e_meta : Serializable_t.metadata option;
(** Other optional, serializable, metadata. *)
val fingerprint : string
(** The election fingerprint. *)
end
e_pks : 'a array option;
(** Trustee public keys. *)
e_fingerprint : string;
(** Fingerprint of the election. *)
}
(** Cryptographic primitives for an election with homomorphic tally. *)
module type ELECTION = sig
......@@ -128,17 +122,17 @@ module type ELECTION = sig
members of a suitably chosen group. *)
type elt
type t = elt election
type private_key = Z.t
type public_key = elt
val election_params : elt Serializable_t.params
(** {2 Ciphertexts} *)
type ciphertext = elt Serializable_t.ciphertext array array
(** A ciphertext that can be homomorphically combined. *)
val neutral_ciphertext : ciphertext
val neutral_ciphertext : t -> ciphertext
(** The neutral element for [combine_ciphertext] below. *)
val combine_ciphertexts : ciphertext -> ciphertext -> ciphertext
......@@ -160,16 +154,16 @@ module type ELECTION = sig
type randomness = Z.t array array
(** Randomness needed to create a ballot. *)
val make_randomness : unit -> randomness m
val make_randomness : t -> randomness m
(** Creates randomness for [create_ballot] below. The result can be
kept for Benaloh-style auditing. *)
val create_ballot : randomness -> plaintext -> ballot m
val create_ballot : t -> randomness -> plaintext -> ballot m
(** [create_ballot r answers] creates a ballot, or raises
[Invalid_argument] if [answers] doesn't satisfy the election
constraints. *)
val check_ballot : ballot -> bool
val check_ballot : t -> ballot -> bool
(** [check_ballot b] checks all the cryptographic proofs in [b]. All
ballots produced by [create_ballot] should pass this check. *)
......@@ -201,7 +195,7 @@ module type ELECTION = sig
produce the election result. The first argument is the number of
tallied ballots. May raise [Invalid_argument]. *)
val check_result : result -> bool
val check_result : t -> result -> bool
val extract_tally : result -> plaintext
(** Extract the plaintext result of the election. *)
......
open Signatures
open Util
open Serializable_t
open Lwt
......@@ -6,6 +7,10 @@ open Lwt
<maxrequestbodysize> doesn't work *)
let () = Ocsigen_config.set_maxrequestbodysizeinmemory 128000
module G = Election.DefaultGroup
module M = Web_common.MakeLwtRandom(struct let rng = Web_common.make_rng () end)
module E = Election.MakeElection(G)(M)
module EMap = Map.Make(Uuidm)
let ( / ) = Filename.concat
......@@ -148,39 +153,27 @@ lwt election_table =
return (Web_common.SSet.mem (Web_common.string_of_user u) set)
)
in
let election = {
e_params = params;
e_meta = metadata;
e_pks = None;
e_fingerprint = fingerprint;
} in
let election_web = Web_common.({
params_fname;
fingerprint;
params;
public_keys_fname;
public_creds;
featured_p = true;
can_read = Any;
can_vote;
}) in
let {group; y} = params.e_public_key in
let module G = (val
Election.finite_field group : Election.FF_GROUP
) in
let module P = struct
module G = G
let public_keys = lazy (assert false)
let params = { params with e_public_key = y }
let fingerprint = fingerprint
let metadata = metadata
end in
let module X : Web_common.WEB_ELECTION = struct
open Web_common
module G = G
module M = MakeLwtRandom(struct let rng = make_rng () end)
module P = P
module E = Election.MakeElection(P)(M)
module B = MakeBallotBox(P)(E)
let election_web = election_web
end in
let web_election = Web_common.make_web_election
(module E : Web_common.LWT_ELECTION with type elt = Z.t)
election election_web
in
let module X = (val web_election : Web_common.WEB_ELECTION) in
X.B.inject_creds public_creds >>
let uuid = params.e_uuid in
return (EMap.add uuid (module X : Web_common.WEB_ELECTION) accu)
return (EMap.add uuid web_election accu)
) else return accu
)
)
......@@ -195,8 +188,9 @@ let get_election_by_uuid x =
let get_featured_elections () =
EMap.fold (fun uuid e res ->
let module X = (val e : Web_common.WEB_ELECTION) in
let e = X.election_web in
if e.Web_common.featured_p then e::res else res
if X.election_web.Web_common.featured_p then
X.election :: res
else res
) election_table [] |> return
let fail_http status =
......@@ -506,7 +500,7 @@ let do_cast election uuid () =
with Error e -> return (`Error e)
in
Eliom_reference.unset Services.ballot >>
Templates.do_cast_ballot ~auth_systems ~election:X.election_web ~result
Templates.do_cast_ballot ~auth_systems ~election:X.election ~result
) else forbidden ()
| None -> forbidden ()
end