sandbox.ml 10.4 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1
open Util
2
open Serializable_compat_t
3
open Common
Stephane Glondu's avatar
Stephane Glondu committed
4 5

module type TYPES = sig
6
  type elt
Stephane Glondu's avatar
Stephane Glondu committed
7 8 9
  type 'a t
  val read : 'a t -> Yojson.Safe.lexer_state -> Lexing.lexbuf -> 'a
  val write : 'a t -> Bi_outbuf.t -> 'a -> unit
10 11 12
  val election : elt election t
  val private_key : elt private_key t
  val trustee_public_key : elt trustee_public_key t
Stephane Glondu's avatar
Stephane Glondu committed
13
  val ballot : elt ballot t
14 15 16 17
  val encrypted_tally : elt encrypted_tally t
  val partial_decryption : elt partial_decryption t
  val election_public_data : elt election_public_data t
  val election_private_data : elt election_private_data t
Stephane Glondu's avatar
Stephane Glondu committed
18 19
end

20 21 22 23 24 25 26 27
module type SGROUP = sig
  type t
  val write : Bi_outbuf.t -> t -> unit
  val read : Yojson.Safe.lexer_state -> Lexing.lexbuf -> t
end

module SFiniteFieldMult : SGROUP with type t = Z.t = struct
  type t = Z.t
28 29
  let write = Serializable_builtin_j.write_number
  let read = Serializable_builtin_j.read_number
30 31 32
end

module MakeTypes (G : SGROUP) : TYPES with type elt = G.t = struct
33
  open Serializable_compat_j
34
  type elt = G.t
Stephane Glondu's avatar
Stephane Glondu committed
35 36 37
  type 'a t = (Yojson.Safe.lexer_state -> Lexing.lexbuf -> 'a) * (Bi_outbuf.t -> 'a -> unit)
  let read = fst
  let write = snd
38 39 40
  let election = (read_election G.read, write_election G.write)
  let private_key = (read_private_key G.read, write_private_key G.write)
  let trustee_public_key = (read_trustee_public_key G.read, write_trustee_public_key G.write)
Stephane Glondu's avatar
Stephane Glondu committed
41
  let ballot = (read_ballot G.read, write_ballot G.write)
42 43 44 45
  let encrypted_tally = (read_encrypted_tally G.read, write_encrypted_tally G.write)
  let partial_decryption = (read_partial_decryption G.read, write_partial_decryption G.write)
  let election_public_data = (read_election_public_data G.read, write_election_public_data G.write)
  let election_private_data = (read_election_private_data G.read, write_election_private_data G.write)
Stephane Glondu's avatar
Stephane Glondu committed
46 47
end

48 49
module Types : TYPES with type elt = Z.t = MakeTypes (SFiniteFieldMult)

50
let load typ fname = load_from_file (Types.read typ) fname
Stephane Glondu's avatar
Stephane Glondu committed
51 52 53 54 55 56 57 58

let save typ fname x =
  let o = open_out fname in
  let buf = Bi_outbuf.create_channel_writer o in
  Types.write typ buf x;
  Bi_outbuf.flush_channel_writer buf;
  close_out o

59 60
let load_and_check ?(verbose=false) typ fname =
  if verbose then Printf.eprintf "Loading and checking %s...\n%!" fname;
61 62 63 64
  let thing = load typ fname in
  let tempfname = Filename.temp_file "belenios" ".json" in
  save typ tempfname thing;
  let r = Printf.ksprintf Sys.command "bash -c 'diff -u <(json_pp < %s) <(json_pp < %s)'" fname tempfname in
Stephane Glondu's avatar
Stephane Glondu committed
65
  assert (r = 0);
66 67
  Sys.remove tempfname;
  thing
Stephane Glondu's avatar
Stephane Glondu committed
68

69 70 71
let load_election_private_data ?(verbose=false) dir uuid =
  Printf.ksprintf (Filename.concat dir) "{%s}/private.json" uuid |>
  load_and_check ~verbose Types.election_private_data
72

73
let verbose_assert msg it =
Stephane Glondu's avatar
Stephane Glondu committed
74
  Printf.eprintf "   %s...%!" msg;
75 76 77
  let r = Lazy.force it in
  Printf.eprintf " %s\n%!" (if r then "OK" else "failed!")

Stephane Glondu's avatar
Stephane Glondu committed
78
let verbose_verify_election_test_data (e, ballots, signatures, private_data) =
Stephane Glondu's avatar
Stephane Glondu committed
79
  Printf.eprintf "Verifying election %S:\n%!" e.election.e_short_name;
80 81 82
  let {g; p; q; y} = e.election.e_public_key in
  let module G = (val ElGamal.make_ff_msubgroup p q g : ElGamal.GROUP with type t = Z.t) in
  let module Crypto = ElGamal.Make (G) in
83
  verbose_assert "election key" (lazy (
84
    Crypto.check_election_key
85 86 87
      e.election.e_public_key.y
      e.public_data.public_keys
  ));
Stephane Glondu's avatar
Stephane Glondu committed
88 89
  if Array.length ballots = 0 then (
    Printf.eprintf "   no ballots available\n%!"
90
  ) else (
Stephane Glondu's avatar
Stephane Glondu committed
91
    verbose_assert "ballots" (lazy (
92
      Array.foralli (fun _ x ->
93
        Crypto.check_ballot e.election e.fingerprint x
Stephane Glondu's avatar
Stephane Glondu committed
94
      ) ballots
95 96 97 98
    ));
    (match e.public_data.election_result with
      | Some r ->
        verbose_assert "encrypted tally" (lazy (
Stephane Glondu's avatar
Stephane Glondu committed
99
          r.encrypted_tally = Crypto.compute_encrypted_tally e.election ballots
100 101 102
        ))
      | None -> ()
    );
103 104 105 106
  );
  (match e.public_data.election_result with
    | Some r ->
      verbose_assert "partial decryptions" (lazy (
107
        Crypto.check_partial_decryptions
108 109
          e.election e.public_data.public_keys r
      ));
110
      verbose_assert "result" (lazy (Crypto.check_result e.election r));
111 112
    | None -> Printf.eprintf "   no results available\n%!"
  );
Stephane Glondu's avatar
Stephane Glondu committed
113 114
  verbose_assert "signature count" (lazy (
    Array.length signatures = Array.length ballots
Stephane Glondu's avatar
Stephane Glondu committed
115
  ));
116 117
  verbose_assert "private keys" (lazy (
    Array.foralli
118
      (fun _ k -> Crypto.check_private_key k)
119
      private_data.private_keys
120
  ));;
121

122 123
let iter_keep f xs = List.iter f xs; xs;;

Stephane Glondu's avatar
Stephane Glondu committed
124
let load_election_and_verify_it_all dirname =
125 126
  load_elections_and_votes dirname |>
  Lwt_stream.to_list |> Lwt_main.run |>
Stephane Glondu's avatar
Stephane Glondu committed
127
  List.map (fun (e, ballots, signatures) ->
Stephane Glondu's avatar
Stephane Glondu committed
128
    let ballots = Lwt_stream.to_list ballots |> Lwt_main.run |> Array.of_list in
Stephane Glondu's avatar
Stephane Glondu committed
129
    let signatures = Lwt_stream.to_list signatures |> Lwt_main.run |> Array.of_list in
130
    let private_data = load_election_private_data dirname (Uuidm.to_string e.election.e_uuid) in
Stephane Glondu's avatar
Stephane Glondu committed
131
    (e, ballots, signatures, private_data)
132
  ) |>
133
  iter_keep verbose_verify_election_test_data;;
Stephane Glondu's avatar
Stephane Glondu committed
134

135
let all_data = load_election_and_verify_it_all "tests/data";;
Stephane Glondu's avatar
Stephane Glondu committed
136 137 138 139 140 141 142 143 144

let rec get_election name = function
  | [] -> raise Not_found
  | ((e, _, _, _) as x)::xs when e.election.e_short_name = name -> x
  | _::xs -> get_election name xs

let e, ballots, signatures, private_data = get_election "editor" all_data;;
let {g; p; q; y} = e.election.e_public_key
module G = (val ElGamal.make_ff_msubgroup p q g : ElGamal.GROUP with type t = Z.t)
Stephane Glondu's avatar
Stephane Glondu committed
145
module MyCrypto = ElGamal.Make (G)
Stephane Glondu's avatar
Stephane Glondu committed
146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233

let random_exponent =
  let pseudo = lazy Cryptokit.Random.(pseudo_rng (string secure_rng 20)) in
  (* 20 is 160 bits of entropy, taken from secure source *)
  fun () ->
    let raw = Cryptokit.Random.(string (Lazy.force pseudo) 32) in
    (* 32 is 256 bits of entropy, taken from pseudo-random source *)
    let hex = Cryptokit.(transform_string (Hexa.encode ()) raw) in
    Z.(of_string_base 16 hex mod q)

open G

let dummy_proof_item = {
  dp_commitment = { a = Z.one; b = Z.one };
  dp_challenge = Z.zero;
  dp_response = Z.zero;
}

let make_proof min max choice r {alpha; beta} =
  let n = max-min+1 in
  let j = choice-min in
  let proof = Array.create n dummy_proof_item in
  for i = 0 to n-1 do
    if i <> j then (
      let dp_challenge = random_exponent ()
      and dp_response = random_exponent () in
      let a = g **~ dp_response *~ inv (alpha **~ dp_challenge)
      and b = y **~ dp_response *~ inv ((beta *~ inv (g **~ Z.of_int i)) **~ dp_challenge) in
      proof.(i) <- { dp_commitment = {a; b}; dp_challenge; dp_response }
    )
  done;
  let w = random_exponent () in
  let a = g **~ w and b = y **~ w in
  let dp_challenge =
    let commitments = ref [] and challenges = ref Z.zero in
    for i = 0 to j-1 do
      let {a; b} = proof.(i).dp_commitment in
      commitments := b :: a :: !commitments;
      challenges := Z.(!challenges + proof.(i).dp_challenge);
    done;
    commitments := b :: a :: !commitments;
    for i = j+1 to n-1 do
      let {a; b} = proof.(i).dp_commitment in
      commitments := b :: a :: !commitments;
      challenges := Z.(!challenges + proof.(i).dp_challenge);
    done;
    Z.((G.hash (List.rev !commitments) + q - !challenges) mod q)
  in
  let dp_response = Z.((r * dp_challenge + w) mod q) in
  proof.(j) <- { dp_commitment = {a; b}; dp_challenge; dp_response };
  proof

let make_ballot e election_hash answers =
  let y = e.e_public_key.y in
  {
    answers =
      Array.mapi (fun i answer ->
        let randoms = Array.init (Array.length answer) (fun _ -> random_exponent ()) in
        let choices =
          Array.mapi (fun i choice ->
            assert (choice = 0 || choice = 1);
            let r = randoms.(i) in
            { alpha = g **~ r; beta = y **~ r *~ g **~ Z.of_int choice }
          ) answer
        in
        let individual_proofs =
          Array.mapi (fun i x -> make_proof 0 1 answer.(i) randoms.(i) x) choices
        in
        let min = e.e_questions.(i).q_min in
        let max = match e.e_questions.(i).q_max with
          | Some x -> x
          | None -> assert false (* FIXME *)
        in
        let overall_proof =
          let ( *- ) a b = Z.({ alpha = a.alpha * b.alpha; beta = a.beta * b.beta }) in
          let dummy_ciphertext = Z.({ alpha = one; beta = one}) in
          let sum_cleartexts = Array.fold_left ( + ) 0 answer in
          let sum_ciphertexts = Array.fold_left ( *- ) dummy_ciphertext choices in
          let sum_randoms = Z.(Array.fold_left ( + ) zero randoms) in
          make_proof min max sum_cleartexts sum_randoms sum_ciphertexts
        in
        { choices; individual_proofs; overall_proof }
      ) answers;
    election_hash;
    election_uuid = e.e_uuid;
  }

let b1 = make_ballot e.election e.fingerprint [| [| 1; 0; 0; 0 |] |];;
Stephane Glondu's avatar
Stephane Glondu committed
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
assert (MyCrypto.check_ballot e.election e.fingerprint b1);;

module P = struct
  module G = (val Crypto.finite_field ~p ~q ~g : Crypto_sigs.GROUP with type t = Z.t)
  let params = Serializable_compat.of_election e.election
  let fingerprint = e.fingerprint
end

module Election = Crypto.MakeHomomorphicElection(P)
module Compat = Serializable_compat.MakeCompat(P)

let nballots = Array.map Serializable_compat.of_ballot ballots;;
assert (Array.forall Election.check_ballot nballots);;
assert (Array.forall2 (fun b b' -> b = Compat.to_ballot b') ballots nballots);;

let create_ballot b =
  let randomness = Array.map (fun x ->
    Array.map (fun _ -> random q) x
  ) b in
  Election.create_ballot randomness b

let test_ballot = create_ballot [| [| 1; 0; 0; 0 |] |];;
assert (Election.check_ballot test_ballot);;
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274

let result =
  match e.public_data.election_result with
    | Some r -> r
    | None -> assert false

let tally = result.encrypted_tally.tally;;
let fs = Array.map Serializable_compat.of_partial_decryption result.partial_decryptions;;
assert (Array.forall2 (fun f f' -> f = Compat.to_partial_decryption tally f') result.partial_decryptions fs);;
let ys = Array.map (fun x -> x.trustee_public_key.y) e.public_data.public_keys;;
assert (Array.forall2 (Election.check_factor tally) ys fs);;

let y = ys.(0);;
let x = Z.of_string "45298523167338358817538343074024028933886309805828157085973885299032584889325";;
assert (g **~ x =% y);;

let test_factor = Election.compute_factor tally x;;
assert (Election.check_factor tally y test_factor);;
Stephane Glondu's avatar
Stephane Glondu committed
275 276 277 278 279 280 281 282 283 284 285 286
assert (Serializable_t.(test_factor.decryption_factors) = result.partial_decryptions.(0).decryption_factors);;

let nresult = Serializable_compat.of_result result;;

let () =
  let open Serializable_t in
  let nresult' = Election.combine_factors
    nresult.nb_tallied nresult.encrypted_tally nresult.partial_decryptions
  in
  assert (nresult'.result = nresult.result);
  assert (Election.check_result ys nresult');
;;