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. *)
Abort.
(* TODO: locate [expected_time_at_most] *) (* Theorem knowledgeExtractor_small_efficient : forall x y, (~(4 / expnat 2 t) <= (acceptance_prob x y)) -> (~ (acceptance_prob x y) <= (1 / expnat 2 t)) -> expected_time_at_most_polynomial cost ((expnat 2 t / 1) * (2 / 1 + sigma x y) * (ratInverse (sigma x y))) (knowledgeExtractor_small x (mk_rewindable_P_oracle x y)).  (* intuition.  econstructor. (*   eapply (@expected_time_R_Repeat _ (((expnat 2 t) / 1) * (ratInverse (sigma x y)))). *)
econstructor.
eapply knowledgeExtractor_small_h_efficient.
rewrite <- ratInverse_ratMult.
eapply ratInverse_leRat.
intuition.
eapply H0.
eapply ratSubtract_0_inv.
trivial.
eapply leRat_trans.
Focus 2.
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply knowledgeExtractor_small_h_effective.
unfold sigma.
SearchAbout leRat ratSubtract 0.
continue here
apply knowledgeExtractor_small_h_effective.
assert (expnat 2 t / 1 == (ratInverse (1 / expnat 2 t))).
simpl.
intuition.
unfold sigma.
unfold at_least_polynomial.
exists 1%nat.
simpl.
eapply leRat_trans.
Focus 2.
eapply eqRat_impl_leRat.
rewrite ratMult_1_r.
symmetry.
eapply eqRat_trans.
eapply ratMult_eqRat_compat.
eapply H1.
eapply eqRat_refl.
rewrite <- ratInverse_ratMult.
eapply eqRat_refl.
intuition.
intuition.
admit.
eapply ratInverse_leRat.
intuition.
admit.
rewrite ratMult_comm.
rewrite ratMult_ratSubtract_distrib_r.
eapply leRat_trans.
eapply eqRat_impl_leRat.
eapply ratSubtract_eqRat_compat.
rewrite ratMult_assoc.
rewrite ratMult_eq_rat1.
eapply ratMult_1_r.
eapply ratMult_1_l.
intuition.
*)
Admitted.
Hypothesis bvToNat_cost : forall (n : nat)(v : Bvector n) t,
cost v t ->
cost (bvToNat v) (t + n/1).
intuition.
destruct (V_challenge_efficient x).
unfold knowledgeExtractor_large_h, knowledgeExtractor_h.
unfold mk_rewindable_P_oracle.
econstructor.
econstructor.
econstructor.
econstructor.
eauto.
intuition.
destruct a.
econstructor.
econstructor.
econstructor.
eapply H1.
intuition.
econstructor.
eapply H0.
eapply H2.
intuition.
econstructor.
eauto.
intuition.
destruct a.
econstructor.
eauto.
intuition.
econstructor.
eauto.
intuition.
destruct a.
destruct p0.
destruct p1.
unfold largeRowQuery.
destruct p0.
econstructor.
unfold queryRowWithEmergencyBreak, emergencyBreak, to_P_oracle.
econstructor.
econstructor.
econstructor.
econstructor.
eapply RndNat_expected_time; intuition.
unfold d.
omega.
intros.
econstructor.
econstructor.
econstructor.
econstructor.
eapply H.
intros.
destruct a0.
econstructor.
econstructor.
here
Qed.

Theorem knowledgeExtractor_large_h_effective : forall x y,
1 / 8 <= Pr[y' <-$ knowledgeExtractor_large_h x (mk_rewindable_P_oracle x y); ret (R x y')].