Commit f01c69d9 authored by Stephane Glondu's avatar Stephane Glondu

Add "shape" type and use it during tally

parent ac823344
Pipeline #67200 passed with stages
in 16 minutes and 38 seconds
......@@ -46,6 +46,15 @@ module Array = struct
else true
in check (pred n))
let forall3 f a b c =
let n = Array.length a in
n = Array.length b &&
n = Array.length c &&
(let rec check i =
if i >= 0 then f a.(i) b.(i) c.(i) && check (pred i)
else true
in check (pred n))
let fforall f xs =
let rec loop_outer i =
if i >= 0 then
......@@ -175,6 +184,61 @@ module Option = struct
| None -> None
end
module Shape = struct
type 'a t =
| SAtomic of 'a
| SArray of 'a t array
let of_array_array x =
SArray (
Array.map (fun x ->
SArray (Array.map (fun x -> SAtomic x) x)
) x
)
let to_array_array = function
| SAtomic _ -> invalid_arg "Shape.to_array_array"
| SArray x ->
Array.map (function
| SAtomic _ -> invalid_arg "Shape.to_array_array"
| SArray x ->
Array.map (function
| SAtomic x -> x
| SArray _ -> invalid_arg "Shape.to_array_array"
) x
) x
let rec map f = function
| SAtomic x -> SAtomic (f x)
| SArray x -> SArray (Array.map (map f) x)
let rec map2 f a b =
match a, b with
| SAtomic x, SAtomic y -> SAtomic (f x y)
| SArray x, SArray y -> SArray (Array.map2 (map2 f) x y)
| _, _ -> invalid_arg "Shape.map2"
let split x =
map fst x, map snd x
let rec forall p = function
| SAtomic x -> p x
| SArray x -> Array.forall (forall p) x
let rec forall2 p x y =
match x, y with
| SAtomic x, SAtomic y -> p x y
| SArray x, SArray y -> Array.forall2 (forall2 p) x y
| _, _ -> invalid_arg "Shape.forall2"
let rec forall3 p x y z =
match x, y, z with
| SAtomic x, SAtomic y, SAtomic z -> p x y z
| SArray x, SArray y, SArray z -> Array.forall3 (forall3 p) x y z
| _, _, _ -> invalid_arg "Shape.forall3"
end
let save_to filename writer x =
let oc = open_out filename in
let ob = Bi_outbuf.create_channel_writer oc in
......
......@@ -26,6 +26,7 @@ module Array : sig
val exists : ('a -> bool) -> 'a array -> bool
val forall : ('a -> bool) -> 'a array -> bool
val forall2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
val forall3 : ('a -> 'b -> 'c -> bool) -> 'a array -> 'b array -> 'c array -> bool
val fforall : ('a -> bool) -> 'a array array -> bool
val fforall2 : ('a -> 'b -> bool) ->
'a array array -> 'b array array -> bool
......@@ -60,6 +61,20 @@ module Option : sig
val map : ('a -> 'b) -> 'a option -> 'b option
end
module Shape : sig
type 'a t =
| SAtomic of 'a
| SArray of 'a t array
val of_array_array : 'a array array -> 'a t
val to_array_array : 'a t -> 'a array array
val map : ('a -> 'b) -> 'a t -> 'b t
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
val split : ('a * 'b) t -> 'a t * 'b t
val forall : ('a -> bool) -> 'a t -> bool
val forall2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
val forall3 : ('a -> 'b -> 'c -> bool) -> 'a t -> 'b t -> 'c t -> bool
end
val save_to : string -> (Bi_outbuf.t -> 'a -> unit) -> 'a -> unit
val compare_b64 : string -> string -> int
......
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Platform
open Serializable_builtin_t
open Serializable_core_j
open Serializable_j
open Signatures
......@@ -113,20 +114,6 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
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) []
let create_answer y zkp q m =
Q.create_answer q ~public_key:y ~prefix:zkp m
......@@ -206,13 +193,23 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
fs_prove [| g; alpha |] x (hash zkp)
let check_ciphertext c =
Array.fforall (fun {alpha; beta} -> G.check alpha && G.check beta) c
Shape.forall (fun {alpha; beta} -> G.check alpha && G.check beta) c
let rec swaps = function
| SAtomic x -> x >>= fun x -> return (SAtomic x)
| SArray x ->
let rec loop i accu =
if i >= 0
then swaps x.(i) >>= fun x -> loop (pred i) (x::accu)
else return (SArray (Array.of_list accu))
in
loop (pred (Array.length x)) []
let compute_factor c x =
if check_ciphertext c then (
let res = Array.mmap (eg_factor x) c in
let decryption_factors, decryption_proofs = Array.ssplit res in
sswap decryption_proofs >>= fun decryption_proofs ->
let res = Shape.map (eg_factor x) c in
let decryption_factors, decryption_proofs = Shape.split res in
swaps decryption_proofs >>= fun decryption_proofs ->
return {decryption_factors; decryption_proofs}
) else (
fail (Invalid_argument "Invalid ciphertext")
......@@ -220,7 +217,7 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
let check_factor c y f =
let zkp = "decrypt|" ^ G.to_string y ^ "|" in
Array.fforall3 (fun {alpha; _} f {challenge; response} ->
Shape.forall3 (fun {alpha; _} f {challenge; response} ->
check_modulo q challenge &&
check_modulo q response &&
let commitments =
......@@ -233,11 +230,11 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
type result = elt Serializable_t.election_result
type combinator = factor list -> elt array array
type combinator = factor list -> elt shape
let compute_result num_tallied encrypted_tally partial_decryptions combinator =
let factors = combinator partial_decryptions in
let results = Array.mmap2 (fun {beta; _} f ->
let results = Shape.map2 (fun {beta; _} f ->
beta / f
) encrypted_tally factors in
let log =
......@@ -253,17 +250,17 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
| Some x -> x
| None -> invalid_arg "Cannot compute result"
in
let result = Array.mmap log results in
let result = Shape.map log results in
{num_tallied; encrypted_tally; partial_decryptions; result}
let check_result combinator r =
let {encrypted_tally; partial_decryptions; result; _} = r in
check_ciphertext encrypted_tally &&
let factors = combinator partial_decryptions in
let results = Array.mmap2 (fun {beta; _} f ->
let results = Shape.map2 (fun {beta; _} f ->
beta / f
) encrypted_tally factors in
Array.fforall2 (fun r1 r2 ->
Shape.forall2 (fun r1 r2 ->
let g' = if r2 = 0 then G.one else g **~ Z.of_int r2 in
r1 =~ g'
) results result
......
......@@ -26,6 +26,7 @@
type json <ocaml module="Yojson.Safe"> = abstract
type number <ocaml predef from="Serializable_builtin"> = abstract
type uuid <ocaml predef from="Serializable_builtin"> = abstract
type 'a shape <ocaml predef from="Serializable_builtin"> = abstract
type 'a ciphertext <ocaml predef from="Serializable_core"> = abstract
type proof <ocaml predef from="Serializable_core"> = abstract
type question <ocaml module="Question"> = abstract
......@@ -87,19 +88,19 @@ type 'a ballot = {
}
type 'a partial_decryption = {
decryption_factors : 'a list <ocaml repr="array"> list <ocaml repr="array">;
decryption_proofs : proof list <ocaml repr="array"> list <ocaml repr="array">;
decryption_factors : 'a shape;
decryption_proofs : proof shape;
}
type plaintext = int list <ocaml repr="array"> list <ocaml repr="array">
type 'a encrypted_tally = 'a ciphertext list <ocaml repr="array"> list <ocaml repr="array">
type 'a encrypted_tally = 'a ciphertext shape
type 'a election_result = {
num_tallied : int;
encrypted_tally : 'a encrypted_tally;
partial_decryptions : 'a partial_decryption list;
result : plaintext;
result : int shape;
}
(** {2 PKI support} *)
......
......@@ -45,3 +45,19 @@ let read_number = make_read "read_number" Z.of_string
let write_uuid = make_write raw_string_of_uuid
let read_uuid = make_read "read_uuid" uuid_of_raw_string
(** {1 Serializers for type shape} *)
let rec write_shape write buf = function
| SAtomic x -> write buf x
| SArray xs -> Atdgen_runtime.Oj_run.write_array (write_shape write) buf xs
let rec read_shape read state buf =
Yojson.Safe.read_space state buf;
let open Lexing in
if buf.lex_curr_pos >= buf.lex_buffer_len then buf.refill_buff buf;
if buf.lex_curr_pos >= buf.lex_buffer_len then Yojson.json_error "Unexpected end of input";
if Bytes.get buf.lex_buffer buf.lex_curr_pos = '[' then
SArray (Yojson.Safe.read_array (read_shape read) state buf)
else
SAtomic (read state buf)
......@@ -30,3 +30,8 @@ val read_number : Yojson.Safe.lexer_state -> Lexing.lexbuf -> number
val write_uuid : Bi_outbuf.t -> uuid -> unit
val read_uuid : Yojson.Safe.lexer_state -> Lexing.lexbuf -> uuid
(** {1 Serializers for type shape} *)
val write_shape : (Bi_outbuf.t -> 'a -> unit) -> Bi_outbuf.t -> 'a shape -> unit
val read_shape : (Yojson.Safe.lexer_state -> Lexing.lexbuf -> 'a) -> Yojson.Safe.lexer_state -> Lexing.lexbuf -> 'a shape
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Platform
open Common
type number = Z.t
type uuid = string
......@@ -46,3 +47,7 @@ let uuid_of_raw_string x =
else Printf.ksprintf invalid_arg "%S is not a valid UUID" x
let raw_string_of_uuid x = x
type 'a shape = 'a Shape.t =
| SAtomic of 'a
| SArray of 'a shape array
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Platform
open Common
type number = Z.t
type uuid
......@@ -28,3 +29,7 @@ val min_uuid_length : int
val uuid_of_raw_string : string -> uuid
val raw_string_of_uuid : uuid -> string
type 'a shape = 'a Shape.t =
| SAtomic of 'a
| SArray of 'a shape array
......@@ -191,9 +191,9 @@ module type ELECTION = sig
private key share and the encrypted tally, and contains a
cryptographic proof that he or she didn't cheat. *)
val compute_factor : ciphertext -> private_key -> factor m
val compute_factor : elt Serializable_t.ciphertext shape -> private_key -> factor m
val check_factor : ciphertext -> public_key -> factor -> bool
val check_factor : elt Serializable_t.ciphertext shape -> public_key -> factor -> bool
(** [check_factor c pk f] checks that [f], supposedly submitted by a
trustee whose public_key is [pk], is valid with respect to the
encrypted tally [c]. *)
......@@ -204,16 +204,16 @@ module type ELECTION = sig
(** The election result. It contains the needed data to validate the
result from the encrypted tally. *)
type combinator = factor list -> elt array array
type combinator = factor list -> elt shape
val compute_result : int -> ciphertext -> factor list -> combinator -> result
val compute_result : int -> elt Serializable_t.ciphertext shape -> factor list -> combinator -> result
(** Combine the encrypted tally and the factors from all trustees to
produce the election result. The first argument is the number of
tallied ballots. May raise [Invalid_argument]. *)
val check_result : combinator -> result -> bool
val extract_tally : result -> plaintext
val extract_tally : result -> int shape
(** Extract the plaintext result of the election. *)
end
......@@ -258,5 +258,5 @@ module type PEDERSEN = sig
val combine : elt threshold_parameters -> elt
type checker = elt -> elt partial_decryption -> bool
val combine_factors : checker -> elt threshold_parameters -> elt partial_decryption list -> elt array array
val combine_factors : checker -> elt threshold_parameters -> elt partial_decryption list -> elt shape
end
......@@ -75,12 +75,12 @@ module MakeSimple (G : GROUP) (M : RANDOM) = struct
let combine_factors checker pks pds =
let dummy =
match pds with
| x :: _ -> Array.mmap (fun _ -> G.one) x.decryption_factors
| x :: _ -> Shape.map (fun _ -> G.one) x.decryption_factors
| [] -> failwith "no partial decryptions"
in
assert (Array.forall (fun pk -> List.exists (checker pk) pds) pks);
List.fold_left (fun a b ->
Array.mmap2 ( *~ ) a b.decryption_factors
Shape.map2 ( *~ ) a b.decryption_factors
) dummy pds
end
......@@ -255,7 +255,7 @@ module MakePedersen (G : GROUP) (M : RANDOM)
let combine_factors checker t pds =
let dummy =
match pds with
| x :: _ -> Array.mmap (fun _ -> G.one) x.decryption_factors
| x :: _ -> Shape.map (fun _ -> G.one) x.decryption_factors
| [] -> failwith "no partial decryptions"
in
let pds_with_ids =
......@@ -283,7 +283,7 @@ module MakePedersen (G : GROUP) (M : RANDOM)
let indexes = List.map fst pds_with_ids in
List.fold_left (fun a (j, b) ->
let l = lagrange indexes j in
Array.mmap2 (fun x y -> x *~ y **~ l) a b.decryption_factors
Shape.map2 (fun x y -> x *~ y **~ l) a b.decryption_factors
) dummy pds_with_ids
let combine t =
......
......@@ -44,7 +44,7 @@ module MakeSimple (G : GROUP) (M : RANDOM) : sig
(** Combine all public key shares into an election public key. *)
type checker = G.t -> G.t partial_decryption -> bool
val combine_factors : checker -> G.t array -> G.t partial_decryption list -> G.t array array
val combine_factors : checker -> G.t array -> G.t partial_decryption list -> G.t shape
end
(** Simple distributed generation of an election public key. *)
......
......@@ -147,9 +147,12 @@ module Make (P : PARSED_PARAMS) : S = struct
match Lazy.force ballots with
| None -> failwith "ballots.jsons is missing"
| Some ballots ->
List.fold_left (fun accu (b, _) ->
E.combine_ciphertexts (E.extract_ciphertext b) accu
) (E.neutral_ciphertext ()) ballots,
let tally =
List.fold_left (fun accu (b, _) ->
E.combine_ciphertexts (E.extract_ciphertext b) accu
) (E.neutral_ciphertext ()) ballots
in
Shape.of_array_array tally,
List.length ballots
)
......
......@@ -370,6 +370,7 @@ let compute_encrypted_tally uuid =
n + 1, E.combine_ciphertexts accu ciphertext
) (0, E.neutral_ciphertext ()) ballots
in
let tally = Shape.of_array_array tally in
let tally = string_of_encrypted_tally E.G.write tally in
let%lwt () = write_file ~uuid (string_of_election_file ESETally) [tally] in
return (Some (num_tallied, sha256_b64 tally, tally))
......
......@@ -1749,7 +1749,7 @@ let election_home election state () =
let%lwt result = Web_persist.get_election_result uuid in
match result with
| Some r ->
let result = r.result in
let result = Shape.to_array_array r.result in
let questions = Array.to_list election.e_params.e_questions in
return @@ div [
ul (List.mapi (fun i (Question.Standard x) ->
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment