Attention une mise à jour du serveur va être effectuée le vendredi 16 avril entre 12h et 12h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit 8beb9ed4 authored by Stephane Glondu's avatar Stephane Glondu

Add support for blank ballots (backend)

parent aae61603
......@@ -42,11 +42,11 @@ belenios-tool mkelection $uuid $group --template $BELENIOS/demo/templates/questi
header "Simulate votes"
cat > votes.txt <<EOF
[[1,0]]
[[1,0]]
[[0,1]]
[[1,0]]
[[0,0]]
[[1,0],[1,0,0]]
[[1,0],[0,1,0]]
[[0,1],[0,0,1]]
[[1,0],[1,0,0]]
[[0,0],[0,1,0]]
EOF
paste private_creds.txt votes.txt | while read id cred vote; do
......
{"description":"Description of the election.","name":"Name of the election","questions":[{"answers":["Answer 1","Answer 2"],"min":0,"max":1,"question":"Question 1?"}],"short_name":"short_name"}
{"description":"Description of the election.","name":"Name of the election","questions":[{"answers":["Answer 1","Answer 2"],"min":0,"max":1,"question":"Question 1?"},{"answers":["Answer 1","Answer 2"],"blank":true,"min":1,"max":1,"question":"Question 2?"}]}
......@@ -28,6 +28,11 @@ open Common
let check_modulo p x = Z.(geq x zero && lt x p)
let question_length q =
Array.length q.q_answers + match q.q_blank with
| Some true -> 1
| _ -> 0
(** Simple monad *)
module MakeSimpleMonad (G : GROUP) = struct
......@@ -126,7 +131,7 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
}
let neutral_ciphertext e = Array.map (fun q ->
Array.make (Array.length q.q_answers) dummy_ciphertext
Array.make (question_length q) dummy_ciphertext
) e.e_params.e_questions
let combine_ciphertexts = Array.mmap2 eg_combine
......@@ -220,6 +225,194 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
Z.(hash prefix commitments =% !total_challenges)
with Exit -> false
(** ZKPs for blank ballots *)
let make_blank_proof y zkp min max m0 c0 r0 mS cS rS =
let zkp = Printf.sprintf "%s|%s,%s,%s,%s,%s,%s" zkp
(G.to_string g) (G.to_string y)
(G.to_string c0.alpha) (G.to_string c0.beta)
(G.to_string cS.alpha) (G.to_string cS.beta)
in
if m0 = 0 then (
let blank_proof =
(* proof of m0 = 0 \/ mS = 0 (first is true) *)
random q >>= fun challenge1 ->
random q >>= fun response1 ->
let commitmentA1 = g **~ response1 *~ cS.alpha **~ challenge1 in
let commitmentB1 = y **~ response1 *~ cS.beta **~ challenge1 in
random q >>= fun w ->
let commitmentA0 = g **~ w and commitmentB0 = y **~ w in
let prefix = Printf.sprintf "bproof0|%s|" zkp in
let h = G.hash prefix [|commitmentA0; commitmentB0; commitmentA1; commitmentB1|] in
let challenge0 = Z.(erem (h - challenge1) q) in
let response0 = Z.(erem (w - r0 * challenge0) q) in
return [|
{challenge=challenge0; response=response0};
{challenge=challenge1; response=response1};
|]
in
let overall_proof =
(* proof of m0 = 1 \/ min <= mS <= max (second is true) *)
assert (min <= mS && mS <= max);
random q >>= fun challenge0 ->
random q >>= fun response0 ->
let proof0 = {challenge=challenge0; response=response0} in
let overall_proof = Array.make (max-min+2) proof0 in
let commitments = Array.make (2*(max-min+2)) g in
let total_challenges = ref challenge0 in
commitments.(0) <- g **~ response0 *~ c0.alpha **~ challenge0;
commitments.(1) <- y **~ response0 *~ (c0.beta / g) **~ challenge0;
let index_true = mS-min+1 in
let rec loop i =
if i < max-min+2 then (
if i <> index_true then (
random q >>= fun challenge ->
random q >>= fun response ->
let nbeta = cS.beta / (g **~ Z.of_int (min+i-1)) in
let j = 2*i in
overall_proof.(i) <- {challenge; response};
commitments.(j) <- g **~ response *~ cS.alpha **~ challenge;
commitments.(j+1) <- y **~ response *~ nbeta **~ challenge;
total_challenges := Z.(!total_challenges + challenge);
loop (i+1)
) else loop (i+1)
) else return ()
in
loop 1 >>= fun () ->
random q >>= fun w ->
let j = 2 * index_true in
commitments.(j) <- g **~ w;
commitments.(j+1) <- y **~ w;
let prefix = Printf.sprintf "bproof1|%s|" zkp in
let h = G.hash prefix commitments in
let challenge = Z.(erem (h - !total_challenges) q) in
let response = Z.(erem (w - rS * challenge) q) in
overall_proof.(index_true) <- {challenge; response};
return overall_proof
in
blank_proof >>= fun blank_proof ->
overall_proof >>= fun overall_proof ->
return (overall_proof, blank_proof)
) else (
let blank_proof =
(* proof of m0 = 0 \/ mS = 0 (second is true) *)
assert (mS = 0);
random q >>= fun challenge0 ->
random q >>= fun response0 ->
let commitmentA0 = g **~ response0 *~ c0.alpha **~ challenge0 in
let commitmentB0 = y **~ response0 *~ c0.beta **~ challenge0 in
random q >>= fun w ->
let commitmentA1 = g **~ w and commitmentB1 = y **~ w in
let prefix = Printf.sprintf "bproof0|%s|" zkp in
let h = G.hash prefix [|commitmentA0; commitmentB0; commitmentA1; commitmentB1|] in
let challenge1 = Z.(erem (h - challenge0) q) in
let response1 = Z.(erem (w - rS * challenge1) q) in
return [|
{challenge=challenge0; response=response0};
{challenge=challenge1; response=response1}
|]
in
let overall_proof =
(* proof of m0 = 1 \/ min <= mS <= max (first is true) *)
assert (m0 = 1);
let nil_proof = {challenge=Z.zero; response=Z.zero} in
let overall_proof = Array.make (max-min+2) nil_proof in
let commitments = Array.make (2*(max-min+2)) g in
let total_challenges = ref Z.zero in
let rec loop i =
if i < max-min+2 then (
random q >>= fun challenge ->
random q >>= fun response ->
let nbeta = cS.beta / (g **~ Z.of_int (min+i-1)) in
let j = 2*i in
overall_proof.(i) <- {challenge; response};
commitments.(j) <- g **~ response *~ cS.alpha **~ challenge;
commitments.(j+1) <- y **~ response *~ nbeta **~ challenge;
total_challenges := Z.(!total_challenges + challenge);
loop (i+1)
) else return ()
in
loop 1 >>= fun () ->
random q >>= fun w ->
commitments.(0) <- g **~ w;
commitments.(1) <- y **~ w;
let prefix = Printf.sprintf "bproof1|%s|" zkp in
let h = G.hash prefix commitments in
let challenge = Z.(erem (h - !total_challenges) q) in
let response = Z.(erem (w - r0 * challenge) q) in
overall_proof.(0) <- {challenge; response};
return overall_proof
in
blank_proof >>= fun blank_proof ->
overall_proof >>= fun overall_proof ->
return (overall_proof, blank_proof)
)
let verify_blank_proof y zkp min max c0 cS overall_proof blank_proof =
G.check c0.alpha && G.check c0.beta &&
G.check cS.alpha && G.check cS.beta &&
let zkp = Printf.sprintf "%s|%s,%s,%s,%s,%s,%s" zkp
(G.to_string g) (G.to_string y)
(G.to_string c0.alpha) (G.to_string c0.beta)
(G.to_string cS.alpha) (G.to_string cS.beta)
in
(* check blank_proof, proof of m0 = 0 \/ mS = 0 *)
Array.length blank_proof = 2 &&
(
try
let commitments = Array.make 4 g in
let total_challenges = ref Z.zero in
let {challenge; response} = blank_proof.(0) in
if not (check_modulo q challenge && check_modulo q response) then
raise Exit;
commitments.(0) <- g **~ response *~ c0.alpha **~ challenge;
commitments.(1) <- y **~ response *~ c0.beta **~ challenge;
total_challenges := Z.(!total_challenges + challenge);
let {challenge; response} = blank_proof.(1) in
if not (check_modulo q challenge && check_modulo q response) then
raise Exit;
commitments.(2) <- g **~ response *~ cS.alpha **~ challenge;
commitments.(3) <- y **~ response *~ cS.beta **~ challenge;
total_challenges := Z.(!total_challenges + challenge);
let prefix = Printf.sprintf "bproof0|%s|" zkp in
let h = G.hash prefix commitments in
let total_challenges = Z.(!total_challenges mod q) in
Z.(h =% total_challenges)
with Exit -> false
) &&
(* check overall_proof, proof of m0 = 1 \/ min <= mS <= max *)
Array.length overall_proof = max-min+2 &&
(
try
let commitments = Array.make (2*(max-min+2)) g in
let total_challenges = ref Z.zero in
let {challenge; response} = overall_proof.(0) in
if not (check_modulo q challenge && check_modulo q response) then
raise Exit;
commitments.(0) <- g **~ response *~ c0.alpha **~ challenge;
commitments.(1) <- y **~ response *~ (c0.beta / g) **~ challenge;
total_challenges := Z.(!total_challenges + challenge);
let rec loop i =
if i < max-min+2 then (
let {challenge; response} = overall_proof.(i) in
if not (check_modulo q challenge && check_modulo q response) then
raise Exit;
let nbeta = cS.beta / (g **~ Z.of_int (min+i-1)) in
let j = 2*i in
commitments.(j) <- g **~ response *~ cS.alpha **~ challenge;
commitments.(j+1) <- y **~ response *~ nbeta **~ challenge;
total_challenges := Z.(!total_challenges + challenge);
loop (i+1)
) else ()
in
loop 1;
let prefix = Printf.sprintf "bproof1|%s|" zkp in
let h = G.hash prefix commitments in
let total_challenges = Z.(!total_challenges mod q) in
Z.(h =% total_challenges)
with Exit -> false
)
(** Ballot creation *)
let invg = invert g
......@@ -255,23 +448,45 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
in loop_outer (Array.length xs - 1) []
let create_answer y zkp q r m =
let n = Array.length r in
assert (n = Array.length m);
let choices = Array.map2 (eg_encrypt y) r m in
let individual_proofs = Array.map3 (eg_disj_prove y d01 zkp) m r choices in
(* create overall_proof from homomorphic combination of individual
weights *)
let sumr = Array.fold_left Z.(+) Z.zero r in
let summ = Array.fold_left (+) 0 m in
let sumc = Array.fold_left eg_combine dummy_ciphertext choices in
assert (q.q_min <= summ && summ <= q.q_max);
let d = make_d q.q_min q.q_max in
let overall_proof = eg_disj_prove y d zkp (summ - q.q_min) sumr sumc in
swap individual_proofs >>= fun individual_proofs ->
overall_proof >>= fun overall_proof ->
return {choices; individual_proofs; overall_proof}
match q.q_blank with
| Some true ->
(* index 0 is whether the ballot is blank or not,
indexes 1..n-1 are the actual choices *)
assert (n = Array.length q.q_answers + 1);
let choices' = Array.sub choices 1 (n - 1) in
let r' = Array.sub r 1 (n - 1) in
let m' = Array.sub m 1 (n - 1) in
let sumr = Array.fold_left Z.(+) Z.zero r' in
let summ = Array.fold_left (+) 0 m' in
let sumc = Array.fold_left eg_combine dummy_ciphertext choices' in
let bproofs =
make_blank_proof y zkp q.q_min q.q_max
m.(0) choices.(0) r.(0) summ sumc sumr
in
bproofs >>= fun (overall_proof, blank_proof) ->
let blank_proof = Some blank_proof in
return {choices; individual_proofs; overall_proof; blank_proof}
| _ ->
(* indexes 0..n-1 are the actual choices *)
assert (n = Array.length q.q_answers);
let sumr = Array.fold_left Z.(+) Z.zero r in
let summ = Array.fold_left (+) 0 m in
let sumc = Array.fold_left eg_combine dummy_ciphertext choices in
assert (q.q_min <= summ && summ <= q.q_max);
let d = make_d q.q_min q.q_max in
let overall_proof = eg_disj_prove y d zkp (summ - q.q_min) sumr sumc in
overall_proof >>= fun overall_proof ->
let blank_proof = None in
return {choices; individual_proofs; overall_proof; blank_proof}
let make_randomness e =
sswap (Array.map (fun q ->
Array.init (Array.length q.q_answers) (fun _ -> random G.q)
Array.init (question_length q) (fun _ -> random G.q)
) e.e_params.e_questions)
let make_sig_prefix zkp commitment =
......@@ -318,10 +533,21 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
(** Ballot verification *)
let verify_answer y zkp q a =
let n = Array.length a.choices in
n = Array.length a.individual_proofs &&
Array.forall2 (eg_disj_verify y d01 zkp) a.individual_proofs a.choices &&
let sumc = Array.fold_left eg_combine dummy_ciphertext a.choices in
let d = make_d q.q_min q.q_max in
eg_disj_verify y d zkp a.overall_proof sumc
match q.q_blank, a.blank_proof with
| Some true, Some blank_proof ->
n = Array.length q.q_answers + 1 &&
let c = Array.sub a.choices 1 (n - 1) in
let sumc = Array.fold_left eg_combine dummy_ciphertext c in
verify_blank_proof y zkp q.q_min q.q_max a.choices.(0) sumc a.overall_proof blank_proof
| _, None ->
n = Array.length q.q_answers &&
let sumc = Array.fold_left eg_combine dummy_ciphertext a.choices in
let d = make_d q.q_min q.q_max in
eg_disj_verify y d zkp a.overall_proof sumc
| _, _ -> false
let check_ballot e b =
let p = e.e_params in
......
......@@ -25,6 +25,8 @@ open Platform
open Serializable_t
open Signatures
val question_length : question -> int
module MakeSimpleMonad (G : GROUP) : sig
(** {2 Monadic definitions} *)
......
......@@ -67,6 +67,7 @@ type ('a, 'b) wrapped_pubkey = {
type question = {
answers : string list <ocaml repr="array">;
?blank : bool option;
min : int;
max : int;
question : string;
......@@ -92,6 +93,7 @@ type 'a answer = {
choices : 'a ciphertext list <ocaml repr="array">;
individual_proofs : disjunctive_proof list <ocaml repr="array">;
overall_proof : disjunctive_proof;
?blank_proof : disjunctive_proof option;
}
<doc text="An answer to a question. It consists of a weight for each
choice, a proof that each of these weights is 0 or 1, and an overall
......
......@@ -46,6 +46,7 @@ let extractQuestion q =
try return (int_of_string x)
with _ -> failwith (error_msg ^ ": " ^ x ^ ".")
in
let q_blank = None in
numeric ".question_min" "Invalid minimum number of choices" >>= fun q_min ->
numeric ".question_max" "Invalid maximum number of choices" >>= fun q_max ->
if not (q_min <= q_max) then
......@@ -58,7 +59,7 @@ let extractQuestion q =
let a = answers##item (i) >>= extractAnswer in
Js.Opt.get a (fun () -> failwith "extractQuestion"))
in
return {q_question; q_min; q_max; q_answers}
return {q_question; q_blank; q_min; q_max; q_answers}
let extractTemplate () =
let t_name = get_input "election_name" in
......@@ -131,7 +132,7 @@ let rec createQuestion q =
let insert_text = document##createTextNode (Js.string "Insert") in
let insert_btn = Dom_html.createButton document in
let f _ =
let x = createQuestion {q_question=""; q_min=0; q_max=1; q_answers=[||]} in
let x = createQuestion {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]} in
container##parentNode >>= fun p ->
Dom.insertBefore p x (Js.some container);
return ()
......@@ -229,7 +230,7 @@ let createTemplate template =
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Add a question") in
let f _ =
let x = createQuestion {q_question=""; q_min=0; q_max=1; q_answers=[||]} in
let x = createQuestion {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]} in
Dom.appendChild h_questions_div x
in
b##onclick <- handler f;
......
......@@ -331,6 +331,7 @@ let create_new_election owner cred auth =
} in
let question = {
q_answers = [| "Answer 1"; "Answer 2"; "Blank" |];
q_blank = None;
q_min = 1;
q_max = 1;
q_question = "Question 1?";
......
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