crypto.ml 8.29 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

(** 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)
Stephane Glondu's avatar
Stephane Glondu committed
45
      let compare = Z.compare
Stephane Glondu's avatar
Stephane Glondu committed
46
47
48
49
50
51
    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 *)

Stephane Glondu's avatar
Stephane Glondu committed
52
module MakeElection (P : Crypto_sigs.ELECTION_PARAMS) = struct
Stephane Glondu's avatar
Stephane Glondu committed
53
54
55
  open Serializable_t
  open P
  open G
Stephane Glondu's avatar
Stephane Glondu committed
56
  type elt = G.t
Stephane Glondu's avatar
Stephane Glondu committed
57
  type private_key = Z.t
Stephane Glondu's avatar
Stephane Glondu committed
58
  type public_key = elt
Stephane Glondu's avatar
Stephane Glondu committed
59
60
61
62
63

  let election_params = params
  let y = params.e_public_key
  let ( / ) x y = x *~ invert y

Stephane Glondu's avatar
Stephane Glondu committed
64
  type ciphertext = elt Serializable_t.ciphertext array array
Stephane Glondu's avatar
Stephane Glondu committed
65
66
67
68
69
70
71
72
73
74
75
76
77
78

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

79
  let combine_ciphertexts = Array.mmap2 eg_combine
Stephane Glondu's avatar
Stephane Glondu committed
80
81

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

  (** Ballot creation *)

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

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
161
162
163
164
165
166
167
168
  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
169
  let create_answer q r m =
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
170
171
    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
172
173
174
175
176
177
    (* 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
178
179
    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
180
181
    {choices; individual_proofs; overall_proof}

182
183
184
185
186
  let create_randomness () =
    Array.map (fun q ->
      Array.init (Array.length q.q_answers) (fun _ -> random G.q)
    ) params.e_questions

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

  let check_ballot b =
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
203
204
    b.election_uuid = params.e_uuid &&
    b.election_hash = P.fingerprint &&
Stephane Glondu's avatar
Stephane Glondu committed
205
206
207
208
    Array.forall2 verify_answer params.e_questions b.answers

  let extract_ciphertext b = Array.map (fun x -> x.choices) b.answers

Stephane Glondu's avatar
Stephane Glondu committed
209
  type factor = elt Serializable_t.partial_decryption
Stephane Glondu's avatar
Stephane Glondu committed
210

211
212
213
214
  let eg_factor x {alpha; beta} =
    alpha **~ x,
    fs_prove [| g; alpha |] x hash

Stephane Glondu's avatar
Stephane Glondu committed
215
216
217
  let check_ciphertext c =
    Array.fforall (fun {alpha; beta} -> G.check alpha && G.check beta) c

218
  let compute_factor c x =
Stephane Glondu's avatar
Stephane Glondu committed
219
220
221
222
223
224
225
    if check_ciphertext c then (
      let res = Array.mmap (eg_factor x) c in
      let decryption_factors, decryption_proofs = Array.ssplit res in
      {decryption_factors; decryption_proofs}
    ) else (
      invalid_arg "Invalid ciphertext"
    )
226
227
228

  let check_factor c y f =
    Array.fforall3 (fun {alpha; _} f {challenge; response} ->
Stephane Glondu's avatar
Stephane Glondu committed
229
230
      check_modulo q challenge &&
      check_modulo q response &&
231
232
233
234
235
236
237
      let commitments =
        [|
          g **~ response / (y **~ challenge);
          alpha **~ response / (f **~ challenge);
        |]
      in hash commitments =% challenge
    ) c f.decryption_factors f.decryption_proofs
Stephane Glondu's avatar
Stephane Glondu committed
238

Stephane Glondu's avatar
Stephane Glondu committed
239
  type result = elt Serializable_t.result
Stephane Glondu's avatar
Stephane Glondu committed
240

Stephane Glondu's avatar
Stephane Glondu committed
241
242
243
244
245
  let combine_factors nb_tallied encrypted_tally partial_decryptions =
    let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in
    let factors = Array.fold_left (fun a b ->
      Array.mmap2 ( *~ ) a b.decryption_factors
    ) dummy partial_decryptions in
Stephane Glondu's avatar
Stephane Glondu committed
246
    let results = Array.mmap2 (fun {beta; _} f ->
Stephane Glondu's avatar
Stephane Glondu committed
247
248
249
250
251
      beta / f
    ) encrypted_tally factors in
    let log =
      let module GMap = Map.Make(G) in
      let rec loop i cur accu =
Stephane Glondu's avatar
Stephane Glondu committed
252
        if i <= nb_tallied
Stephane Glondu's avatar
Stephane Glondu committed
253
254
255
256
257
258
259
260
261
262
        then loop (succ i) (cur *~ g) (GMap.add cur i accu)
        else accu
      in
      let map = loop 0 G.one GMap.empty in
      fun x ->
        try
          GMap.find x map
        with Not_found ->
          invalid_arg "Cannot compute result"
    in
Stephane Glondu's avatar
Stephane Glondu committed
263
    let result = Array.mmap log results in
Stephane Glondu's avatar
Stephane Glondu committed
264
    {nb_tallied; encrypted_tally; partial_decryptions; result}
Stephane Glondu's avatar
Stephane Glondu committed
265

266
  let check_result r =
Stephane Glondu's avatar
Stephane Glondu committed
267
268
    let {encrypted_tally; partial_decryptions; result; nb_tallied} = r in
    check_ciphertext encrypted_tally &&
269
270
    Array.forall2 (check_factor encrypted_tally)
      public_keys partial_decryptions &&
Stephane Glondu's avatar
Stephane Glondu committed
271
272
273
274
275
276
277
278
    let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in
    let factors = Array.fold_left (fun a b ->
      Array.mmap2 ( *~ ) a b.decryption_factors
    ) dummy partial_decryptions in
    let results = Array.mmap2 (fun {beta; _} f ->
      beta / f
    ) encrypted_tally factors in
    Array.fforall2 (fun r1 r2 -> r1 =~ g **~ Z.of_int r2) results r.result
Stephane Glondu's avatar
Stephane Glondu committed
279

Stephane Glondu's avatar
Stephane Glondu committed
280
  let extract_tally r = r.result
Stephane Glondu's avatar
Stephane Glondu committed
281
end