Commit f4168cd8 authored by Stephane Glondu's avatar Stephane Glondu

Factorize question-related signatures

parent 1fa83008
Pipeline #68611 passed with stages
in 17 minutes and 5 seconds
......@@ -20,8 +20,6 @@
(**************************************************************************)
open Signatures_core
open Serializable_builtin_t
open Serializable_core_t
type question =
| Standard of Question_std_t.question
......@@ -71,23 +69,7 @@ let erase_question = function
q_question = "";
}
module type S = sig
type elt
type 'a m
val create_answer : question -> public_key:elt -> prefix:string -> int array -> Yojson.Safe.json m
val verify_answer : question -> public_key:elt -> prefix:string -> Yojson.Safe.json -> bool
val extract_ciphertexts : question -> Yojson.Safe.json -> elt ciphertext shape
val process_ciphertexts : question -> elt ciphertext shape array -> elt ciphertext shape
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
type elt = G.t
type 'a m = 'a M.t
let ( >>= ) = M.bind
module QStandard = Question_std.Make (M) (G)
......@@ -123,16 +105,16 @@ module Make (M : RANDOM) (G : GROUP) = struct
let extract_ciphertexts q a =
match q with
| Standard _ ->
| Standard q ->
a
|> Yojson.Safe.to_string
|> Question_std_j.answer_of_string G.read
|> QStandard.extract_ciphertexts
| Open _ ->
|> QStandard.extract_ciphertexts q
| Open q ->
a
|> Yojson.Safe.to_string
|> Question_open_j.answer_of_string G.read
|> QOpen.extract_ciphertexts
|> QOpen.extract_ciphertexts q
let process_ciphertexts q e =
match q with
......@@ -144,7 +126,7 @@ module Make (M : RANDOM) (G : GROUP) = struct
fun q x ->
match q with
| Standard q -> Lazy.force compute_std q x
| Open q -> QOpen.compute_result q x
| Open q -> QOpen.compute_result ~num_tallied q x
let check_result q x r =
match q with
......
......@@ -20,8 +20,6 @@
(**************************************************************************)
open Signatures_core
open Serializable_builtin_t
open Serializable_core_t
type question =
| Standard of Question_std_t.question
......@@ -32,18 +30,8 @@ val write_question : Bi_outbuf.t -> question -> unit
val erase_question : question -> question
module type S = sig
type elt
type 'a m
val create_answer : question -> public_key:elt -> prefix:string -> int array -> Yojson.Safe.json m
val verify_answer : question -> public_key:elt -> prefix:string -> Yojson.Safe.json -> bool
val extract_ciphertexts : question -> Yojson.Safe.json -> elt ciphertext shape
val process_ciphertexts : question -> elt ciphertext shape array -> elt ciphertext shape
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
module Make (M : RANDOM) (G : GROUP) : Question_sigs.QUESTION
with type 'a m := 'a M.t
and type elt := G.t
and type question := question
and type answer := Yojson.Safe.json
......@@ -27,23 +27,7 @@ open Question_open_t
let check_modulo p x = Z.(geq x zero && lt x p)
module type S = sig
type elt
type 'a m
val create_answer : question -> public_key:elt -> prefix:string -> int array -> elt answer m
val verify_answer : question -> public_key:elt -> prefix:string -> elt answer -> bool
val extract_ciphertexts : elt answer -> elt ciphertext shape
val process_ciphertexts : question -> elt ciphertext shape array -> elt ciphertext shape
val compute_result : question -> elt shape -> int shape
val check_result : question -> elt shape -> int shape -> bool
end
module Make (M : RANDOM) (G : GROUP) = struct
type elt = G.t
type 'a m = 'a M.t
let ( >>= ) = M.bind
open G
......@@ -69,7 +53,7 @@ module Make (M : RANDOM) (G : GROUP) = struct
let zkp = Printf.sprintf "raweg|%s|%s,%s,%s|" prefix (G.to_string y) (G.to_string alpha) (G.to_string beta) in
Z.(challenge =% G.hash zkp [| commitment |])
let extract_ciphertexts a =
let extract_ciphertexts _ a =
SAtomic a.choices
let compare_ciphertexts x y =
......@@ -83,7 +67,7 @@ module Make (M : RANDOM) (G : GROUP) = struct
Array.fast_sort compare_ciphertexts es;
SArray es
let compute_result q x =
let compute_result ~num_tallied:_ q x =
let n = Array.length q.q_answers in
let rec aux = function
| SAtomic x -> SArray (Array.map (fun x -> SAtomic x) (G.to_ints n x))
......@@ -91,5 +75,5 @@ module Make (M : RANDOM) (G : GROUP) = struct
in aux x
let check_result q x r =
r = compute_result q x
r = compute_result 0 q x
end
......@@ -20,21 +20,10 @@
(**************************************************************************)
open Signatures_core
open Serializable_builtin_t
open Question_open_t
module type S = sig
type elt
type 'a m
val create_answer : question -> public_key:elt -> prefix:string -> int array -> elt answer m
val verify_answer : question -> public_key:elt -> prefix:string -> elt answer -> bool
val extract_ciphertexts : elt answer -> elt ciphertext shape
val process_ciphertexts : question -> elt ciphertext shape array -> elt ciphertext shape
val compute_result : 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
module Make (M : RANDOM) (G : GROUP) : Question_sigs.QUESTION
with type 'a m := 'a M.t
and type elt := G.t
and type question := question
and type answer := G.t answer
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2019 Inria *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Affero General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version, with the additional *)
(* exemption that compiling, linking, and/or using OpenSSL is allowed. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* Affero General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Affero General Public *)
(* License along with this program. If not, see *)
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_builtin_t
open Serializable_core_t
module type QUESTION = sig
type question
type answer
type elt
type 'a m
val create_answer : question -> public_key:elt -> prefix:string -> int array -> answer m
val verify_answer : question -> public_key:elt -> prefix:string -> answer -> bool
val extract_ciphertexts : question -> answer -> elt ciphertext shape
val process_ciphertexts : question -> elt ciphertext shape array -> elt ciphertext shape
val compute_result : num_tallied:int -> question -> elt shape -> int shape
val check_result : question -> elt shape -> int shape -> bool
end
......@@ -35,23 +35,8 @@ let question_length q =
| Some true -> 1
| _ -> 0
module type S = sig
type elt
type 'a m
val create_answer : question -> public_key:elt -> prefix:string -> int array -> elt answer m
val verify_answer : question -> public_key:elt -> prefix:string -> elt answer -> bool
val extract_ciphertexts : elt answer -> elt ciphertext shape
val process_ciphertexts : question -> elt ciphertext shape array -> elt ciphertext shape
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
type elt = G.t
type 'a m = 'a M.t
open M
open G
......@@ -422,7 +407,7 @@ module Make (M : RANDOM) (G : GROUP) = struct
eg_disj_verify y d zkp a.overall_proof sumc
| _, _ -> false
let extract_ciphertexts a =
let extract_ciphertexts _ a =
SArray (Array.map (fun x -> SAtomic x) a.choices)
let process_ciphertexts q es =
......
......@@ -20,23 +20,12 @@
(**************************************************************************)
open Signatures_core
open Serializable_builtin_t
open Question_std_t
val question_length : question -> int
module type S = sig
type elt
type 'a m
val create_answer : question -> public_key:elt -> prefix:string -> int array -> elt answer m
val verify_answer : question -> public_key:elt -> prefix:string -> elt answer -> bool
val extract_ciphertexts : elt answer -> elt ciphertext shape
val process_ciphertexts : question -> elt ciphertext shape array -> elt ciphertext shape
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
module Make (M : RANDOM) (G : GROUP) : Question_sigs.QUESTION
with type 'a m := 'a M.t
and type elt := G.t
and type question := question
and type answer := G.t answer
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