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.
Admitted.
intuition.
econstructor.
econstructor.
eapply knowledgeExtractor_large_h_efficient.
cbv beta.
eapply leRat_trans.
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply ratInverse_leRat.
Focus 2.
eapply knowledgeExtractor_large_h_effective.
intuition.
simpl.
rewrite ratMult_comm.
rewrite <- ratMult_assoc.
eapply ratMult_leRat_compat; intuition.
rewrite <- ratMult_num_den.
simpl.
eapply leRat_terms; intuition.
Qed.
*)
Admitted.
Admitted.
(* Theorem sigma_knowledge_soundness : knowledge_soundness cost (fun x => 1 / expnat 2 t).  unfold knowledge_soundness. intuition.  (* start by splitting on acceptance_prob -- we use a different knowledge extractor when acceptance_prob is large/small *)
destruct (le_Rat_dec (4 / expnat 2 t) (acceptance_prob x y)).
(* acceptance probability is "large" *)
exists knowledgeExtractor_large.
intuition.
apply knowledgeExtractor_large_efficient.
eapply eqRat_trans.
eapply evalDist_Bind_1.
eapply knowledgeExtractor_large_wf.
intuition.
apply getSupport_Repeat_In in H0.
apply filter_In in H0.
destruct H0.
rewrite H1.
simpl.
eapply eqRat_refl.
destruct (EqDec_dec bool_EqDec true true); intuition.
exists knowledgeExtractor_small.
intuition.
specialize knowledgeExtractor_small_efficient.
intuition.
intuition.
eapply H.
eapply ratSubtract_0.
intuition.
eapply eqRat_trans.
eapply evalDist_Bind_1.
eapply knowledgeExtractor_small_wf.
intuition.
apply getSupport_Repeat_In in H0.
apply filter_In in H0.
destruct H0.
rewrite H1.
simpl.
eapply eqRat_refl.
destruct (EqDec_dec bool_EqDec true true); intuition.
Qed.
exists knowledge
(* we'll come back to running time *)
admit.
unfold knowledgeExtractor.
unfold knowledgeExtractor, mk_rewindable_P_oracle.
eapply leRat_trans.
Focus 2.
eapply eqRat_impl_leRat.
comp_inline 1%nat O.
eapply eqRat_refl.
eapply leRat_trans.
Focus 2.
(* Run the initial query, then case split on whether we end up in a "heavy" row. *)
eapply (@evalDist_bind_case_split_ge _
(fun (p : (Bvector t * Response * bool) * (P_State * Commitment)) => let (s_P, a) := (snd p) in (isHeavy (P_respond s_P) x y a))
(1/2) (1/2) _
(Repeat
(z <- P_commit x y;
[s_P, a]<-* z;
p0 <-
(z0 <- queryRow (P_respond s_P) x a;
[e, z1]<-* z0; ret (e, z1, V_accept x a e z1));
ret (p0, (s_P, a)))
(fun p0 : Bvector t * Response * bool * (P_State * Commitment) =>
[_, b]<-* fst p0; eqb b true)
)).
(* This is true when acceptance_prob is non-zero, which should be implied by the first case split. *)
admit.
intuition.
comp_simp.
simpl in H0.
apply getSupport_Repeat_In in H.
apply filter_In in H.
destruct H.
apply getSupport_Bind_In in H.
destruct H.
destruct H.
destruct x0.
apply getSupport_Bind_In in H2.
destruct H2.
destruct H2.
apply getSupport_Bind_In in H2.
destruct H2.
destruct H2.
destruct x1.
simpl in H4.
destruct H4.
Focus 2.
inversion H4.
simpl in H3.
destruct H3.
Focus 2.
inversion H3.
inversion H3; clear H3; subst.
inversion H4; clear H4; subst.
simpl in H1.
(* The row is heavy, so we expect to get an accepting conversation before the emergency break kicks in. *)
eapply leRat_trans.
Focus 2.
eapply eqRat_impl_leRat.
comp_inline 1%nat O.
eapply eqRat_refl.
eapply leRat_trans.
Focus 2.
eapply (evalDist_bind_spec_ge (fun p0 : bool * (Bvector t * Response) =>
let (e', z') := snd p0 in
V_accept x c e' z' && negb (eqb b0 e'))); intros.
admit.
destruct b.
unfold snd in H4.
destruct p0.
apply andb_true_iff in H4.
destruct H4.
apply getSupport_Repeat_In in H3.
apply filter_In in H3.
destruct H3.
simpl in H6.
apply getSupport_Bind_In in H3.
destruct H3.
destruct H3.
(* The emergency break did not fire in this case, so that part of the computation is irrelvant*)
clear H3.
apply getSupport_Bind_In in H2.
destruct H2.
destruct H2.
apply getSupport_Bind_In in H3.
destruct H3.
destruct H3.
simpl in H8.
destruct H8; inversion H8; clear H8; subst.
apply getSupport_Bind_In in H7.
destruct H7.
destruct H7.
apply getSupport_Bind_In in H7.
destruct H7.
destruct H7.
apply getSupport_Bind_In in H9.
destruct H9.
destruct H9.
simpl in H8.
destruct H8; inversion H8; clear H8; subst.
simpl in H10.
destruct H10.
Focus 2.
inversion H8.
inversion H8; clear H8; subst.
eapply eqRat_impl_leRat.
symmetry.
unfold snd.
eapply special_soundness.
eapply p.
unfold not.
intro.
subst.
rewrite (eqb_refl) in H5.
simpl in H5.
inversion H5.
exists y.
eapply getSupport_In_Bind.
eapply H.
comp_simp.
eapply getSupport_In_Bind.
eapply H2.
eapply getSupport_In_Bind.
eapply H3.
simpl.
left.
eapply refl_equal.
exists y.
eapply getSupport_In_Bind.
eapply H.
comp_simp.
eapply getSupport_In_Bind.
eapply H7.
eapply getSupport_In_Bind.
eapply H9.
simpl.
left.
eapply refl_equal.
eapply eqb_true_iff.
trivial.
trivial.
eapply leRat_trans.
Focus 2.
eapply eqRat_impl_leRat.
rewrite ratMult_1_r.
eapply eqRat_refl.
remember (queryRowWithEmergencyBreak
(to_P_oracle
(fun (A : Set) (eqd : EqDec A)
(f1 : Commitment -> P_respond_oracle -> Comp (A * bool))
(B : Set) (f2 : A -> Commitment -> P_respond_oracle -> Comp B) =>
z <-
Repeat
(z <- P_commit x y;
[s_P, a]<-* z; p0 <- f1 a (P_respond s_P); ret (p0, (s_P, a)))
(fun p0 : A * bool * (P_State * Commitment) =>
[_, b]<-* fst p0; eqb b true);
(let '(e, _, (s_P, a)) := z in f2 e a (P_respond s_P))))
(P_respond p1) x c) as exp.
remember (fun p0 : bool * (Bvector t * Response) =>
let (e', z') := snd p0 in
V_accept x c e' z' && negb (eqb b0 e')) as pred1.
remember (fun p0 : bool * (Bvector t * Response) =>
fst p0) as pred2.
eapply leRat_trans.
Focus 2.
eapply eqRat_impl_leRat.
Admitted.
Show.
eapply evalDist_Bind_id; intuition.
eapply (evalDist_Repeat_pred_eq (fun x => pred1 x || pred2 x)).
intuition.
subst.
destruct x0.
unfold snd.
destruct p0.
eapply refl_equal.
assert (evalDist (ret (pred1 x0)) true ==
Pr
[ret (let (e', z') := snd x0 in V_accept x c e' z' && negb (eqb b0 e')) ]).
subst.
eapply eqRat_refl.
eapply H4.
eapply emergency_break.
subst.
intuition.
unfold queryRowWithEmergencyBreak, to_P_oracle.
remember (emergencyBreak x
(fun (B : Set) (f : Commitment -> P_respond_oracle -> Comp B) =>
z <-
Repeat
(z <- P_commit x y;
[s_P, a]<-* z; p0 <- ret (tt, true); ret (p0, (s_P, a)))
(fun p0 : unit * bool * (P_State * Commitment) =>
[_, b]<-* fst p0; eqb b true);
(let '(_, _, (s_P, a)) := z in f a (P_respond s_P)))) as c1.
remember (queryRow (P_respond p1) x c) as c2.
eapply leRat_trans.
eapply eqRat_impl_leRat.
comp_inline O O.
comp_inline O 1%nat.
comp_swap O O.
eapply eqRat_refl.
eapply leRat_trans.
Focus 2.
eapply eqRat_impl_leRat.
symmetry.
comp_inline O O.
comp_inline O 1%nat.
eapply eqRat_refl.
eapply evalDist_Bind_1_le_l; intuition.
admit.
eapply evalDist_Bind_1_le_r; intuition.
admit.
(* The loop executes exactly once *)
rewrite Heqc1.
eapply leRat_trans.
eapply eqRat_impl_leRat.
unfold emergencyBreak.
comp_inline O O.
eapply evalDist_Bind_id; intros.
eapply eqRat_refl.
comp_inline O O.
comp_inline O O.
eapply evalDist_Bind_id; intros.
Admitted.

Lemma repeat_once : forall (A : Set)(eqd : EqDec A)(c : Comp A)(P : A -> bool) a,
(well_formed_comp c) ->
(exists x : A, In x (filter P (getSupport c))) ->
(forall x, In x (getSupport c) -> P x = true) ->
evalDist (Repeat c P) a == evalDist c a.