sandbox.ml 7.83 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
  let {g; p; q; y} = e.election.e_public_key in
81
82
  let module P = struct
    module G = (val Crypto.finite_field ~p ~q ~g : Crypto_sigs.GROUP with type t = Z.t)
83
84
85
86
    let public_keys =
      Array.map (fun x ->
        x.trustee_public_key.y
      ) e.public_data.public_keys
87
88
89
    let params = Serializable_compat.of_election e.election
    let fingerprint = e.fingerprint
  end in
Stephane Glondu's avatar
Stephane Glondu committed
90
  let module Election = Crypto.MakeElection(P) in
91
(*
Stephane Glondu's avatar
Stephane Glondu committed
92
  verbose_assert "election key" (lazy (
93
    Crypto.check_election_key
Stephane Glondu's avatar
Stephane Glondu committed
94
95
96
      e.election.e_public_key.y
      e.public_data.public_keys
  ));
97
*)
Stephane Glondu's avatar
Stephane Glondu committed
98
99
  if Array.length ballots = 0 then (
    Printf.eprintf "   no ballots available\n%!"
100
  ) else (
Stephane Glondu's avatar
Stephane Glondu committed
101
    verbose_assert "ballots" (lazy (
102
      Array.foralli (fun _ x ->
103
        Election.check_ballot (Serializable_compat.of_ballot x)
Stephane Glondu's avatar
Stephane Glondu committed
104
      ) ballots
105
    ));
106
(*
107
108
109
    (match e.public_data.election_result with
      | Some r ->
        verbose_assert "encrypted tally" (lazy (
Stephane Glondu's avatar
Stephane Glondu committed
110
          r.encrypted_tally = Crypto.compute_encrypted_tally e.election ballots
111
112
113
        ))
      | None -> ()
    );
114
*)
Stephane Glondu's avatar
Stephane Glondu committed
115
  );
116
(*
Stephane Glondu's avatar
Stephane Glondu committed
117
118
119
  (match e.public_data.election_result with
    | Some r ->
      verbose_assert "partial decryptions" (lazy (
120
        Crypto.check_partial_decryptions
Stephane Glondu's avatar
Stephane Glondu committed
121
122
          e.election e.public_data.public_keys r
      ));
123
      verbose_assert "result" (lazy (Crypto.check_result e.election r));
Stephane Glondu's avatar
Stephane Glondu committed
124
125
    | None -> Printf.eprintf "   no results available\n%!"
  );
126
*)
Stephane Glondu's avatar
Stephane Glondu committed
127
128
  verbose_assert "signature count" (lazy (
    Array.length signatures = Array.length ballots
Stephane Glondu's avatar
Stephane Glondu committed
129
  ));
130
(*
Stephane Glondu's avatar
Stephane Glondu committed
131
132
  verbose_assert "private keys" (lazy (
    Array.foralli
133
      (fun _ k -> Crypto.check_private_key k)
134
      private_data.private_keys
135
136
137
  ))
*)
  ();;
138

139
140
let iter_keep f xs = List.iter f xs; xs;;

Stephane Glondu's avatar
Stephane Glondu committed
141
let load_election_and_verify_it_all dirname =
142
143
  load_elections_and_votes dirname |>
  Lwt_stream.to_list |> Lwt_main.run |>
Stephane Glondu's avatar
Stephane Glondu committed
144
  List.map (fun (e, ballots, signatures) ->
Stephane Glondu's avatar
Stephane Glondu committed
145
    let ballots = Lwt_stream.to_list ballots |> Lwt_main.run |> Array.of_list in
Stephane Glondu's avatar
Stephane Glondu committed
146
    let signatures = Lwt_stream.to_list signatures |> Lwt_main.run |> Array.of_list in
147
    let private_data = load_election_private_data dirname (Uuidm.to_string e.election.e_uuid) in
Stephane Glondu's avatar
Stephane Glondu committed
148
    (e, ballots, signatures, private_data)
149
  ) |>
150
  iter_keep verbose_verify_election_test_data;;
Stephane Glondu's avatar
Stephane Glondu committed
151

152
let all_data = load_election_and_verify_it_all "tests/data";;
Stephane Glondu's avatar
Stephane Glondu committed
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

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

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)

Stephane Glondu's avatar
Debug    
Stephane Glondu committed
171
172
module P = struct
  module G = (val Crypto.finite_field ~p ~q ~g : Crypto_sigs.GROUP with type t = Z.t)
173
174
175
176
  let public_keys =
    Array.map (fun x ->
      x.trustee_public_key.y
    ) e.public_data.public_keys
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
177
178
179
180
  let params = Serializable_compat.of_election e.election
  let fingerprint = e.fingerprint
end

Stephane Glondu's avatar
Stephane Glondu committed
181
module Election = Crypto.MakeElection(P)
Stephane Glondu's avatar
Debug    
Stephane Glondu committed
182
183
184
185
186
187
188
189
190
191
192
193
194
195
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);;
196
197
198
199
200
201
202
203
204
205
206
207
208
209

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";;
210
assert P.G.(g **~ x =% y);;
211
212
213

let test_factor = Election.compute_factor tally x;;
assert (Election.check_factor tally y test_factor);;
Stephane Glondu's avatar
Stephane Glondu committed
214
215
216
217
218
219
220
221
222
223
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);
224
  assert (Election.check_result nresult');
Stephane Glondu's avatar
Stephane Glondu committed
225
;;