(************************************************************************)
(* Copyright (c) 2022, Gergei Bana, Rohit Chadha, Ajay Kumar Eeralla,   *)
(* Qianli Zhang                                                         *)
(*                                                                      *)
(* This work is licensed under the MIT license. The license is          *)
(* described in the file "LICENSE" available at the root of the source  *)
(* or at https://opensource.org/licenses/MIT                            *)
(************************************************************************)

Require Import Coq.micromega.Lia.
Require Export prop21.
Import ListNotations.

(*************************************************************************)
(***** In this first part of the proof we replace n0 with a fresh n0'*****)
(***** on both sides using CCA2 security of encryption with public *******)
(***** key pkS of the mixer **********************************************)
(*************************************************************************)

(* We use a lot of functions defined in definitions.v to make the terms manageable.
   Also note that ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0) or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0 or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0) expresses that the ballot of the first voter was not replaced,
   the negation of which is the guard of Lemma25 *)

(* The actual statement of Lemma25 is at the end *)

(* In the next proposition we show that the terms with "Fiv" and "Fv" are equal.
   Fiv inserts the if-then-else terms in front of the decrytions of the voting phase that is necessary for the CCA2 axiom. *)

Lemma lemma25_CCA2Game1n:
  forall side n m0, ContextTerm General Term (fun _ : ToL Term => m0) ->
   (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => If  ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,                  (e1 c0 c1 n1),         (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fido c0 c1 x0 v1 v2 v3 n0)＞＞)
             ) (Fiv1 c0 c1 x0 m0) (Fiv2 c0 c1 x0 m0) (Fiv3 c0 c1 x0 m0)
  ) (e0 c0 c1 n)) (c0 side) (c1 side)
=
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => If  ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,               (e1 c0 c1 n1),            (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fido c0 c1 x0 v1 v2 v3 n0)＞＞)
             ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
  ) (e0 c0 c1 n)) (c0 side) (c1 side).
Proof.
  intros.
  rewrite (OrComp) at 1.
  unfold Fiv1.
  rewrite (@If_eval (fun _ => _) (fun b1 => If _ Then ⫠ Else If _ Then ⫠
            Else (＜ ＜ _, _,  dv (If b1 Then _ Else If b1 Then _ Else _) _ _ (s _ _ (If b1 Then _ Else If b1 Then _ Else _) _ _) ＞,
                  ＜ Fl0 _ _ _ (If b1 Then _ Else If b1 Then _ Else _) _ _,
                     Fl1 _ _ _ (If b1 Then _ Else If b1 Then _ Else _) _ _,
                     Fido _ _ _ (If b1 Then _ Else If b1 Then _ Else _) _ _ _ ＞ ＞) )_ ).
  rewrite If_false. rewrite If_false.

  unfold Fiv2.
  rewrite (@If_eval (fun _ => _) (fun b2 => If _ Then ⫠
            Else (＜ ＜ _, _,  dv _ (If b2 Then _ Else If b2 Then _ Else _) _ (s _ _ _ (If b2 Then _ Else If b2 Then _ Else _) _) ＞,
                  ＜ Fl0 _ _ _ _ (If b2 Then _ Else If b2 Then _ Else _)  _,
                     Fl1 _ _ _ _ (If b2 Then _ Else If b2 Then _ Else _)  _,
                     Fido _ _ _ _ (If b2 Then _ Else If b2 Then _ Else _) _ _ ＞ ＞) )_ ).
  rewrite If_false. rewrite If_false.

  unfold Fiv3.
  rewrite (@If_eval (fun _ => _) (fun b3 => (＜ ＜ _, _,  dv _ _ (If b3 Then _ Else If b3 Then _ Else _) (s _ _ _ _ (If b3 Then _ Else If b3 Then _ Else _) ) ＞,
                  ＜ Fl0 _ _ _ _ _ (If b3 Then _ Else If b3 Then _ Else _),
                     Fl1 _ _ _ _ _ (If b3 Then _ Else If b3 Then _ Else _),
                     Fido _ _ _ _ _ (If b3 Then _ Else If b3 Then _ Else _) _ ＞ ＞) )_ ).
  rewrite If_false. rewrite If_false.

  rewrite <- OrComp.
  reflexivity.

(*  *)
  1,3,4,6,7,9: ProveboolandContext.
  apply lemma25_game1n_context1. auto.
  apply lemma25_game1n_context2. auto.
  apply lemma25_game1n_context3. auto.
Qed.

(* In the next two propositions we show that the terms with "Fido" and "Fdo" are equal. *)

(* Lemma25_CCA2Game2n_helper expresses that if the ballot of the first voter was sent in the OPENING phase, the shuffle will not be published due to the phase check.
   This shows the protocol could prevent replay attack. *)

Lemma lemma25_CCA2Game2n_helper:
  forall side n n0,
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => If  ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,               (e1 c0 c1 n1),            (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fido c0 c1 x0 v1 v2 v3 n0)＞＞)
             ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
   ) (e0 c0 c1 n)) (c0 side) (c1 side)
 =
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => If ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0) Then ⫠
                              Else If ((τ1 (fFΦ5 c0 c1 x0 v1 v2 v3)) ≟ x0)
                                   or ((τ2 (fFΦ5 c0 c1 x0 v1 v2 v3)) ≟ x0)
                                   or ((τ3 (fFΦ5 c0 c1 x0 v1 v2 v3)) ≟ x0)
       Then (＜＜ x0 , (e1 c0 c1 n1), (dv v1 v2 v3 (s c0 c1 v1 v2 v3)) ＞, ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3,   ⫠   ＞＞)
       Else (＜＜ x0 , (e1 c0 c1 n1), (dv v1 v2 v3 (s c0 c1 v1 v2 v3)) ＞, ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fdo c0 c1 x0 v1 v2 v3) ＞ ＞)
            ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
   ) (e0 c0 c1 n)) (c0 side) (c1 side).
Proof.
  intros. simpl.
  pose (lemma25_game2n_fFΦ3 side n) as ee.
  pose (lemma25_game2n_fFΦ5 side n) as eee.
  unfold Fido. unfold pchko.
  rewrite Tau1Tri, Tau2Tri, Tau3Tri. (*  *)
  unfold Fio1 at 2. rewrite decSimpl.
  unfold Fio2 at 2. rewrite decSimpl.
  unfold Fio3 at 2. rewrite decSimpl.
  repeat rewrite (@If_morph (fun x => ph3 ≟ (π2 x)) _ _).
  unfold m0. rewrite proj2pair. rewrite ph2Neqph3.
  rewrite AndGuard.
  rewrite (@If_morph (fun x => (＜ ＜ _ , _ , _ ＞, ＜ _, _, If _ & x & _ Then _ Else ⫠ ＞ ＞))).
  rewrite If_false. rewrite If_same. rewrite If_false.
  rewrite (@If_morph (fun x => (＜ ＜ _ , _ , _ ＞, ＜ _, _, If _ & x & _ Then _ Else ⫠ ＞ ＞))).
  rewrite If_false. rewrite If_same. rewrite If_false.
  rewrite (@If_morph (fun x => (＜ ＜ _ , _ , _ ＞, ＜ _, _, If _ & x & _ Then _ Else ⫠ ＞ ＞))).
  rewrite If_false. rewrite If_same. rewrite If_false.

  unfold Fio1.
  rewrite (@If_eval (fun _ => _) (fun b1 => If _ Then _ Else If _ Then _
                 Else (＜ ＜ _, _, _ ＞,
                       ＜ _, _,
                       If dist (If b1 Then _ Else If b1 Then Error Else _) _ _ & (_ & _ & _) &
                          isinkc kc0 kc1 (＜ π2 (π1 (If b1 Then _ Else If b1 Then Error Else _)),  π2 (π1 _), π2 (π1 _) ＞)
                       Then shufl (π1 (If b1 Then _ Else If b1 Then Error Else _)) (π1 _) (π1 _) Else ⫠ ＞ ＞))).
  rewrite If_false. rewrite If_false.

  unfold Fio2.
  rewrite (@If_eval (fun _ => _) (fun b2 => If _ Then _ Else
                      (＜ ＜ _, _, _ ＞,
                       ＜ _, _,
                       If dist _ (If b2 Then _ Else If b2 Then Error Else _) _ & (_ & _ & _) &
                          isinkc kc0 kc1 (＜ π2 (π1 _), π2 (π1 (If b2 Then _ Else If b2 Then Error Else _)),  π2 (π1 _) ＞)
                       Then shufl (π1 _) (π1 (If b2 Then _ Else If b2 Then Error Else _)) (π1 _) Else ⫠ ＞ ＞))).
  rewrite If_false. rewrite If_false.

  unfold Fio3.
  rewrite (@If_eval (fun _ => _) (fun b3 => (＜ ＜ _, _, _ ＞,
                       ＜ _, _,
                       If dist _ _ (If b3 Then _ Else If b3 Then Error Else _) & (_ & _ & _) &
                          isinkc kc0 kc1 (＜ π2 (π1 _), π2 (π1 _), π2 (π1 (If b3 Then _ Else If b3 Then Error Else _)) ＞)
                       Then shufl (π1 _) (π1 _) (π1 (If b3 Then _ Else If b3 Then Error Else _)) Else ⫠ ＞ ＞))).
  rewrite If_false. rewrite If_false.
  rewrite <- OrComp.

(* right hand side *)
  unfold Fdo. unfold pchko. rewrite Tau1Tri, Tau2Tri, Tau3Tri.
  reflexivity.

  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
  time (destruct side; simpl;  ProveboolandContext).
Qed.

(* Lemma25_CCA2Game2n expresses that the terms with "Fido" and "Fdo" are equal.
   Fido again inserts the if-then-else terms in front of the decrytions of the opening phase that is necessary for the CCA2 axiom. *)

Lemma lemma25_CCA2Game2n:
  forall side n n0,
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => If  ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,               (e1 c0 c1 n1),            (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fido c0 c1 x0 v1 v2 v3 n0)＞＞)
             ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
   ) (e0 c0 c1 n)) (c0 side) (c1 side)
 =
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => If  ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,               (e1 c0 c1 n1),            (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fdo c0 c1 x0 v1 v2 v3 )＞＞) (**)
             ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
  ) (e0 c0 c1 n)) (c0 side) (c1 side).
Proof.
  intros; simpl.
  unfold Fdo.

  assert ( let c0 := (c0 side) in let c1 := (c1 side) in
            (Fo1 c0 c1 (e0 c0 c1 n) (Fv1 c0 c1 (e0 c0 c1 n)) (Fv2 c0 c1 (e0 c0 c1 n)) (Fv3 c0 c1 (e0 c0 c1 n)))
          = (Fio1 c0 c1 (e0 c0 c1 n) (Fv1 c0 c1 (e0 c0 c1 n)) (Fv2 c0 c1 (e0 c0 c1 n)) (Fv3 c0 c1 (e0 c0 c1 n)) n)) as H.
    apply (decIfThenElse (m0 (c0 side) (c1 side) n) 7
           (τ1 (fFΦ5 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n) (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n))
               (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n)) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n))))).
    rewrite H; clear H.

  assert ( let c0 := (c0 side) in let c1 := (c1 side) in
            (Fo2 c0 c1 (e0 c0 c1 n) (Fv1 c0 c1 (e0 c0 c1 n)) (Fv2 c0 c1 (e0 c0 c1 n)) (Fv3 c0 c1 (e0 c0 c1 n)))
          = (Fio2 c0 c1 (e0 c0 c1 n) (Fv1 c0 c1 (e0 c0 c1 n)) (Fv2 c0 c1 (e0 c0 c1 n)) (Fv3 c0 c1 (e0 c0 c1 n)) n)) as H.
    apply (decIfThenElse (m0 (c0 side) (c1 side) n) 7
           (τ2 (fFΦ5 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n) (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n))
               (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n)) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n))))).
    rewrite H; clear H.

  assert ( let c0 := (c0 side) in let c1 := (c1 side) in
            (Fo3 c0 c1 (e0 c0 c1 n) (Fv1 c0 c1 (e0 c0 c1 n)) (Fv2 c0 c1 (e0 c0 c1 n)) (Fv3 c0 c1 (e0 c0 c1 n)))
          = (Fio3 c0 c1 (e0 c0 c1 n) (Fv1 c0 c1 (e0 c0 c1 n)) (Fv2 c0 c1 (e0 c0 c1 n)) (Fv3 c0 c1 (e0 c0 c1 n)) n)) as H.
    apply (decIfThenElse (m0 (c0 side) (c1 side) n) 7
           (τ3 (fFΦ5 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n) (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n))
               (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n)) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n))))).
    rewrite H; clear H.

(**)
  rewrite (lemma25_CCA2Game2n_helper side n n0).
(**)
  pose (lemma25_CCA2Game2n_helper side n n) as H.
    unfold Fido in H. rewrite H; clear H.

  reflexivity.
Qed.

(* Now we are ready to use the CCA2 axiom and replace n0 with n0' *)

Proposition prop25_replace_n0_with_n0': forall side,
  (| ＜ pv0 (c0 side) (c1 side) n0, ph2 ＞ |) = (| ＜ pv0 (c0 side) (c1 side) n0', ph2 ＞ |) ->
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                                   (If ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,               (e1 c0 c1 n1),            (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fdo c0 c1 x0 v1 v2 v3 )＞＞)) Else ⫠)] (**)
             ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
  ) (e0 c0 c1 n0)) (c0 side) (c1 side)
  ~
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                                   (If  ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,               (e1 c0 c1 n1),            (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fdo c0 c1 x0 v1 v2 v3 )＞＞)) Else ⫠)] (**)
             ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
  ) (e0 c0 c1 n0')) (c0 side) (c1 side).
Proof.
(* Here using lemma25_CCA2Game1n and lemma25_CCA2Game2n to rewrite the term will ensure the context CCA2 applicable.
   Then we will use CCA2 to replace the nonce n0 with n0'. *)
  intros side. intros.
  simpl.

  rewrite <- (lemma25_CCA2Game2n side n0 n0).
  rewrite <- (lemma25_CCA2Game1n side n0 (＜ pv0 (c0 side) (c1 side) n0, ph2 ＞)).

(* Φ6[x, pv01] is (pkS, rd0, pv00, pv00') −- CCA2 compliant. pkS := nonce 6, rd0 := nonce 7 *)
  pose (cca2 [nonce 6] [nonce 7]
             (fun x0 => (fun c0 c1 => (fun v1 v2 v3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                                    If  ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,                  (e1 c0 c1 n1),         (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fido c0 c1 x0 v1 v2 v3 n0)＞＞) Else ⫠
             )]) (Fiv1 c0 c1 x0 (m0 c0 c1 n0)) (Fiv2 c0 c1 x0 (m0 c0 c1 n0)) (Fiv3 c0 c1 x0 (m0 c0 c1 n0))) (c0 side) (c1 side))
             (＜ pv0 (c0 side) (c1 side) n0, ph2 ＞) (＜ pv0 (c0 side) (c1 side) n0', ph2 ＞)) as claim0; simpl in claim0.
  rewrite claim0; clear claim0.

  rewrite <- (lemma25_CCA2Game2n side n0' n0).
  rewrite <- (lemma25_CCA2Game1n side n0' (＜ pv0 (c0 side) (c1 side) n0, ph2 ＞)).
  reflexivity.

  destruct side; ProveContext.
  8 : { destruct side; ProveContext. }
  1,2,3,4,5: destruct side; ProveCCA2.
  apply lemma25_CCA2_n0_n0'_AfterCnxt.
  auto.
Qed.

(*************************************************************************)
(***** Next we show that as n0 is removed, the first voter check of it ***)
(***** in the opening phase fails and the commitment key kc0 is not sent**)
(*************************************************************************)

(* In the next proposition we show that after n0 is removed, the isin-chech in front of the Voting phase shuffle will turn false,
   so the shuffle might be published. *)

Lemma lemma25_isin_pv0_false : forall side, (fun c0 c1 => (fun x0 => (fun v1 v2 v3 =>
  (shufl (π1 v1) (π1 v2) (π1 v3)) = (s c0 c1 v1 v2 v3)) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)) (e0 c0 c1 n0')) (c0 side) (c1 side).
Proof.
  intros; simpl.
  unfold s. rewrite NotElim.
  unfold isin. rewrite Tau1Tri, Tau2Tri, Tau3Tri.
  assert ((pv0 (c0 side) (c1 side) n0) ≠ (π1 Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))).
    apply NeqIdem with (f := fun x => τ3 x). ProveContext. unfold pv0.
    rewrite Tau3Tri. apply FreshNEqeq. destruct side; ProveFresh.
    rewrite H; clear H. rewrite If_false.
  assert ((pv0 (c0 side) (c1 side) n0) ≠ (π1 Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))).
    apply NeqIdem with (f := fun x => τ3 x). ProveContext. unfold pv0.
    rewrite Tau3Tri. apply FreshNEqeq. destruct side; ProveFresh.
    rewrite H; clear H. rewrite If_false.
  assert ((pv0 (c0 side) (c1 side) n0) ≠ (π1 Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))).
    apply NeqIdem with (f := fun x => τ3 x). ProveContext. unfold pv0.
    rewrite Tau3Tri. apply FreshNEqeq. destruct side; ProveFresh.
    rewrite H; clear H. rewrite If_false.
  reflexivity.
Qed.

(* We show that if the vallot of the first voter was replaced, he will not send out his commitment key in the opening phase.
   More specifically, we see that the bnlcheck in front of the opening-phase encryption fails, and "Fl" will turn to ⫠. *)

Lemma lemma25_Fl0_bot : forall side,
   ⫠ = (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => Fl0 c0 c1 x0 v1 v2 v3) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)) (e0 c0 c1 n0')) (c0 side) (c1 side).
Proof.
  intros. simpl.
  unfold Fl0. unfold bnlcheck.
  unfold fFΦ3 at 2.
  rewrite <- lemma25_isin_pv0_false.

  unfold ncheck. unfold isin. rewrite Tau1Tri, Tau2Tri, Tau3Tri.
  assert (n0 ≠ τ3 (π2 τ1 (f3 [b0 (c0 side); b1 (c1 side); e0 (c0 side) (c1 side) n0'; e1 (c0 side) (c1 side) n1;
    dv (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))
   (shufl (π1 Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (π1 Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (π1 Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')))]))).
    apply FreshNEqeq.  destruct side; ProveFresh.
    rewrite H. clear H. rewrite If_false.
  assert (n0 ≠ τ3 (π2 τ2 (f3 [b0 (c0 side); b1 (c1 side); e0 (c0 side) (c1 side) n0'; e1 (c0 side) (c1 side) n1;
    dv (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))
   (shufl (π1 Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (π1 Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (π1 Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')))]))).
    apply FreshNEqeq.  destruct side; ProveFresh.
    rewrite H. clear H. rewrite If_false.
  assert (n0 ≠ τ3 (π2 τ3 (f3 [b0 (c0 side); b1 (c1 side); e0 (c0 side) (c1 side) n0'; e1 (c0 side) (c1 side) n1;
    dv (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))
   (shufl (π1 Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (π1 Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (π1 Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')))]))).
    apply FreshNEqeq.  destruct side; ProveFresh.
    rewrite H. clear H.
  repeat rewrite If_same.
  rewrite If_false.
  reflexivity.
Qed.

(* Now we see that if the Commitment key of the first voter was not sent, the isinkc0 check in front of the OPENING phase shuffle will fail.  *)

Lemma lemma25_ininkc0_false: forall side,
  FAlse = (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => isin kc0 (＜(π2 (π1 (Fo1 c0 c1 x0 v1 v2 v3))), (π2 (π1 (Fo2 c0 c1 x0 v1 v2 v3))), (π2 (π1 (Fo3 c0 c1 x0 v1 v2 v3)))＞)
            ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)) (e0 c0 c1 n0')) (c0 side) (c1 side).
Proof.
  intros.
  simpl. unfold Fo1, Fo2, Fo3.
  unfold fFΦ5. rewrite <- lemma25_Fl0_bot.
  unfold isin. rewrite Tau1Tri, Tau2Tri, Tau3Tri.

  assert ((fun c0 c1 => kc0 ≠ π2 (π1 (decS (τ1 (f5 [b0 c0; b1 c1; e0 c0 c1 n0'; e1 c0 c1 n1; dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                  (s c0 c1 (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))); ⫠;
                   Fl1 c0 c1 (e0 c0 c1 n0') (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))]))))) (c0 side) (c1 side)).
    pose (@prop11 (fun c0 => (fun c1 => π2 (π1 (decS (τ1 (f5 [b0 c0; b1 c1; e0 c0 c1 n0'; e1 c0 c1 n1; dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                 (s c0 c1 (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))); ⫠;
                  Fl1 c0 c1 (e0 c0 c1 n0') (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))]))))) (c1 side)) (vot side) 0) as H.
    simpl in *. rewrite c0EqVot in H. rewrite H. auto.
    destruct side; simpl; ProvePPT; ProveFresh.
    apply lemma25_ininkc0_false_FreshC_τ1.
    rewrite H. rewrite If_false. clear H.

  assert ((fun c0 c1 => kc0 ≠ π2 (π1 (decS (τ2 (f5 [b0 c0; b1 c1; e0 c0 c1 n0'; e1 c0 c1 n1; dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                  (s c0 c1 (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))); ⫠;
                   Fl1 c0 c1 (e0 c0 c1 n0') (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))]))))) (c0 side) (c1 side)).
    pose (@prop11 (fun c0 => (fun c1 => π2 (π1 (decS (τ2 (f5 [b0 c0; b1 c1; e0 c0 c1 n0'; e1 c0 c1 n1; dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                 (s c0 c1 (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))); ⫠;
                  Fl1 c0 c1 (e0 c0 c1 n0') (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))]))))) (c1 side)) (vot side) 0) as H.
    simpl in *. rewrite c0EqVot in H. rewrite H. auto.
    destruct side; simpl; ProvePPT; ProveFresh.
    apply lemma25_ininkc0_false_FreshC_τ2.
    rewrite H. rewrite If_false. clear H.

  assert ((fun c0 c1 => kc0 ≠ π2 (π1 (decS (τ3 (f5 [b0 c0; b1 c1; e0 c0 c1 n0'; e1 c0 c1 n1; dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                  (s c0 c1 (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))); ⫠;
                   Fl1 c0 c1 (e0 c0 c1 n0') (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))]))))) (c0 side) (c1 side)).
    pose (@prop11 (fun c0 => (fun c1 => π2 (π1 (decS (τ3 (f5 [b0 c0; b1 c1; e0 c0 c1 n0'; e1 c0 c1 n1; dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                 (s c0 c1 (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))); ⫠;
                  Fl1 c0 c1 (e0 c0 c1 n0') (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))]))))) (c1 side)) (vot side) 0) as H.
    simpl in *. rewrite c0EqVot in H. rewrite H. auto.
    destruct side; simpl; ProvePPT; ProveFresh.
    apply lemma25_ininkc0_false_FreshC_τ3.
    rewrite H.

  reflexivity.

Qed.

(*************************************************************************)
(***** Now we replace kc1 that was sent with a fresh kc1' in the *********)
(***** encryption of the opening phase using again CCA2 ******************)
(*************************************************************************)

(* In the next proposition, again we insert the necessary if-then-else terms to prepare for the use of the CCA2 axiom  *)

Lemma lemma25_CCA2Game1kc: forall side,
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                                   (If  ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,               (e1 c0 c1 n1),            (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fdo c0 c1 x0 v1 v2 v3 )＞＞)) Else ⫠)] (**)
             ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
  ) (e0 c0 c1 n0')) (c0 side) (c1 side)
=
  (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                     (If  ((τ1 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ2 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ3 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                      Then ⫠
                      Else (＜＜ (e0 c0 c1 n0') ,  (e1 c0 c1 n1),
                                (dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                                    (shufl (π1 (Fv1 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv2 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv3 c0 c1 (e0 c0 c1 n0'))))) ＞,
                              ＜ ⫠,
                                FL1 c0 c1 y1,
                               (FIDO o1 o2 o3 )＞＞)) Else ⫠)] (**)
           ) (FiiO1 c0 c1 y1) (FiiO2 c0 c1 y1) (FiiO3 c0 c1 y1)
  ) (E1 c0 c1 kc1)) (c0 side) (c1 side).
Proof.
  intros. simpl.

(*  *)
  assert (FiiO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1) = FO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)).
    unfold FiiO1, FO1.
    rewrite (decIfThenElse (M1 (c0 side) (c1 side) kc1) 11 (τ1 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)))) at 2.
    reflexivity. rewrite H. clear H.

  assert (FiiO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1) = FO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)).
    unfold FiiO2, FO2.
    rewrite (decIfThenElse (M1 (c0 side) (c1 side) kc1) 11 (τ2 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)))) at 2.
    reflexivity. rewrite H. clear H.

  assert (FiiO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1) = FO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)).
    unfold FiiO3, FO3.
    rewrite (decIfThenElse (M1 (c0 side) (c1 side) kc1) 11 (τ3 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)))) at 2.
    reflexivity. rewrite H. clear H.

(*  *)
  unfold Fdo.
  unfold isinkc.
  rewrite <- lemma25_ininkc0_false. rewrite If_false.

(*  *)
  assert (FO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)
        = Fo1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0') (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))
              (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))).
    unfold Fo1. unfold fFΦ5.
    rewrite <- lemma25_Fl0_bot.
    rewrite <- lemma25_isin_pv0_false.
    reflexivity.
    rewrite <- H.
    clear H.

  assert (FO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)
        = Fo2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0') (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))
              (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))).
    unfold Fo2. unfold fFΦ5.
    rewrite <- lemma25_Fl0_bot.
    rewrite <- lemma25_isin_pv0_false.
    reflexivity.
    rewrite <- H.
    clear H.

  assert (FO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1)
        = Fo3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0') (Fv1 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))
              (Fv2 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0')) (Fv3 (c0 side) (c1 side) (e0 (c0 side) (c1 side) n0'))).
    unfold Fo3. unfold fFΦ5.
    rewrite <- lemma25_Fl0_bot.
    rewrite <- lemma25_isin_pv0_false.
    reflexivity.
    rewrite <- H.
    clear H.

(*  *)
  rewrite <- lemma25_Fl0_bot.
  rewrite <- lemma25_isin_pv0_false.

  reflexivity.
Qed.

(* We replace kc1 with kc1' using CCA2 axiom. *)

Proposition prop25_replace_kc1_with_kc1': forall side, (| (M1  (c0 side) (c1 side) kc1) | = |(M1  (c0 side) (c1 side) kc1') |) ->
(fun c0 c1 => (fun y1 => (fun o1 o2 o3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                     (If  ((τ1 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ2 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ3 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                      Then ⫠
                      Else (＜＜ (e0 c0 c1 n0') ,  (e1 c0 c1 n1),
                                (dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                                    (shufl (π1 (Fv1 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv2 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv3 c0 c1 (e0 c0 c1 n0'))))) ＞,
                              ＜ ⫠,
                                FL1 c0 c1 y1,
                               (FIDO o1 o2 o3 )＞＞)) Else ⫠)] (**)
           ) (FiiO1 c0 c1 y1) (FiiO2 c0 c1 y1) (FiiO3 c0 c1 y1)
  ) (E1 c0 c1 kc1)) (c0 side) (c1 side)
  ~
(fun c0 c1 => (fun y1 => (fun o1 o2 o3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                     (If  ((τ1 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ2 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ3 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                      Then ⫠
                      Else (＜＜ (e0 c0 c1 n0') ,  (e1 c0 c1 n1),
                                (dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                                    (shufl (π1 (Fv1 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv2 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv3 c0 c1 (e0 c0 c1 n0'))))) ＞,
                              ＜ ⫠,
                                FL1 c0 c1 y1,
                               (FIDO o1 o2 o3 )＞＞)) Else ⫠)] (**)
           ) (FiiO1 c0 c1 y1) (FiiO2 c0 c1 y1) (FiiO3 c0 c1 y1)
  ) (E1 c0 c1 kc1')) (c0 side) (c1 side).
Proof.
  intros side. intros.
  simpl.

(* Φ6[x, pv01] is (pkS, rdd1, kc1, kc1') −- CCA2 compliant. pkS := nonce 6, rd0 := nonce 11 *)
  pose (cca2 [nonce 6] [nonce 11]
             (fun y1 => (fun c0 c1 => (fun o1 o2 o3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                     (If  ((τ1 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ2 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ3 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                      Then ⫠
                      Else (＜＜ (e0 c0 c1 n0') ,  (e1 c0 c1 n1),
                                (dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                                    (shufl (π1 (Fv1 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv2 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv3 c0 c1 (e0 c0 c1 n0'))))) ＞,
                              ＜ ⫠,
                                FL1 c0 c1 y1,
                               (FIDO o1 o2 o3 )＞＞)) Else ⫠)] (**)
           ) (FiiO1 c0 c1 y1) (FiiO2 c0 c1 y1) (FiiO3 c0 c1 y1)) (c0 side) (c1 side))
          (M1 (c0 side) (c1 side) kc1) (M1 (c0 side) (c1 side) kc1')) as claim0; simpl in claim0. rewrite claim0; clear claim0.
  reflexivity.

  1, 2, 3, 7: ProveCCA2.
  ProveListFresh. lia. 1,2,3 :constructor.

  apply lemma25_CCA2_kc1_kc1'_M1.
  apply lemma25_CCA2_kc1_kc1'_M1'.
  apply lemma25_CCA2_kc1_kc1'_Φ5.
Qed.

(** In the next few propositions we discuss whether the OPENING phase shuffle will be published. **)

(* Notice that ((τ1 (FFΦ5 c0 c1 y1)) ≟ y1) or ((τ2 (FFΦ5 c0 c1 y1)) ≟ y1) or ((τ3 (FFΦ5 c0 c1 y1)) ≟ y1) expresses that the commitment key of the second voter was not replaced,
   then definitely the OPENING phase shuffle will not be published. *)

(* The negation of which is "FDO", where the shuffle might still be published. *)

Lemma lemma25_elim_kc1_in_then_branch: forall side,
 (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => FIDO o1 o2 o3) (FiiO1 c0 c1 y1) (FiiO2 c0 c1 y1) (FiiO3 c0 c1 y1)) (E1 c0 c1 kc1')) (c0 side) (c1 side)
 =
 (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => If (τ1 (FFΦ5 c0 c1 y1)) ≟ y1 Then ⫠
                             Else If (τ2 (FFΦ5 c0 c1 y1)) ≟ y1 Then ⫠
                             Else If (τ3 (FFΦ5 c0 c1 y1)) ≟ y1 Then ⫠
                             Else FDO o1 o2 o3) (FO1 c0 c1 y1) (FO2 c0 c1 y1) (FO3 c0 c1 y1)) (E1 c0 c1 kc1')) (c0 side) (c1 side).
Proof.
  intros.
  pose (lemma25_elim_kc1_cnxtΦ3 side) as ee.
  pose (lemma25_elim_kc1_cnxtΦ5 side) as eee.
  unfold FIDO. simpl.

  unfold isin.
  rewrite Tau1Tri, Tau2Tri, Tau3Tri.

  unfold FiiO1 at 3. unfold FiiO2 at 3. unfold FiiO3 at 3. repeat rewrite decSimpl.
  repeat rewrite (@If_morph (fun x => (kc1 ≟ (π2 (π1 x))))).
  unfold M1.
  rewrite proj1pair, proj2pair.
  rewrite ceqeq.

  simpl.
  assert (((kc1 ≟ (π2 (π1 decS (τ1 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))))))) = FAlse).
    assert ((com (vot (op side)) kc1) = c1 side).
    destruct side; reflexivity.
    pose (@prop11 (fun x => (π2 (π1 decS (τ1 (FFΦ5 (c0 side) x (E1 (c0 side) x kc1')))))) (vot (op side)) 1) as cont.
    rewrite H in cont.
    apply cont.
    destruct side; simpl; ProvePPT.
    1, 2: ProveFresh.
    apply lemma25_elim_kc1_freshc1.
    rewrite H; clear H; rewrite <- If_tf.
  assert (((kc1 ≟ (π2 (π1 decS (τ2 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))))))) = FAlse).
    assert ((com (vot (op side)) kc1) = c1 side).
    destruct side; reflexivity.
    pose (@prop11 (fun x => (π2 (π1 decS (τ2 (FFΦ5 (c0 side) x (E1 (c0 side) x kc1')))))) (vot (op side)) 1) as cont.
    rewrite H in cont.
    apply cont.
    destruct side; simpl; ProvePPT.
    1,2: ProveFresh.
    apply lemma25_elim_kc1_freshc2.
    rewrite H; clear H; rewrite <- If_tf.
  assert (((kc1 ≟ (π2 (π1 decS (τ3 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))))))) = FAlse).
    assert ((com (vot (op side)) kc1) = c1 side).
    destruct side; reflexivity.
    pose (@prop11 (fun x => (π2 (π1 decS (τ3 (FFΦ5 (c0 side) x (E1 (c0 side) x kc1')))))) (vot (op side)) 1) as cont.
    rewrite H in cont.
    apply cont.
    destruct side; simpl; ProvePPT.
    1,2: ProveFresh.
    apply lemma25_elim_kc1_freshc3.
    rewrite H; clear H; rewrite <- If_tf.

  rewrite CNF_IfThenElse.

  repeat rewrite (@If_morph (fun x => If dist (FiiO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')) (FiiO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))
                              (FiiO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')) &
                           pchko (＜ FiiO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'), FiiO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'),
                                  FiiO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1') ＞) & x
     Then shufl (π1 FiiO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')) (π1 FiiO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))
  (π1 FiiO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')) Else ⫠ )).
  repeat rewrite If_same.  repeat rewrite If_false.

  unfold FiiO1, FiiO2, FiiO3.  repeat rewrite decSimpl. rewrite <- If_tf.

  rewrite (@If_eval (fun _ => _) (fun b1 => If _ Then ⫠ Else If _ Then ⫠
                                      Else If dist (If b1 Then _ Else _) _ _ & pchko (＜ If b1 Then _ Else _ , _ , _ ＞) Then shufl (π1 If b1 Then _ Else _ ) (π1 _) (π1 _) Else ⫠)).
    rewrite If_false.
  rewrite (@If_eval (fun _ => _) (fun b2 => If _ Then ⫠
                                      Else If dist _ (If b2 Then _ Else _) _ & pchko (＜ _,  If b2 Then _ Else _ , _ ＞) Then shufl (π1 _) (π1 If b2 Then _ Else _ ) (π1 _) Else ⫠)).
    rewrite If_false.
  rewrite (@If_eval (fun _ => _) (fun b3 => If dist _ _ (If b3 Then _ Else _) & pchko (＜ _, _, If b3 Then _ Else _ ＞) Then shufl (π1 _) (π1 _) (π1 If b3 Then _ Else _ ) Else ⫠)).
    rewrite If_false.

  reflexivity.
  all : time ProveboolandContext. (*10.709 secs*)
  unfold pchko.
  Provebool.
Qed.

(* In the next two propositions,  we show that in the opening phase
   if the message sent from the second voter is ＜ ⫠, ph2 ＞, and replaced with (＜＜label, kc1' ＞, ph3 ＞) by the attacker,
   then isinkc1 check in front of the OPENING phase shuffle will fail. *)

Lemma lemma25_ininkc1_FIO_false: forall side,
  FAlse
 =
  (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => (isin kc1 (＜(π2 (π1 o1)), (π2 (π1 o2)), (π2 (π1 o3))＞))) (FiO1 c0 c1 y1) (FiO2 c0 c1 y1) (FiO3 c0 c1 y1)) (E1 c0 c1 kc1')) (c0 side) (c1 side).
Proof.
  intros.
  pose (lemma25_ininkc1_Freshkc1_Φ3 side) as ee.
  pose (lemma25_ininkc1_Freshkc1_Φ5 side) as eee.
  unfold isin.
  rewrite Tau1Tri, Tau2Tri, Tau3Tri.
  assert (kc1 ≠ (π2 (π1 FiO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')))).
    assert ((com (vot (op side)) kc1) = c1 side).
    destruct side; reflexivity.
    pose (@prop11 (fun x => (π2 (π1 (FiO1 (c0 side) x (E1 (c0 side) x kc1'))))) (vot (op side)) 1) as cont.
    rewrite H in cont.
    apply cont.
    destruct side; simpl; ProvePPT.
    1, 2: ProveFresh.
    (destruct side; simpl; ProveFreshCTerm).
    rewrite H. clear H.
  assert (kc1 ≠ (π2 (π1 FiO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')))).
    assert ((com (vot (op side)) kc1) = c1 side).
    destruct side; reflexivity.
    pose (@prop11 (fun x => (π2 (π1 (FiO2 (c0 side) x (E1 (c0 side) x kc1'))))) (vot (op side)) 1) as cont.
    rewrite H in cont.
    apply cont.
    destruct side; simpl; ProvePPT.
    1, 2: ProveFresh.
    (destruct side; simpl; ProveFreshCTerm).
    rewrite H. clear H.
  assert (kc1 ≠ (π2 (π1 FiO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')))).
    assert ((com (vot (op side)) kc1) = c1 side).
    destruct side; reflexivity.
    pose (@prop11 (fun x => (π2 (π1 (FiO3 (c0 side) x (E1 (c0 side) x kc1'))))) (vot (op side)) 1) as cont.
    rewrite H in cont.
    apply cont.
    destruct side; simpl; ProvePPT.
    1, 2: ProveFresh.
    (destruct side; simpl; ProveFreshCTerm).
    rewrite H. clear H.
  repeat rewrite If_false.
  reflexivity.
Qed.

(*  *)

Lemma lemma25_elim_kc1_in_FIDO: forall side,
 (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => FIDO o1 o2 o3) (FiO1 c0 c1 y1) (FiO2 c0 c1 y1) (FiO3 c0 c1 y1)) (E1 c0 c1 kc1')) (c0 side) (c1 side)
 =
 (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => FDO o1 o2 o3)  (FiO1 c0 c1 y1) (FiO2 c0 c1 y1) (FiO3 c0 c1 y1)) (E1 c0 c1 kc1')) (c0 side) (c1 side).
Proof.
  intros. simpl.
  unfold FIDO.
  rewrite <- lemma25_ininkc1_FIO_false.
  rewrite If_false. rewrite <- If_tf.
  reflexivity. unfold pchko.  Provebool.
Qed.

(* In the next two propositions, We show that in the opening phase, two scenarios that if
   "the plaintext sent from the second voter is ＜ ⫠, ph2 ＞,             and replaced with (＜＜label, kc1' ＞, ph3 ＞) by the attacker",
     and
   "the plaintext sent from the second voter is ＜＜label, kc1 ＞, ph3 ＞, and replaced with (＜＜label, kc1' ＞, ph3 ＞) by the attacker",
   appear to be the same. *)

Lemma lemma25_elim_bot_in_then_branch: forall side,
 (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => FIDO o1 o2 o3) (FiO1 c0 c1 y1) (FiO2 c0 c1 y1) (FiO3 c0 c1 y1)) (E1 c0 c1 kc1')) (c0 side) (c1 side)
 =
 (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => If (τ1 (FFΦ5 c0 c1 y1)) ≟ y1 Then ⫠
                             Else If (τ2 (FFΦ5 c0 c1 y1)) ≟ y1 Then ⫠
                             Else If (τ3 (FFΦ5 c0 c1 y1)) ≟ y1 Then ⫠
                             Else FDO o1 o2 o3) (FO1 c0 c1 y1) (FO2 c0 c1 y1) (FO3 c0 c1 y1)) (E1 c0 c1 kc1')) (c0 side) (c1 side).
Proof.
  intros. simpl.
  pose (lemma25_elim_bot_cnxtΦ3 side) as ee.
  pose (lemma25_elim_bot_cnxtΦ5 side) as eee.
(*  *)
  rewrite lemma25_elim_kc1_in_FIDO.
  unfold FDO. simpl.

(*  *)
  unfold pchko. rewrite Tau1Tri, Tau2Tri, Tau3Tri.
  unfold FiO1 at 2.  unfold FiO2 at 2.  unfold FiO3 at 2.
  repeat rewrite (@If_morph (fun x => (ph3 ≟ (π2 x)))).
  rewrite proj2pair.
  rewrite ph2Neqph3.

(*  *)
  rewrite AndGuard.
  assert (((ph3 ≟ (π2 decS (τ1 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))))) & (ph3 ≟ (π2 decS (τ2 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')))))
         & (ph3 ≟ (π2 decS (τ3 (FFΦ5 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))))))
        = (pchko (＜ FO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'), FO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'),
                     FO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1') ＞))).
    unfold pchko. rewrite Tau1Tri, Tau2Tri, Tau3Tri.
    reflexivity.
    simpl. rewrite H; clear H.
    repeat rewrite (@If_morph (fun x => If dist (FiO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))
                                        (FiO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))
                                        (FiO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')) & x
           Then shufl (π1 FiO1 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')) (π1 FiO2 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1'))
         (π1 FiO3 (c0 side) (c1 side) (E1 (c0 side) (c1 side) kc1')) Else ⫠)).
  repeat rewrite If_same.
  repeat rewrite If_false.

(*  *)
  unfold FiO1, FiO2, FiO3.
  rewrite (@If_eval (fun _ => _) (fun b1 => If _ Then ⫠ Else If _ Then ⫠
                                      Else If dist (If b1 Then _ Else _) _ _ & pchko (＜ _, _ , _ ＞) Then shufl (π1 If b1 Then _ Else _ ) (π1 _) (π1 _) Else ⫠)).
    rewrite If_false.
  rewrite (@If_eval (fun _ => _) (fun b2 => If _ Then ⫠
                                      Else If dist _ (If b2 Then _ Else _) _ & pchko (＜ _,  _, _ ＞) Then shufl (π1 _) (π1 If b2 Then _ Else _ ) (π1 _) Else ⫠)).
    rewrite If_false.
  rewrite (@If_eval (fun _ => _) (fun b3 => If dist _ _ (If b3 Then _ Else _) & pchko (＜ _, _, _ ＞) Then shufl (π1 _) (π1 _) (π1 If b3 Then _ Else _ ) Else ⫠)).
    rewrite If_false.

(*  *)
  reflexivity.

  all : time ProveboolandContext. (*2.667 secs*)
Qed.

(*  *)

Lemma lemma25_CCA2Game2kc: forall side,
  (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                     (If  ((τ1 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ2 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ3 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                      Then ⫠
                      Else (＜＜ (e0 c0 c1 n0') ,  (e1 c0 c1 n1),
                                (dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                                    (shufl (π1 (Fv1 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv2 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv3 c0 c1 (e0 c0 c1 n0'))))) ＞,
                              ＜ ⫠,
                                FL1 c0 c1 y1,
                               (FIDO o1 o2 o3 )＞＞)) Else ⫠)] (**)
           ) (FiiO1 c0 c1 y1) (FiiO2 c0 c1 y1) (FiiO3 c0 c1 y1)
  ) (E1 c0 c1 kc1')) (c0 side) (c1 side)
 =
  (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                     (If  ((τ1 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ2 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ3 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                      Then ⫠
                      Else (＜＜ (e0 c0 c1 n0') ,  (e1 c0 c1 n1),
                                (dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                                    (shufl (π1 (Fv1 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv2 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv3 c0 c1 (e0 c0 c1 n0'))))) ＞,
                              ＜ ⫠,
                                FL1 c0 c1 y1,
                               (FDO o1 o2 o3 )＞＞)) Else ⫠)] (**)
           ) (FiO1 c0 c1 y1) (FiO2 c0 c1 y1) (FiO3 c0 c1 y1)
  ) (E1 c0 c1 kc1')) (c0 side) (c1 side).
Proof.
  (* Same kind of theorems are needed to replace n0 on the other side, and kc1. Then use hiding. *)
  intros. simpl.
  rewrite <- lemma25_elim_kc1_in_FIDO.
  rewrite lemma25_elim_kc1_in_then_branch.
  rewrite lemma25_elim_bot_in_then_branch.
  reflexivity.
Qed.

(*************************************************************************)
(***** Next we put together what we have so far using transitivity: ******)
(*************************************************************************)

Proposition remove_n0_and_kc1_from_both : forall side,
    (| ＜ pv0 (c0 side) (c1 side) n0, ph2 ＞ |) = (| ＜ pv0 (c0 side) (c1 side) n0', ph2 ＞ |) ->
    (| (M1  (c0 side) (c1 side) kc1) | = |(M1  (c0 side) (c1 side) kc1') |) ->
  (fun c0 c1 => (fun x0 => (fun v1 v2 v3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                                   (If ((τ1 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ2 (fFΦ2 c0 c1 x0)) ≟ x0)  or ((τ3 (fFΦ2 c0 c1 x0)) ≟ x0)
                                    Then ⫠
                                    Else (＜＜ x0 ,               (e1 c0 c1 n1),            (dv v1 v2 v3 (s c0 c1 v1 v2 v3) ) ＞,
                                           ＜ Fl0 c0 c1 x0 v1 v2 v3, Fl1 c0 c1 x0 v1 v2 v3, (Fdo c0 c1 x0 v1 v2 v3 )＞＞)) Else ⫠)] (**)
             ) (Fv1 c0 c1 x0) (Fv2 c0 c1 x0) (Fv3 c0 c1 x0)
  ) (e0 c0 c1 n0)) (c0 side) (c1 side)
 ~
  (fun c0 c1 => (fun y1 => (fun o1 o2 o3 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                     (If  ((τ1 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ2 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                       or ((τ3 (fFΦ2 c0 c1 (e0 c0 c1 n0'))) ≟ (e0 c0 c1 n0'))
                      Then ⫠
                      Else (＜＜ (e0 c0 c1 n0') ,  (e1 c0 c1 n1),
                                (dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
                                    (shufl (π1 (Fv1 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv2 c0 c1 (e0 c0 c1 n0'))) (π1 (Fv3 c0 c1 (e0 c0 c1 n0'))))) ＞,
                              ＜ ⫠,
                                FL1 c0 c1 y1,
                               (FDO o1 o2 o3 )＞＞)) Else ⫠)] (**)
           ) (FiO1 c0 c1 y1) (FiO2 c0 c1 y1) (FiO3 c0 c1 y1)
  ) (E1 c0 c1 kc1')) (c0 side) (c1 side).
Proof.
  (* transitivity of ~ and the removal of n0 and kc1 and some of the above rewrites *)
  intros. simpl.
  rewrite prop25_replace_n0_with_n0'.
  rewrite lemma25_CCA2Game1kc.
  rewrite prop25_replace_kc1_with_kc1'.
  rewrite lemma25_CCA2Game2kc.
  reflexivity.
  all : auto.
Qed.

(*************************************************************************)
(***** Finally, we use hiding property of the Commitment to  *************)
(***** show equivalence of the two sides *********************************)
(*************************************************************************)

Lemma lemma25 :
    (fun c0 c1 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                              (If ((τ1 (fΦ2 c0 c1)) ≟ (e0 c0 c1 n0)) or ((τ2 (fΦ2 c0 c1)) ≟ (e0 c0 c1 n0)) or ((τ3 (fΦ2 c0 c1)) ≟ (e0 c0 c1 n0))
                                    Then ⫠
                                    Else (＜＜(e0 c0 c1 n0), (e1 c0 c1 n1), (dv (v1 c0 c1) (v2 c0 c1) (v3 c0 c1) (s c0 c1 (v1 c0 c1) (v2 c0 c1) (v3 c0 c1)) ) ＞,
                                           ＜ l0 c0 c1,      l1 c0 c1,      (do c0 c1)＞＞)) Else ⫠)]) (c0 lhs) (c1 lhs)
   ~
    (fun c0 c1 => [b0 c0; b1 c1; (If ((acc0 c0 c1) & (acc1 c0 c1)) Then
                              (If ((τ1 (fΦ2 c0 c1)) ≟ (e0 c0 c1 n0)) or ((τ2 (fΦ2 c0 c1)) ≟ (e0 c0 c1 n0)) or ((τ3 (fΦ2 c0 c1)) ≟ (e0 c0 c1 n0))
                                    Then ⫠
                                    Else (＜＜(e0 c0 c1 n0), (e1 c0 c1 n1), (dv (v1 c0 c1) (v2 c0 c1) (v3 c0 c1) (s c0 c1 (v1 c0 c1) (v2 c0 c1) (v3 c0 c1)) ) ＞,
                                           ＜ l0 c0 c1,      l1 c0 c1,      (do c0 c1)＞＞)) Else ⫠)]) (c0 rhs) (c1 rhs).
Proof.
  intros.
  rewrite (remove_n0_and_kc1_from_both lhs).
  rewrite (remove_n0_and_kc1_from_both rhs).
  simpl.

(*  *)
  assert ([c00; c01; b0 c00; b1 c01; acc0 c00 c01 & acc1 c00 c01; e0 c00 c01 n0'; e1 c00 c01 n1;
    dv (Fv1 c00 c01 (e0 c00 c01 n0')) (Fv2 c00 c01 (e0 c00 c01 n0')) (Fv3 c00 c01 (e0 c00 c01 n0'))
                 (shufl (π1 Fv1 c00 c01 (e0 c00 c01 n0')) (π1 Fv2 c00 c01 (e0 c00 c01 n0')) (π1 Fv3 c00 c01 (e0 c00 c01 n0')));
    FL1 c00 c01 (E1 c00 c01 kc1'); FDO (FiO1 c00 c01 (E1 c00 c01 kc1')) (FiO2 c00 c01 (E1 c00 c01 kc1')) (FiO3 c00 c01 (E1 c00 c01 kc1')) ]
 ~
   [c10; c11; b0 c10; b1 c11; acc0 c10 c11 & acc1 c10 c11; e0 c10 c11 n0'; e1 c10 c11 n1;
    dv (Fv1 c10 c11 (e0 c10 c11 n0')) (Fv2 c10 c11 (e0 c10 c11 n0')) (Fv3 c10 c11 (e0 c10 c11 n0'))
                 (shufl (π1 Fv1 c10 c11 (e0 c10 c11 n0')) (π1 Fv2 c10 c11 (e0 c10 c11 n0')) (π1 Fv3 c10 c11 (e0 c10 c11 n0'))) ;
    FL1 c10 c11 (E1 c10 c11 kc1'); FDO (FiO1 c10 c11 (E1 c10 c11 kc1')) (FiO2 c10 c11 (E1 c10 c11 kc1')) (FiO3 c10 c11 (E1 c10 c11 kc1'))]).
    pose lemma25_freshcΦ3kc0.
    pose lemma25_freshcΦ3kc1.
    pose lemma25_freshcΦ5kc0.
    pose lemma25_freshcΦ5kc1.
    apply (@CompHidEx (fun lx => let c0 := Nth 0 lx in let c1 := Nth 1 lx in
         [c0; c1; b0 c0; b1 c1; acc0 c0 c1 & acc1 c0 c1; e0 c0 c1 n0'; e1 c0 c1 n1;
          dv (Fv1 c0 c1 (e0 c0 c1 n0')) (Fv2 c0 c1 (e0 c0 c1 n0')) (Fv3 c0 c1 (e0 c0 c1 n0'))
             (shufl (π1 Fv1 c0 c1 (e0 c0 c1 n0')) (π1 Fv2 c0 c1 (e0 c0 c1 n0')) (π1 Fv3 c0 c1 (e0 c0 c1 n0'))); FL1 c0 c1 (E1 c0 c1 kc1');
          FDO (FiO1 c0 c1 (E1 c0 c1 kc1')) (FiO2 c0 c1 (E1 c0 c1 kc1')) (FiO3 c0 c1 (E1 c0 c1 kc1'))       ])
                    vot0 vot1 0 1).
    all : simpl; time ProveFreshC. (*4.216 secs*)

    (*  *)
  apply voteLen.

(*  *)
  1, 2: ProveFresh.

(*   *)
  apply (@cind_funcapp (fun lc => [Nth 2 lc; Nth 3 lc; Nth 4 lc; Nth 5 lc; Nth 6 lc;
                                ((τ1 (f2 [(Nth 2 lc); (Nth 3 lc); (Nth 5 lc); (Nth 6 lc)])) ≟ (Nth 5 lc)) or
                                ((τ2 (f2 [(Nth 2 lc); (Nth 3 lc); (Nth 5 lc); (Nth 6 lc)])) ≟ (Nth 5 lc)) or
                                ((τ3 (f2 [(Nth 2 lc); (Nth 3 lc); (Nth 5 lc); (Nth 6 lc)])) ≟ (Nth 5 lc));
                               Nth 7 lc; Nth 8 lc; Nth 9 lc])) in H. unfold Nth in H.  unfold nth in H; simpl in H.

  apply (IF_branch' [b0 c00; b1 c01] [b0 c10; b1 c11] _ _ _ _ _ _ ); simpl.
  apply (IF_branch' [b0 c00; b1 c01; acc0 c00 c01 & acc1 c00 c01] [b0 c10; b1 c11; acc0 c10 c11 & acc1 c10 c11] _ _ _ _ _ _ ); simpl.

(**)
  assert (exists x, x = H). exists H; auto. destruct H0. clear H0. rename x into H0.
  apply (@cind_funcapp (fun lc => [(Nth 0 lc); (Nth 1 lc); (Nth 2 lc); (Nth 5 lc); ⫠])) in H0.
     unfold Nth in H0; unfold nth in H0; simpl in H0; apply H0. simpl; ProveContext.
(**)
  assert (exists x, x = H). exists H; auto. destruct H0. clear H0. rename x into H0.
  apply (@cind_funcapp (fun lc => [(Nth 0 lc); (Nth 1 lc); (Nth 2 lc); (Nth 5 lc);
  ＜ ＜ (Nth 3 lc), (Nth 4 lc), (Nth 6 lc) ＞, ＜ ⫠, (Nth 7 lc), (Nth 8 lc) ＞ ＞])) in H0.
     unfold Nth in H0; unfold nth in H0; simpl in H0; auto. clear H0. simpl; ProveContext.

  apply (@cind_funcapp (fun lc => [(Nth 0 lc); (Nth 1 lc); (Nth 2 lc); ⫠])) in H.
     unfold Nth in H; unfold nth in H; simpl in H; auto. clear H. simpl; ProveContext.

  clear H.
  ProveContext.
  - unfold pv0.
    apply PairLen.
    + apply TripleLen.
      * reflexivity.
      * reflexivity.
    + reflexivity.
  - unfold M1.
    apply PairLen.
    + apply PairLen.
      reflexivity.
      apply ComkLen.
    + reflexivity.
  - unfold pv0.
    apply PairLen.
    + apply TripleLen.
      * reflexivity.
      * reflexivity.
    + reflexivity.
  - unfold M1.
    apply PairLen.
    + apply PairLen.
      reflexivity.
      apply ComkLen.
    + reflexivity.
Qed.


Class Monad (m : Type -> Type) : Type := {
  return_ : forall {A}, A -> m A
  ; bind : forall {A}, m A -> forall {B}, (A -> m B) -> m B
  (* monad laws *)
  ; right_unit : forall A (a : m A), a = bind a (@return_ A)
  ; left_unit : forall A (a : A) B (f : A -> m B),
      f a = bind (return_ a) f
  ; associativity : forall A (ma : m A) B f C (g : B -> m C),
      bind ma (fun x => bind (f x) g) = bind (bind ma f) g
}.

Notation "a >>= f" := (bind a f) (at level 50, left associativity).
Notation "a >> b" := (a >>= (fun _ => b)) (at level 50, left associativity).
Notation "'do' a <- e ; c" :=
  (e >>= (fun a => c)) (at level 60, right associativity).

Instance OptionMonad : Monad option := {
  return_ := Some
  ; bind A m B f :=
      match m with
      | None => None
      | Some a => f a
      end
}.
Proof.
 destruct a; reflexivity.

 reflexivity.

 destruct ma.
  intros B f C g. destruct (f a); reflexivity.

  reflexivity.
Defined.


(*
  This module defines the functional unit entries for floating
  point arithmetic.

  TODO: WARNING: check that the instructions set exceptions on invalid rounding modes.
*)
Require Import Kami.AllNotations.
Require Import FpuKami.Definitions.
Require Import FpuKami.MulAdd.
Require Import FpuKami.Compare.
Require Import FpuKami.NFToIN.
Require Import FpuKami.INToNF.
Require Import FpuKami.Classify.
Require Import FpuKami.ModDivSqrt.
Require Import FpuKami.Round.
Require Import ProcKami.FU.
Require Import ProcKami.RiscvIsaSpec.Insts.Fpu.FpuFuncs.
Require Import List.
Import ListNotations.

Section Fpu.
  Context `{procParams: ProcParams}.

  Variable fpuParamsSingle : FpuParams.
  Variable fpuParamsDouble : FpuParams.

  Local Notation single_expWidthMinus2 := (@expWidthMinus2 fpuParamsSingle).
  Local Notation single_sigWidthMinus2 := (@sigWidthMinus2 fpuParamsSingle).
  Local Notation double_expWidthMinus2 := (@expWidthMinus2 fpuParamsDouble).
  Local Notation double_sigWidthMinus2 := (@sigWidthMinus2 fpuParamsDouble).

  Local Definition single_Flen := single_expWidthMinus2 + 1 + 1 + (single_sigWidthMinus2 + 1 + 1).
  Local Definition double_Flen := double_expWidthMinus2 + 1 + 1 + (double_sigWidthMinus2 + 1 + 1).

  Open Scope kami_expr.

  Definition Float_double
    :  FUEntry
    := {|
         fuName := "float_double";
         fuFunc
           := fun ty (sem_in_pkt_expr : RoundInput single_expWidthMinus2 single_sigWidthMinus2 ## ty)
                => LETE sem_in_pkt
                     :  RoundInput single_expWidthMinus2 single_sigWidthMinus2
                     <- sem_in_pkt_expr;
                   RoundNF_def_expr double_expWidthMinus2 double_sigWidthMinus2 #sem_in_pkt;
         fuInsts
           := [
                {|
                  instName   := "fcvt.d.s";
                  xlens      := xlens_all;
                  extensions := ["D"];
                  ext_ctxt_off := ["fs"];
                  uniqId
                    := [
                         fieldVal instSizeField ('b"11");
                         fieldVal opcodeField   ('b"10100");
                         fieldVal rs2Field      ('b"00000");
                         fieldVal funct7Field   ('b"0100001")
                       ];
                  inputXform
                    := (fun ty (cfg_pkt : ContextCfgPkt @# ty) context_pkt_expr
                          => LETE context_pkt <- context_pkt_expr;
                             RetE
                               (STRUCT {
                                  "in"
                                    ::= @bitToNF fpuParamsSingle ty
                                          (@fp_get_float fpuParamsSingle ty
                                             Rlen
                                             Flen
                                             (#context_pkt @% "reg1"));
                                  "afterRounding" ::= $$false;
                                  "roundingMode"  ::= rounding_mode (#context_pkt)
                                } : RoundInput single_expWidthMinus2 single_sigWidthMinus2 @# ty));
                  outputXform
                    := (fun ty (sem_out_pkt_expr : OpOutput double_expWidthMinus2 double_sigWidthMinus2 ## ty)
                        => LETE sem_out_pkt <- sem_out_pkt_expr;
                             LETC val1: RoutedReg <- (STRUCT {
                                                    "tag"  ::= (Const ty (natToWord RoutingTagSz FloatRegTag) : RoutingTag @# ty);
                                                    "data" ::= (OneExtendTruncLsb Rlen (NFToBit (#sem_out_pkt @% "out")) : Bit Rlen @# ty)
                                                     });
                             LETC val2: RoutedReg <- (STRUCT {
                                                    "tag"  ::= (Const ty (natToWord RoutingTagSz FflagsTag) : RoutingTag @# ty);
                                                    "data" ::= (csr (#sem_out_pkt @% "exceptionFlags") : Bit Rlen @# ty)
                                                     });
                             LETC fstVal
                               :  ExecUpdPkt
                               <- (noUpdPkt ty)
                                    @%["val1" <- (Valid #val1)]
                                    @%["val2" <- (Valid #val2)];
                             RetE
                               (STRUCT {
                                  "fst"
                                    ::= #fstVal;
                                  "snd" ::= Invalid
                                } : PktWithException ExecUpdPkt @# ty));
                  optMemParams := None;
                  instHints   := falseHints<|hasFrs1 := true|><|hasFrd := true|>
                |}
              ]
       |}.

  Definition Double_float
    :  FUEntry
    := {|
         fuName := "double_float";
         fuFunc
           := fun ty (sem_in_pkt_expr : RoundInput double_expWidthMinus2 double_sigWidthMinus2 ## ty)
                => LETE sem_in_pkt
                     :  RoundInput double_expWidthMinus2 double_sigWidthMinus2
                     <- sem_in_pkt_expr;
                   RoundNF_def_expr single_expWidthMinus2 single_sigWidthMinus2 #sem_in_pkt;
         fuInsts
           := [
                {|
                  instName   := "fcvt.s.d";
                  xlens      := xlens_all;
                  extensions := ["D"];
                  ext_ctxt_off := ["fs"];
                  uniqId
                    := [
                         fieldVal instSizeField ('b"11");
                         fieldVal opcodeField   ('b"10100");
                         fieldVal rs2Field      ('b"00001");
                         fieldVal funct7Field   ('b"0100000")
                       ];
                  inputXform
                    := (fun ty (cfg_pkt : ContextCfgPkt @# ty) context_pkt_expr
                          => LETE context_pkt <- context_pkt_expr;
                             RetE
                               (STRUCT {
                                  "in"
                                    ::= @bitToNF fpuParamsDouble ty
                                          (@fp_get_float fpuParamsDouble ty
                                             Rlen
                                             Flen
                                             (#context_pkt @% "reg1"));
                                  "afterRounding" ::= $$false;
                                  "roundingMode"  ::= rounding_mode (#context_pkt)
                                } : RoundInput double_expWidthMinus2 double_sigWidthMinus2 @# ty));
                  outputXform
                    := (fun ty (sem_out_pkt_expr : OpOutput single_expWidthMinus2 single_sigWidthMinus2 ## ty)
                        => LETE sem_out_pkt <- sem_out_pkt_expr;
                             LETC val1: RoutedReg <- (STRUCT {
                                                    "tag"  ::= (Const ty (natToWord RoutingTagSz FloatRegTag) : RoutingTag @# ty);
                                                    "data" ::= (OneExtendTruncLsb Rlen (NFToBit (#sem_out_pkt @% "out")) : Bit Rlen @# ty)
                                          });
                             LETC val2: RoutedReg <- (STRUCT {
                                                    "tag"  ::= (Const ty (natToWord RoutingTagSz FflagsTag) : RoutingTag @# ty);
                                                    "data" ::= (csr (#sem_out_pkt @% "exceptionFlags") : Bit Rlen @# ty)
                                          });
                             LETC fstVal
                               :  ExecUpdPkt
                               <- (noUpdPkt ty)
                                    @%["val1" <- (Valid #val1)]
                                    @%["val2" <- (Valid #val2)];
                             RetE
                               (STRUCT {
                                  "fst"
                                    ::= #fstVal;
                                  "snd" ::= Invalid
                                } : PktWithException ExecUpdPkt @# ty));
                  optMemParams := None;
                  instHints   := falseHints<|hasFrs1 := true|><|hasFrd := true|>
                |}
              ]
       |}.

  Close Scope kami_expr.

End Fpu.


(** * Push-Button Synthesis of Montgomery Reduction *)
Require Import Coq.Strings.String.
Require Import Coq.ZArith.ZArith.
Require Import Coq.micromega.Lia.
Require Import Coq.Lists.List.
Require Import Coq.derive.Derive.
Require Import Crypto.Util.ErrorT.
Require Import Crypto.Util.ListUtil.
Require Import Crypto.Util.ZRange.
Require Import Crypto.Util.ZUtil.Div.
Require Import Crypto.Util.ZUtil.ModInv.
Require Import Crypto.Util.ZUtil.Tactics.LtbToLt.
Require Import Crypto.Util.ZUtil.Tactics.PullPush.Modulo.
Require Import Crypto.Util.ZUtil.Tactics.RewriteModSmall.
Require Import Rewriter.Language.Language.
Require Import Crypto.Language.API.
Require Import Crypto.Stringification.Language.
Require Import Crypto.Arithmetic.Core.
Require Import Crypto.Arithmetic.FancyMontgomeryReduction.
Require Import Crypto.BoundsPipeline.
Require Import Crypto.COperationSpecifications.
Require Import Crypto.Fancy.Compiler.
Require Import Crypto.PushButtonSynthesis.ReificationCache.
Require Import Crypto.PushButtonSynthesis.Primitives.
Require Import Crypto.PushButtonSynthesis.FancyMontgomeryReductionReificationCache.
Require Import Crypto.PushButtonSynthesis.InvertHighLow.
Import ListNotations.
Local Open Scope string_scope. Local Open Scope Z_scope. Local Open Scope list_scope. Local Open Scope bool_scope.

Import
  Language.Compilers
  Language.Wf.Compilers
  Stringification.Language.Compilers.
Import Compilers.API.

Import COperationSpecifications.Primitives.

Import COperationSpecifications.MontgomeryReduction.

Import Associational Positional FancyMontgomeryReduction.MontgomeryReduction.

Local Set Keyed Unification. (* needed for making [autorewrite] fast, c.f. COQBUG(https://github.com/coq/coq/issues/9283) *)

Local Opaque reified_montred_gen. (* needed for making [autorewrite] not take a very long time *)

Section rmontred.
  Context {output_language_api : ToString.OutputLanguageAPI}
          {pipeline_opts : PipelineOptions}
          {pipeline_to_string_opts : PipelineToStringOptions}
          {synthesis_opts : SynthesisOptions}
          (N R N' : Z) (n : nat)
          (machine_wordsize : machine_wordsize_opt).

  Let value_range := r[0 ~> (2^machine_wordsize - 1)%Z]%zrange.
  Let flag_range := r[0 ~> 1]%zrange.
  Let bound := Some value_range.
  Let consts_list := [N; N'].
  Let R' := Z.modinv R N.

  Definition possible_values_of_machine_wordsize
    := [1; machine_wordsize / 2; machine_wordsize; 2 * machine_wordsize]%Z.
  Local Arguments possible_values_of_machine_wordsize / .

  Local Notation possible_values := possible_values_of_machine_wordsize.

  Local Instance no_select_size : no_select_size_opt := no_select_size_of_no_select machine_wordsize.
  Local Instance split_mul_to : split_mul_to_opt := split_mul_to_of_should_split_mul machine_wordsize possible_values.
  Local Instance split_multiret_to : split_multiret_to_opt := split_multiret_to_of_should_split_multiret machine_wordsize possible_values.

  Local Instance fancy_args : translate_to_fancy_opt
    := (Some {| BoundsPipeline.invert_low log2wordsize := invert_low log2wordsize consts_list;
                BoundsPipeline.invert_high log2wordsize := invert_high log2wordsize consts_list;
                BoundsPipeline.value_range := value_range;
                BoundsPipeline.flag_range := flag_range |}).

  Local Instance fancy_args_good : translate_to_fancy_opt_correct.
  Proof using consts_list value_range.
    cbv [translate_to_fancy_opt_correct translate_to_fancy fancy_args invert_low invert_high constant_to_scalar constant_to_scalar_single consts_list fold_right];
      split; intros; break_innermost_match_hyps; Z.ltb_to_lt; subst; congruence.
  Qed.

  (** Note: If you change the name or type signature of this
        function, you will need to update the code in CLI.v *)
  Definition check_args {T} (requests : list string) (res : Pipeline.ErrorT T)
    : Pipeline.ErrorT T
    := fold_right
         (fun '(b, e) k => if b:bool then Error e else k)
         res
         [
            ((negb (1 <? R))%Z, Pipeline.Value_not_ltZ "R ≤ 1" 1 R);
            ((n =? 0)%nat, Pipeline.Values_not_provably_distinctZ "n = 0" (Z.of_nat n) 0);
            ((R' =? 0)%Z, Pipeline.No_modular_inverse "R⁻¹ mod N" R N);
            (negb ((R * R') mod N =? 1 mod N)%Z, Pipeline.Values_not_provably_equalZ "(R * R') mod N ≠ 1 mod N" ((R * R') mod N) (1 mod N));
            (negb ((N * N') mod R =? (-1) mod R)%Z, Pipeline.Values_not_provably_equalZ "(N * N') mod R ≠ (-1) mod R" ((N * N') mod R) ((-1) mod R));
            (negb (2 ^ machine_wordsize =? R)%Z, Pipeline.Values_not_provably_equalZ "2^machine_wordsize ≠ R" (2^machine_wordsize) R);
            ((negb (0 <? N))%Z, Pipeline.Value_not_ltZ "N ≤ 0" 0 N);
            ((negb (N <? R))%Z, Pipeline.Value_not_ltZ "R ≤ N" R N);
            ((negb (0 <=? N'))%Z, Pipeline.Value_not_leZ "N' < 0" 0 N');
            ((negb (N' <? R))%Z, Pipeline.Value_not_ltZ "R ≤ N'" R N');
            ((negb (2 <=? machine_wordsize))%Z, Pipeline.Value_not_leZ "machine_wordsize < 2" 2 machine_wordsize)].

  Local Arguments Z.mul !_ !_.

  Local Ltac use_curve_good_t :=
    repeat first [ assumption
                 | progress cbv [EquivModulo.Z.equiv_modulo]
                 | progress rewrite ?Z.mul_0_r, ?Pos.mul_1_r, ?Z.mul_1_r in *
                 | reflexivity
                 | lia
                 | progress cbn in *
                 | progress intros
                 | solve [ auto with zarith ]
                 | rewrite Z.log2_pow2 by use_curve_good_t ].

  Context (requests : list string)
          (curve_good : check_args requests (Success tt) = Success tt).

  Lemma use_curve_good
    : 0 <= N < R
      /\ 0 <= N' < R
      /\ N <> 0
      /\ R > 1
      /\ EquivModulo.Z.equiv_modulo R (N * N') (-1)
      /\ EquivModulo.Z.equiv_modulo N (R * R') 1
      /\ n <> 0%nat
      /\ 2 <= machine_wordsize
      /\ 2 ^ machine_wordsize = R.
  Proof using curve_good.
    prepare_use_curve_good ().
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
  Qed.

  Definition montred
    := Pipeline.BoundsPipeline
         false (* subst01 *)
         possible_values
         (reified_montred_gen
            @ GallinaReify.Reify N @ GallinaReify.Reify R @ GallinaReify.Reify N' @ GallinaReify.Reify (machine_wordsize:Z))
         (bound, (bound, tt))
         bound.

  Definition smontred (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "montred" montred
          (fun _ _ _ => @nil string).

  Local Ltac solve_montred_preconditions :=
    repeat first [ lia
           | apply use_curve_good
           | progress (push_Zmod; pull_Zmod)
           | progress autorewrite with zsimplify_fast
           | rewrite Z.div_add' by lia
           | rewrite Z.div_small by lia
           | progress Z.rewrite_mod_small ].

  Local Strategy -100 [montred]. (* needed for making Qed not take forever *)
  Local Strategy -100 [montred']. (* needed for making prove_correctness not take forever *)
  Lemma montred_correct res (Hres : montred = Success res)
    : montred_correct N R R' (API.Interp res).
  Proof using n curve_good.
    cbv [montred_correct]; intros.
    rewrite <- MontgomeryReduction.montred'_correct with (R:=R) (N':=N') (Zlog2R:=machine_wordsize) (n:=n) (lo:=lo) (hi:=hi) by solve_montred_preconditions.
    prove_correctness' ltac:(fun _ => idtac) use_curve_good.
    { cbv [ZRange.type.base.option.is_bounded_by ZRange.type.base.is_bounded_by bound is_bounded_by_bool value_range upper lower].
      rewrite Bool.andb_true_iff, !Z.leb_le. lia. }
    { cbv [ZRange.type.base.option.is_bounded_by ZRange.type.base.is_bounded_by bound is_bounded_by_bool value_range upper lower].
      rewrite Bool.andb_true_iff, !Z.leb_le. lia. }
  Qed.

  Lemma Wf_montred res (Hres : montred = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.
End rmontred.

Module Export Hints.
#[global]
  Hint Opaque
       montred
  : wf_op_cache.
#[global]
  Hint Immediate
       Wf_montred
  : wf_op_cache.
End Hints.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall E Eprime P A B C A1 B1 C1 N C1prime M : Universe, ((wd_ N E /\ (wd_ A C /\ (wd_ B P /\ (wd_ A B /\ (wd_ N M /\ (wd_ M C1 /\ (wd_ N C1 /\ (wd_ C1 C1prime /\ (wd_ N C1prime /\ (wd_ E Eprime /\ (wd_ N Eprime /\ (wd_ P A /\ (wd_ P C /\ (wd_ C1prime A1 /\ (wd_ N A1 /\ (wd_ N B1 /\ (wd_ M C1prime /\ (wd_ N N /\ (wd_ A1 Eprime /\ (col_ P A B /\ (col_ C B P /\ (col_ N E C1 /\ (col_ N E B1 /\ (col_ N E A1 /\ (col_ M C1 C1prime /\ (col_ N C1prime N /\ (col_ N C1 N /\ col_ N A1 C1))))))))))))))))))))))))))) -> col_ P A C)).
Proof.
  time tac.
Qed.

End FOFProblem.


(*

Author:  Adam Petz, ampetz@ku.edu
*)
Require Import Maps Impl_vm.
Require Import Coq.Arith.EqNat.
Require Import Term StVM StAM
        MonadVM GenStMonad ConcreteEvidence VmSemantics.
(*Require Import Coq.ZArith.ZArith_base Coq.Strings.String Coq.Strings.Ascii. *)
(* Require Import ExtLib.Data.Monads.StateMonad ExtLib.Data.Monads.ReaderMonad
ExtLib.Structures.Monads ExtLib.Data.Monads.IdentityMonad. *)
Require Import List.

(* Import MonadNotation. *)
Import ListNotations.
(* Local Open Scope monad_scope. *)

(*
Definition Policy := nat.

Record AM_Env : Type := mkAM_Env
                          { myPolicy : Policy}.

Definition init_env := (mkAM_Env 0).
 *)

(* ident is the identity monad, acting as a place-holder for the base monad.
   TODO:  eventually we need this to be IO (or something that models IO) *)
Definition AM := St AM_St.     (* readerT AM_Env (stateT AM_St ident). *)

(*
Definition am_newNonce (bs :BS) : AM EvidenceC :=
  (*let myPol := asks myPolicy in *)
  am_st <- get ;;
  let mm := am_nonceMap am_st in
  let i := am_nonceId am_st in
  let appm := st_aspmap am_st in
  let sigm := st_sigmap am_st in
  (*let plm := am_pl am_st in *)

  let newMap := map_set mm i bs in
  let newId := i + 1 in
  put (mkAM_St newMap newId appm sigm (*plm*)) ;;
      ret (nnc i bs mtc).
*)

Definition runAM {A:Type} (k:(AM A)) (* (env:AM_Env) *) (st:AM_St) : (option A) * AM_St :=
  runSt k st.

(*
Definition incNonce := runAM (am_newNonce 42) empty_amst.
Check incNonce.
Compute (incNonce).

Check annotated.
*)

Definition am_run_t (t:Term) (e:EvidenceC) : AM EvidenceC :=
  let annt := annotated t in
  let start_st := mk_st e [] 0 [] in
  ret (st_ev (run_vm annt start_st)).

Definition t1 := (att 1 (lseq (asp (ASPC 44 [])) (asp SIG))).
Definition t2 := (lseq (asp (ASPC 44 [])) (asp SIG)).

(*
Compute (am_run_t t2 mtc empty_amst).
*)

(*
Definition am_proto_1 :=
  n2 <- am_newNonce 42 ;;
    n <- am_newNonce 43 ;;
    am_run_t t2 n.

Compute (runAM am_proto_1 empty_amst).
*)

(*
Fixpoint nonces (e:EvidenceC) (l:list nat) : list nat :=
  match e with
  | nnc i _ e' => nonces e' ([i] ++ l)
  | _ => l
  end.
 *)

(** * Helper functions for Appraisal *)

Definition am_get_app_asp (p:Plc) (i:ASP_ID) : AM ASP_ID :=
  m <- gets st_aspmap ;;
  let maybeId := map_get m (p,i) in
  match maybeId with
  | Some i' => ret i'
  | None => failm
  end.

Definition am_get_sig_asp (p:Plc) : AM ASP_ID :=
  m <- gets st_sigmap ;;
  let maybeId := map_get m p in
  match maybeId with
  | Some i' => ret i'
  | None => failm
  end.


(*

  Copyright 2014 Cornell University
  Copyright 2015 Cornell University
  Copyright 2016 Cornell University
  Copyright 2017 Cornell University
  Copyright 2018 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Websites: http://nuprl.org/html/verification/
            http://nuprl.org/html/Nuprl2Coq
            https://github.com/vrahli/NuprlInCoq

  Authors: Abhishek Anand & Vincent Rahli

*)

Require Export alphaeq4.
Require Export stronger_continuity_defs4.
Require Export per_props_nat2.
Require Export per_props_squash.
Require Export sequents_tacs.

Definition mod_fun_type {o} (x : NVar) : @NTerm o :=
  mk_function
    mk_tnat
    x
    (mk_fun (mk_natk2nat (mk_var x))  mk_natU).

Lemma lsubstc_mod_fun_type {o} :
  forall v w (s : @CSub o) c,
    alphaeqc (lsubstc (mod_fun_type v) w s c) modulus_fun_type_u.
Proof.
  introv.
  unfold mod_fun_type.
  lsubst_tac.
  allrw @lsubstc_mkc_tnat.
  unfold modulus_fun_type.

  apply implies_alphaeqc_mkc_function; eauto 2 with slow.
  introv.
  repeat substc_lsubstc_vars3.
  eapply alphaeqc_trans;[|apply alphaeqc_sym;apply substc_mkcv_fun].

  match goal with
    | [ |- context[lsubstc (mk_fun ?a ?b) ?w ?s ?c] ] =>
      pose proof (lsubstc_mk_fun_ex a b s w c) as h;
        exrepnd; clear_irr
  end.
  eapply alphaeqc_trans;[exact h1|]; clear h1.

  apply alphaeqc_mkc_fun.

  - eapply alphaeqc_trans;[|apply alphaeqc_sym;apply substc_mkcv_fun].
    eapply alphaeqc_trans;
      [|apply alphaeqc_sym;apply alphaeqc_mkc_fun;
        [apply mkcv_natk_substc
        |apply alphaeqc_refl]
      ].
    rw @mkcv_tnat_substc.
    rw @mkc_var_substc.

    eapply alphaeqc_trans;[apply lsubstc_mk_natk2nat_sp1|].
    eauto 2 with slow.

  - eapply alphaeqc_trans;[apply lsubstc_mk_natU|].
    rw @csubst_mk_cv; eauto 3 with slow.
Qed.

Lemma lsubstc_nat2nat_to_nat {o} :
  forall w (s : @CSub o) c,
    alphaeqc
      (lsubstc (mk_fun mk_nat2nat mk_tnat) w s c)
      (mkc_fun nat2nat mkc_tnat).
Proof.
  introv.
  unfold alphaeqc; simpl.
  eapply alpha_eq_trans;[apply csubst_mk_fun|].
  autorewrite with slow.
  apply alpha_eq_mk_fun; auto.
  unfold mk_nat2nat.
  eapply alpha_eq_trans;[apply csubst_mk_fun|].
  autorewrite with slow; auto.
Qed.
Hint Resolve lsubstc_nat2nat_to_nat : slow.

(* XXXXXXXXXX *)

Definition mk_sqexists {o} (a : @NTerm o) v b := mk_squash (mk_exists a v b).

Definition strong_continuous_type {o} (x M f n : NVar) (F : @NTerm o) :=
  mk_sqexists
    (mod_fun_type x)
    M
    (mk_all
       mk_nat2nat
       f
       (mk_sqexists
          mk_tnat
          n
          (mk_equality
             (mk_apply2 (mk_var M) (mk_var n) (mk_var f))
             (mk_apply F (mk_var f))
             mk_natU))).

Definition rule_strong_continuity {o}
           (F : @NTerm o)
           (x M f n : NVar)
           (H : barehypotheses) :=
    mk_rule
      (mk_baresequent H (mk_conclax (strong_continuous_type x M f n F)))
      [ mk_baresequent H (mk_conclax (mk_member F (mk_fun mk_nat2nat mk_tnat))) ]
      [].

Lemma rule_strong_continuity_true {p} :
  forall lib
         (F : NTerm)
         (x M f n : NVar)
         (H : @barehypotheses p)
         (d1 : M <> f)
         (d2 : n <> f)
         (d3 : n <> M)
         (d4 : !LIn M (free_vars F))
         (d5 : !LIn f (free_vars F))
         (d6 : !LIn n (free_vars F)),
    rule_true lib (rule_strong_continuity
                     F
                     x M f n
                     H).
Proof.
  unfold rule_strong_continuity, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.

  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp.
  rename Hyp into hyp1.
  destruct hyp1 as [wc1 hyp1].
  destseq; allsimpl; proof_irr; GC.
  unfold closed_extract; simpl.

  exists (@covered_axiom p (nh_vars_hyps H)).

  (* We prove some simple facts on our sequents *)
  (* done with proving these simple facts *)

  vr_seq_true.

  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as h; exrepnd; clear hyp1.

  allunfold @strong_continuous_type.
  allunfold @mk_sqexists.
  lsubst_tac.

  apply member_if_inhabited in h1.
  apply tequality_mkc_member in h0; repnd.
  allrw @fold_equorsq.
  clear h2.

  lsubst_tac.
  allrw @lsubstc_mkc_tnat.
  eapply member_respects_alphaeqc_r in h1;
    [|apply alphaeqc_mkc_fun;[apply lsubstc_mk_nat2nat|apply alphaeqc_refl] ].
  autodimp h0 hyp.
  { clear - h1.
    lsubst_tac.
    eapply member_respects_alphaeqc_r;
      [apply alphaeqc_sym;apply alphaeqc_mkc_fun;[apply lsubstc_mk_nat2nat|apply alphaeqc_refl]|].
    autorewrite with slow in *; auto. }
  eapply alphaeqc_preserving_equality in h0;
    [|apply lsubstc_nat2nat_to_nat];[].

  dup h1 as memF.
  dup h0 as eqF.

  prove_and teq.

  - apply tequality_mkc_squash.

    unfold mk_exists.
    lsubst_tac.

    apply tequality_product.
    dands.

    + eapply tequality_respects_alphaeqc_left;
      [apply alphaeqc_sym; apply lsubstc_mod_fun_type|].
      eapply tequality_respects_alphaeqc_right;
        [apply alphaeqc_sym; apply lsubstc_mod_fun_type|].
      apply type_modulus_fun_type_u.

    + intros M1 M2 em.
      eapply alphaeqc_preserving_equality in em;[|apply lsubstc_mod_fun_type].
      repeat substc_lsubstc_vars3.

      unfold mk_all.
      lsubst_tac.

      apply tequality_function; dands.

      * eapply tequality_respects_alphaeqc_left;
        [apply alphaeqc_sym; apply lsubstc_mk_nat2nat|].
        eapply tequality_respects_alphaeqc_right;
          [apply alphaeqc_sym; apply lsubstc_mk_nat2nat|].
        apply type_nat2nat.

      * intros f1 f2 en2n.
        eapply alphaeqc_preserving_equality in en2n;[|apply lsubstc_mk_nat2nat].
        repeat substc_lsubstc_vars3.
        lsubst_tac.
        apply tequality_mkc_squash.
        allrw @lsubstc_mkc_tnat.

        apply tequality_product; dands; eauto 3 with slow.
        { apply type_tnat. }

        intros n1 n2 en.
        repeat substc_lsubstc_vars3.
        a_lsubst_tac.

        apply tequality_mkc_equality_if_equal.

        { eapply tequality_respects_alphaeqc_left;
          [apply alphaeqc_sym; apply lsubstc_mk_natU|].
          eapply tequality_respects_alphaeqc_right;
            [apply alphaeqc_sym; apply lsubstc_mk_natU|].
          apply type_natU. }

        { eapply alphaeqc_preserving_equality;
          [|apply alphaeqc_sym; apply lsubstc_mk_natU].

          apply equality_in_function2 in em; repnd.
          clear em0.
          applydup em in en as e.
          eapply alphaeqc_preserving_equality in e;[|apply substc_mkcv_fun].
          rw @csubst_mk_cv in e.

          try (fold (@natU p) in e).
          eapply alphaeqc_preserving_equality in e;
            [|apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
              apply substc_mkcv_fun].
          eapply alphaeqc_preserving_equality in e;
            [|apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
              apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
              apply mkcv_natk_substc
            ].
          allrw @mkc_var_substc.
          allrw @mkcv_tnat_substc.

          try (fold (natk2nat n1) in e).

          applydup @equality_refl in en.
          apply (equality_nat2nat_to_natk2nat lib n1) in en2n; auto;[].

          apply equality_in_fun in e; repnd; clear e0 e1.
          apply e in en2n.
          allrw <- @mkc_apply2_eq; auto. }

        { eapply alphaeqc_preserving_equality;
          [|apply alphaeqc_sym; apply lsubstc_mk_natU].
          apply equality_in_fun in eqF; repnd; clear eqF0 eqF1.
          apply eqF in en2n; auto.
          apply equality_in_bunion_left; eauto 2 with slow. }

  - apply equality_in_mkc_squash; dands;
    try (spcast; apply computes_to_valc_refl; eauto 3 with slow);[].

    unfold mk_exists.
    lsubst_tac.

    exists (mkc_pair (spM_c (lsubstc F wt s1 ct0))
                     (mkc_lam f (mkcv_axiom f))).

    apply equality_in_product.
    dands.

    + eapply type_respects_alphaeqc;
      [apply alphaeqc_sym; apply lsubstc_mod_fun_type|].
      apply type_modulus_fun_type_u.

    + intros M1 M2 em.
      eapply alphaeqc_preserving_equality in em;[|apply lsubstc_mod_fun_type].
      repeat substc_lsubstc_vars3.

      unfold mk_all.
      lsubst_tac.

      apply tequality_function; dands.

      * eapply tequality_respects_alphaeqc_left;
        [apply alphaeqc_sym; apply lsubstc_mk_nat2nat|].
        eapply tequality_respects_alphaeqc_right;
          [apply alphaeqc_sym; apply lsubstc_mk_nat2nat|].
        apply type_nat2nat.

      * intros f1 f2 en2n.
        eapply alphaeqc_preserving_equality in en2n;[|apply lsubstc_mk_nat2nat].
        repeat substc_lsubstc_vars3.
        lsubst_tac.
        apply tequality_mkc_squash.
        allrw @lsubstc_mkc_tnat.

        apply tequality_product; dands; eauto 3 with slow.
        { apply type_tnat. }

        intros n1 n2 en.
        repeat substc_lsubstc_vars3.
        a_lsubst_tac.

        apply tequality_mkc_equality_if_equal.

        { eapply tequality_respects_alphaeqc_left;
          [apply alphaeqc_sym; apply lsubstc_mk_natU|].
          eapply tequality_respects_alphaeqc_right;
            [apply alphaeqc_sym; apply lsubstc_mk_natU|].
          apply type_natU. }

        { eapply alphaeqc_preserving_equality;
          [|apply alphaeqc_sym; apply lsubstc_mk_natU].

          apply equality_in_function2 in em; repnd.
          clear em0.
          applydup em in en as e.
          eapply alphaeqc_preserving_equality in e;[|apply substc_mkcv_fun].
          rw @csubst_mk_cv in e.

          try (fold (@natU p) in e).
          eapply alphaeqc_preserving_equality in e;
            [|apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
              apply substc_mkcv_fun].
          eapply alphaeqc_preserving_equality in e;
            [|apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
              apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
              apply mkcv_natk_substc
            ].
          allrw @mkc_var_substc.
          allrw @mkcv_tnat_substc.

          try (fold (natk2nat n1) in e).

          applydup @equality_refl in en.
          apply (equality_nat2nat_to_natk2nat lib n1) in en2n; auto;[].

          apply equality_in_fun in e; repnd; clear e0 e1.
          apply e in en2n.
          allrw <- @mkc_apply2_eq; auto. }

        { eapply alphaeqc_preserving_equality;
          [|apply alphaeqc_sym; apply lsubstc_mk_natU].
          apply equality_refl in memF.
          apply equality_in_fun in memF; repnd; clear memF0 memF1.
          apply memF in en2n; auto.
          apply equality_in_bunion_left; eauto 2 with slow. }

    + eexists; eexists; eexists; eexists; dands; spcast;
      try (apply computes_to_valc_refl; eauto 3 with slow).

      * eapply alphaeqc_preserving_equality;
        [|apply alphaeqc_sym; apply lsubstc_mod_fun_type].

        apply spM_in_modulus_fun_type_u; auto.

      * repeat substc_lsubstc_vars3.
        unfold mk_all.
        lsubst_tac.

        apply equality_in_function.
        dands.

        { eapply type_respects_alphaeqc;
          [apply alphaeqc_sym; apply lsubstc_mk_nat2nat|].
          eauto 3 with slow. }

        { intros f1 f2 en2n.
          eapply alphaeqc_preserving_equality in en2n;[|apply lsubstc_mk_nat2nat].
          repeat substc_lsubstc_vars3.
          lsubst_tac.
          apply tequality_mkc_squash.
          allrw @lsubstc_mkc_tnat.

          apply tequality_product; dands; eauto 3 with slow.
          { apply type_tnat. }

          intros n1 n2 en.
          repeat substc_lsubstc_vars3.
          a_lsubst_tac.

          apply tequality_mkc_equality_if_equal.

          { eapply tequality_respects_alphaeqc_left;
            [apply alphaeqc_sym; apply lsubstc_mk_natU|].
            eapply tequality_respects_alphaeqc_right;
              [apply alphaeqc_sym; apply lsubstc_mk_natU|].
            apply type_natU. }

          { eapply alphaeqc_preserving_equality;
            [|apply alphaeqc_sym; apply lsubstc_mk_natU].

            pose proof (spM_in_modulus_fun_type_u lib (lsubstc F wt s1 ct0) h1) as h.
            rw @equality_in_function in h; repnd.
            applydup h in en as e.
            eapply alphaeqc_preserving_equality in e;[|apply substc_mkcv_fun].
            rw @csubst_mk_cv in e.

            try (fold (@natU p) in e).
            eapply alphaeqc_preserving_equality in e;
              [|apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
                apply substc_mkcv_fun].
            eapply alphaeqc_preserving_equality in e;
              [|apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
                apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
                apply mkcv_natk_substc
              ].
            allrw @mkc_var_substc.
            allrw @mkcv_tnat_substc.

            try (fold (natk2nat n1) in e).

            applydup @equality_refl in en.
            apply (equality_nat2nat_to_natk2nat lib n1) in en2n; auto;[].

            apply equality_in_fun in e; repnd; clear e0 e1.
            apply e in en2n.
            allrw <- @mkc_apply2_eq; auto. }

          { eapply alphaeqc_preserving_equality;
            [|apply alphaeqc_sym; apply lsubstc_mk_natU].
            apply equality_refl in memF.
            apply equality_in_fun in memF; repnd; clear memF0 memF1.
            apply memF in en2n; auto.
            apply equality_in_bunion_left; eauto 2 with slow. }
        }

        { intros f1 f2 en2n.
          eapply alphaeqc_preserving_equality in en2n;[|apply lsubstc_mk_nat2nat].
          repeat substc_lsubstc_vars3.
          lsubst_tac.

          eapply equality_respects_cequivc_left;
            [apply cequivc_sym;apply cequivc_beta|].
          eapply equality_respects_cequivc_right;
            [apply cequivc_sym;apply cequivc_beta|].
          allrw @substc_mkcv_axiom.

          apply equality_in_mkc_squash; dands; spcast;
          try (apply computes_to_valc_refl; eauto 3 with slow);[].

          applydup @equality_refl in en2n as mf1.
          pose proof (spM_cond lib (lsubstc F wt s1 ct0) f1 h1 mf1) as h.
          exrepnd.

          allrw @lsubstc_mkc_tnat.

          exists (mkc_pair (mkc_nat n0) (@mkc_axiom p)).

          apply equality_in_product; dands; eauto 3 with slow.

          - intros n1 n2 en.
            repeat substc_lsubstc_vars3.
            a_lsubst_tac.

            apply tequality_mkc_equality_if_equal.

            { eapply tequality_respects_alphaeqc_left;
              [apply alphaeqc_sym; apply lsubstc_mk_natU|].
              eapply tequality_respects_alphaeqc_right;
              [apply alphaeqc_sym; apply lsubstc_mk_natU|].
              apply type_natU. }

            { eapply alphaeqc_preserving_equality;
              [|apply alphaeqc_sym; apply lsubstc_mk_natU].

              pose proof (spM_in_modulus_fun_type_u lib (lsubstc F wt s1 ct0) h1) as h.
              rw @equality_in_function in h; repnd.
              applydup h in en as e.
              eapply alphaeqc_preserving_equality in e;[|apply substc_mkcv_fun].
              rw @csubst_mk_cv in e.

              try (fold (@natU p) in e).
              eapply alphaeqc_preserving_equality in e;
                [|apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
                  apply substc_mkcv_fun].
              eapply alphaeqc_preserving_equality in e;
                [|apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
                  apply alphaeqc_mkc_fun;[|apply alphaeqc_refl];
                  apply mkcv_natk_substc
                ].
              allrw @mkc_var_substc.
              allrw @mkcv_tnat_substc.

              try (fold (natk2nat n1) in e).

              applydup @equality_refl in en.
              apply (equality_nat2nat_to_natk2nat lib n1) in en2n; auto;[].

              apply equality_in_fun in e; repnd; clear e0 e1.
              applydup @equality_refl in en2n as ef.
              apply e in ef.
              allrw <- @mkc_apply2_eq; auto. }

            { eapply alphaeqc_preserving_equality;
              [|apply alphaeqc_sym; apply lsubstc_mk_natU].
              apply equality_refl in memF.
              apply equality_in_fun in memF; repnd; clear memF0 memF1.
              apply memF in en2n; auto.
              apply equality_in_bunion_left; eauto 2 with slow. }

          - eexists; eexists; eexists; eexists; dands; spcast;
            try (apply computes_to_valc_refl; eauto 3 with slow);
            eauto 3 with slow.

            repeat substc_lsubstc_vars3.
            a_lsubst_tac.

            apply member_equality.
            eapply alphaeqc_preserving_equality;
              [|apply alphaeqc_sym; apply lsubstc_mk_natU].
            auto.
        }
Qed.


From Coq Require Import Init.Nat.
Require Import RuntimeDefinitions.

Fixpoint set_all_zeroes (mu: memory) (block: block_ID) (offset: data_offset) (block_size: nat) (current_size: nat) {struct current_size}: option memory :=
  match current_size with
  | 0 => Some mu
  | S new_size =>
    match (NatMap.find block mu) with
    | None => None
    | Some l =>
      match ((S offset) =? block_size) with
      | true => set_all_zeroes (NatMap.add block (NatMap.add offset (memory_value_data (data_value 0)) l) mu) (S block) 0 block_size new_size
      | false => set_all_zeroes (NatMap.add block (NatMap.add offset (memory_value_data (data_value 0)) l) mu) block (S offset) block_size new_size
      end
    end
  end.
Definition reinitialize_memory (e: raw_enclave_ID) (state: enclave_state) (mu: memory): option memory :=
  match state with
  | enclave_state_value _ E =>
    match (NatMap.find e E) with
    | None => None
    | Some mem_range =>
      match mem_range with
      | enclave_address_and_data l n =>
        match l with
        | address block offset =>
          match (NatMap.find block mu) with
          | None => None
          | Some x => set_all_zeroes mu block offset (length (NatMapProperties.to_list x)) n
          end
        end
      end
    end
  end.