Commit 195f31a3 authored by Stephane Glondu's avatar Stephane Glondu

Add Question.{compute,check}_result

parent 4f84a8e1
Pipeline #67567 passed with stages
in 16 minutes and 12 seconds
......@@ -237,20 +237,13 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
let results = Shape.map2 (fun {beta; _} f ->
beta / f
) encrypted_tally factors in
let log =
let module GMap = Map.Make(G) in
let rec loop i cur accu =
if i <= num_tallied
then loop (succ i) (cur *~ g) (GMap.add cur i accu)
else accu
let result =
match results with
| SAtomic _ ->
invalid_arg "Election.compute_result: cannot compute result"
| SArray xs ->
SArray (Array.map2 (Q.compute_result ~num_tallied) election.e_params.e_questions xs)
in
let map = loop 0 G.one GMap.empty in
fun x ->
match GMap.find_opt x map with
| Some x -> x
| None -> invalid_arg "Cannot compute result"
in
let result = Shape.map log results in
{num_tallied; encrypted_tally; partial_decryptions; result}
let check_result combinator r =
......@@ -260,10 +253,10 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
let results = Shape.map2 (fun {beta; _} f ->
beta / f
) encrypted_tally factors in
Shape.forall2 (fun r1 r2 ->
let g' = if r2 = 0 then G.one else g **~ Z.of_int r2 in
r1 =~ g'
) results result
match results, result with
| SArray xs, SArray rs ->
Array.forall3 Q.check_result election.e_params.e_questions xs rs
| _, _ -> false
let extract_tally r = r.result
end
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Signatures_core
open Serializable_builtin_t
open Serializable_core_t
type question =
......@@ -50,6 +51,9 @@ module type S = sig
val verify_answer : question -> public_key:elt -> prefix:string -> Yojson.Safe.json -> bool
val extract_ciphertexts : Yojson.Safe.json -> elt ciphertext array
val compute_result : num_tallied:int -> question -> elt shape -> int shape
val check_result : question -> elt shape -> int shape -> bool
end
module Make (M : RANDOM) (G : GROUP) = struct
......@@ -76,4 +80,12 @@ module Make (M : RANDOM) (G : GROUP) = struct
|> Yojson.Safe.to_string
|> Question_std_j.answer_of_string G.read
|> Q.extract_ciphertexts
let compute_result ~num_tallied =
let compute_std = lazy (Q.compute_result ~num_tallied) in
fun (Standard q) x ->
Lazy.force compute_std q x
let check_result (Standard q) x r =
Q.check_result q x r
end
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Signatures_core
open Serializable_builtin_t
open Serializable_core_t
type question =
......@@ -39,6 +40,9 @@ module type S = sig
val verify_answer : question -> public_key:elt -> prefix:string -> Yojson.Safe.json -> bool
val extract_ciphertexts : Yojson.Safe.json -> elt ciphertext array
val compute_result : num_tallied:int -> question -> elt shape -> int shape
val check_result : question -> elt shape -> int shape -> bool
end
module Make (M : RANDOM) (G : GROUP) : S with type 'a m = 'a M.t and type elt = G.t
......@@ -22,6 +22,7 @@
open Platform
open Common
open Signatures_core
open Serializable_builtin_t
open Serializable_core_t
open Question_std_t
......@@ -42,6 +43,9 @@ module type S = sig
val verify_answer : question -> public_key:elt -> prefix:string -> elt answer -> bool
val extract_ciphertexts : elt answer -> elt ciphertext array
val compute_result : num_tallied:int -> question -> elt shape -> int shape
val check_result : question -> elt shape -> int shape -> bool
end
module Make (M : RANDOM) (G : GROUP) = struct
......@@ -418,4 +422,28 @@ module Make (M : RANDOM) (G : GROUP) = struct
| _, _ -> false
let extract_ciphertexts a = a.choices
let compute_result ~num_tallied =
let log =
let module GMap = Map.Make(G) in
let rec loop i cur accu =
if i <= num_tallied
then loop (succ i) (cur *~ g) (GMap.add cur i accu)
else accu
in
let map = loop 0 G.one GMap.empty in
fun x ->
match GMap.find_opt x map with
| Some x -> x
| None -> invalid_arg "Cannot compute result"
in
fun _ x ->
Shape.map log x
let check_result _ x r =
Shape.forall2 (fun x r ->
let g' = if r = 0 then G.one else g **~ Z.of_int r in
x =~ g'
) x r
end
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Signatures_core
open Serializable_builtin_t
open Question_std_t
val question_length : question -> int
......@@ -32,6 +33,9 @@ module type S = sig
val verify_answer : question -> public_key:elt -> prefix:string -> elt answer -> bool
val extract_ciphertexts : elt answer -> elt ciphertext array
val compute_result : num_tallied:int -> question -> elt shape -> int shape
val check_result : question -> elt shape -> int shape -> bool
end
module Make (M : RANDOM) (G : GROUP) : S with type 'a m = 'a M.t and type elt = G.t
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