Commit 5a9eaf5e authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Rework crypto interface

parent 2a5df0c2
Serializable_t
Crypto_sigs
Crypto
ElGamal
open StdExtra
(** Helper functions *)
let check_modulo p x = Z.(geq x zero && lt x p)
let hashZ x = Cryptokit.(x |>
hash_string (Hash.sha1 ()) |>
transform_string (Hexa.encode ()) |>
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
for i = 0 to n-1 do
Buffer.add_string res (f xs.(i));
Buffer.add_char res ',';
done;
let size = Buffer.length res - 1 in
if size > 0 then Buffer.sub res 0 size else ""
(** Finite field arithmetic *)
let finite_field ~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 q = q
let one = Z.one
let g = g
let ( *~ ) a b = a * b mod p
let ( **~ ) a b = powm a b p
let invert x = invert x p
let ( =~ ) = equal
let check x = check_modulo p x && x **~ q =~ one
let hash xs = hashZ (map_and_concat_with_commas Z.to_string xs)
end in (module G : Crypto_sigs.GROUP with type t = Z.t)
else
invalid_arg "Invalid parameters for a multiplicative subgroup of finite field"
(** Homomorphic elections *)
module MakeHomomorphicElection (P : Crypto_sigs.ELECTION_PARAMS) = struct
open Serializable_t
open P
open G
type private_key = Z.t
type public_key = G.t
let election_params = params
let y = params.e_public_key
let ( / ) x y = x *~ invert y
type ciphertext = public_key Serializable_t.ciphertext array array
let dummy_ciphertext =
{
alpha = G.one;
beta = G.one;
}
(** Multiply two ElGamal ciphertexts. *)
let eg_combine c1 c2 =
{
alpha = c1.alpha *~ c2.alpha;
beta = c1.beta *~ c2.beta;
}
let combine_ciphertexts = map2ij eg_combine
type plaintext = int array array
type ballot = public_key Serializable_t.ballot
type randomness = Z.t array array
(** ElGamal encryption. *)
let eg_encrypt r x =
{
alpha = g **~ r;
beta = y **~ r *~ g **~ Z.of_int x;
}
let dummy_proof =
{
challenge = Z.zero;
response = Z.zero;
}
(** Fiat-Shamir non-interactive zero-knowledge proofs of
knowledge *)
let fs_prove gs x oracle =
let w = random q in
let commitments = Array.map (fun g -> g **~ w) gs in
let challenge = oracle commitments in
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} =
(* 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
assert (0 <= x && x < n);
let proofs = Array.create n dummy_proof
and commitments = Array.create (2*n) g
and total_challenges = ref Z.zero in
(* compute fake proofs *)
let f i =
let challenge = random q
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);
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 ->
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} =
let n = Array.length d in
assert (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
(** Ballot creation *)
let invg = invert g
let d01 = [| G.one; invg |]
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
(* 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
{choices; individual_proofs; overall_proof}
let create_ballot r m =
{
answers = map3 create_answer params.e_questions r m;
election_hash = fingerprint;
election_uuid = params.e_uuid
}
(** Ballot verification *)
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;
eg_disj_verify d a.overall_proof sumc
let check_ballot b =
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 check_factor = assert false
type result = public_key Serializable_t.result
let combine_factors = assert false
let check_result = assert false
let extract_tally = assert false
end
(** Cryptographic primitives *)
val finite_field : p:Z.t -> q:Z.t -> g:Z.t ->
(module Crypto_sigs.GROUP with type t = Z.t)
(** [finite_field p q g] builds the multiplicative subgroup of F[p],
generated by [g], of order [q]. It performs basic consistency
checks on [p], [q] and [g] and raises [Invalid_argument] in caise
of failure. *)
module MakeHomomorphicElection (P : Crypto_sigs.ELECTION_PARAMS) :
Crypto_sigs.HOMOMORPHIC with type public_key = P.G.t
(** Cryptographic primitives signatures *)
(** A group suitable for discrete logarithm-based cryptography. *)
module type GROUP = sig
(** The following interface is redundant: it is assumed, but not
checked, that usual mathematical relations hold. *)
type t
(** The type of elements. Note that it may be larger than the group
itself, hence the [check] function below. *)
val check : t -> bool
(** Check group membership. *)
val one : t
(** The neutral element of the group. *)
val g : t
(** A generator of the group. *)
val q : Z.t
(** The order of [g]. *)
val ( *~ ) : t -> t -> t
(** Multiplication. *)
val ( **~ ) : t -> Z.t -> t
(** Exponentiation. *)
val ( =~ ) : t -> t -> bool
(** Equality test. *)
val invert : t -> t
(** Inversion. *)
val hash : t array -> Z.t
(** Hash an array of elements into an integer mod [q]. *)
end
(** Parameters for an election. *)
module type ELECTION_PARAMS = sig
module G : GROUP
(** The group used for cryptography. *)
val params : G.t Serializable_t.election
(** Other parameters. *)
val fingerprint : string
(** The election fingerprint. *)
end
(** Cryptographic primives for an election with homomorphic tally. *)
module type HOMOMORPHIC = sig
(** {2 Election parameters} *)
(** Ballots are encrypted using public-key cryptography secured by
the discrete logarithm problem. Here, we suppose private keys
are integers modulo a large prime number. Public keys are
members of a suitably chosen group. *)
type private_key = Z.t
type public_key
val election_params : public_key Serializable_t.election
(** {2 Ciphertexts} *)
type ciphertext = public_key Serializable_t.ciphertext array array
(** A ciphertext that can be homomorphically combined. *)
val combine_ciphertexts : ciphertext -> ciphertext -> ciphertext
(** Combine two ciphertexts. The encrypted tally of an election is
the combination of all ciphertexts of valid cast ballots. *)
(** {2 Ballots} *)
type plaintext = int array array
(** The plaintext equivalent of [ciphertext], i.e. the contents of a
ballot. When [x] is such a value, [x.(i).(j)] is the weight (0
or 1) given to answer [j] in question [i]. *)
type ballot = public_key Serializable_t.ballot
(** A ballot ready to be transmitted, containing the encrypted
answers and cryptographic proofs that they satisfy the election
constraints. *)
type randomness = Z.t array array
(** Randomness needed to create a ballot. *)
val create_ballot : randomness -> plaintext -> ballot
(** [create_ballot answers] creates a ballot, or raises
[Invalid_argument] if [answers] doesn't satisfy the election
constraints. *)
val check_ballot : ballot -> bool
(** [check_ballot b] checks all the cryptographic proofs in [b]. All
ballots produced by [create_ballot] should pass this check. *)
val extract_ciphertext : ballot -> ciphertext
(** Extract the ciphertext from a ballot. *)
(** {2 Partial decryptions} *)
type factor = public_key Serializable_t.partial_decryption
(** A decryption share. It is computed by a trustee from his or her
private key share and the encrypted tally, and contains a
cryptographic proof that he or she didn't cheat. *)
val compute_factor : randomness -> ciphertext -> private_key -> factor
val check_factor : ciphertext -> public_key -> factor -> bool
(** [check_factor c pk f] checks that [f], supposedly submitted by a
trustee whose public_key is [pk], is valid with respect to the
encrypted tally [c]. *)
(** {2 Result} *)
type result = public_key Serializable_t.result
(** The election result. It contains the needed data to validate the
result from the encrypted tally. *)
val combine_factors : int -> ciphertext -> factor array -> result
(** Combine the encrypted tally and the factors from all trustees to
produce the election result. This first argument is the number
of tallied ballots. *)
val check_result : result -> bool
val extract_tally : result -> plaintext
(** Extract the plaintext result of the election. *)
end
......@@ -3,4 +3,5 @@ Core_datatypes_j
Helios_datatypes_t
Helios_datatypes_j
Common
Crypto
ElGamal
<doc text="Serializable datatypes">
(** {2 Predefined types} *)
type number <ocaml predef from="Core_datatypes"> = abstract
type uuid <ocaml predef from="Core_datatypes"> = abstract
(** {2 Basic cryptographic datastructures} *)
type 'a ciphertext = {
alpha : 'a;
beta : 'a;
}
<doc text="An ElGamal ciphertext.">
type proof = {
challenge : number;
response : number;
}
<doc text="A Fiat-Shamir non-interactive zero-knowledge proof of knowledge (ZKP).">
type disjunctive_proof = proof list <ocaml repr="array">
<doc text="A disjunctive ZKP. The size of the array is the number of disjuncts. ">
(** {2 Elections} *)
type question = {
answers : string list <ocaml repr="array">;
min : int;
max : int;
question : string;
} <ocaml field_prefix="q_">
type 'a election = {
description : string;
name : string;
public_key : 'a;
questions : question list <ocaml repr="array">;
uuid : uuid;
short_name : string;
} <ocaml field_prefix="e_">
<doc text="Election parameters relevant for creating a ballot.">
type 'a answer = {
choices : 'a ciphertext list <ocaml repr="array">;
individual_proofs : disjunctive_proof list <ocaml repr="array">;
overall_proof : disjunctive_proof;
}
<doc text="An answer to a question. It consists of a weight for each
choice, a proof that each of these weights is 0 or 1, and an overall
proof that the total weight is within bounds.">
type 'a ballot = {
answers : 'a answer list <ocaml repr="array">;
election_hash : string;
election_uuid : uuid;
}
type 'a partial_decryption = {
decryption_factors : 'a list <ocaml repr="array"> list <ocaml repr="array">;
decryption_proofs : proof list <ocaml repr="array"> list <ocaml repr="array">;
}
type 'a result = {
encrypted_tally : 'a ciphertext list <ocaml repr="array"> list <ocaml repr="array">;
partial_decryptions : 'a partial_decryption list <ocaml repr="array">;
result : int list <ocaml repr="array"> list <ocaml repr="array">;
}
......@@ -60,3 +60,5 @@ let non_empty_lines_of_file fname =
Lwt_io.lines_of_file fname |>
Lwt_stream.filter (fun s -> s <> "") |>
Lwt_stream.to_list
let random q = assert false
......@@ -22,3 +22,5 @@ val hashB : string -> string
val load_from_file : (Yojson.lexer_state -> Lexing.lexbuf -> 'a) -> string -> 'a
val non_empty_lines_of_file : string -> string list Lwt.t
val random : Z.t -> Z.t
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