(**
CoLoR, a Coq library on rewriting and termination.
See the COPYRIGHTS and LICENSE files.

- Adam Koprowski, 2004-09-06

This file provides an implementation of finite multisets using list
representation.
*)

Set Implicit Arguments.

From Coq Require Import Permutation PermutSetoid Omega Multiset.
From CoLoR Require Import LogicUtil RelExtras MultisetCore ListExtras.

Module MultisetList (ES : Eqset_dec) <: MultisetCore with Module Sid := ES.

  Module Export Sid := ES.

Section Operations.

  Definition Multiset := list A.

  Definition empty : Multiset := nil.
  Definition singleton a : Multiset := a :: nil.
  Definition union := app (A:=A).
  Definition meq := permutation eqA eqA_dec.

  Definition mult := countIn eqA eqA_dec.
  Definition rem := removeElem eqA eqA_dec.
  Definition diff := removeAll eqA eqA_dec.

  Definition intersection := inter_as_diff diff.

  Definition fold_left := fun T : Type => List.fold_left (A := T) (B := A).

End Operations.

  Infix "=mul=" := meq (at level 70) : msets_scope.
  Notation "X <>mul Y" := (~meq X Y) (at level 50) : msets_scope.
  Notation "{{ x }}" := (singleton x) (at level 5) : msets_scope.
  Infix "+" := union : msets_scope.
  Infix "-" := diff : msets_scope.
  Infix "#" := intersection (at level 50, left associativity) : msets_scope.
  Infix "/" := mult : msets_scope.

  Delimit Scope msets_scope with msets.
  Open Scope msets_scope.
  Bind Scope msets_scope with Multiset.

Section ImplLemmas.

  Lemma empty_empty : forall M, (forall x, x / M = 0) -> M = empty.

  Proof.
    intros M mulM; destruct M.
    trivial.
    absurd (a / (a::M) = 0).
    simpl. destruct (eqA_dec a a); auto with sets.
    auto.
  Qed.

End ImplLemmas.

Section SpecConformation.

  Lemma mult_eqA_compat : forall M x y, x =A= y -> x / M = y / M.

  Proof.
     induction M.
     auto.
     intros; simpl.
     destruct (eqA_dec x a); destruct (eqA_dec y a); intros;
       solve [ absurd (y =A= a); eauto with sets
             | assert (x / M = y / M); auto ].
  Qed.

  Lemma mult_comp : forall l a,
    a / l = multiplicity (list_contents eqA eqA_dec l) a.

  Proof.
    induction l.
    auto.
    intro a0; simpl.
    destruct (eqA_dec a0 a); destruct (eqA_dec a a0); simpl;
    rewrite <- (IHl a0); (reflexivity || absurd (a0 =A= a); auto with sets).
  Qed.

  Lemma multeq_meq : forall M N, (forall x, x / M = x / N) -> M =mul= N.

  Proof.
    unfold meq. intros M N mult_MN x. rewrite <- !mult_comp. exact (mult_MN x).
  Qed.

  Lemma meq_multeq : forall M N, M =mul= N -> forall x, x / M = x / N.

  Proof.
    unfold meq, permutation, Multiset.meq.
    intros M N eqMN x. rewrite !mult_comp. exact (eqMN x).
  Qed.

  Lemma empty_mult : forall x, mult x empty = 0.

  Proof. auto. Qed.

  Lemma union_mult : forall M N x,
                       (x/(M + N))%msets = ((x/M)%msets + (x/N)%msets)%nat.

  Proof.
    induction M; auto.
    intros N x; simpl. destruct (eqA_dec x a); auto. rewrite IHM. auto.
  Qed.

  Lemma diff_empty_l : forall M, empty - M = empty.

  Proof.
    induction M; auto.
  Qed.

  Lemma diff_empty_r : forall M, M - empty = M.

  Proof.
    induction M; auto.
  Qed.

  Lemma mult_remove_in : forall x a M,
    x =A= a -> (x / (rem a M))%msets = ((x / M)%msets - 1)%nat.

  Proof.
    induction M.
    auto.
    intro x_a.
    simpl; destruct (eqA_dec x a0); destruct (eqA_dec a a0);
      simpl; try solve [absurd (x =A= a); eauto with sets].
    auto with arith.
    destruct (eqA_dec x a0).
    contr.
    auto.
  Qed.

  Lemma mult_remove_not_in : forall M a x,
    ~ x =A= a -> x / (rem a M) = x / M.

  Proof.
    induction M; intros.
    auto.
    simpl; destruct (eqA_dec a0 a).
    destruct (eqA_dec x a);
      solve [absurd (x =A= a); eauto with sets | trivial].
    simpl; destruct (eqA_dec x a).
    rewrite (IHM a0 x); trivial.
    apply IHM; trivial.
  Qed.

  Lemma remove_perm_single : forall x a b M,
   x / (rem a (rem b M)) = x / (rem b (rem a M)).

  Proof.
    intros x a b M.
    case (eqA_dec x a); case (eqA_dec x b); intros x_b x_a.
     (* x=b,  x=a *)
    rewrite !mult_remove_in; trivial.
     (* x<>b, x=a *)
    rewrite mult_remove_in; trivial.
    do 2 (rewrite mult_remove_not_in; trivial).
    rewrite mult_remove_in; trivial.
     (* x=b,  x<>a *)
    rewrite mult_remove_not_in; trivial.
    do 2 (rewrite mult_remove_in; trivial).
    rewrite mult_remove_not_in; trivial.
     (* x<>b, x<>a *)
    rewrite !mult_remove_not_in; trivial.
  Qed.

  Lemma diff_mult_comp : forall x N M M',
    M =mul= M' -> x / (M - N) = x / (M' - N).

  Proof.
    induction N.
    intros; apply meq_multeq; trivial.
    intros M M' MM'.
    simpl.
    apply IHN.
    apply multeq_meq.
    intro x'.
    case (eqA_dec x' a).
    intro xa; rewrite !mult_remove_in; trivial.
    rewrite (meq_multeq MM'); trivial.
    intro xna; rewrite !mult_remove_not_in; trivial.
    apply meq_multeq; trivial.
  Qed.

  Lemma diff_perm_single : forall x a b M N,
    x / (M - (a::b::N)) = x / (M - (b::a::N)).

  Proof.
    intros x a b M N.
    simpl; apply diff_mult_comp.
    apply multeq_meq.
    intro x'; apply remove_perm_single.
  Qed.

  Lemma diff_perm : forall M N a x,
    x / ((rem a M) - N) = x / (rem a (M - N)).

  Proof.
    intros M N; gen M; clear M.
    induction N.
    auto.
    intros M b x.
    change (rem b M - (a::N)) with (M - (b::a::N)).
    rewrite diff_perm_single.
    simpl; apply IHN.
  Qed.

  Lemma diff_mult_step_eq : forall M N a x,
    x =A= a -> x / (rem a M - N) = ((x / (M - N))%msets - 1)%nat.

  Proof.
    intros M N a x x_a.
    rewrite diff_perm.
    rewrite mult_remove_in; trivial.
  Qed.

  Lemma diff_mult_step_neq : forall M N a x,
    ~ x =A= a -> x / (rem a M - N) = x / (M - N).

  Proof.
    intros M N a x x_a.
    rewrite diff_perm.
    rewrite mult_remove_not_in; trivial.
  Qed.

  Lemma diff_mult : forall M N x,
                      x / (M - N) = ((x / M)%msets - (x / N)%msets)%nat.

  Proof.
    induction N.
     (* induction base *)
    simpl; intros; omega.
     (* induction step *)
    intro x; simpl.
    destruct (eqA_dec x a); simpl.
     (* x = a *)
    fold rem.
    rewrite (diff_mult_step_eq M N e).
    rewrite (IHN x).
    omega.
     (* x <> a *)
    fold rem.
    rewrite (diff_mult_step_neq M N n).
    exact (IHN x).
  Qed.

  Definition intersection_mult := inter_as_diff_ok mult diff diff_mult.

  Lemma singleton_mult_in : forall x y, x =A= y -> x / {{y}} = 1.

  Proof.
    intros; compute.
    case (eqA_dec x y); [trivial | contr].
  Qed.

  Lemma singleton_mult_notin : forall x y, ~x =A= y -> x / {{y}} = 0.

  Proof.
    intros; compute.
    case (eqA_dec x y); [contr | trivial].
  Qed.

  Lemma rev_list_ind_type : forall P : Multiset -> Type,
    P nil -> (forall a l, P (rev l) -> P (rev (a :: l))) -> forall l, P (rev l).

  Proof.
    induction l; auto.
  Defined.

  Lemma rev_ind_type : forall P : Multiset -> Type,
    P nil -> (forall x l, P l -> P (l ++ x :: nil)) -> forall l, P l.

  Proof.
    intros.
    gen (rev_involutive l).
    intros E; rewrite <- E.
    apply (rev_list_ind_type P).
    auto.
    simpl in |- *.
    intros.
    apply (X0 a (rev l0)).
    auto.
  Defined.

  Lemma mset_ind_type : forall P : Multiset -> Type,
    P empty -> (forall M a, P M -> P (union M {{a}})) -> forall M, P M.

  Proof.
    induction M as [| x M] using rev_ind_type.
    exact X.
    exact (X0 M x IHM).
  Defined.

End SpecConformation.

  Hint Unfold meq
	      empty
              singleton
              mult
              union
              diff : multisets.

  Hint Resolve mult_eqA_compat
               meq_multeq
               multeq_meq
               empty_mult
               union_mult
               diff_mult
               intersection_mult
               singleton_mult_in
               singleton_mult_notin : multisets.

  Hint Rewrite empty_mult
               union_mult
	       diff_mult
	       intersection_mult using trivial : multisets.

End MultisetList.


Require Import CommonDefinitions.

Require Import Raft.

Section StateMachineSafety.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Definition state_machine_safety_host net :=
    forall h h' e e',
      commit_recorded net h e ->
      commit_recorded net h' e' ->
      eIndex e = eIndex e' ->
      e = e'.

  Definition state_machine_safety_nw net :=
    forall h p t leaderId prevLogIndex prevLogTerm entries leaderCommit e,
      In p (nwPackets net) ->
      pBody p = AppendEntries t leaderId prevLogIndex prevLogTerm
                              entries leaderCommit ->
      t >= currentTerm (nwState net h) ->
      commit_recorded net h e ->
      (prevLogIndex > eIndex e \/
       (prevLogIndex = eIndex e /\ prevLogTerm = eTerm e) \/
       eIndex e > maxIndex entries \/
       In e entries).

  Definition state_machine_safety net :=
    state_machine_safety_host net /\ state_machine_safety_nw net.

  Class state_machine_safety_interface : Prop :=
    {
      state_machine_safety_invariant :
        forall net,
          raft_intermediate_reachable net ->
          state_machine_safety net
    }.

End StateMachineSafety.


Require Import VerifiedVerifier.Machine.
Require Import VerifiedVerifier.Maps.
Require Import Coq.Init.Nat.
Require Import Coq.Lists.List.
Require Import Coq.Lists.ListSet.
Require Import VerifiedVerifier.BinaryLattice.
Require Import VerifiedVerifier.AbstractAnalysis.
Require Import VerifiedVerifier.Semantics.
Require Import VerifiedVerifier.Coqlib.
Require Import Lia.

Definition is_heap_base_data (s : state) (i : data_ty) : BinarySet :=
if (Nat.eqb i s.(heap_base)) then bottom else top.

Definition is_heap_bounded_data (s : state) (i : data_ty) : BinarySet :=
if (ltb i (above_heap_guard_size s)) then bottom else top.

Definition is_cf_bounded_data (s : state) (i : data_ty) : BinarySet :=
if (ltb i (List.length (program s).(Funs))) then bottom else top.

Definition is_globals_base_data (s : state) (i : data_ty) : BinarySet :=
if (Nat.eqb i s.(globals_base)) then bottom else top.

Definition is_above_stack_bounded_data (s : state) (i : data_ty) : BinarySet :=
if (Nat.eqb i (above_stack_guard_size s)) then bottom else top.

Definition is_below_stack_bounded_data (s : state) (i : data_ty) : BinarySet :=
if (Nat.eqb i (below_stack_guard_size s)) then bottom else top.

Definition abstractify_data (s : state) (i : data_ty) : info :=
{| is_heap_base := is_heap_base_data s i;
   heap_bounded := is_heap_bounded_data s i;
   cf_bounded := is_cf_bounded_data s i;
   is_globals_base := is_globals_base_data s i;
   above_stack_bounded := is_above_stack_bounded_data s i;
   below_stack_bounded := is_below_stack_bounded_data s i;
|}.

Definition abstractify_list (s : state) (l : list data_ty) : list info :=
  map (abstractify_data s) l.

Definition abstractify_registers (s : state) (f : registers_ty) : abs_registers_ty :=
  fun r => (abstractify_data s (f r)).

Definition abstractify (s : state) : abs_state :=
{| abs_regs := abstractify_registers s s.(regs);
   abs_stack := abstractify_list s s.(stack);
   abs_lifted_state := sub_state;
   abs_heap_base := (heap_base s);
   abs_below_stack_guard_size := (below_stack_guard_size s);
   abs_above_stack_guard_size := (above_stack_guard_size s);
   abs_above_heap_guard_size := (above_heap_guard_size s);
   abs_globals_size := (globals_size s);
   abs_globals_base := (globals_base s);
   abs_program := Some s.(program);
   abs_frame_size := s.(frame_size);
   abs_call_stack := s.(call_stack);
   abs_rsp := get_register s rsp;
   abs_stack_base := s.(stack_base);
   abs_stack_size := s.(stack_size);
   abs_max_stack_size := s.(max_stack_size);
|}.

Lemma BinarySet_eqb_eq: forall a b,
  BinarySet_eqb a b = true <-> a = b.
Proof.
  intros. split.
  - intros. unfold BinarySet_eqb in H. destruct (BinarySet_eq_dec a b) eqn:H'; auto; inversion H.
  - intros. unfold BinarySet_eqb. inversion H. destruct (BinarySet_eq_dec b b); auto; inversion H.
Qed.

Lemma leq_abs_state_is_heap_base: forall abs_st abs_st' r,
  leq_abs_state abs_st' abs_st ->
  is_heap_base (get_register_info abs_st r) = bottom ->
  is_heap_base (get_register_info abs_st' r) = bottom.
Proof.
  intros abs_st abs_st' r Hleq H. inversion Hleq. auto. subst. inversion H. subst.
  specialize H6 with r. inversion H6. rewrite H20. auto.
  subst. inversion H18. auto. rewrite H in H18. inversion H18. auto.
Qed.

Lemma leq_abs_state_is_globals_base: forall abs_st abs_st' r,
  leq_abs_state abs_st' abs_st ->
  is_globals_base (get_register_info abs_st r) = bottom ->
  is_globals_base (get_register_info abs_st' r) = bottom.
Proof.
  intros abs_st abs_st' r Hleq H. inversion Hleq. auto. subst. inversion H. subst.
  specialize H6 with r. inversion H6. rewrite H20. auto.
  subst. inversion H21. auto. rewrite H in H21. inversion H21. auto.
Qed.

Lemma leq_abs_state_heap_bounded: forall abs_st abs_st' r,
  leq_abs_state abs_st' abs_st ->
  heap_bounded (get_register_info abs_st r) = bottom ->
  heap_bounded (get_register_info abs_st' r) = bottom.
Proof.
  intros abs_st abs_st' r Hleq H. inversion Hleq. auto. subst. inversion H. subst.
  specialize H6 with r. inversion H6. rewrite H20. auto.
  subst. inversion H19. auto. rewrite H in H19. inversion H19. auto.
Qed.

Lemma leq_abs_state_cf_bounded: forall abs_st abs_st' r,
  leq_abs_state abs_st' abs_st ->
  cf_bounded (get_register_info abs_st r) = bottom ->
  cf_bounded (get_register_info abs_st' r) = bottom.
Proof.
  intros abs_st abs_st' r Hleq H. inversion Hleq. auto. subst. inversion H. subst.
  specialize H6 with r. inversion H6. rewrite H20. auto.
  subst. inversion H20. auto. rewrite H in H20. inversion H20. auto.
Qed.

Lemma if_thn_true: forall (cond : bool),
  (if cond then bottom else top) = bottom ->
  cond = true.
Proof.
  intros. destruct cond; auto; inversion H.
Qed.

Definition first_block f :=
match (V f) with
| nil => nil
| h :: t => h
end.

Definition run_function p f :=
(first_block f, start_state p).

Lemma leq_abs_state_verifies : forall i abs_st abs_st',
  leq_abs_state abs_st' abs_st ->
  instr_class_verifier i abs_st = true ->
  instr_class_verifier i abs_st' = true.
Proof.
  intros i abs_st abs_st' Hleq Hv. inversion Hleq. auto. rewrite <- H0 in Hv. inversion Hv.
  destruct i eqn:Hi; unfold instr_class_verifier in *; rewrite H0 in Hv; rewrite H; eauto.
  - apply andb_prop in Hv as [Hbase Hv].
    apply andb_prop in Hv as [Hindex Hoffset]. apply BinarySet_eqb_eq in Hbase. apply BinarySet_eqb_eq in Hindex.
    apply BinarySet_eqb_eq in Hoffset. repeat (apply andb_true_intro; split; try (apply BinarySet_eqb_eq)).
    + eapply leq_abs_state_is_heap_base. apply Hleq. auto.
    + eapply leq_abs_state_heap_bounded. apply Hleq. auto.
    + eapply leq_abs_state_heap_bounded. apply Hleq. auto.
  - apply andb_prop in Hv as [Hbase Hv].
    apply andb_prop in Hv as [Hindex Hoffset]. apply BinarySet_eqb_eq in Hbase. apply BinarySet_eqb_eq in Hindex.
    apply BinarySet_eqb_eq in Hoffset. repeat (apply andb_true_intro; split; try (apply BinarySet_eqb_eq)).
    + eapply leq_abs_state_is_heap_base. apply Hleq. auto.
    + eapply leq_abs_state_heap_bounded. apply Hleq. auto.
    + eapply leq_abs_state_heap_bounded. apply Hleq. auto.
  - apply andb_prop in Hv. destruct Hv as [Hv1 Hv3]. apply PeanoNat.Nat.ltb_lt in Hv3.
    apply andb_prop in Hv1. destruct Hv1 as [Hv1 Hv2].
    apply PeanoNat.Nat.ltb_lt in Hv1. apply PeanoNat.Nat.ltb_lt in Hv2.
    repeat (apply andb_true_intro; split; try (apply BinarySet_eqb_eq)); apply PeanoNat.Nat.ltb_lt.
    + rewrite H2. rewrite H7. assumption.
    + rewrite H12. rewrite H11. assumption.
    + rewrite H11. rewrite H12. rewrite H13. assumption.
  - apply andb_prop in Hv. destruct Hv as [Hv1 Hv3]. apply PeanoNat.Nat.ltb_lt in Hv3.
    apply andb_prop in Hv1. destruct Hv1 as [Hv1 Hv2].
    apply PeanoNat.Nat.ltb_lt in Hv1. apply PeanoNat.Nat.ltb_lt in Hv2.
    repeat (apply andb_true_intro; split; try (apply BinarySet_eqb_eq)); apply PeanoNat.Nat.ltb_lt.
    + rewrite H7. assumption.
    + rewrite H12. rewrite H11. assumption.
    + rewrite H11. rewrite H12. rewrite H14. assumption.
  - apply andb_prop in Hv. destruct Hv as [Hv1 Hv2].
    apply BinarySet_eqb_eq in Hv1. apply BinarySet_eqb_eq in Hv2.
    repeat (apply andb_true_intro; split; try (apply BinarySet_eqb_eq)).
    + specialize H5 with r. inversion H5.
      * rewrite H21. assumption.
      * inversion H21; auto.
        rewrite Hv1 in H27. discriminate.
    + specialize H5 with rdi. inversion H5.
      * rewrite H21. assumption.
      * inversion H19; auto.
        rewrite Hv2 in H27. discriminate.
  - apply andb_prop in Hv. destruct Hv as [Hv1 Hv2]. apply BinarySet_eqb_eq in Hv2.
    repeat (apply andb_true_intro; split; try (apply BinarySet_eqb_eq)).
    + unfold AbstractAnalysis.get_function in *. rewrite H8. assumption.
    + specialize H5 with rdi. inversion H5.
      * rewrite H21. assumption.
      * inversion H19; auto.
        rewrite Hv2 in H27. discriminate.
  - apply andb_prop in Hv. destruct Hv as [Hv1 Hv2].
    repeat (apply andb_true_intro; split).
    + unfold get_bb. unfold AbstractAnalysis.get_function.
      unfold get_bb in Hv1. unfold AbstractAnalysis.get_function in Hv1.
      rewrite H8. rewrite H10. assumption.
    + unfold get_bb. unfold AbstractAnalysis.get_function.
      unfold get_bb in Hv2. unfold AbstractAnalysis.get_function in Hv2.
      rewrite H8. rewrite H10. assumption.
  - unfold get_bb in *. unfold AbstractAnalysis.get_function in *.
    rewrite H8. rewrite H10. assumption.
  - apply BinarySet_eqb_eq. apply BinarySet_eqb_eq in Hv.
    eapply leq_abs_state_is_heap_base. eapply Hleq. auto.
  - apply andb_prop in Hv. destruct Hv as [Hv1 Hv2]. apply BinarySet_eqb_eq in Hv1.
    apply PeanoNat.Nat.ltb_lt in Hv2. apply andb_true_intro; split.
    + apply BinarySet_eqb_eq. pose proof leq_abs_state_is_globals_base as Hglobal.
      specialize Hglobal with abs_st abs_st' r.
      apply Hglobal; auto.
    + apply PeanoNat.Nat.ltb_lt. rewrite H15. auto.
  - apply andb_prop in Hv. destruct Hv as [Hv1 Hv2]. apply BinarySet_eqb_eq in Hv1.
    apply PeanoNat.Nat.ltb_lt in Hv2. apply andb_true_intro; split.
    + apply BinarySet_eqb_eq. pose proof leq_abs_state_is_globals_base as Hglobal.
      specialize Hglobal with abs_st abs_st' r.
      apply Hglobal; auto.
    + apply PeanoNat.Nat.ltb_lt. rewrite H15. auto.
Qed.

Lemma unfold_binaryset_eqb: forall b1 b2 b3 b4,
  (BinarySet_eqb b1 b2 && BinarySet_eqb b3 b4)%bool = true ->
  b1 = b2 /\ b3 = b4.
Proof.
  intros. apply andb_prop in H as [H1 H2].
  apply BinarySet_eqb_eq in H1. apply BinarySet_eqb_eq in H2. auto.
Qed.

Lemma unfold_binaryset_eqb_3: forall b1 b2 b3 b4 b5 b6,
  (BinarySet_eqb b1 b2 && BinarySet_eqb b3 b4 && BinarySet_eqb b5 b6)%bool = true ->
  b1 = b2 /\ b3 = b4 /\ b5 = b6.
Proof.
  intros. apply andb_prop in H as [H1 H2]. apply unfold_binaryset_eqb in H1 as [H1 H1'].
  apply BinarySet_eqb_eq in H2. auto.
Qed.

Theorem get_function_concrete_abstract :
  forall s n f,
    Semantics.get_function s n = Some f ->
    AbstractAnalysis.get_function (abstractify s) n = Some f.
Proof.
  intros. unfold AbstractAnalysis.get_function. unfold get_function in H.
  unfold abstractify. unfold abs_program. apply H.
Qed.

Theorem get_function_abstract_concrete :
  forall s n f,
    AbstractAnalysis.get_function (abstractify s) n = Some f ->
    Semantics.get_function s n = Some f.
Proof.
  intros. unfold AbstractAnalysis.get_function in H. unfold get_function.
  unfold abstractify in H. unfold abs_program in H. apply H.
Qed.

Theorem get_bb_abstract_concrete :
  forall s n bb,
    get_bb (abstractify s) n = Some bb ->
    get_basic_block s n = Some bb.
Proof.
  intros. unfold get_basic_block. unfold get_bb in H. unfold abstractify in H.
  unfold abs_call_stack in H. unfold AbstractAnalysis.get_function in H.
  unfold abs_program in H. unfold get_function. apply H.
Qed.

Lemma verified_impl_istep : forall i is st,
  instr_class_verifier i.(instr) (abstractify st) = true ->
  exists is' st', (i :: is) / st i--> is' / st'.
Proof.
  intros. destruct i eqn:Hibase; destruct instr eqn:Hi; unfold instr_class_verifier in H; simpl in H.
  - apply andb_prop in H as [Hbase Hv]. apply andb_prop in Hv as [Hindex Hoffset].
    apply BinarySet_eqb_eq in Hbase. apply BinarySet_eqb_eq in Hindex.
    apply BinarySet_eqb_eq in Hoffset.
    remember ((get_register st r2) + (get_register st r1) + (get_register st r0)) as index.
    remember (ltb index ((heap_base st) + (max_heap_size st))) as valid_index.
    destruct valid_index.
    + apply eq_sym, PeanoNat.Nat.ltb_lt in Heqvalid_index. repeat eexists. eapply I_Heap_Read.
      apply Heqindex. unfold is_heap_base, get_register_info, abstractify in *. simpl in *.
      unfold is_heap_base_data, is_heap_bounded_data in *.
      apply if_thn_true, EqNat.beq_nat_true in Hbase. Search (_ <? _).
      apply if_thn_true, PeanoNat.Nat.ltb_lt in Hindex. apply if_thn_true, PeanoNat.Nat.ltb_lt in Hoffset.
      unfold get_register in *. lia. auto.
    + Search (_ <? _). apply eq_sym, PeanoNat.Nat.ltb_nlt in Heqvalid_index. repeat eexists. eapply I_Heap_Read_Guard.
      apply Heqindex. lia. unfold is_heap_base, get_register_info, abstractify in *. simpl in *.
      unfold is_heap_base_data, is_heap_bounded_data in *.
      apply if_thn_true, EqNat.beq_nat_true in Hbase. Search (_ <? _).
      apply if_thn_true, PeanoNat.Nat.ltb_lt in Hindex. apply if_thn_true, PeanoNat.Nat.ltb_lt in Hoffset.
      unfold get_register in *. pose proof (heap_size_eq_guard st) as H. lia.
  - apply andb_prop in H as [Hbase Hv]. apply andb_prop in Hv as [Hindex Hoffset].
    apply BinarySet_eqb_eq in Hbase. apply BinarySet_eqb_eq in Hindex.
    apply BinarySet_eqb_eq in Hoffset.
    remember ((get_register st r) + (get_register st r0) + (get_register st r1)) as index.
    remember (ltb index ((heap_base st) + (max_heap_size st))) as valid_index.
    destruct valid_index.
    + apply eq_sym, PeanoNat.Nat.ltb_lt in Heqvalid_index. repeat eexists. eapply I_Heap_Write.
      auto. unfold is_heap_base, get_register_info, abstractify in *. simpl in *.
      unfold is_heap_base_data, is_heap_bounded_data in *.
      apply if_thn_true, EqNat.beq_nat_true in Hbase. Search (_ <? _).
      apply if_thn_true, PeanoNat.Nat.ltb_lt in Hindex. apply if_thn_true, PeanoNat.Nat.ltb_lt in Hoffset.
      unfold get_register in *. lia. lia.
    + Search (_ <? _). apply eq_sym, PeanoNat.Nat.ltb_nlt in Heqvalid_index. repeat eexists. eapply I_Heap_Write_Guard.
      auto. lia. unfold is_heap_base, get_register_info, abstractify in *. simpl in *.
      unfold is_heap_base_data, is_heap_bounded_data in *.
      apply if_thn_true, EqNat.beq_nat_true in Hbase. Search (_ <? _).
      apply if_thn_true, PeanoNat.Nat.ltb_lt in Hindex. apply if_thn_true, PeanoNat.Nat.ltb_lt in Hoffset.
      unfold get_register in *. pose proof (heap_size_eq_guard st) as H. lia.
  - repeat eexists. apply I_Heap_Check.
  - destruct (get_register st r <? List.length (program st).(Funs)) eqn:valid_function.
    + repeat eexists. eapply I_Call_Check. apply PeanoNat.Nat.ltb_lt. auto.
    + repeat eexists. eapply I_Call_Check_Bad. apply PeanoNat.Nat.ltb_nlt in valid_function. apply Compare_dec.not_lt. auto.
  - repeat eexists. apply I_Reg_Move.
  - repeat eexists. apply I_Reg_Write.
  - repeat eexists. apply I_Stack_Expand_Static.
  - destruct (n + (stack_size st) <=? (max_stack_size st)) eqn:valid_expansion.
    + repeat eexists. eapply I_Stack_Expand_Dynamic. Search (_ <=? _). apply Compare_dec.leb_complete. auto.
    + repeat eexists. eapply I_Stack_Expand_Dynamic_Guard. apply Compare_dec.leb_complete_conv. auto.
  - repeat eexists. apply I_Stack_Contract.
  - repeat eexists. apply andb_prop in H. destruct H. apply andb_prop in H. destruct H.
    apply PeanoNat.Nat.ltb_lt in H. apply PeanoNat.Nat.ltb_lt in H1. apply PeanoNat.Nat.ltb_lt in H0.
    apply I_Stack_Read; auto.
  - repeat eexists. apply andb_prop in H. destruct H. apply andb_prop in H. destruct H.
    apply PeanoNat.Nat.ltb_lt in H. apply PeanoNat.Nat.ltb_lt in H1. apply PeanoNat.Nat.ltb_lt in H0.
    apply I_Stack_Write; auto.
  - repeat eexists. apply I_Op.
  - apply andb_prop in H as [Hcf Hheap]. apply BinarySet_eqb_eq in Hcf. apply BinarySet_eqb_eq in Hheap.
    unfold is_cf_bounded_data in Hcf. unfold is_heap_base_data in Hheap.
    apply if_thn_true in Hcf. apply if_thn_true in Hheap. apply PeanoNat.Nat.ltb_lt in Hcf.
    pose proof Coqlib.nth_error_lt as Hnth.
    specialize Hnth with ControlFlowGraph (get_register st r) (Funs (program st)).
    unfold get_register in Hnth. apply Hnth in Hcf. destruct Hcf.
    repeat eexists. apply I_Indirect_Call. unfold get_function. apply H.
  - apply andb_prop in H. destruct H.
    destruct (AbstractAnalysis.get_function (abstractify st) n) eqn: Hget.
    pose proof get_function_abstract_concrete as Habs.
    specialize Habs with st n f. apply Habs in Hget.
    repeat eexists. apply I_Direct_Call. apply Hget. inversion H.
  - case (run_conditional st c) eqn:Hcond.
    + apply andb_prop in H. destruct H. destruct (get_bb (abstractify st) l) eqn:Hget1; try inversion H.
      destruct (get_bb (abstractify st) l0) eqn:Hget2; try inversion H0.
      pose proof I_Branch_True. specialize H1 with st is c l l0 b b0 addr.
      repeat eexists. apply H1; auto.
    + apply andb_prop in H. destruct H. destruct (get_bb (abstractify st) l) eqn:Hget1; try inversion H.
      destruct (get_bb (abstractify st) l0) eqn:Hget2; try inversion H0.
      pose proof I_Branch_False. specialize H1 with st is c l l0 b b0 addr.
      repeat eexists. apply H1; auto.
  - destruct (get_bb (abstractify st) l) eqn: Hget; try inversion H.
    pose proof get_bb_abstract_concrete as Habs.
    specialize Habs with st l b. apply Habs in Hget.
    repeat eexists. apply I_Jmp. apply Hget.
  - apply BinarySet_eqb_eq in H. repeat eexists. eapply I_Get_Globals_Base.
    unfold is_heap_base_data in H. destruct (regs st r =? heap_base st) eqn:Hbase.
    + apply EqNat.beq_nat_true in Hbase. auto.
    + discriminate.
  - apply andb_prop in H as [Hbase Hindex]. apply BinarySet_eqb_eq in Hbase.
    apply PeanoNat.Nat.ltb_lt in Hindex. repeat eexists. eapply I_Globals_Read.
    unfold is_globals_base_data in Hbase. destruct (regs st r =? globals_base st) eqn:Hglobal.
    + apply EqNat.beq_nat_true in Hglobal. auto.
    + discriminate.
    + auto.
  - apply andb_prop in H as [Hbase Hindex]. apply BinarySet_eqb_eq in Hbase.
    apply PeanoNat.Nat.ltb_lt in Hindex. repeat eexists. eapply I_Globals_Write.
    unfold is_globals_base_data in Hbase. destruct (regs st r =? globals_base st) eqn:Hglobal.
    + apply EqNat.beq_nat_true in Hglobal. auto.
    + discriminate.
    + auto.
  - repeat eexists. apply I_Ret. apply EqNat.beq_nat_true in H. assumption.
Qed.

Lemma verified_program_impl_verified_function : forall p f,
  program_verifier p (abstractify (start_state p)) = true ->
  In f p.(Funs) ->
  function_verifier f (abstractify (start_state p)) = true.
Proof.
  intros. unfold program_verifier in H. rewrite forallb_forall in H.
  specialize H with f. apply H. apply H0.
Qed.

(* NOTE: This is, in general, a true statement about abstract analyses. It is
   admitted here because we assume the abstract analysis is implemented
   correctly and instead focus on proving facts about whether or not we have
   enough information to guarantee sfi properties. *)
(* TODO: update this to use the verifier fixpoint when we update the verifier
   to associate fixpoints with functions. *)
Theorem verifier_fixpoint_relation :
forall i,
  exists fixpoint,
  forall p f is st fuel,
    program_verifier p (abstractify (start_state p)) = true ->
    In f p.(Funs) ->
    imultistep_fuel ((run_function p f), fuel) (i :: is, st, 0) ->
    (leq_abs_state (abstractify st) fixpoint /\
     instr_class_verifier i.(instr) fixpoint = true).
Admitted.

Theorem verified_program_step :
  forall p f fuel is1 st1,
    program_verifier p (abstractify (start_state p)) = true ->
    In f p.(Funs) ->
    imultistep_fuel ((run_function p f), fuel) (is1, st1, 0) ->
    exists is' st',
      imultistep_fuel ((run_function p f), S fuel) (is', st', 0).
Proof.
  intros.
  unfold run_function. unfold run_function in H1.
  pose proof imultistep_finish' as Hfinish.
  destruct (first_block f) eqn:Hfirst.
  - repeat eexists. constructor. apply IFuel_End.
  - destruct is1 eqn:Hstream.
    + exists nil. exists st1.
      eapply imultistep_finish'. apply H1.
      constructor. apply IFuel_End.
    + pose proof verified_impl_istep as Hstep.
      specialize Hstep with i0 l0 st1.
      pose proof verifier_fixpoint_relation as Hfixpoint.
      specialize Hfixpoint with i0. destruct Hfixpoint as [fixpoint Hfixpoint].
      pose proof leq_abs_state_verifies as Hleq.
      specialize Hleq with i0.(instr) fixpoint (abstractify st1).
      specialize Hfixpoint with p f l0 st1 fuel.
      apply Hfixpoint in H as [].
      apply Hleq in H.
      apply Hstep in H. rewrite <- Hstream in H. destruct H as []. destruct H as [].
      eexists ?[is']. eexists ?[st'].
      specialize Hfinish with fuel (first_block f) (start_state p) is1 st1 ?is' ?st'.
      rewrite <- Hfirst. apply Hfinish. rewrite Hfirst. rewrite Hstream. apply H1.
      constructor. apply IFuel_Step.
      apply H.
      auto. auto. auto.
      unfold run_function. rewrite Hfirst. apply H1.
Qed.

Theorem verified_program :
  forall p f fuel,
    program_verifier p (abstractify (start_state p)) = true ->
    In f p.(Funs) ->
    exists is' st',
      imultistep_fuel ((run_function p f), fuel) (is', st', 0).
Proof.
  intros. induction fuel.
  - repeat eexists. constructor. apply IFuel_Base.
  - destruct IHfuel. destruct H1.
    eapply verified_program_step; auto.
    eapply H1.
Qed.


Require Import VST.floyd.proofauto.
Import ListNotations.
Local Open Scope logic.

Require Import hmacdrbg.HMAC_DRBG_algorithms.
Require Import hmacdrbg.spec_hmac_drbg.
Require Import sha.HMAC256_functional_prog.

Fixpoint HMAC_DRBG_update_round (HMAC: list byte -> list byte -> list byte) (provided_data K V: list byte) (round: nat): (list byte * list byte) :=
  match round with
    | O => (K, V)
    | S round' =>
      let (K, V) := HMAC_DRBG_update_round HMAC provided_data K V round' in
      let K := HMAC (V ++ [Byte.repr (Z.of_nat round')] ++ provided_data) K in
      let V := HMAC V K in
      (K, V)
  end.

Definition HMAC_DRBG_update_concrete (HMAC: list byte -> list byte -> list byte) (provided_data K V: list byte): (list byte * list byte) :=
  let rounds := match provided_data with
                  | [] => 1%nat
                  | _ => 2%nat
                end in
  HMAC_DRBG_update_round HMAC provided_data K V rounds.

Theorem HMAC_DRBG_update_concrete_correct:
  forall HMAC provided_data K V, HMAC_DRBG_update HMAC provided_data K V = HMAC_DRBG_update_concrete HMAC provided_data K V.
Proof.
  intros.
  destruct provided_data; reflexivity.
Qed.

Definition update_rounds (non_empty_additional: bool): Z :=
  if non_empty_additional then 2 else 1.

Lemma HMAC_DRBG_update_round_incremental:
  forall key V initial_state_abs contents n,
    (key, V) = HMAC_DRBG_update_round HMAC256 contents
                           (hmac256drbgabs_key initial_state_abs)
                           (hmac256drbgabs_value initial_state_abs) n ->
    (HMAC256 (V ++ Byte.repr (Z.of_nat n) :: contents) key,
     HMAC256 V (HMAC256 (V ++ Byte.repr (Z.of_nat n) :: contents) key)) =
    HMAC_DRBG_update_round HMAC256 contents
                           (hmac256drbgabs_key initial_state_abs)
                           (hmac256drbgabs_value initial_state_abs) (n + 1).
Proof.
  intros.
  rewrite Nat.add_comm.
  simpl.
  rewrite <- H.
  reflexivity.
Qed.

Lemma HMAC_DRBG_update_round_incremental_Z:
  forall key V initial_state_abs contents i,
    0 <= i ->
    (key, V) = HMAC_DRBG_update_round HMAC256 contents
                           (hmac256drbgabs_key initial_state_abs)
                           (hmac256drbgabs_value initial_state_abs) (Z.to_nat i) ->
    (HMAC256 (V ++ Byte.repr i :: contents) key,
     HMAC256 V (HMAC256 (V ++ Byte.repr i :: contents) key)) =
    HMAC_DRBG_update_round HMAC256 contents
                           (hmac256drbgabs_key initial_state_abs)
                           (hmac256drbgabs_value initial_state_abs) (Z.to_nat (i + 1)).
Proof.
  intros.
  specialize (HMAC_DRBG_update_round_incremental _ _ _ _ _ H0); intros. clear H0.
  rewrite (Z2Nat.id _ H) in H1.
  rewrite Z2Nat.inj_add; try assumption; lia.
Qed.

Lemma update_char add_len contents (HL:add_len = Zlength contents \/ add_len = 0)
       (key1 V0 : list byte) additional reseed_counter entropy_len prediction_resistance V key0
     reseed_interval
    (H : (key1, V0) =
    HMAC_DRBG_update_round HMAC256 (contents_with_add additional add_len contents) key0 V
      (Z.to_nat
         (if
           (negb (EqDec_val additional nullval) &&
            negb (EqDec_Z add_len 0))%bool
          then 2
          else 1))):
hmac256drbgabs_hmac_drbg_update
  (HMAC256DRBGabs key0 V reseed_counter entropy_len prediction_resistance
     reseed_interval) (contents_with_add additional add_len contents) =
HMAC256DRBGabs key1 V0 reseed_counter entropy_len prediction_resistance
  reseed_interval.
Proof. rename key0 into K. rename V0 into VV. rename key1 into KK.
unfold hmac256drbgabs_hmac_drbg_update, HMAC256_DRBG_functional_prog.HMAC256_DRBG_update.
rewrite HMAC_DRBG_update_concrete_correct. unfold HMAC_DRBG_update_concrete, contents_with_add in *; simpl in *.
destruct (EqDec_val additional nullval); simpl in *.
+ inv H; trivial.
+ destruct (EqDec_Z add_len 0).
  -  subst add_len. change (negb (left eq_refl)) with false in *.
     simpl in H. inv H; trivial.
  - change (negb (right n0)) with true in *. simpl.
    destruct HL; try lia; subst add_len.
    destruct contents. rewrite Zlength_nil in n0; lia.
    change  (Z.to_nat 2) with 2%nat in H.
    rewrite <- H; trivial.
Qed.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.

Local Open Scope Z_scope.

Section Spec.

  Definition reset_last_run_info_spec (rec: Pointer) (adt: RData) : option RData :=
    rely (peq (base rec) buffer_loc);
    when gidx == (buffer (priv adt)) @ (offset rec);
    let gn := (gs (share adt)) @ gidx in
    rely (ref_accessible gn CPU_ID);
    rely (g_tag (ginfo gn) =? GRANULE_STATE_REC);
    let g' := gn {grec: (grec gn) {g_esr: 0}} in
    Some adt {share: (share adt) {gs: (gs (share adt)) # gidx == g'}}.

End Spec.


Require compcert.cfrontend.ClightBigstep.
Require EventsX.

Import Coqlib.
Import AST.
Import Globalenvs.
Import EventsX.
Import Ctypes.
Import Clight.
Export ClightBigstep.

Require Import ClightX.

Section WITHCONFIG.
Context `{external_calls_prf: ExternalCalls}.

Inductive bigstep_function_terminates' function_entry p i sg vargs (m: mem) t : Values.val * mem -> Prop :=
  | bigstep_function_terminates_intro b f targs tres cc vres m':
      let ge := Clight.globalenv p in
      Genv.find_symbol ge i = Some b ->
      Genv.find_funct_ptr ge b = Some f ->
      type_of_fundef f = Tfunction targs tres cc ->
      sg = signature_of_type targs tres cc ->
      eval_funcall ge function_entry m f vargs t m' vres ->
      bigstep_function_terminates' function_entry p i sg vargs m t (vres,  m').

Definition bigstep_function_terminates2 := bigstep_function_terminates' function_entry2.

Inductive bigstep_function_diverges' function_entry (p: program) i sg vargs m: traceinf -> Prop :=
  | bigstep_function_diverges_intro: forall b f targs tres cc t,
      let ge := globalenv p in
      Genv.find_symbol ge i = Some b ->
      Genv.find_funct_ptr ge b = Some f ->
      type_of_fundef f = Tfunction targs tres cc ->
      sg = signature_of_type targs tres cc ->
      evalinf_funcall ge function_entry m f vargs t ->
      bigstep_function_diverges' function_entry p i sg vargs m t.

Definition bigstep_function_diverges2 := bigstep_function_diverges' function_entry2.

Definition bigstep_function_semantics2 (p: program) i sg vargs m :=
  Smallstep.Bigstep_semantics
    (bigstep_function_terminates2 p i sg vargs m)
    (bigstep_function_diverges2 p i sg vargs m).

Theorem bigstep_function_semantics_sound prog i (sg: AST.signature) (vargs: list Values.val) m:
  Smallstep.bigstep_sound
    (bigstep_function_semantics2 prog i sg vargs m)
    (ClightX.semantics prog i m sg vargs).
Proof.
  constructor; simpl; intros.
(* termination *)
  inv H. econstructor; econstructor.
  split. econstructor; eauto.
  split. eapply eval_funcall_steps. eauto. red; auto.
  econstructor.
(* divergence *)
  inv H. econstructor.
  split. econstructor; eauto.
  eapply Smallstep.forever_N_forever with (order := order).
  red; intros. constructor; intros. red in H. elim H.
  eapply evalinf_funcall_forever; eauto.
Qed.

End WITHCONFIG.


(************************************************************************)
(* 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.


From mathcomp.ssreflect Require Import all_ssreflect seq.
Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

From Coq Require Extraction.

Extract Inductive nat => int [ "0" "succ" ] "(fun fO fS n -> if n=0 then fO () else fS (n-1))".
Extract Inlined Constant predn => "(fun n -> n-1) ".
Extract Inlined Constant leq => "( <= )".
Extract Inlined Constant maxn => "max".
Extraction Inline leq.
Extraction Inline predn.
Extraction Inline maxn.

Extract Inductive bool => bool [ "true" "false" ].
Extract Inductive seq => list [ "[]" "( :: )" ].
Extract Inductive option => option [ "Some" "None" ].

Extract Inductive sigT => "( * )" [ "(, )" ].
Extract Constant projT1 => "fst".
Extract Constant projT2 => "snd".
Extraction Inline projT1.
Extraction Inline projT2.

Extract Inductive reflect => bool [ "true" "false" ].
Extraction Inline pred.
Extraction Inline rel.
Extraction Inline Equality.axiom.

Set Extraction Flag 2047.

(** Extract CSeq
 *)
Require fcoind.cseq.

Extraction Implicit cseq.Cns [ n ].
Extraction Implicit cseq.vseq_to_seq' [ n ].
Extraction Implicit cseq.vseq_to_seq [ n ].
Extraction Implicit cseq.v_foldl' [ n ].
Extraction Implicit cseq.v_foldl [ n ].

Extraction Inline cseq.vseq_to_seq'.
Extraction Inline cseq.v_foldl'.
Extraction Inline cseq.v_foldl.
Extraction Inline cseq.t_foldl.

Extraction Implicit cseq.Fseq [ n ].
Extract Inductive cseq.fseq => vseq [ "" ].
Extract Inlined Constant cseq.getVseq => "".
Extraction Inline cseq.getVseq.
Extraction Inline cseq.getVsize.
Extraction Inline cseq.vseq_to_seq.
Extraction Inline cseq.seq_to_vseq.

(* Unset Extraction SafeImplicits. *)
Extraction "extraction/cseq"
           cseq.fseq_to_seq
           cseq.seq_to_fseq
           cseq.f_nil
           cseq.f_cons
           cseq.f_head
           cseq.f_tail
           cseq.t_foldl
           cseq.t_reverse
           cseq.t_filter.

(** Extract Tree *)
(*  *)

Require fcoind.stree.
Extraction Implicit stree.CN [ l r ].
Extraction Implicit stree.vtree_to_tree' [ n ].
Extraction Implicit stree.vtree_to_tree  [ n ].

Extraction Inline stree.vtree_to_tree'.

Extraction "extraction/stree"
           fcoind.stree.shape
           fcoind.stree.tree
           fcoind.stree.vtree
           fcoind.stree.vtree_to_tree
           fcoind.stree.tshape
           fcoind.stree.tree_to_vtree
           fcoind.stree.ftree
           fcoind.stree.f_leaf
           fcoind.stree.f_node
           fcoind.stree.ftree_to_tree
           fcoind.stree.tree_to_ftree.

(** Extract Tree *)
(*  *)

Require fcoind.ctree.
Extraction Implicit ctree.CN [ l r ].
Extraction Implicit ctree.vtree_to_tree' [ n ].
Extraction Implicit ctree.vtree_to_tree  [ n ].

Extraction Inline ctree.vtree_to_tree'.

Extraction "extraction/ctree"
           fcoind.ctree.tree
           fcoind.ctree.vtree
           fcoind.ctree.vtree_to_tree
           fcoind.ctree.tree_to_vtree
           fcoind.ctree.ftree
           fcoind.ctree.f_leaf
           fcoind.ctree.f_node
           fcoind.ctree.ftree_to_tree
           fcoind.ctree.tree_to_ftree.


Require Import ZArith.
Require Import Coq.Strings.String.
Require Import List. Import ListNotations.

Set Warnings "-extraction-reserved-identifier".

From QuickChick Require Import QuickChick.

Require Import IFC.Rules.
Require Import IFC.TestingCommon.
Require Import IFC.Generation.
Require Import IFC.Shrinking.
Require Import IFC.SSNI.
Require Import IFC.Reachability.
Require Import IFC.SingleStateArb.

Require Import IFC.SanityChecks.

Require Import Mutate.

Definition testMutantX_ p n : Checker :=
  p (nth n (mutate_table default_table) default_table).

Definition rSSNI_smart := propSSNI_smart exp_result_random.
Definition fSSNI_smart := propSSNI_smart exp_result_fuzz.
Definition rSSNI_naive := propSSNI_arb   exp_result_random.
Definition fSSNI_naive := propSSNI_arb   exp_result_fuzz.

Definition nth_table n := nth n (mutate_table default_table) default_table.

Definition es := "".

ManualExtract [BinOpT; Label; Instr; Pointer; Value; Atom; Ptr_atom; StackFrame; Stack; memframe; State; Variation].


(* remove_values might reactivate a shadowed key *)
Definition remove_values(M: map K V)(vs: set V): map K V :=
  filter (fun '(ki, vi) => if in_dec veq vi vs then false else true) M.


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.