election.ml 16.8 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1 2 3
(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
Stephane Glondu's avatar
Stephane Glondu committed
4
(*  Copyright © 2012-2014 Inria                                           *)
Stephane Glondu's avatar
Stephane Glondu committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful, but   *)
(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

Stephane Glondu's avatar
Stephane Glondu committed
22
open Util
Stephane Glondu's avatar
Stephane Glondu committed
23
open Serializable_t
24
open Signatures
Stephane Glondu's avatar
Stephane Glondu committed
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41

(** Helper functions *)

let check_modulo p x = Z.(geq x zero && lt x p)

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

42
let check_finite_field {p; q; g} =
43 44
  Z.probab_prime p 20 > 0 &&
  Z.probab_prime q 20 > 0 &&
Stephane Glondu's avatar
Stephane Glondu committed
45 46 47 48
  check_modulo p g &&
  check_modulo p q &&
  Z.(powm g q p =% one)

49 50 51
module type FF_GROUP = GROUP
  with type t = Z.t
  and type group = ff_params
Stephane Glondu's avatar
Stephane Glondu committed
52

53 54
let finite_field group =
  let {p; q; g} = group in
Stephane Glondu's avatar
Stephane Glondu committed
55 56 57
  let module G = struct
    open Z
    type t = Z.t
Stephane Glondu's avatar
Stephane Glondu committed
58
    let p = p
Stephane Glondu's avatar
Stephane Glondu committed
59 60 61 62 63 64 65 66
    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 = Z.invert x p
    let ( =~ ) = Z.equal
    let check x = check_modulo p x && x **~ q =~ one
67
    let to_string = Z.to_string
68
    let hash prefix xs =
69 70 71
      let x = prefix ^ (map_and_concat_with_commas Z.to_string xs) in
      let z = Z.of_string_base 16 (sha256_hex x) in
      Z.(z mod q)
Stephane Glondu's avatar
Stephane Glondu committed
72
    let compare = Z.compare
73 74
    type group = ff_params
    let group = group
Stephane Glondu's avatar
Stephane Glondu committed
75 76
  end in (module G : FF_GROUP)

77 78 79 80 81
let default_ff_params = {
  p = Z.of_string "16328632084933010002384055033805457329601614771185955389739167309086214800406465799038583634953752941675645562182498120750264980492381375579367675648771293800310370964745767014243638518442553823973482995267304044326777047662957480269391322789378384619428596446446984694306187644767462460965622580087564339212631775817895958409016676398975671266179637898557687317076177218843233150695157881061257053019133078545928983562221396313169622475509818442661047018436264806901023966236718367204710755935899013750306107738002364137917426595737403871114187750804346564731250609196846638183903982387884578266136503697493474682071";
  q = Z.of_string "61329566248342901292543872769978950870633559608669337131139375508370458778917";
  g = Z.of_string "14887492224963187634282421537186040801304008017743492304481737382571933937568724473847106029915040150784031882206090286938661464458896494215273989547889201144857352611058572236578734319505128042602372864570426550855201448111746579871811249114781674309062693442442368697449970648232621880001709535143047913661432883287150003429802392229361583608686643243349727791976247247948618930423866180410558458272606627111270040091203073580238905303994472202930783207472394578498507764703191288249547659899997131166130259700604433891232298182348403175947450284433411265966789131024573629546048637848902243503970966798589660808533";
}
Stephane Glondu's avatar
Stephane Glondu committed
82

83
module DefaultGroup = (val finite_field default_ff_params : FF_GROUP)
Stephane Glondu's avatar
Stephane Glondu committed
84 85 86

(** Parameters *)

Stephane Glondu's avatar
Stephane Glondu committed
87 88
let check_election_public_key (type t) g e =
  let module G = (val g : GROUP with type t = t) in
Stephane Glondu's avatar
Stephane Glondu committed
89 90
  let open G in
  (* check public key *)
Stephane Glondu's avatar
Stephane Glondu committed
91 92 93
  match e.e_pks with
  | Some pks -> Array.fold_left ( *~ ) G.one pks =~ e.e_params.e_public_key
  | None -> false
Stephane Glondu's avatar
Stephane Glondu committed
94

Stephane Glondu's avatar
Stephane Glondu committed
95
(** Simple monad *)
Stephane Glondu's avatar
Stephane Glondu committed
96

97
let prng = lazy (Cryptokit.Random.(pseudo_rng (string secure_rng 16)))
Stephane Glondu's avatar
Stephane Glondu committed
98

Stephane Glondu's avatar
Stephane Glondu committed
99
module MakeSimpleMonad (G : GROUP) = struct
Stephane Glondu's avatar
Stephane Glondu committed
100
  type 'a t = unit -> 'a
Stephane Glondu's avatar
Stephane Glondu committed
101
  let ballots = ref []
102
  let records = ref []
Stephane Glondu's avatar
Stephane Glondu committed
103 104
  let return x () = x
  let bind x f = f (x ())
105
  let fail e = raise e
Stephane Glondu's avatar
Stephane Glondu committed
106 107 108

  let random q =
    let size = Z.size q * Sys.word_size / 8 in
Stephane Glondu's avatar
Stephane Glondu committed
109 110 111
    fun () ->
      let r = Cryptokit.Random.string (Lazy.force prng) size in
      Z.(of_bits r mod q)
Stephane Glondu's avatar
Stephane Glondu committed
112

Stephane Glondu's avatar
Stephane Glondu committed
113
  type ballot = G.t Serializable_t.ballot
114 115 116 117 118
  type record = string
  let cast x r () = ballots := x :: !ballots; records := r :: !records
  let fold_ballots f x () = List.fold_left (fun accu b -> f b accu ()) x !ballots
  let fold_records f x () = List.fold_left (fun accu b -> f b accu ()) x !records
  let turnout () = List.length !ballots
Stephane Glondu's avatar
Stephane Glondu committed
119 120
end

121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
(** Distributed key generation *)

module MakeSimpleDistKeyGen (G : GROUP) (M : RANDOM) = struct
  open G
  open M

  let ( >>= ) = bind
  let ( / ) x y = x *~ invert y

  (** Fiat-Shamir non-interactive zero-knowledge proofs of
      knowledge *)

  let fs_prove gs x oracle =
    random q >>= fun w ->
    let commitments = Array.map (fun g -> g **~ w) gs in
    let challenge = oracle commitments in
    let response = Z.((w + x * challenge) mod q) in
    return {challenge; response}

  let generate_and_prove () =
    random q >>= fun x ->
    let trustee_public_key = g **~ x in
143 144
    let zkp = "pok|" ^ G.to_string trustee_public_key ^ "|" in
    fs_prove [| g |] x (G.hash zkp) >>= fun trustee_pok ->
145 146 147 148 149 150 151 152
    return (x, {trustee_pok; trustee_public_key})

  let check {trustee_pok; trustee_public_key = y} =
    G.check y &&
    let {challenge; response} = trustee_pok in
    check_modulo q challenge &&
    check_modulo q response &&
    let commitment = g **~ response / (y **~ challenge) in
153 154
    let zkp = "pok|" ^ G.to_string y ^ "|" in
    challenge =% G.hash zkp [| commitment |]
155 156 157 158 159 160 161 162

  let combine pks =
    Array.fold_left (fun y {trustee_public_key; _} ->
      y *~ trustee_public_key
    ) G.one pks

end

Stephane Glondu's avatar
Stephane Glondu committed
163 164
(** Homomorphic elections *)

Stephane Glondu's avatar
Stephane Glondu committed
165
module MakeElection (G : GROUP) (M : RANDOM) = struct
Stephane Glondu's avatar
Stephane Glondu committed
166
  open G
Stephane Glondu's avatar
Stephane Glondu committed
167

Stephane Glondu's avatar
Stephane Glondu committed
168 169 170
  type 'a m = 'a M.t
  open M
  let ( >>= ) = bind
Stephane Glondu's avatar
Stephane Glondu committed
171

Stephane Glondu's avatar
Stephane Glondu committed
172
  type elt = G.t
Stephane Glondu's avatar
Stephane Glondu committed
173 174

  type t = elt election
Stephane Glondu's avatar
Stephane Glondu committed
175
  type private_key = Z.t
Stephane Glondu's avatar
Stephane Glondu committed
176
  type public_key = elt
Stephane Glondu's avatar
Stephane Glondu committed
177 178 179

  let ( / ) x y = x *~ invert y

Stephane Glondu's avatar
Stephane Glondu committed
180
  type ciphertext = elt Serializable_t.ciphertext array array
Stephane Glondu's avatar
Stephane Glondu committed
181 182 183 184 185 186 187 188 189 190 191 192 193 194

  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
Stephane Glondu committed
195
  let neutral_ciphertext e = Array.map (fun q ->
196
    Array.make (Array.length q.q_answers) dummy_ciphertext
Stephane Glondu's avatar
Stephane Glondu committed
197
  ) e.e_params.e_questions
198

199
  let combine_ciphertexts = Array.mmap2 eg_combine
Stephane Glondu's avatar
Stephane Glondu committed
200 201

  type plaintext = int array array
Stephane Glondu's avatar
Stephane Glondu committed
202
  type ballot = elt Serializable_t.ballot
Stephane Glondu's avatar
Stephane Glondu committed
203 204 205
  type randomness = Z.t array array

  (** ElGamal encryption. *)
Stephane Glondu's avatar
Stephane Glondu committed
206
  let eg_encrypt y r x =
Stephane Glondu's avatar
Stephane Glondu committed
207 208 209 210 211 212 213 214 215 216 217 218 219 220 221
    {
      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 =
Stephane Glondu's avatar
Stephane Glondu committed
222
    random q >>= fun w ->
Stephane Glondu's avatar
Stephane Glondu committed
223 224 225
    let commitments = Array.map (fun g -> g **~ w) gs in
    let challenge = oracle commitments in
    let response = Z.((w + x * challenge) mod q) in
Stephane Glondu's avatar
Stephane Glondu committed
226
    return {challenge; response}
Stephane Glondu's avatar
Stephane Glondu committed
227 228 229

  (** ZKPs for disjunctions *)

Stephane Glondu's avatar
Stephane Glondu committed
230
  let eg_disj_prove y d zkp x r {alpha; beta} =
Stephane Glondu's avatar
Stephane Glondu committed
231 232 233 234 235 236 237 238 239 240 241
    (* 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
Stephane Glondu's avatar
Stephane Glondu committed
242 243
      challenge >>= fun challenge ->
      response >>= fun response ->
Stephane Glondu's avatar
Stephane Glondu committed
244 245
      proofs.(i) <- {challenge; response};
      commitments.(2*i) <- g **~ response / alpha **~ challenge;
Stephane Glondu's avatar
Debug  
Stephane Glondu committed
246
      commitments.(2*i+1) <- y **~ response / (beta *~ d.(i)) **~ challenge;
Stephane Glondu's avatar
Stephane Glondu committed
247
      total_challenges := Z.(!total_challenges + challenge);
Stephane Glondu's avatar
Stephane Glondu committed
248
      return ()
Stephane Glondu's avatar
Stephane Glondu committed
249
    in
Stephane Glondu's avatar
Stephane Glondu committed
250 251 252 253 254 255
    let rec loop i =
      if i < x then f i >>= fun () -> loop (succ i)
      else if i = x then loop (succ i)
      else if i < n then f i >>= fun () -> loop (succ i)
      else return ()
    in loop 0 >>= fun () ->
Stephane Glondu's avatar
Stephane Glondu committed
256 257
    total_challenges := Z.(q - !total_challenges mod q);
    (* compute genuine proof *)
Stephane Glondu's avatar
Stephane Glondu committed
258
    fs_prove [| g; y |] r (fun commitx ->
Stephane Glondu's avatar
Stephane Glondu committed
259
      Array.blit commitx 0 commitments (2*x) 2;
260
      let prefix = Printf.sprintf "prove|%s|%s,%s|"
261
        zkp (G.to_string alpha) (G.to_string beta)
262 263
      in
      Z.((G.hash prefix commitments + !total_challenges) mod q)
Stephane Glondu's avatar
Stephane Glondu committed
264 265 266
    ) >>= fun p ->
    proofs.(x) <- p;
    return proofs
Stephane Glondu's avatar
Stephane Glondu committed
267

Stephane Glondu's avatar
Stephane Glondu committed
268
  let eg_disj_verify y d zkp proofs {alpha; beta} =
Stephane Glondu's avatar
Debug  
Stephane Glondu committed
269
    G.check alpha && G.check beta &&
Stephane Glondu's avatar
Stephane Glondu committed
270
    let n = Array.length d in
Stephane Glondu's avatar
Debug  
Stephane Glondu committed
271
    n = Array.length proofs &&
Stephane Glondu's avatar
Stephane Glondu committed
272 273
    let commitments = Array.create (2*n) g
    and total_challenges = ref Z.zero in
Stephane Glondu's avatar
Debug  
Stephane Glondu committed
274 275 276 277 278 279 280 281 282 283
    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);
284
      let prefix = Printf.sprintf "prove|%s|%s,%s|"
285
        zkp (G.to_string alpha) (G.to_string beta)
286 287
      in
      hash prefix commitments =% !total_challenges
Stephane Glondu's avatar
Debug  
Stephane Glondu committed
288
    with Exit -> false
Stephane Glondu's avatar
Stephane Glondu committed
289 290 291 292 293 294

  (** Ballot creation *)

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

Stephane Glondu's avatar
Debug  
Stephane Glondu committed
295 296 297 298 299 300 301 302
  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
303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323
  let swap xs =
    let rec loop i accu =
      if i >= 0
      then xs.(i) >>= fun x -> loop (pred i) (x::accu)
      else return (Array.of_list accu)
    in loop (pred (Array.length xs)) []

  let sswap xs =
    let rec loop_outer i accu =
      if i >= 0 then (
        let x = xs.(i) in
        let rec loop_inner j accu =
          if j >= 0
          then x.(j) >>= fun r -> loop_inner (pred j) (r::accu)
          else return (Array.of_list accu)
        in
        loop_inner (Array.length x - 1) [] >>= fun ys ->
        loop_outer (pred i) (ys::accu)
      ) else return (Array.of_list accu)
    in loop_outer (Array.length xs - 1) []

Stephane Glondu's avatar
Stephane Glondu committed
324 325 326
  let create_answer y zkp q r m =
    let choices = Array.map2 (eg_encrypt y) r m in
    let individual_proofs = Array.map3 (eg_disj_prove y d01 zkp) m r choices in
Stephane Glondu's avatar
Stephane Glondu committed
327 328 329 330 331 332
    (* 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
333
    let d = make_d q.q_min q.q_max in
Stephane Glondu's avatar
Stephane Glondu committed
334
    let overall_proof = eg_disj_prove y d zkp (summ - q.q_min) sumr sumc in
Stephane Glondu's avatar
Stephane Glondu committed
335 336 337
    swap individual_proofs >>= fun individual_proofs ->
    overall_proof >>= fun overall_proof ->
    return {choices; individual_proofs; overall_proof}
Stephane Glondu's avatar
Stephane Glondu committed
338

Stephane Glondu's avatar
Stephane Glondu committed
339
  let make_randomness e =
Stephane Glondu's avatar
Stephane Glondu committed
340
    sswap (Array.map (fun q ->
341
      Array.init (Array.length q.q_answers) (fun _ -> random G.q)
Stephane Glondu's avatar
Stephane Glondu committed
342
    ) e.e_params.e_questions)
343

344 345 346 347 348 349 350 351 352 353 354 355 356 357 358
  let make_sig_prefix zkp commitment =
    "sig|" ^ zkp ^ "|" ^ G.to_string commitment ^ "|"

  let make_sig_contents answers =
    List.flatten (
      List.map (fun a ->
        List.flatten (
          List.map (fun {alpha; beta} ->
            [alpha; beta]
          ) (Array.to_list a.choices)
        )
      ) (Array.to_list answers)
    ) |> Array.of_list

  let create_ballot e ?sk r m =
Stephane Glondu's avatar
Stephane Glondu committed
359
    let p = e.e_params in
360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377
    let sk, zkp =
      match sk with
      | None -> None, ""
      | Some x -> let y = G.(g **~ x) in Some (x, y), G.to_string y
    in
    swap (Array.map3 (create_answer p.e_public_key zkp) p.e_questions r m) >>= fun answers ->
    (
      match sk with
      | None -> return None
      | Some (x, y) ->
        random q >>= fun w ->
        let commitment = g **~ w in
        let prefix = make_sig_prefix zkp commitment in
        let contents = make_sig_contents answers in
        let s_challenge = G.hash prefix contents in
        let s_response = Z.(erem (w - x * s_challenge) q) in
        return (Some {s_public_key = y; s_challenge; s_response})
    ) >>= fun signature ->
Stephane Glondu's avatar
Stephane Glondu committed
378 379
    return {
      answers;
Stephane Glondu's avatar
Stephane Glondu committed
380 381
      election_hash = e.e_fingerprint;
      election_uuid = p.e_uuid;
382
      signature;
Stephane Glondu's avatar
Stephane Glondu committed
383 384 385 386
    }

  (** Ballot verification *)

Stephane Glondu's avatar
Stephane Glondu committed
387 388
  let verify_answer y zkp q a =
    Array.forall2 (eg_disj_verify y d01 zkp) a.individual_proofs a.choices &&
Stephane Glondu's avatar
Stephane Glondu committed
389
    let sumc = Array.fold_left eg_combine dummy_ciphertext a.choices in
Stephane Glondu's avatar
Debug  
Stephane Glondu committed
390
    let d = make_d q.q_min q.q_max in
Stephane Glondu's avatar
Stephane Glondu committed
391
    eg_disj_verify y d zkp a.overall_proof sumc
Stephane Glondu's avatar
Stephane Glondu committed
392

Stephane Glondu's avatar
Stephane Glondu committed
393 394 395 396
  let check_ballot e b =
    let p = e.e_params in
    b.election_uuid = p.e_uuid &&
    b.election_hash = e.e_fingerprint &&
397
    let ok, zkp = match b.signature with
Stephane Glondu's avatar
Stephane Glondu committed
398
      | Some {s_public_key = y; s_challenge; s_response} ->
399
        let zkp = G.to_string y in
400 401 402 403
        let ok =
          check_modulo q s_challenge &&
          check_modulo q s_response &&
          let commitment = g **~ s_response *~ y **~ s_challenge in
404 405 406 407
          let prefix = make_sig_prefix zkp commitment in
          let contents = make_sig_contents b.answers in
          s_challenge =% G.hash prefix contents
        in ok, zkp
408
      | None -> true, ""
409
    in ok &&
Stephane Glondu's avatar
Stephane Glondu committed
410
    Array.forall2 (verify_answer p.e_public_key zkp) p.e_questions b.answers
Stephane Glondu's avatar
Stephane Glondu committed
411 412 413

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

Stephane Glondu's avatar
Stephane Glondu committed
414
  type factor = elt Serializable_t.partial_decryption
Stephane Glondu's avatar
Stephane Glondu committed
415

416
  let eg_factor x {alpha; beta} =
417
    let zkp = "decrypt|" ^ G.to_string (g **~ x) ^ "|" in
418
    alpha **~ x,
419
    fs_prove [| g; alpha |] x (hash zkp)
420

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

424
  let compute_factor c x =
Stephane Glondu's avatar
Stephane Glondu committed
425 426 427
    if check_ciphertext c then (
      let res = Array.mmap (eg_factor x) c in
      let decryption_factors, decryption_proofs = Array.ssplit res in
Stephane Glondu's avatar
Stephane Glondu committed
428 429
      sswap decryption_proofs >>= fun decryption_proofs ->
      return {decryption_factors; decryption_proofs}
Stephane Glondu's avatar
Stephane Glondu committed
430
    ) else (
431
      fail (Invalid_argument "Invalid ciphertext")
Stephane Glondu's avatar
Stephane Glondu committed
432
    )
433 434

  let check_factor c y f =
435
    let zkp = "decrypt|" ^ G.to_string y ^ "|" in
436
    Array.fforall3 (fun {alpha; _} f {challenge; response} ->
Stephane Glondu's avatar
Stephane Glondu committed
437 438
      check_modulo q challenge &&
      check_modulo q response &&
439 440 441 442 443
      let commitments =
        [|
          g **~ response / (y **~ challenge);
          alpha **~ response / (f **~ challenge);
        |]
444
      in hash zkp commitments =% challenge
445
    ) c f.decryption_factors f.decryption_proofs
Stephane Glondu's avatar
Stephane Glondu committed
446

Stephane Glondu's avatar
Stephane Glondu committed
447
  type result = elt Serializable_t.result
Stephane Glondu's avatar
Stephane Glondu committed
448

Stephane Glondu's avatar
Stephane Glondu committed
449
  let combine_factors num_tallied encrypted_tally partial_decryptions =
Stephane Glondu's avatar
Stephane Glondu committed
450 451 452 453
    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
454
    let results = Array.mmap2 (fun {beta; _} f ->
Stephane Glondu's avatar
Stephane Glondu committed
455 456 457 458 459
      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
460
        if i <= num_tallied
Stephane Glondu's avatar
Stephane Glondu committed
461 462 463 464 465 466 467 468 469 470
        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
471
    let result = Array.mmap log results in
Stephane Glondu's avatar
Stephane Glondu committed
472
    {num_tallied; encrypted_tally; partial_decryptions; result}
Stephane Glondu's avatar
Stephane Glondu committed
473

Stephane Glondu's avatar
Stephane Glondu committed
474
  let check_result e r =
Stephane Glondu's avatar
Stephane Glondu committed
475
    let {encrypted_tally; partial_decryptions; result; num_tallied} = r in
Stephane Glondu's avatar
Stephane Glondu committed
476
    check_ciphertext encrypted_tally &&
Stephane Glondu's avatar
Stephane Glondu committed
477 478 479 480
    (match e.e_pks with
    | Some pks ->
      Array.forall2 (check_factor encrypted_tally) pks partial_decryptions
    | None -> false) &&
Stephane Glondu's avatar
Stephane Glondu committed
481 482 483 484 485 486 487 488
    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
489

Stephane Glondu's avatar
Stephane Glondu committed
490
  let extract_tally r = r.result
Stephane Glondu's avatar
Stephane Glondu committed
491
end