Attention une mise à jour du service Gitlab va être effectuée le mardi 14 décembre entre 13h30 et 14h00. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

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

Remove module ElGamal (obsolete)

parent cbcd7675
Serializable_t
Crypto_sigs
Crypto
ElGamal
Serializable_compat_t
Serializable_compat
open Util
open Serializable_compat_t
module type GROUP = sig
type t
val g : t
val q : Z.t
val p : Z.t
val ( *~ ) : t -> t -> t
val ( **~ ) : t -> Z.t -> t
val ( =~ ) : t -> t -> bool
val inv : t -> t
val check_element : t -> bool
val hash : t list -> Z.t
end
let hashZ x = Cryptokit.(x |>
hash_string (Hash.sha1 ()) |>
transform_string (Hexa.encode ()) |>
Z.of_string_base 16
)
let check_modulo p x = Z.(geq x zero && lt x p)
let make_ff_msubgroup ~p ~q ~g =
if
Z.probab_prime p 10 > 0 &&
Z.probab_prime q 10 > 0 &&
check_modulo p g &&
check_modulo p q &&
Z.(powm g q p =% one)
then
let module G = struct
open Z
type t = Z.t
let p = p
let q = q
let g = g
let ( *~ ) a b = a * b mod p
let ( **~ ) a b = powm a b p
let inv x = invert x p
let ( =~ ) = equal
let check_element x = check_modulo p x && x **~ q =~ one
let hash x = hashZ (String.concat "," (List.map to_string x)) mod q
end in (module G : GROUP with type t = Z.t)
else
invalid_arg "Invalid parameters for a multiplicative subgroup of finite field"
module type ELGAMAL_CRYPTO = sig
type t
val check_public_key : t public_key -> bool
val check_private_key : t private_key -> bool
val check_election_key : t -> t trustee_public_key array -> bool
val check_ballot : t election -> string -> t ballot -> bool
val check_partial_decryptions : t election ->
t trustee_public_key array -> t result -> bool
val check_result : t election -> t result -> bool
val compute_encrypted_tally : t election -> t ballot array -> t encrypted_tally
end
module Make (G : GROUP) = struct
open G
(* FIXME: redundancy of group parameters that are embedded in the
abstract group *)
let check_exponent x = check_modulo q x
let one = g **~ Z.zero
let check_public_key k =
let {g = g'; p = p'; q = q'; y} = k in
g =~ g' && p =% p' && q =% q' && check_element y
let check_private_key k =
let {x; public_key = {y; _}} = k in
check_exponent x && y =~ g **~ x
let check_pok y pok =
let {pok_commitment; pok_challenge; pok_response} = pok in
(* NB: we don't check commitment and challenge thanks to hash *)
check_exponent pok_response &&
g **~ pok_response =~ pok_commitment *~ y **~ pok_challenge &&
pok_challenge =% hash [pok_commitment]
let check_election_key y tpks =
let n = Array.length tpks in
assert (n > 0);
let rec loop i accu =
if i >= 0 then
let tpk = tpks.(i) in
let {g = g'; p = p'; q = q'; y = y'} = tpk.trustee_public_key in
g =~ g' && p =% p' && q =% q' && check_pok y' tpk.trustee_pok &&
loop (pred i) (accu *~ y')
else accu =~ y
in loop (pred n) one
let check_disjunction h big_g big_hs proof =
let n = Array.length big_hs in
assert (n > 0);
n = Array.length proof &&
(let rec check i commitments challenges =
if i >= 0 then
let {dp_commitment = {a; b}; dp_challenge; dp_response} = proof.(i) in
(* NB: we don't check commitment and challenge thanks to hash *)
check_exponent dp_response &&
g **~ dp_response =~ big_g **~ dp_challenge *~ a &&
h **~ dp_response =~ big_hs.(i) **~ dp_challenge *~ b &&
check (pred i) (a :: b :: commitments) Z.(challenges + dp_challenge)
else
hash commitments =% Z.(challenges mod q)
in check (pred n) [] Z.zero)
let check_range h min max alpha beta proof =
Array.length proof = 2 &&
let big_hs = Array.init (max-min+1) (fun i -> beta *~ inv (g **~ Z.of_int (i-min))) in
check_disjunction h alpha big_hs proof
let check_answer y question answer =
let {q_max; q_min; q_answers; _} = question in
let q_max =
match q_max with
| Some q -> q
| None -> assert false (* FIXME *)
in
let nb = Array.length q_answers in
Array.length answer.choices = nb &&
Array.length answer.individual_proofs = nb &&
(let rec check i alphas betas =
if i >= 0 then
let {alpha; beta} = answer.choices.(i) in
check_element alpha &&
check_element beta &&
check_range y 0 1 alpha beta answer.individual_proofs.(i) &&
check (pred i) (alphas *~ alpha) (betas *~ beta)
else
check_range y q_min q_max alphas betas answer.overall_proof
in check (pred nb) one one)
let check_ballot e fingerprint v =
v.election_hash = fingerprint &&
e.e_uuid = v.election_uuid &&
Array.forall2 (check_answer e.e_public_key.y) e.e_questions v.answers
let check_equality h g' h' proof =
(* NB: similar to disjunctive, but with different challenge
checking... hardly factorizable *)
let {dp_commitment = {a; b}; dp_challenge; dp_response} = proof in
(* NB: we don't check commitment and challenge thanks to hash *)
check_exponent dp_response &&
g **~ dp_response =~ g' **~ dp_challenge *~ a &&
h **~ dp_response =~ h' **~ dp_challenge *~ b &&
dp_challenge =% hash [a; b]
let check_partial_decryption election tally tpk pds =
let y = tpk.trustee_public_key.y in
let {decryption_factors = dfs; decryption_proofs = dps} = pds in
Array.foralli (fun i question ->
let dfs_i = dfs.(i) and dps_i = dps.(i) and tally_i = tally.(i) in
Array.foralli (fun j answer ->
check_equality tally_i.(j).alpha y dfs_i.(j) dps_i.(j)
) question.q_answers
) election.e_questions
let check_partial_decryptions election public_keys r =
Array.forall2 (check_partial_decryption election r.encrypted_tally.tally)
public_keys
r.partial_decryptions
let check_result election public_data =
let pds = public_data.partial_decryptions in
let tally = public_data.encrypted_tally.tally in
let result = public_data.result in
Array.foralli (fun i question ->
Array.foralli (fun j answer ->
let combined_factor = Array.fold_left (fun accu f ->
accu *~ f.decryption_factors.(i).(j)
) one pds in
inv combined_factor *~ tally.(i).(j).beta =~ g **~ Z.of_int result.(i).(j)
) question.q_answers
) election.e_questions
let compute_encrypted_tally e vs =
let ( * ) a b = Z.({ alpha = a.alpha *~ b.alpha; beta = a.beta *~ b.beta}) in
let num_tallied = Array.length vs in
let tally = Array.mapi (fun i question ->
Array.mapi (fun j answer ->
Array.fold_left (fun accu v ->
accu * v.answers.(i).choices.(j)
) { alpha = one; beta = one} vs
) question.q_answers
) e.e_questions in
{ num_tallied; tally }
end
(** ElGamal cryptographic operations *)
open Serializable_compat_t
module type GROUP = sig
type t
(** type of elements *)
val g : t
(** generator *)
val q : Z.t
(** order of [g] *)
val p : Z.t
(** order of surrounding group *)
val ( *~ ) : t -> t -> t
(** multiplication *)
val ( **~ ) : t -> Z.t -> t
(** exponentiation *)
val ( =~ ) : t -> t -> bool
(** equality test *)
val inv : t -> t
(** inversion *)
val check_element : t -> bool
(** check group membership *)
val hash : t list -> Z.t
(** hash a list of elements into an integer mod [q] using SHA-1 *)
end
(** Signature of an abstract group suitable for ElGamal. *)
val make_ff_msubgroup : p:Z.t -> q:Z.t -> g:Z.t -> (module GROUP with type t = Z.t)
(** [make_ff_msubgroup p q g] builds the multiplicative subgroup of
F[p], generated by [g], of order [q]. *)
module type ELGAMAL_CRYPTO = sig
type t
val check_public_key : t public_key -> bool
val check_private_key : t private_key -> bool
val check_election_key : t -> t trustee_public_key array -> bool
val check_ballot : t election -> string -> t ballot -> bool
val check_partial_decryptions : t election ->
t trustee_public_key array -> t result -> bool
val check_result : t election -> t result -> bool
val compute_encrypted_tally : t election -> t ballot array -> t encrypted_tally
end
module Make (G : GROUP) : ELGAMAL_CRYPTO with type t := G.t
......@@ -8,4 +8,3 @@ Serializable_compat_j
Serializable_compat
Common
Crypto
ElGamal
......@@ -78,21 +78,28 @@ let verbose_assert msg it =
let verbose_verify_election_test_data (e, ballots, signatures, 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
let module Crypto = ElGamal.Make (G) in
let 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 in
let module Election = Crypto.MakeHomomorphicElection(P) in
(*
verbose_assert "election key" (lazy (
Crypto.check_election_key
e.election.e_public_key.y
e.public_data.public_keys
));
*)
if Array.length ballots = 0 then (
Printf.eprintf " no ballots available\n%!"
) else (
verbose_assert "ballots" (lazy (
Array.foralli (fun _ x ->
Crypto.check_ballot e.election e.fingerprint x
Election.check_ballot (Serializable_compat.of_ballot x)
) ballots
));
(*
(match e.public_data.election_result with
| Some r ->
verbose_assert "encrypted tally" (lazy (
......@@ -100,7 +107,9 @@ let verbose_verify_election_test_data (e, ballots, signatures, private_data) =
))
| None -> ()
);
*)
);
(*
(match e.public_data.election_result with
| Some r ->
verbose_assert "partial decryptions" (lazy (
......@@ -110,14 +119,18 @@ let verbose_verify_election_test_data (e, ballots, signatures, private_data) =
verbose_assert "result" (lazy (Crypto.check_result e.election r));
| None -> Printf.eprintf " no results available\n%!"
);
*)
verbose_assert "signature count" (lazy (
Array.length signatures = Array.length ballots
));
(*
verbose_assert "private keys" (lazy (
Array.foralli
(fun _ k -> Crypto.check_private_key k)
private_data.private_keys
));;
))
*)
();;
let iter_keep f xs = List.iter f xs; xs;;
......@@ -141,8 +154,6 @@ 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 MyCrypto = ElGamal.Make (G)
let random_exponent =
let pseudo = lazy Cryptokit.Random.(pseudo_rng (string secure_rng 20)) in
......@@ -153,86 +164,6 @@ let random_exponent =
let hex = Cryptokit.(transform_string (Hexa.encode ()) raw) in
Z.(of_string_base 16 hex mod q)
open G
let dummy_proof_item = {
dp_commitment = { a = Z.one; b = Z.one };
dp_challenge = Z.zero;
dp_response = Z.zero;
}
let make_proof min max choice r {alpha; beta} =
let n = max-min+1 in
let j = choice-min in
let proof = Array.create n dummy_proof_item in
for i = 0 to n-1 do
if i <> j then (
let dp_challenge = random_exponent ()
and dp_response = random_exponent () in
let a = g **~ dp_response *~ inv (alpha **~ dp_challenge)
and b = y **~ dp_response *~ inv ((beta *~ inv (g **~ Z.of_int i)) **~ dp_challenge) in
proof.(i) <- { dp_commitment = {a; b}; dp_challenge; dp_response }
)
done;
let w = random_exponent () in
let a = g **~ w and b = y **~ w in
let dp_challenge =
let commitments = ref [] and challenges = ref Z.zero in
for i = 0 to j-1 do
let {a; b} = proof.(i).dp_commitment in
commitments := b :: a :: !commitments;
challenges := Z.(!challenges + proof.(i).dp_challenge);
done;
commitments := b :: a :: !commitments;
for i = j+1 to n-1 do
let {a; b} = proof.(i).dp_commitment in
commitments := b :: a :: !commitments;
challenges := Z.(!challenges + proof.(i).dp_challenge);
done;
Z.((G.hash (List.rev !commitments) + q - !challenges) mod q)
in
let dp_response = Z.((r * dp_challenge + w) mod q) in
proof.(j) <- { dp_commitment = {a; b}; dp_challenge; dp_response };
proof
let make_ballot e election_hash answers =
let y = e.e_public_key.y in
{
answers =
Array.mapi (fun i answer ->
let randoms = Array.init (Array.length answer) (fun _ -> random_exponent ()) in
let choices =
Array.mapi (fun i choice ->
assert (choice = 0 || choice = 1);
let r = randoms.(i) in
{ alpha = g **~ r; beta = y **~ r *~ g **~ Z.of_int choice }
) answer
in
let individual_proofs =
Array.mapi (fun i x -> make_proof 0 1 answer.(i) randoms.(i) x) choices
in
let min = e.e_questions.(i).q_min in
let max = match e.e_questions.(i).q_max with
| Some x -> x
| None -> assert false (* FIXME *)
in
let overall_proof =
let ( *- ) a b = Z.({ alpha = a.alpha * b.alpha; beta = a.beta * b.beta }) in
let dummy_ciphertext = Z.({ alpha = one; beta = one}) in
let sum_cleartexts = Array.fold_left ( + ) 0 answer in
let sum_ciphertexts = Array.fold_left ( *- ) dummy_ciphertext choices in
let sum_randoms = Z.(Array.fold_left ( + ) zero randoms) in
make_proof min max sum_cleartexts sum_randoms sum_ciphertexts
in
{ choices; individual_proofs; overall_proof }
) answers;
election_hash;
election_uuid = e.e_uuid;
}
let b1 = make_ballot e.election e.fingerprint [| [| 1; 0; 0; 0 |] |];;
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
......@@ -268,7 +199,7 @@ assert (Array.forall2 (Election.check_factor tally) ys fs);;
let y = ys.(0);;
let x = Z.of_string "45298523167338358817538343074024028933886309805828157085973885299032584889325";;
assert (g **~ x =% y);;
assert P.G.(g **~ x =% y);;
let test_factor = Election.compute_factor tally x;;
assert (Election.check_factor tally y test_factor);;
......
......@@ -184,11 +184,15 @@ let () = Eliom_registration.Html5.register
try
let ballot = Serializable_compat_j.ballot_of_string Serializable_builtin_j.read_number raw_ballot in
let {g; p; q; y} = election.Common.election.e_public_key in
let module G = (val ElGamal.make_ff_msubgroup p q g : ElGamal.GROUP with type t = Z.t) in
let module Crypto = ElGamal.Make (G) in
let 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 election.Common.election
let fingerprint = assert false
end in
let module Election = Crypto.MakeHomomorphicElection(P) in
if
Uuidm.equal uuid ballot.election_uuid &&
Crypto.check_ballot election.Common.election election.Common.fingerprint ballot
Election.check_ballot (Serializable_compat.of_ballot ballot)
then `Valid (Common.hash_ballot ballot)
else `Invalid
with e -> `Malformed
......
Util
Serializable_builtin_j
Serializable_compat_j
ElGamal
Serializable_j
Serializable_compat
Common
Crypto
Helios_services
Helios_templates
Helios_registration
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