Commit 2713e452 authored by Jakob Botsch Nielsen's avatar Jakob Botsch Nielsen

Implement vote zero knowledge proof

This proof is based on the description given in the original open vote
network article. It verifies that the public vote is on the form
g^(x*y)*g^v for either v=0 or v=1, and where x corresponds to the secret
key sent in the first part of the protocol.

This also updates a few things so that the test keeps working.
Specifically, it changes the hash function used to be simple (insecure)
xor, as the encoding used before was causing major computational
isssues.
parent f6dacc26
Pipeline #19367 passed with stage
in 9 minutes and 59 seconds
...@@ -42,6 +42,7 @@ Class BoardroomAxioms {A : Type} := ...@@ -42,6 +42,7 @@ Class BoardroomAxioms {A : Type} :=
mul_proper :> Proper (elmeq ==> elmeq ==> elmeq) mul; mul_proper :> Proper (elmeq ==> elmeq ==> elmeq) mul;
opp_proper :> Proper (elmeq ==> elmeq) opp; opp_proper :> Proper (elmeq ==> elmeq) opp;
inv_proper :> Proper (elmeq ==> elmeq) inv; inv_proper :> Proper (elmeq ==> elmeq) inv;
pow_base_proper :> Proper (elmeq ==> eq ==> elmeq) pow;
pow_exp_proper a : pow_exp_proper a :
~(elmeq a zero) -> Proper (expeq ==> elmeq) (pow a); ~(elmeq a zero) -> Proper (expeq ==> elmeq) (pow a);
...@@ -76,6 +77,11 @@ Class BoardroomAxioms {A : Type} := ...@@ -76,6 +77,11 @@ Class BoardroomAxioms {A : Type} :=
~(elmeq a zero) -> ~(elmeq a zero) ->
elmeq (pow a (e + e')) (mul (pow a e) (pow a e')); elmeq (pow a (e + e')) (mul (pow a e) (pow a e'));
pow_pow a b e :
~(elmeq a zero) ->
elmeq (pow (pow a b) e)
(pow a (b * e)%Z);
pow_nonzero a e : pow_nonzero a e :
~(elmeq a zero) -> ~(elmeq a zero) ->
~(elmeq (pow a e) zero); ~(elmeq (pow a e) zero);
...@@ -564,6 +570,25 @@ Section WithBoardroomAxioms. ...@@ -564,6 +570,25 @@ Section WithBoardroomAxioms.
now intros ? ? <-. now intros ? ? <-.
Qed. Qed.
Global Instance elmeqb_elmeq_proper :
Proper (elmeq ==> elmeq ==> eq) elmeqb.
Proof.
intros x x' xeq y y' yeq.
destruct (elmeqb_spec x y), (elmeqb_spec x' y'); auto.
- contradiction n.
now rewrite <- xeq, <- yeq.
- contradiction n.
now rewrite xeq, yeq.
Qed.
Lemma elmeqb_refl a :
a =? a = true.
Proof.
destruct (elmeqb_spec a a); [easy|].
contradiction n.
reflexivity.
Qed.
Lemma bruteforce_tally_aux_correct result max : Lemma bruteforce_tally_aux_correct result max :
Z.of_nat max < order - 1 -> Z.of_nat max < order - 1 ->
(result <= max)%nat -> (result <= max)%nat ->
...@@ -573,13 +598,10 @@ Section WithBoardroomAxioms. ...@@ -573,13 +598,10 @@ Section WithBoardroomAxioms.
induction max as [|max IH]. induction max as [|max IH].
- replace result with 0%nat by lia. - replace result with 0%nat by lia.
cbn. cbn.
destruct (elmeqb_spec (generator^0) (generator^0)); auto. now rewrite elmeqb_refl.
contradiction n; reflexivity.
- destruct (Nat.eq_dec result (S max)) as [->|?]. - destruct (Nat.eq_dec result (S max)) as [->|?].
+ cbn. + cbn.
destruct (elmeqb_spec (generator ^ Z.pos (Pos.of_succ_nat max)) now rewrite elmeqb_refl.
(generator ^ Z.pos (Pos.of_succ_nat max))); auto.
contradiction n; reflexivity.
+ cbn -[Z.of_nat]. + cbn -[Z.of_nat].
destruct (elmeqb_spec (generator ^ Z.of_nat (S max)) destruct (elmeqb_spec (generator ^ Z.of_nat (S max))
(generator ^ Z.of_nat result)) as [eq|?]; auto. (generator ^ Z.of_nat result)) as [eq|?]; auto.
...@@ -962,6 +984,16 @@ Module Zp. ...@@ -962,6 +984,16 @@ Module Zp.
mod_pow_pos (a mod p) x p = mod_pow_pos a x p. mod_pow_pos (a mod p) x p = mod_pow_pos a x p.
Proof. apply mod_pow_pos_aux_mod_idemp. Qed. Proof. apply mod_pow_pos_aux_mod_idemp. Qed.
Lemma mod_pow_mod_idemp a e p :
mod_pow (a mod p) e p = mod_pow a e p.
Proof.
unfold mod_pow.
destruct e.
- now rewrite Z_pow_mod_idemp.
- now rewrite mod_pow_pos_mod_idemp.
- now rewrite mod_pow_pos_mod_idemp.
Qed.
Lemma mod_pow_pos_aux_mod a x p r : Lemma mod_pow_pos_aux_mod a x p r :
mod_pow_pos_aux a x p r mod p = mod_pow_pos_aux a x p r. mod_pow_pos_aux a x p r mod p = mod_pow_pos_aux a x p r.
Proof. Proof.
...@@ -1487,6 +1519,8 @@ Module Zp. ...@@ -1487,6 +1519,8 @@ Module Zp.
- intros a a' aeq. - intros a a' aeq.
cbn. cbn.
now rewrite <- mod_inv_mod_idemp, aeq, mod_inv_mod_idemp by auto. now rewrite <- mod_inv_mod_idemp, aeq, mod_inv_mod_idemp by auto.
- intros a a' aeq e ? <-.
now rewrite <- mod_pow_mod_idemp, aeq, mod_pow_mod_idemp.
- intros a anp e e' eeq. - intros a anp e e' eeq.
rewrite <- (mod_pow_exp_mod _ e), <- (mod_pow_exp_mod _ e') by auto. rewrite <- (mod_pow_exp_mod _ e), <- (mod_pow_exp_mod _ e') by auto.
now rewrite eeq. now rewrite eeq.
...@@ -1533,6 +1567,8 @@ Module Zp. ...@@ -1533,6 +1567,8 @@ Module Zp.
now rewrite mod_inv_mod_idemp. now rewrite mod_inv_mod_idemp.
- intros a e e' ap0. - intros a e e' ap0.
now rewrite mod_pow_exp_plus by auto. now rewrite mod_pow_exp_plus by auto.
- intros a b e anz.
now rewrite mod_pow_exp_mul.
- auto. - auto.
- auto. - auto.
Defined. Defined.
...@@ -1708,6 +1744,9 @@ Module BigZp. ...@@ -1708,6 +1744,9 @@ Module BigZp.
- intros a a' aeq. - intros a a' aeq.
autorewrite with zsimpl in *. autorewrite with zsimpl in *.
now rewrite <- Zp.mod_inv_mod_idemp, aeq, Zp.mod_inv_mod_idemp. now rewrite <- Zp.mod_inv_mod_idemp, aeq, Zp.mod_inv_mod_idemp.
- intros a a' aeq e ? <-.
autorewrite with zsimpl in *.
now rewrite <- Zp.mod_pow_mod_idemp, aeq, Zp.mod_pow_mod_idemp.
- intros a anp e e' eeq. - intros a anp e e' eeq.
autorewrite with zsimpl in *. autorewrite with zsimpl in *.
rewrite <- (Zp.mod_pow_exp_mod _ e), <- (Zp.mod_pow_exp_mod _ e') by auto. rewrite <- (Zp.mod_pow_exp_mod _ e), <- (Zp.mod_pow_exp_mod _ e') by auto.
...@@ -1770,6 +1809,9 @@ Module BigZp. ...@@ -1770,6 +1809,9 @@ Module BigZp.
- intros a e e' ap0. - intros a e e' ap0.
autorewrite with zsimpl in *. autorewrite with zsimpl in *.
now rewrite Zp.mod_pow_exp_plus by auto. now rewrite Zp.mod_pow_exp_plus by auto.
- intros a b e ap0.
autorewrite with zsimpl in *.
now rewrite Zp.mod_pow_exp_mul.
- intros a e ap0. - intros a e ap0.
autorewrite with zsimpl in *. autorewrite with zsimpl in *.
auto. auto.
......
...@@ -39,10 +39,6 @@ Instance generator_instance : Generator axioms := ...@@ -39,10 +39,6 @@ Instance generator_instance : Generator axioms :=
BoardroomMath.generator_nonzero := generator_nonzero; BoardroomMath.generator_nonzero := generator_nonzero;
generator_generates := generator_is_generator; |}. generator_generates := generator_is_generator; |}.
Instance id_scheme : @VoteProofScheme Z :=
{| make_vote_proof l n z b := 0%Z;
verify_vote l n a z := true; |}.
Definition num_parties : nat := 7. Definition num_parties : nat := 7.
Definition votes_for : nat := 4. Definition votes_for : nat := 4.
...@@ -64,8 +60,13 @@ Definition svs : list bool := ...@@ -64,8 +60,13 @@ Definition svs : list bool :=
Definition pks : list Z := Definition pks : list Z :=
Eval native_compute in map compute_public_key sks. Eval native_compute in map compute_public_key sks.
Definition rks : list Z :=
Eval native_compute in map (reconstructed_key pks) (seq 0 (length pks)).
(* In this example we just use xor for the hash function, which is
obviously not cryptographically secure. *)
Definition hash_func (l : list positive) : positive := Definition hash_func (l : list positive) : positive :=
countable.encode l. N.succ_pos (fold_right (fun p a => N.lxor (Npos p) a) 1%N l).
(* Compute the signup messages that would be sent by each party. (* Compute the signup messages that would be sent by each party.
We just use the public key as the chosen randomness here. *) We just use the public key as the chosen randomness here. *)
...@@ -75,10 +76,11 @@ Definition signups : list Msg := ...@@ -75,10 +76,11 @@ Definition signups : list Msg :=
(* Compute the submit_vote messages that would be sent by each party *) (* Compute the submit_vote messages that would be sent by each party *)
(* Our functional correctness proof assumes that the votes were computed (* Our functional correctness proof assumes that the votes were computed
using the make_vote_msg function provided by the contract *) using the make_vote_msg function provided by the contract.
In this example we just use the secret key as the random parameters. *)
Definition votes : list Msg := Definition votes : list Msg :=
Eval native_compute in map (fun '(i, sk, sv) => make_vote_msg pks i sk sv) Eval native_compute in map (fun '(i, sk, sv, rk) => make_vote_msg hash_func sk rk sv i sk sk sk)
(zip (zip (seq 0 (length pks)) sks) svs). (zip (zip (zip (seq 0 (length pks)) sks) svs) rks).
Definition AddrSize := (2^128)%N. Definition AddrSize := (2^128)%N.
Instance Base : ChainBase := LocalChainBase AddrSize. Instance Base : ChainBase := LocalChainBase AddrSize.
......
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