Rework crypto interface

api.odocl

+Serializable_t
+Crypto_sigs
+Crypto
 ElGamal

src/crypto.ml

+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

src/crypto.mli

+(** 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

src/crypto_sigs.mli

+(** 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

src/lib.mllib

@@ -3,4 +3,5 @@ Core_datatypes_j
 Helios_datatypes_t
 Helios_datatypes_j
 Common
+Crypto
 ElGamal

src/serializable.atd

+<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">;
+}

src/stdExtra.ml

@@ -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

src/stdExtra.mli

@@ -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