Attention une mise à jour du service Gitlab va être effectuée le mardi 30 novembre entre 17h30 et 18h00. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes. Cette mise à jour intermédiaire en version 14.0.12 nous permettra de rapidement pouvoir mettre à votre disposition une version plus récente.

sandbox.ml 4.96 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
  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 () =
Stephane Glondu's avatar
Stephane Glondu committed
44
  assert (Sys.command "mkdir -p _build/tests/data/favorite-editor" = 0)
Stephane Glondu's avatar
Stephane Glondu committed
45 46 47 48 49 50 51 52 53 54 55

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

Stephane Glondu's avatar
Stephane Glondu committed
56
let data x = Filename.concat "tests/data/favorite-editor" x
Stephane Glondu's avatar
Stephane Glondu committed
57 58 59 60 61 62 63
let one_election = load_and_check Types.election (data "election.json")
let one_trustee_private_key = load_and_check Types.private_key (data "trustee-private-key.json")
let one_trustee_public_key = load_and_check Types.trustee_public_key (data "trustee-public-key.json")
let vote_1 = load_and_check Types.vote (data "vote-emacs-1.json")
let vote_2 = load_and_check Types.vote (data "vote-emacs-2.json")
let encrypted_tally = load_and_check Types.encrypted_tally (data "encrypted-tally.json")
let one_partial_decryption = load_and_check Types.partial_decryption (data "partial-decryption.json")
64

Stephane Glondu's avatar
Stephane Glondu committed
65 66
let check_modulo p x = Z.(geq x zero && lt x p)

67 68 69
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 &&
Stephane Glondu's avatar
Stephane Glondu committed
70 71 72
  check_modulo p g &&
  check_modulo p y &&
  check_modulo p q &&
73
  g ** q = Z.one &&
Stephane Glondu's avatar
Stephane Glondu committed
74
  y ** q = Z.one
75 76 77

let () = assert (verify_public_key one_trustee_public_key.trustee_public_key)

Stephane Glondu's avatar
Stephane Glondu committed
78 79 80 81 82 83 84 85 86
let ( |> ) x f = f x
let ( =~ ) = Z.equal

let hashZ x = Cryptokit.(x |>
  hash_string (Hash.sha1 ()) |>
  transform_string (Hexa.encode ()) |>
  Z.of_string_base 16
)

87
let dlog_challenge_generator q x =
Stephane Glondu's avatar
Stephane Glondu committed
88
  Z.(hashZ (Z.to_string x) mod q)
89 90 91 92

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
Stephane Glondu's avatar
Stephane Glondu committed
93
  let ( ** ) a b = Z.powm a b p in
Stephane Glondu's avatar
Stephane Glondu committed
94
  let ( * ) a b = Z.(a * b mod p) in
Stephane Glondu's avatar
Stephane Glondu committed
95 96 97 98
  check_modulo p pok_commitment &&
  check_modulo q pok_response &&
  g ** pok_response =~ pok_commitment * y ** pok_challenge &&
  pok_challenge =~ dlog_challenge_generator q pok_commitment
99 100 101

let () = assert (verify_trustee_pok one_trustee_public_key)

Stephane Glondu's avatar
Stephane Glondu committed
102
let verify_disjunctive_proof pk big_g big_hs proof =
103 104
  let n = Array.length big_hs in
  n = Array.length proof &&
Stephane Glondu's avatar
Stephane Glondu committed
105 106
  let {g; p; q; y = h} = pk in
  let ( ** ) a b = Z.powm a b p in
Stephane Glondu's avatar
Stephane Glondu committed
107
  let ( * ) a b = Z.(a * b mod p) in
Stephane Glondu's avatar
Stephane Glondu committed
108 109 110 111 112 113 114 115 116 117 118 119 120
  assert (n > 0);
  (let rec check i commitments challenges =
     if i >= 0 then
       let {dp_commitment = {a; b}; dp_challenge; dp_response} = proof.(i) in
       check_modulo p a &&
       check_modulo p b &&
       check_modulo q dp_challenge &&
       check_modulo q dp_response &&
       g ** dp_response =~ big_g ** dp_challenge * a &&
       h ** dp_response =~ big_hs.(i) ** dp_challenge * b &&
       check (pred i) (Z.to_string a :: Z.to_string b :: commitments) Z.(challenges + dp_challenge)
     else
       let commitments = String.concat "," commitments in
Stephane Glondu's avatar
Stephane Glondu committed
121
       Z.(hashZ commitments mod q =~ challenges mod q)
Stephane Glondu's avatar
Stephane Glondu committed
122 123 124
   in check (pred n) [] Z.zero)

let verify_zero_or_one pk alpha beta proof =
125 126
  let {g; p; q; y} = pk in
  Array.length proof = 2 &&
Stephane Glondu's avatar
Stephane Glondu committed
127
  let ( ** ) a b = Z.(powm a (of_int b) p) in
Stephane Glondu's avatar
Stephane Glondu committed
128
  let ( / ) a b = Z.(a * invert b p mod p) in
129
  let big_hs = Array.init 2 (fun i -> beta / (g ** i)) in
Stephane Glondu's avatar
Stephane Glondu committed
130 131 132 133 134 135
  verify_disjunctive_proof pk alpha big_hs proof

let verify_answer pk nb answer =
  assert (nb > 0);
  Array.length answer.choices = nb &&
  Array.length answer.individual_proofs = nb &&
Stephane Glondu's avatar
Stephane Glondu committed
136
  let ( * ) a b = Z.(a * b mod pk.p) in
Stephane Glondu's avatar
Stephane Glondu committed
137 138 139 140 141 142 143 144
  (let rec check i alphas betas =
     i = nb ||
     let {alpha; beta} = answer.choices.(i) in
     verify_zero_or_one pk alpha beta answer.individual_proofs.(i) &&
     check (i+1) (alphas * alpha) (betas * beta)
   in check 0 Z.one Z.one)

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