Commit f6c788f4 authored by Stephane Glondu's avatar Stephane Glondu

Merge branch 'master' into explicit-homomorphism

parents 767893db e46b9072
Pipeline #91445 passed with stages
in 27 minutes and 1 second
......@@ -210,6 +210,7 @@ let bytes_to_sample q =
module DirectRandom = struct
type 'a t = 'a
let yield () = ()
let return x = x
let bind x f = f x
let fail e = raise e
......
......@@ -84,6 +84,7 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
let fs_prove gs x oracle =
random q >>= fun w ->
let commitments = Array.map (fun g -> g **~ w) gs in
M.yield () >>= fun () ->
let challenge = oracle commitments in
let response = Z.((w + x * challenge) mod q) in
return {challenge; response}
......
......@@ -77,6 +77,7 @@ module Make (M : RANDOM) (G : GROUP) = struct
let fs_prove gs x oracle =
random q >>= fun w ->
let commitments = Array.map (fun g -> g **~ w) gs in
M.yield () >>= fun () ->
let challenge = oracle commitments in
let response = Z.((w + x * challenge) mod q) in
return {challenge; response}
......@@ -99,7 +100,9 @@ module Make (M : RANDOM) (G : GROUP) = struct
response >>= fun response ->
proofs.(i) <- {challenge; response};
commitments.(2*i) <- g **~ response / alpha **~ challenge;
M.yield () >>= fun () ->
commitments.(2*i+1) <- y **~ response / (beta *~ d.(i)) **~ challenge;
M.yield () >>= fun () ->
total_challenges := Z.(!total_challenges + challenge);
return ()
in
......@@ -157,9 +160,11 @@ module Make (M : RANDOM) (G : GROUP) = struct
random q >>= fun challenge1 ->
random q >>= fun response1 ->
let commitmentA1 = g **~ response1 *~ cS.alpha **~ challenge1 in
M.yield () >>= fun () ->
let commitmentB1 = y **~ response1 *~ cS.beta **~ challenge1 in
random q >>= fun w ->
let commitmentA0 = g **~ w and commitmentB0 = y **~ w in
M.yield () >>= fun () ->
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
......@@ -179,7 +184,9 @@ module Make (M : RANDOM) (G : GROUP) = struct
let commitments = Array.make (2*(max-min+2)) g in
let total_challenges = ref challenge0 in
commitments.(0) <- g **~ response0 *~ c0.alpha **~ challenge0;
M.yield () >>= fun () ->
commitments.(1) <- y **~ response0 *~ (c0.beta / g) **~ challenge0;
M.yield () >>= fun () ->
let index_true = mS-min+1 in
let rec loop i =
if i < max-min+2 then (
......@@ -191,7 +198,9 @@ module Make (M : RANDOM) (G : GROUP) = struct
let j = 2*i in
overall_proof.(i) <- {challenge; response};
commitments.(j) <- g **~ response *~ cS.alpha **~ challenge;
M.yield () >>= fun () ->
commitments.(j+1) <- y **~ response *~ nbeta **~ challenge;
M.yield () >>= fun () ->
total_challenges := Z.(!total_challenges + challenge);
loop (i+1)
) else loop (i+1)
......@@ -202,6 +211,7 @@ module Make (M : RANDOM) (G : GROUP) = struct
let j = 2 * index_true in
commitments.(j) <- g **~ w;
commitments.(j+1) <- y **~ w;
M.yield () >>= fun () ->
let prefix = Printf.sprintf "bproof1|%s|" zkp in
let h = G.hash prefix commitments in
let challenge = Z.(erem (h - !total_challenges) q) in
......@@ -219,9 +229,11 @@ module Make (M : RANDOM) (G : GROUP) = struct
random q >>= fun challenge0 ->
random q >>= fun response0 ->
let commitmentA0 = g **~ response0 *~ c0.alpha **~ challenge0 in
M.yield () >>= fun () ->
let commitmentB0 = y **~ response0 *~ c0.beta **~ challenge0 in
random q >>= fun w ->
let commitmentA1 = g **~ w and commitmentB1 = y **~ w in
M.yield () >>= fun () ->
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
......@@ -247,7 +259,9 @@ module Make (M : RANDOM) (G : GROUP) = struct
let j = 2*i in
overall_proof.(i) <- {challenge; response};
commitments.(j) <- g **~ response *~ cS.alpha **~ challenge;
M.yield () >>= fun () ->
commitments.(j+1) <- y **~ response *~ nbeta **~ challenge;
M.yield () >>= fun () ->
total_challenges := Z.(!total_challenges + challenge);
loop (i+1)
) else return ()
......@@ -256,6 +270,7 @@ module Make (M : RANDOM) (G : GROUP) = struct
random q >>= fun w ->
commitments.(0) <- g **~ w;
commitments.(1) <- y **~ w;
M.yield () >>= fun () ->
let prefix = Printf.sprintf "bproof1|%s|" zkp in
let h = G.hash prefix commitments in
let challenge = Z.(erem (h - !total_challenges) q) in
......@@ -357,7 +372,9 @@ module Make (M : RANDOM) (G : GROUP) = struct
let n = Array.length m in
swap (Array.init n (fun _ -> M.random G.q)) >>= fun r ->
let choices = Array.map2 (eg_encrypt y) r m in
M.yield () >>= fun () ->
let individual_proofs = Array.map3 (eg_disj_prove y d01 zkp) m r choices in
M.yield () >>= fun () ->
swap individual_proofs >>= fun individual_proofs ->
match q.q_blank with
| Some true ->
......
......@@ -99,6 +99,7 @@ end
(** Monad signature. *)
module type MONAD = sig
type 'a t
val yield : unit -> unit t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val fail : exn -> 'a t
......
......@@ -33,7 +33,7 @@ let encryptBallot params cred plaintext () =
let module E = Election.Make (P) (LwtJsRandom) in
let module CD = Credential.MakeDerive (G) in
let sk = CD.derive P.election.e_params.e_uuid cred in
let%lwt b = E.create_ballot ~sk plaintext () in
let%lwt b = E.create_ballot ~sk plaintext in
let s = string_of_ballot G.write b in
set_textarea "ballot" s;
set_content "ballot_tracker" (sha256_b64 s);
......
......@@ -105,18 +105,18 @@ let get_params () =
if n < 1 || x.[0] <> '?' then []
else Url.decode_arguments (String.sub x 1 (n-1))
module LwtJsRandom : Signatures.RANDOM with type 'a t = unit -> 'a Lwt.t = struct
type 'a t = unit -> 'a Lwt.t
let return x () = Lwt.return x
let bind x f () = Lwt.bind (x ()) (fun y -> f y ())
let fail x () = Lwt.fail x
module LwtJsRandom : Signatures.RANDOM with type 'a t = 'a Lwt.t = struct
type 'a t = 'a Lwt.t
let yield = Lwt_js.yield
let return = Lwt.return
let bind = Lwt.bind
let fail = Lwt.fail
let prng = lazy (pseudo_rng (random_string secure_rng 16))
let random q =
let size = Z.bit_length q / 8 + 1 in
fun () ->
let%lwt () = Lwt_js.yield () in
let r = random_string (Lazy.force prng) size in
Lwt.return Z.(of_bits r mod q)
let%lwt () = Lwt_js.yield () in
let r = random_string (Lazy.force prng) size in
Lwt.return Z.(of_bits r mod q)
end
......@@ -29,7 +29,7 @@ let shuffle election ciphertexts =
let module W = (val election) in
let module E = Election.Make (W) (LwtJsRandom) in
let ciphertexts = nh_ciphertexts_of_string E.G.read ciphertexts in
let%lwt shuffle = E.shuffle_ciphertexts ciphertexts () in
let%lwt shuffle = E.shuffle_ciphertexts ciphertexts in
Lwt.return (string_of_shuffle E.G.write shuffle)
let () =
......
......@@ -30,6 +30,7 @@ open Web_serializable_j
module LwtRandom = struct
type 'a t = 'a Lwt.t
let yield = Lwt_main.yield
let return = Lwt.return
let bind = Lwt.bind
let fail = Lwt.fail
......
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