Commit 99c096f5 authored by Stephane Glondu's avatar Stephane Glondu

Debug

parent 271d892e
......@@ -10,25 +10,6 @@ let hashZ x = Cryptokit.(x |>
Z.of_string_base 16
)
(** Some combinators on arrays *)
let map2 f a b =
Array.mapi (fun i ai -> f ai b.(i)) a
let map2i f a b =
Array.mapi (fun i ai -> f i ai b.(i)) a
let map2ij f a b =
Array.mapi (fun i ai ->
let bi = b.(i) in
Array.mapi (fun j aj ->
f aj bi.(j)
) ai
) a
let map3 f a b c =
Array.mapi (fun i ai -> f ai b.(i) c.(i)) a
let map_and_concat_with_commas f xs =
let n = Array.length xs in
let res = Buffer.create (n * 1024) in
......@@ -93,7 +74,7 @@ module MakeHomomorphicElection (P : Crypto_sigs.ELECTION_PARAMS) = struct
beta = c1.beta *~ c2.beta;
}
let combine_ciphertexts = map2ij eg_combine
let combine_ciphertexts = Array.map2ij eg_combine
type plaintext = int array array
type ballot = public_key Serializable_t.ballot
......@@ -122,11 +103,6 @@ module MakeHomomorphicElection (P : Crypto_sigs.ELECTION_PARAMS) = struct
let response = Z.((w + x * challenge) mod q) in
{challenge; response}
let fs_verify gs ys {challenge; response} oracle =
let commitments = map2 (fun g y ->
g **~ response / y **~ challenge
) gs ys in oracle commitments
(** ZKPs for disjunctions *)
let eg_disj_prove d x r {alpha; beta} =
......@@ -143,58 +119,67 @@ module MakeHomomorphicElection (P : Crypto_sigs.ELECTION_PARAMS) = struct
and response = random q in
proofs.(i) <- {challenge; response};
commitments.(2*i) <- g **~ response / alpha **~ challenge;
commitments.(2*i+1) <- y **~ response / beta *~ d.(i);
commitments.(2*i+1) <- y **~ response / (beta *~ d.(i)) **~ challenge;
total_challenges := Z.(!total_challenges + challenge);
in
for i = 0 to x-1 do f i done;
for i = x+1 to n-1 do f i done;
total_challenges := Z.(q - !total_challenges mod q);
(* compute genuine proof *)
proofs.(x) <- fs_prove [| g; beta *~ d.(x) |] r (fun commitx ->
proofs.(x) <- fs_prove [| g; y |] r (fun commitx ->
Array.blit commitx 0 commitments (2*x) 2;
Z.((G.hash commitments + !total_challenges) mod q)
);
proofs
let eg_disj_verify d proofs {alpha; beta} =
G.check alpha && G.check beta &&
let n = Array.length d in
assert (n = Array.length proofs);
n = Array.length proofs &&
let commitments = Array.create (2*n) g
and total_challenges = ref Z.zero in
for i = 0 to n-1 do
let {challenge; response} = proofs.(i) in
commitments.(2*i) <- g **~ response / alpha **~ challenge;
commitments.(2*i+1) <- y **~ response / beta *~ d.(i);
total_challenges := Z.(!total_challenges + challenge);
done;
total_challenges := Z.(!total_challenges mod q);
hash commitments =% !total_challenges
try
for i = 0 to n-1 do
let {challenge; response} = proofs.(i) in
if check_modulo q challenge && check_modulo q response then (
commitments.(2*i) <- g **~ response / alpha **~ challenge;
commitments.(2*i+1) <- y **~ response / (beta *~ d.(i)) **~ challenge;
total_challenges := Z.(!total_challenges + challenge);
) else raise Exit
done;
total_challenges := Z.(!total_challenges mod q);
hash commitments =% !total_challenges
with Exit -> false
(** Ballot creation *)
let invg = invert g
let d01 = [| G.one; invg |]
let make_d min max =
let n = max - min + 1 in
let d = Array.create n (invert (g **~ Z.of_int min)) in
for i = 1 to n-1 do
d.(i) <- d.(i-1) *~ invg
done;
d
let create_answer q r m =
let choices = map2 eg_encrypt r m in
let individual_proofs = map2i (eg_disj_prove d01) r choices in
let choices = Array.map2 eg_encrypt r m in
let individual_proofs = Array.map3 (eg_disj_prove d01) m r choices in
(* create overall_proof from homomorphic combination of individual
weights *)
let sumr = Array.fold_left Z.(+) Z.zero r in
let summ = Array.fold_left (+) 0 m in
let sumc = Array.fold_left eg_combine dummy_ciphertext choices in
assert (q.q_min <= summ && summ <= q.q_max);
let n = q.q_max - q.q_min + 1 in
let d = Array.create n (invert (g **~ Z.of_int q.q_min)) in
for i = 1 to n-1 do
d.(i) <- d.(i-1) *~ invg
done;
let overall_proof = eg_disj_prove d summ sumr sumc in
let d = make_d q.q_min q.q_max in
let overall_proof = eg_disj_prove d (summ - q.q_min) sumr sumc in
{choices; individual_proofs; overall_proof}
let create_ballot r m =
{
answers = map3 create_answer params.e_questions r m;
answers = Array.map3 create_answer params.e_questions r m;
election_hash = fingerprint;
election_uuid = params.e_uuid
}
......@@ -204,29 +189,27 @@ module MakeHomomorphicElection (P : Crypto_sigs.ELECTION_PARAMS) = struct
let verify_answer q a =
Array.forall2 (eg_disj_verify d01) a.individual_proofs a.choices &&
let sumc = Array.fold_left eg_combine dummy_ciphertext a.choices in
let n = q.q_max - q.q_min + 1 in
let d = Array.create n (invert (g **~ Z.of_int q.q_min)) in
for i = 1 to n-1 do
d.(i) <- d.(i-1) *~ invg
done;
let d = make_d q.q_min q.q_max in
eg_disj_verify d a.overall_proof sumc
let check_ballot b =
b.election_uuid = params.e_uuid &&
b.election_hash = P.fingerprint &&
Array.forall2 verify_answer params.e_questions b.answers
let extract_ciphertext b = Array.map (fun x -> x.choices) b.answers
type factor = public_key Serializable_t.partial_decryption
let compute_factor = assert false
let compute_factor c x = assert false
let check_factor = assert false
let check_factor c y f = assert false
type result = public_key Serializable_t.result
let combine_factors = assert false
let combine_factors nb_tallied c fs = assert false
let check_result = assert false
let check_result r = assert false
let extract_tally = assert false
let extract_tally r = assert false
end
......@@ -2,6 +2,7 @@ StdExtra
Core_datatypes_j
Serializable_t
Serializable_j
Crypto
Serializable_compat_t
Serializable_compat_j
Serializable_compat
......
open StdExtra
open Serializable_compat_t
let of_question q =
......@@ -42,3 +43,86 @@ let of_ballot b =
let answers = Array.map of_answer answers in
let open Serializable_t in
{answers; election_hash; election_uuid}
module type COMPAT = sig
type t
val to_ballot : t Serializable_t.ballot -> t ballot
end
module MakeCompat (P : Crypto_sigs.ELECTION_PARAMS) = struct
open Serializable_t
open P
open G
type t = G.t
(* The following duplicates parts of module Crypto, in order to
reconstruct commitments. *)
let dummy_ciphertext =
{
alpha = G.one;
beta = G.one;
}
let eg_combine c1 c2 =
{
alpha = c1.alpha *~ c2.alpha;
beta = c1.beta *~ c2.beta;
}
let dummy_proof =
let open Serializable_compat_t in
{
dp_commitment = {a = G.one; b = G.one};
dp_challenge = Z.zero;
dp_response = Z.zero;
}
let y = params.e_public_key
let ( / ) x y = x *~ invert y
let invg = invert G.g
let d01 = [| G.one; invg |]
let make_d min max =
let n = max - min + 1 in
let d = Array.create n (invert (g **~ Z.of_int min)) in
for i = 1 to n-1 do
d.(i) <- d.(i-1) *~ invg
done;
d
let recommit d proofs {alpha; beta} =
let n = Array.length d in
assert (n = Array.length proofs);
let result = Array.create n dummy_proof in
for i = 0 to n-1 do
let {challenge; response} = proofs.(i) in
let dp_commitment = {
a = g **~ response / alpha **~ challenge;
b = y **~ response / (beta *~ d.(i)) **~ challenge;
} in
let open Serializable_compat_t in
result.(i) <- {
dp_commitment;
dp_challenge = challenge;
dp_response = response;
};
done;
result
let to_answer a q =
let {choices; individual_proofs; overall_proof} = a in
let individual_proofs = Array.map2 (recommit 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 in
let open Serializable_compat_t in
{choices; individual_proofs; overall_proof}
let to_ballot b =
let {answers; election_hash; election_uuid} = b in
let answers = Array.map2 to_answer answers params.e_questions in
let open Serializable_compat_t in
{answers; election_hash; election_uuid}
end
......@@ -4,3 +4,11 @@ open Serializable_compat_t
val of_election : 'a election -> 'a Serializable_t.election
val of_ballot : 'a ballot -> 'a Serializable_t.ballot
module type COMPAT = sig
type t
val to_ballot : t Serializable_t.ballot -> t ballot
end
module MakeCompat (P : Crypto_sigs.ELECTION_PARAMS) :
COMPAT with type t = P.G.t
......@@ -4,6 +4,13 @@ let ( =% ) = Z.equal
module Array = struct
include Array
let forall f a =
let n = Array.length a in
(let rec check i =
if i >= 0 then f a.(i) && check (pred i)
else true
in check (pred n))
let forall2 f a b =
let n = Array.length a in
n = Array.length b &&
......@@ -17,6 +24,23 @@ module Array = struct
if i >= 0 then f i x.(i) && loop (pred i)
else true
in loop (pred (Array.length x))
let map2 f a b =
Array.mapi (fun i ai -> f ai b.(i)) a
let map2i f a b =
Array.mapi (fun i ai -> f i ai b.(i)) a
let map2ij f a b =
Array.mapi (fun i ai ->
let bi = b.(i) in
Array.mapi (fun j aj ->
f aj bi.(j)
) ai
) a
let map3 f a b c =
Array.mapi (fun i ai -> f ai b.(i) c.(i)) a
end
module List = struct
......@@ -61,4 +85,9 @@ let non_empty_lines_of_file fname =
Lwt_stream.filter (fun s -> s <> "") |>
Lwt_stream.to_list
let random q = assert false
let prng = Cryptokit.Random.(pseudo_rng (string secure_rng 32))
let random q =
let size = Z.size q * Sys.word_size / 8 in
let r = Cryptokit.Random.string prng size in
Z.(of_bits r mod q)
......@@ -8,8 +8,13 @@ end
module Array : sig
include module type of Array
val forall : ('a -> bool) -> 'a array -> bool
val forall2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
val foralli : (int -> 'a -> bool) -> 'a array -> bool
val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
val map2i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
val map2ij : ('a -> 'b -> 'c) -> 'a array array -> 'b array array -> 'c array array
val map3 : ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
end
module String : sig
......
......@@ -142,7 +142,7 @@ let rec get_election name = function
let e, ballots, signatures, private_data = get_election "editor" all_data;;
let {g; p; q; y} = e.election.e_public_key
module G = (val ElGamal.make_ff_msubgroup p q g : ElGamal.GROUP with type t = Z.t)
module Crypto = ElGamal.Make (G)
module MyCrypto = ElGamal.Make (G)
let random_exponent =
let pseudo = lazy Cryptokit.Random.(pseudo_rng (string secure_rng 20)) in
......@@ -231,4 +231,26 @@ let make_ballot e election_hash answers =
}
let b1 = make_ballot e.election e.fingerprint [| [| 1; 0; 0; 0 |] |];;
assert (Crypto.check_ballot e.election e.fingerprint b1);;
assert (MyCrypto.check_ballot e.election e.fingerprint b1);;
module P = struct
module G = (val Crypto.finite_field ~p ~q ~g : Crypto_sigs.GROUP with type t = Z.t)
let params = Serializable_compat.of_election e.election
let fingerprint = e.fingerprint
end
module Election = Crypto.MakeHomomorphicElection(P)
module Compat = Serializable_compat.MakeCompat(P)
let nballots = Array.map Serializable_compat.of_ballot ballots;;
assert (Array.forall Election.check_ballot nballots);;
assert (Array.forall2 (fun b b' -> b = Compat.to_ballot b') ballots nballots);;
let create_ballot b =
let randomness = Array.map (fun x ->
Array.map (fun _ -> random q) x
) b in
Election.create_ballot randomness b
let test_ballot = create_ballot [| [| 1; 0; 0; 0 |] |];;
assert (Election.check_ballot test_ballot);;
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