crypto.ml 6.07 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1
open Util
Stephane Glondu's avatar
Stephane Glondu committed
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

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

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

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
77
  let combine_ciphertexts = Array.map2ij eg_combine
Stephane Glondu's avatar
Stephane Glondu committed
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

  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}

  (** 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;
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
122
      commitments.(2*i+1) <- y **~ response / (beta *~ d.(i)) **~ challenge;
Stephane Glondu's avatar
Stephane Glondu committed
123
124
125
126
127
128
      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 *)
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
129
    proofs.(x) <- fs_prove [| g; y |] r (fun commitx ->
Stephane Glondu's avatar
Stephane Glondu committed
130
131
132
133
134
135
      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} =
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
136
    G.check alpha && G.check beta &&
Stephane Glondu's avatar
Stephane Glondu committed
137
    let n = Array.length d in
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
138
    n = Array.length proofs &&
Stephane Glondu's avatar
Stephane Glondu committed
139
140
    let commitments = Array.create (2*n) g
    and total_challenges = ref Z.zero in
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
141
142
143
144
145
146
147
148
149
150
151
152
    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
Stephane Glondu's avatar
Stephane Glondu committed
153
154
155
156
157
158

  (** Ballot creation *)

  let invg = invert g
  let d01 = [| G.one; invg |]

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
159
160
161
162
163
164
165
166
  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

Stephane Glondu's avatar
Stephane Glondu committed
167
  let create_answer q r m =
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
168
169
    let choices = Array.map2 eg_encrypt r m in
    let individual_proofs = Array.map3 (eg_disj_prove d01) m r choices in
Stephane Glondu's avatar
Stephane Glondu committed
170
171
172
173
174
175
    (* 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);
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
176
177
    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
Stephane Glondu's avatar
Stephane Glondu committed
178
179
180
181
    {choices; individual_proofs; overall_proof}

  let create_ballot r m =
    {
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
182
      answers = Array.map3 create_answer params.e_questions r m;
Stephane Glondu's avatar
Stephane Glondu committed
183
184
185
186
187
188
189
190
191
      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
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
192
    let d = make_d q.q_min q.q_max in
Stephane Glondu's avatar
Stephane Glondu committed
193
194
195
    eg_disj_verify d a.overall_proof sumc

  let check_ballot b =
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
196
197
    b.election_uuid = params.e_uuid &&
    b.election_hash = P.fingerprint &&
Stephane Glondu's avatar
Stephane Glondu committed
198
199
200
201
202
203
    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

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
204
  let compute_factor c x = assert false
Stephane Glondu's avatar
Stephane Glondu committed
205

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
206
  let check_factor c y f = assert false
Stephane Glondu's avatar
Stephane Glondu committed
207
208
209

  type result = public_key Serializable_t.result

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
210
  let combine_factors nb_tallied c fs = assert false
Stephane Glondu's avatar
Stephane Glondu committed
211

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
212
  let check_result r = assert false
Stephane Glondu's avatar
Stephane Glondu committed
213

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
214
  let extract_tally r = assert false
Stephane Glondu's avatar
Stephane Glondu committed
215
end