sandbox.ml 4.48 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1 2 3 4 5 6 7 8
open Helios_datatypes_t

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

module Types : TYPES = struct
  open Helios_datatypes_j
  type 'a t = (Yojson.Safe.lexer_state -> Lexing.lexbuf -> 'a) * (Bi_outbuf.t -> 'a -> unit)
  let read = fst
  let write = snd
  let election = (read_election, write_election)
  let private_key = (read_private_key, write_private_key)
22
  let trustee_public_key = (read_trustee_public_key, write_trustee_public_key)
Stephane Glondu's avatar
Stephane Glondu committed
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
  let vote = (read_vote, write_vote)
  let encrypted_tally = (read_encrypted_tally, write_encrypted_tally)
  let partial_decryption = (read_partial_decryption, write_partial_decryption)
end

let load typ fname =
  let i = open_in fname in
  let buf = Lexing.from_channel i in
  let lex = Yojson.init_lexer ~fname () in
  let result = Types.read typ lex buf in
  close_in i;
  result

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

let () =
  assert (Sys.command "mkdir -p _build/tests/data" = 0)

let load_and_check typ fname =
  let one_thing = load typ fname in
  save typ (Filename.concat "_build" fname) one_thing;
  let r = Printf.ksprintf Sys.command "bash -c '\
    diff -u <(json_pp < %s) <(json_pp < _build/%s)
    '" fname fname
  in
  assert (r = 0);
  one_thing

let one_election = load_and_check Types.election "tests/data/election.json"
57
let one_trustee_private_key = load_and_check Types.private_key "tests/data/trustee-private-key.json"
58
let one_trustee_public_key = load_and_check Types.trustee_public_key "tests/data/trustee-public-key.json"
Stephane Glondu's avatar
Stephane Glondu committed
59 60 61 62
let vote_1 = load_and_check Types.vote "tests/data/vote-emacs-1.json"
let vote_2 = load_and_check Types.vote "tests/data/vote-emacs-2.json"
let encrypted_tally = load_and_check Types.encrypted_tally "tests/data/encrypted-tally.json"
let one_partial_decryption = load_and_check Types.partial_decryption "tests/data/partial-decryption.json"
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 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

let verify_public_key {g; p; q; y} =
  let ( = ) = Z.equal and ( ** ) a b = Z.powm a b p in
  Z.probab_prime p 10 > 0 &&
  g = Z.rem g p &&
  y = Z.rem y p &&
  g ** q = Z.one &&
  y ** q = Z.one &&
  true

let () = assert (verify_public_key one_trustee_public_key.trustee_public_key)

let dlog_challenge_generator q x =
  let ( |> ) x f = f x in
  Z.to_string x |>
  Cryptokit.(hash_string (Hash.sha1 ())) |>
  Cryptokit.(transform_string (Hexa.encode ())) |>
  Z.of_string_base 16 |>
  (fun x -> Z.rem x q)

let verify_trustee_pok pk =
  let {g; p; q; y} = pk.trustee_public_key in
  let {pok_commitment; pok_challenge; pok_response} = pk.trustee_pok in
  let ( = ) = Z.equal and ( ** ) a b = Z.powm a b p in
  let ( * ) a b = Z.(rem (a * b) p) in
  pok_commitment = Z.rem pok_commitment p &&
  pok_challenge = Z.rem pok_challenge q &&
  pok_response = Z.rem pok_response q &&
  g ** pok_response = pok_commitment * y ** pok_challenge &&
  let challenge = dlog_challenge_generator q pok_commitment in
  pok_challenge = challenge &&
  true

let () = assert (verify_trustee_pok one_trustee_public_key)

let verify_disjunct pk big_g big_h proof_item =
  let {g; p; q; y = h} = pk in
  let {dp_commitment = {a; b}; dp_challenge; dp_response} = proof_item in
  let ( = ) = Z.equal and ( ** ) a b = Z.powm a b p in
  let ( * ) a b = Z.(rem (a * b) p) in
  a = Z.rem a p &&
  b = Z.rem b p &&
  dp_challenge = Z.rem dp_challenge q &&
106 107
  g ** dp_response = big_g ** dp_challenge * a &&
  h ** dp_response = big_h ** dp_challenge * b &&
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
  true

let verify_disj_proof pk big_g big_hs proof =
  let n = Array.length proof in
  n = Array.length big_hs &&
  (let rec check i =
     i = n || (verify_disjunct pk big_g big_hs.(i) proof.(i) && check (i+1))
   in check 0)

let verify_zero_or_one pk ciphertext proof =
  let {g; p; q; y} = pk in
  let {alpha; beta} = ciphertext in
  Array.length proof = 2 &&
  let ( = ) = Z.equal and ( ** ) a b = Z.(powm a (of_int b) p) in
  let ( / ) a b = Z.(rem (a * invert b p) p) in
  let big_hs = Array.init 2 (fun i -> beta / (g ** i)) in
  verify_disj_proof pk alpha big_hs proof &&
  true

let verify_answer pk answer =
  verify_zero_or_one pk answer.choices.(0) answer.individual_proofs.(0)

let _ = verify_answer one_election.e_public_key vote_1.answers.(0)