Section ProofOfKnowledge.
Context `{p : SigmaProtocol}.
Variable P_State_EqDec : EqDec P_State.
Hypothesis P_commit_well_formed : forall x y,
well_formed_comp (P_commit x y).
Hypothesis V_challenge_wf : forall x a,
well_formed_comp (V_challenge x a).
Hypothesis P_respond_well_formed : forall a b,
well_formed_comp (P_respond a b).
(* The definition of soundness requires us to construct a knowledge extractor that only has the public input and uses P as an oracle.  We want to make sure the knowledge extractor can't cheat by looking at the auxiliary input or the state of P.  We do this by creating an equivalent P in a monadic style that takes a function describing what to do with the information we get from P. *)
(* We need a rewindable oracle, and we create it by supplying two functions.  The first is a predicate which determines when a configuration is acceptable.  The second is a function that uses that configuration to produce some desired result.  The first function also returns some information that is used by the second function.  We can generalize this a bit by producing a list of acceptable configurations which are used by the second function.  *)
Definition P_respond_oracle := Bvector t -> Comp Response.
Definition rewindable_P_oracle := forall (A : Set)(eqd : EqDec A), (Commitment -> P_respond_oracle -> Comp (A * bool)) -> forall (B: Set), (A -> Commitment -> P_respond_oracle -> Comp B) -> Comp B.
Definition mk_rewindable_P_oracle x w (A : Set)(eqd : EqDec A)(f1 : Commitment -> P_respond_oracle -> Comp (A * bool))(B : Set)(f2 : A -> Commitment -> P_respond_oracle -> Comp B)  : Comp B :=
[p1, p2] <-$2 Repeat
([s_P, a] <-$2 P_commit x w;
p <-$ (f1 a (P_respond s_P));
ret (p, (s_P, a)))
(fun p => (snd (fst p)));
e <- fst p1;
s_P <- fst p2;
a <- snd p2;
f2 e a (P_respond s_P).
Hypothesis unit_EqDec : EqDec unit.
Definition P_oracle := forall (B: Set), (Commitment -> P_respond_oracle -> Comp B) -> Comp B.
Definition mk_P_oracle x w (B : Set)(f2 : Commitment -> P_respond_oracle -> Comp B) : Comp B :=
@mk_rewindable_P_oracle x w unit _
(fun a b => ret (tt, true))
_
(fun a b c => f2 b c).
Definition queryRow (respond_oracle : P_respond_oracle) x a :=
e <-$ V_challenge x a;
z <-$ respond_oracle e;
ret (e, z).
Definition d := 16.
Definition emergencyBreak (x : Blist)(oracle : P_oracle) :=
n <-$ [0 .. d);
b <-$ oracle _
(fun a resp =>
[e, z] <-$2 queryRow resp x a;
ret (V_accept x a e z));
ret (b && eqb n O).
Definition queryRowWithEmergencyBreak (oracle : P_oracle)(resp : P_respond_oracle)(x : Blist) a :=
b <-$ emergencyBreak x oracle;
p <-$ queryRow resp x a;
ret (b, p).
Definition to_P_oracle (o : rewindable_P_oracle)(B : Set)(f : Commitment -> P_respond_oracle -> Comp B) :=
(@o unit _ (fun a b => ret (tt, true)) _ (fun a b c => f b c)).
Definition acceptance_prob x y :=
Pr[mk_P_oracle x y
(fun a resp =>
[e, z] <-$2 queryRow resp x a;
ret (V_accept x a e z))].
Definition heavy (resp : P_respond_oracle) x y a :=
(1 / 2) * acceptance_prob x y <= Pr[ [e, z] <-$2 queryRow resp x a; ret (V_accept x a e z) ].
Definition isHeavy (resp : P_respond_oracle) x y a :=
bleRat ((1 / 2) * acceptance_prob x y) (Pr[ [e, z] <-$2 queryRow resp x a; ret (V_accept x a e z) ]).
(* TODO: locate [expected_time_at_most] *) (* Definition knowledge_soundness(cost : forall (A : Set), A -> Rat -> Prop)(k : Blist -> Rat) := forall x y (pf : nz (length x)), exists c, let e := acceptance_prob x y in (~(ratSubtract e (k x)) == 0) -> exists (M : Blist -> rewindable_P_oracle -> Comp Blist), let oracle := (mk_rewindable_P_oracle x y) in expected_time_at_most cost 1 (P_commit x y) -> (forall s c e, In (s, e) (getSupport (P_commit x y)) -> (expected_time_at_most cost 1 (P_respond s c))) -> expected_time_at_most cost ((expRat (length x / 1) c) * ratInverse (ratSubtract e (k x))) (M x oracle) /\ Pr[y' <- M x oracle; ret (R x y')] == 1. *)
(* Lemma evalDist_bind_case_split : forall (B : Set)(e : B -> Comp bool) v1 v2 (A : Set)(c : Comp B)(f : B -> Comp A) a, well_formed_comp c -> (forall b, (e b) = true -> (evalDist (f b) a) == v1) -> (forall b, (e b) = false -> (evalDist (f b) a) == v2) -> evalDist (Bind c f) a == Pr[Bind c e] * *)
Admitted.
intuition.
eapply leRat_trans.
2:{
eapply (evalDist_bind_case_split_ge e); intuition.
eapply rat0_le_all.
}
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
rewrite ratMult_0_r.
rewrite <- ratAdd_0_r.
eapply eqRat_refl.
}
intuition.
Qed.
induction ls; intuition; simpl in *.
destruct (p2 a);
simpl.
destruct (p1 a); simpl.
f_equal.
intuition.
intuition.
rewrite andb_false_r.
intuition.
Qed.
induction ls; intuition; simpl in *.
rewrite H.
destruct (p2 a); intuition.
f_equal.
intuition.
intuition.
Qed.
intuition.
symmetry.
rewrite (sumList_filter_partition p0).
eapply eqRat_trans.
eapply ratAdd_eqRat_compat.
eapply sumList_body_eq; intuition.
apply filter_In in H.
intuition.
rewrite H1.
destruct (eqd true true); try congruence.
eapply ratMult_1_r.
eapply sumList_0; intuition.
apply filter_In in H.
intuition.
destruct (p0 a); simpl in *; try congruence.
destruct (eqd false true); try congruence.
eapply ratMult_0_r.
symmetry.
eapply ratAdd_0_r.
Qed.
intuition.
simpl in *.
(* first assert a fact that we'll need a few times later on. *)
assert (~(sumList (getSupport c)
(fun b : A =>
evalDist c b * (if EqDec_dec bool_EqDec (p1 b) true then 1 else 0)) == 0)).
intuition.
assert (sumList (getSupport c)
(fun b : A =>
evalDist c b * (if EqDec_dec bool_EqDec (p2 b) true then 1 else 0)) ==
0).
eapply leRat_impl_eqRat.
rewrite H.
rewrite H1.
intuition.
eapply rat0_le_all.
destruct H0.
intuition.
apply orb_true_iff in H4.
intuition.
eapply (sumList_0) in H1.
assert ( evalDist c x *
(if EqDec_dec bool_EqDec (p1 x) true then 1 else 0) == 0).
eauto.
rewrite H0 in H1.
destruct (EqDec_dec bool_EqDec true true); try congruence.
rewrite ratMult_1_r in H1.
eapply getSupport_In_evalDist.
eauto.
trivial.
trivial.
eapply (sumList_0) in H2.
assert ( evalDist c x *
(if EqDec_dec bool_EqDec (p2 x) true then 1 else 0) == 0).
eauto.
rewrite H0 in H2.
destruct (EqDec_dec bool_EqDec true true); try congruence.
rewrite ratMult_1_r in H2.
eapply getSupport_In_evalDist.
eauto.
trivial.
trivial.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
symmetry.
eapply sumList_body_eq.
intuition.
apply filter_In in H2.
intuition.
unfold indicator.
rewrite H4.
rewrite ratMult_1_l at 1.
eapply ratMult_assoc.
}
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
symmetry.
eapply sumList_factor_constant_l.
}
simpl in *.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
symmetry.
eapply ratMult_eqRat_compat.
eapply eqRat_refl.
rewrite (sumList_filter_partition p1).
eapply ratAdd_eqRat_compat.
rewrite filter_twice.
rewrite (filter_pred_eq _ p1).
eapply sumList_body_eq; intuition.
apply filter_In in H2.
intuition.
rewrite H4.
destruct (EqDec_dec bool_EqDec true true).
eapply ratMult_1_r.
congruence.
intuition.
destruct (p1 a); trivial.
eapply sumList_0.
intuition.
apply filter_In in H2.
intuition.
destruct (p1 a); simpl in *; try congruence.
destruct (EqDec_dec bool_EqDec false true); try congruence.
eapply ratMult_0_r.
}
eapply leRat_trans.
2:{
eapply ratMult_leRat_compat.
eapply ratInverse_leRat.
destruct H0.
eapply sumList_nz.
exists x.
intuition.
eapply filter_In.
intuition.
eapply getSupport_In_evalDist.
eauto.
trivial.
rewrite (sumList_filter_partition p1).
rewrite filter_twice.
erewrite (filter_pred_eq _ p1).
rewrite sumList_filter_prod_eq_r.
assert (sumList
(filter (fun a : A => negb (p1 a))
(filter (fun a : A => p1 a || p2 a) (getSupport c)))
(evalDist c) <=
(sumList (getSupport c)
(fun b : A =>
evalDist c b * (if EqDec_dec bool_EqDec (p2 b) true then 1 else 0)))).
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
eapply sumList_filter_prod_eq_r.
}
assert (sumList
(filter (fun a : A => negb (p1 a))
(filter (fun a : A => p1 a || p2 a) (getSupport c)))
(evalDist c) ==
sumList
(filter (fun a : A => negb (p1 a))
(filter p2 (getSupport c)))
(evalDist c)).
repeat rewrite filter_twice.
erewrite filter_pred_eq.
eapply eqRat_refl.
intuition.
destruct (p1 a); destruct (p2 a); trivial.
rewrite H2.
clear H2.
eapply sumList_filter_le.
rewrite H2.
rewrite H.
rewrite ratMult_2.
eapply leRat_refl.
intuition.
destruct (p1 a); trivial.
eapply eqRat_impl_leRat.
eapply ratAdd_0_r.
}
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
rewrite ratInverse_ratMult.
rewrite ratMult_comm.
rewrite <- ratMult_assoc.
symmetry.
eapply ratMult_eqRat_compat.
eapply eqRat_trans.
eapply ratMult_eqRat_compat.
eapply eqRat_refl.
eapply ratInverse_eqRat_compat.
trivial.
symmetry.
eapply sumList_filter_prod_eq_r.
rewrite ratMult_comm.
eapply ratInverse_prod_1.
rewrite sumList_filter_prod_eq_r.
eauto.
simpl.
eapply eqRat_refl.
trivial.
intuition.
}
eapply eqRat_impl_leRat.
rewrite ratMult_1_l.
intuition.
Qed.
intuition.
Qed.
Definition knowledgeExtractor_h(x : Blist)(oracle : rewindable_P_oracle)(rowQuery : (Bvector t * Response) -> Commitment -> P_respond_oracle -> Comp Blist) :=
(oracle _ _
(fun a respond_oracle =>
[e, z] <-$2 queryRow respond_oracle x a;
ret ((e, z), V_accept x a e z))
_
rowQuery).
(* The following knowledge extractor works with probability 1/4 when acceptance_prob is "large" and the first hit is in a "heavy" row (which happens with probability at least 1/2. *)
Definition largeRowQuery x oracle :=
(fun p a respond_oracle =>
e <- fst p;
z <- snd p;
p' <-$ Repeat
(queryRowWithEmergencyBreak (to_P_oracle oracle) respond_oracle x a)
(fun p => let (e', z') := snd p in
(V_accept x a e' z' && negb (eqb e e')) || fst p);
e' <- fst ((snd p'));
z' <- snd ((snd p'));
extract x a e e' z z').
Definition knowledgeExtractor_large_h(x : Blist)(oracle : rewindable_P_oracle) :=
knowledgeExtractor_h x oracle (largeRowQuery x oracle).
Definition knowledgeExtractor_large(x : Blist)(oracle : rewindable_P_oracle) :=
Repeat (knowledgeExtractor_large_h x oracle) (fun y => R x y).
Fixpoint BoundedRepeat (A : Set)(eqd : EqDec A)(n : nat)(c : Comp A)(P : A -> bool)(def : A) :=
match n with
| O => ret (def)
| S n' =>
(Bind c (fun x => if (P x) then (ret x) else (BoundedRepeat _ n' c P def)))
end.
Variable cost : forall (A: Set), A -> Rat -> Prop.
Hypothesis cost_respects_equality : forall (A : Set)(a : A) r1 r2,
cost a r1 ->
r1 == r2 ->
cost a r2.
Hypothesis pair_cost : forall (A B : Set)(a : A)(b : B) r1 r2,
cost a r1 ->
cost b r2 ->
cost (a, b) (r1 + r2).
Hypothesis pair_extract_cost : forall (A B : Set)(a : A)(b : B),
cost (a, b) 0 ->
cost a 0 /\
cost b 0.
(* Variable t1 : Rat. Hypothesis P_commit_time_t1 : forall x y, expected_time_at_most cost t1 (P_commit x y). Variable t2 : Rat. Hypothesis V_challenge_time_t2 : forall x y, expected_time_at_most cost t2 (V_challenge x y). Variable t3 : Rat. Hypothesis P_respond_time_t3 : forall x y, expected_time_at_most cost t3 (P_respond x y). *)
Hypothesis V_accept_cost : forall a b c d,
cost (V_accept a b c d) 1.
(* TODO: locate [expected_time_at_most] *) (* Lemma BoundedRepeat_cost : forall (n : nat)(A : Set)(eqd : EqDec A)(c : Comp A)(P : A -> bool) def v, expected_time_at_most cost v c -> cost def 0 -> let c1 :=  (ratInverse (Pr  [v <- c; ret P v ])) in let c2 :=  (n / 1) in expected_time_at_most cost (v * c2) (BoundedRepeat eqd n c P def) .  induction n; intuition; simpl in *. econstructor.  eapply cost_respects_equality. eapply H0. rewrite ratMult_0_r. intuition.  econstructor. econstructor. eauto. intuition. case_eq (P a); intuition. eapply expected_time_R_R. econstructor. eauto. eapply rat0_le_all. eapply IHn. eauto. trivial. eapply leRat_trans. Focus 2. eapply eqRat_impl_leRat.  Lemma ratMult_S : forall r n, r * (S n / 1) == r + r * (n / 1). Admitted.  symmetry. eapply ratMult_S. intuition. Qed. *)
Definition smallRowQuery x :=
(fun p a respond_oracle =>
e <- fst p;
z <- snd p;
p' <-$ BoundedRepeat _ (expnat 2 (t - 2))
(queryRow respond_oracle x a)
(fun p => let (e', z') := p in
(V_accept x a e' z' && negb (eqb e e'))) p;
e' <- fst p';
z' <- snd p';
extract x a e e' z z').
Definition knowledgeExtractor_small_h(x : Blist)(oracle : rewindable_P_oracle) :=
knowledgeExtractor_h x oracle (smallRowQuery x).
Definition knowledgeExtractor_small(x : Blist)(oracle : rewindable_P_oracle) :=
Repeat (knowledgeExtractor_small_h x oracle) (fun y => R x y).
Definition sigma x y :=
(ratSubtract ((acceptance_prob x y) * (expnat 2 t / 1)) 1).
(* TODO: locate [expected_time_at_most] *) (* Hypothesis V_challenge_efficient : forall (x : Blist), exists v, forall a, expected_time_at_most cost v (V_challenge x a) /\ at_most_polynomial (length x / 1) v. *)
(* Theorem knowledgeExtractor_small_h_efficient : forall x y, expected_time_at_most cost (ratInverse (ratSubtract (acceptance_prob x y) (1 / expnat 2 t))) (knowledgeExtractor_small_h x (mk_rewindable_P_oracle x y)).  intuition.  econstructor. econstructor. econstructor. econstructor. eapply P_commit_time_t1. intuition. destruct a. econstructor. econstructor. econstructor. eapply V_challenge_time_t2. intuition. econstructor. eapply P_respond_time_t3. intuition. econstructor. eauto. intuition. destruct a. econstructor. eapply pair_cost. eauto. eauto. intuition. econstructor. eauto. intuition. destruct a. destruct p0. destruct p1. unfold smallRowQuery. destruct p0. econstructor. eapply BoundedRepeat_cost. unfold queryRow. econstructor. eapply V_challenge_time_t2. intuition. econstructor. eapply P_respond_time_t3. intuition. econstructor. eauto.  apply pair_extract_cost in H0; intuition. apply pair_extract_cost in H1; intuition.  intuition. destruct a.  Focus 2.   unfold extract.  here eapply pair_cost  Admitted. *)
(* Check mk_rewindable_P_oracle. *)

Theorem knowledgeExtractor_small_h_effective : forall x y,
expnat 2 t / 1 * ratInverse (sigma x y) <=
Pr
[v <-$ knowledgeExtractor_small_h x (mk_rewindable_P_oracle x y); ret R x v].