(** This file is syntax of Applicative Intersection Types, which is a extension of "Disjoint Intersection Types"

What makes this calculus different from classical simply typed lambda calculus

- It has intersection types
- It has merge operator (create inhabitants of intersection types)
- It has subtyping (BCD-style: allow distribuivity upon function types and intersection types)
- It's type safe: we will prove determinism, preservation and progress
- Enhanced subtyping algorithms can solve overloading problems

 *)

Require Import Metalib.Metatheory.
Require Import Coq.Program.Equality.
Require Import Coq.Strings.String.
Require Import Tactical.

Import ListNotations.

Set Printing Parentheses.

(** * Types

[type] is:

- [Int] is integer type
- [Top] is top type (supertype of all types)
- [Arr] is function type
- [And] is intersection type

*)

Definition label := nat.

Inductive type : Set :=
| Int : type
| Top : type
| Arr : type -> type -> type
| And : type -> type -> type
| Rcd : label -> type -> type.

Hint Constructors type : core.

(** Notation is only used for prettifying goals, we never explicity write customized notation *)

Notation "A → B" := (Arr A B) (at level 20).
Notation "A & B" := (And A B) (at level 20).
Notation "{ l : A }" := (Rcd l A) (at level 20).

(** * Terms

[term] is :

- [Lit] for integers: 1, 2, 3 ...
- [Bvar] and [Fvar] for binded variables and free variables in locally nameless representation
- [Lam] for lambda: \x: A. e : B
- [App] for application: e1 e2
- [Mrg] for merge operator, which creates inhabitants of intersection types: e1 ,, e2
- [Ann] for annotated terms: e : A

*)

Inductive term : Set :=
| Lit : nat -> term
| Bvar : nat -> term
| Fvar : var -> term
| Lam : type -> term -> type -> term
| App : term -> term -> term
| Mrg : term -> term -> term
| Ann : term -> type -> term
| Fld : label -> term -> term
| Prj : term -> label -> term.

Hint Constructors term : core.

Notation "e ∷ A" := (Ann e A) (at level 20).
Notation "ƛ A . e : B" := (Lam A e B) (at level 20).
Notation "{ l = e }" := (Fld l e) (at level 20).
Notation "e ◍ l" := (Prj e l) (at level 20).

(** coerce atom x to (Fvar x) *)

Check (Prj (Fld 1 (Lit 1)) 1).

Coercion Fvar : atom >-> term.

(** * Size of types and terms *)

(** [size_type] and [size_term] are defined for more powerful induction principle: induction on size *)

Fixpoint size_type (A : type) {struct A} : nat :=
  match A with
  | Int => 1
  | Top => 1
  | Arr A B => 1 + (size_type A) + (size_type B)
  | And A B => 1 + (size_type A) + (size_type B)
  | Rcd l A => 1 + (size_type A)
  end.

Fixpoint size_term (e : term) {struct e} : nat :=
  match e with
  | Lit n => 1
  | Bvar n => 1
  | Fvar x => 1
  | Lam A e B => 1 + (size_type A) + (size_term e) + (size_type B)
  | App e1 e2 => 1 + (size_term e1) + (size_term e2)
  | Mrg e1 e2 => 1 + (size_term e1) + (size_term e2)
  | Ann e A => 1 + (size_term e) + (size_type A)
  | Fld l e => 1 + (size_term e)
  | Prj e l => 1 + (size_term e)
  end.

(** induction on size *)

Ltac ind_type_size s :=
  assert (SizeInd: exists i, s < i) by eauto;
  destruct SizeInd as [i SizeInd];
  repeat match goal with
         | [ h : type |- _ ] => (gen h)
         end;
  induction i as [|i IH]; [
      intros; match goal with
              | [ H : _ < 0 |- _ ] => (dependent destruction H)
              end
    | intros ].

(** * Substituion *)

Fixpoint substitution (z : atom) (u : term) (e : term) {struct e} : term :=
  match e with
  | Lit n => Lit n
  | Bvar i => Bvar i
  | Fvar x => if x == z then u else (Fvar x)
  | Lam A e B => Lam A (substitution z u e) B
  | App e1 e2 => App (substitution z u e1) (substitution z u e2)
  | Mrg e1 e2 => Mrg (substitution z u e1) (substitution z u e2)
  | Ann e A => Ann (substitution z u e) A
  | Fld l e => Fld l (substitution z u e)
  | Prj e l => Prj (substitution z u e) l
  end.

Notation "{ z ↦ u } e" := (substitution z u e) (at level 69).

(** * Free variables *)

Fixpoint fv (e : term) {struct e} : atoms :=
  match e with
  | Lit n => empty
  | Bvar i => empty
  | Fvar x => singleton x
  | Lam A e B => fv e
  | App e1 e2 => (fv e1) `union` (fv e2)
  | Mrg e1 e2 => (fv e1) `union` (fv e2)
  | Ann e A => fv e
  | Fld l e => fv e
  | Prj e l => fv e
  end.

(** * Context *)

Definition ctx : Set := list (var * type).

(** * Opening *)

Fixpoint open_rec (k : nat) (u : term) (e : term) {struct e} : term :=
  match e with
  | Lit n => Lit n
  | Bvar i => if k == i then u else (Bvar i)
  | Fvar x => Fvar x
  | Lam A e B => Lam A (open_rec (S k) u e) B
  | App e1 e2 => App (open_rec k u e1) (open_rec k u e2)
  | Mrg e1 e2 => Mrg (open_rec k u e1) (open_rec k u e2)
  | Ann e A => Ann (open_rec k u e) A
  | Fld l e => Fld l (open_rec k u e)
  | Prj e l => Prj (open_rec k u e) l
  end.

Definition open e u := open_rec 0 u e.

(** Auxiliary functions for building contexts automatically *)

Ltac gather_atoms ::=
  let A := gather_atoms_with (fun x : atoms => x) in
  let B := gather_atoms_with (fun x : atom => singleton x) in
  let C := gather_atoms_with (fun x : list (atom * type) => dom x) in
  let D := gather_atoms_with (fun x : term => fv x) in
  constr:(A `union` B `union` C `union` D).


Require Import Category.Lib.

Generalizable All Variables.

Reserved Infix "~>" (at level 90, right associativity).
Reserved Infix "∘" (at level 40, left associativity).

(* The objects of a category are all of some `Type`.

  Morphisms, or arrows, are also of type `Type`, but always in a universe
  above objects. All of the library has `Universe Polymorphism` enabled,
  allowing categories whose objects are categories, etc.

  The morphisms identified by `A ~> B` form a hom-set, except that in this
  library it is a hom-setoid, requiring the meaning of (computationally
  relevant) equivalence between morphisms to be given. This makes it a
  quotient category C/R over the equivalence relation R, but since this is
  almost always needed (since equality is very restrictive in Coq's type
  theory), we call it a [Category] here, and assume the existence of some
  other category using only equality, with a functor from that category to
  this.

  Categories (as distinct from Category/~) are identified by [homset :=
  Morphism_equality]. *)

Class Category@{o h p | h <= p} : Type@{max(o+1,h+1,p+1)} := {
  obj : Type@{o};

  uhom := Type@{h} : Type@{h+1};
  hom : obj → obj → uhom where "a ~> b" := (hom a b);
  homset : ∀ X Y, Setoid@{h p} (X ~> Y);

  id {x} : x ~> x;
  compose {x y z} (f: y ~> z) (g : x ~> y) : x ~> z
    where "f ∘ g" := (compose f g);

  compose_respects {x y z} :
    Proper@{h p} (respectful@{h p h p h p} equiv
                    (respectful@{h p h p h p} equiv equiv))
      (@compose x y z);

  dom {x y} (f : x ~> y) := x;
  cod {x y} (f : x ~> y) := y;

  id_left  {x y} (f : x ~> y) : id ∘ f ≈ f;
  id_right {x y} (f : x ~> y) : f ∘ id ≈ f;

  comp_assoc {x y z w} (f : z ~> w) (g : y ~> z) (h : x ~> y) :
    f ∘ (g ∘ h) ≈ (f ∘ g) ∘ h;
  comp_assoc_sym {x y z w} (f : z ~> w) (g : y ~> z) (h : x ~> y) :
    (f ∘ g) ∘ h ≈ f ∘ (g ∘ h)
}.
#[export] Existing Instance homset.
#[export] Existing Instance compose_respects.

Declare Scope category_scope.
Declare Scope object_scope.
Declare Scope homset_scope.
Declare Scope morphism_scope.

Bind Scope category_scope with Category.
Bind Scope object_scope with obj.
Bind Scope homset_scope with hom.

Delimit Scope category_scope with category.
Delimit Scope object_scope with object.
Delimit Scope homset_scope with homset.
Delimit Scope morphism_scope with morphism.

Arguments dom {_%category _%object _%object} _%morphism.
Arguments cod {_%category _%object _%object} _%morphism.

Notation "obj[ C ]" := (@obj C%category)
  (at level 0, format "obj[ C ]") : type_scope.
Notation "hom[ C ]" := (@hom C%category)
  (at level 0, format "hom[ C ]") : type_scope.

Notation "x ~> y" := (@hom _%category x%object y%object)
  (at level 90, right associativity) : homset_scope.
Notation "x ~{ C }~> y" := (@hom C%category x%object y%object)
  (at level 90) : homset_scope.

Notation "x <~ y" := (@hom _%category y%object x%object)
  (at level 90, right associativity, only parsing) : homset_scope.
Notation "x <~{ C }~ y" := (@hom C%category y%object x%object)
  (at level 90, only parsing) : homset_scope.

Notation "id[ x ]" := (@id _%category x%object)
  (at level 9, format "id[ x ]") : morphism_scope.

Notation "id{ C }" := (@id C%category _%object)
  (at level 9, format "id{ C }") : morphism_scope.

Notation "f ∘ g" :=
  (@compose _%category _%object _%object _%object f%morphism g%morphism)
  : morphism_scope.
Notation "f ∘[ C ] g" :=
  (@compose C%category _%object _%object _%object f%morphism g%morphism)
  (at level 40, only parsing) : morphism_scope.

Notation "f ≈[ C ] g" :=
  (@equiv _ (@homset C%category _%object _%object) f%morphism g%morphism)
  (at level 79, only parsing) : category_theory_scope.
Notation "f ≈[ C ] g" :=
  (@equiv _ (@homset C%category _%object _%object) f%morphism g%morphism)
  (at level 79, only parsing) : category_theory_scope.

Notation "f << A ~~> B >> g" :=
  (@equiv (A%object ~> B%object)%homset _ f%morphism g%morphism)
  (at level 99, A at next level, B at next level, only parsing) : category_theory_scope.

Coercion obj : Category >-> Sortclass.

#[export] Hint Rewrite @id_left : categories.
#[export] Hint Rewrite @id_right : categories.

(** [Build_Category'] is a custom constructor that automatically provides the
    definition of [comp_assoc_sym]. It is intended to be used with the
    [refine] tactic, such as in the example below. *)
Definition Build_Category'
           {obj} hom {homset} id compose
           {compose_respects}
           {id_left id_right comp_assoc} :=
  {| obj              := obj;
     hom              := hom;
     homset           := homset;
     id               := id;
     compose          := compose;
     compose_respects := compose_respects;
     id_left          := id_left;
     id_right         := id_right;
     comp_assoc       := comp_assoc;
     comp_assoc_sym   :=
       fun _ _ _ _ _ _ _ => symmetry (@comp_assoc _ _ _ _ _ _ _);
  |}.

Example Build_Category'_Coq : Category.
Proof.
  unshelve refine (Build_Category' (@Basics.arrow)
                                   (@Datatypes.id) (@Basics.compose));
  intros; try reflexivity.
  - refine {| equiv := fun f g => ∀ x, f x = g x |}.
    equivalence.
    now transitivity (y x0).
  - proper.
    now rewrite X, X0.
Defined.

Open Scope category_scope.
Open Scope object_scope.
Open Scope homset_scope.
Open Scope morphism_scope.

Program Definition Morphism_equality@{o h p}
  {ob : Type@{o}} {hom : ob → ob → Type@{h}}
  (x y : ob) : Setoid@{h p} (hom x y) := {|
  equiv := eq
|}.
Arguments Morphism_equality {_ _} _ _ /.

Section Category.

Context {C : Category}.

Corollary dom_id {x : C} : dom (@id C x) = x.
Proof. auto. Qed.

Corollary cod_id {x : C} : cod (@id C x) = x.
Proof. auto. Qed.

Corollary dom_comp {x y z : C} (g : y ~> z) (f : x ~> y) :
  dom g = cod f ↔ dom (g ∘ f) = dom f.
Proof. split; auto. Qed.

Corollary cod_comp {x y z : C} (g : y ~> z) (f : x ~> y) :
  dom g = cod f ↔ cod (g ∘ f) = cod g.
Proof. split; auto. Qed.

End Category.

Arguments dom {_%category _%object _%object} _%morphism.
Arguments cod {_%category _%object _%object} _%morphism.
Arguments id_left {_%category _%object _%object} _%morphism.
Arguments id_right {_%category _%object _%object} _%morphism.
Arguments comp_assoc {_%category _%object _%object _%object _%object}
  _%morphism _%morphism _%morphism.

#[export]
Program Instance hom_preorder {C : Category} : PreOrder (@hom C) := {
  PreOrder_Reflexive  := fun _ => id;
  PreOrder_Transitive := fun _ _ _ f g => g ∘ f
}.

Ltac comp_left :=
  try rewrite <- !comp_assoc;
  apply compose_respects; [reflexivity|].

Ltac comp_right :=
  try rewrite !comp_assoc;
  apply compose_respects; [|reflexivity].

#[export] Hint Extern 10 (?X ∘ ?Y ≈ ?Z ∘ ?Q) =>
  apply compose_respects; auto : category_laws.
#[export] Hint Extern 10 (?X ∘ (?Y ∘ ?Z) ≈ ?W) =>
  apply comp_assoc : category_laws.

Ltac rewrites :=
  repeat match goal with
  | [ H : ?X ≈ ?Y                      |- context[?X] ] => rewrite !H; clear H
  | [ H : ?X ≈ ?Y                      |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _, ?X ≈ ?Y                 |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _, ?X ≈ ?Y                 |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _, ?X _ ≈ ?Y _             |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _, ?X _ ≈ ?Y _             |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _ _, ?X ≈ ?Y               |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _ _, ?X ≈ ?Y               |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _ _, ?X _ ≈ ?Y _           |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _ _, ?X _ ≈ ?Y _           |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _ _, ?X _ _ ≈ ?Y _ _       |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _ _, ?X _ _ ≈ ?Y _ _       |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _ _ _, ?X ≈ ?Y             |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _ _ _, ?X ≈ ?Y             |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _ _ _, ?X _ ≈ ?Y _         |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _ _ _, ?X _ ≈ ?Y _         |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _ _ _, ?X _ _ ≈ ?Y _ _     |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _ _ _, ?X _ _ ≈ ?Y _ _     |- context[?X] ] => srewrite H; clear H
  | [ H : ∀ _ _ _, ?X _ _ _ ≈ ?Y _ _ _ |- context[?X] ] => rewrite !H; clear H
  | [ H : ∀ _ _ _, ?X _ _ _ ≈ ?Y _ _ _ |- context[?X] ] => srewrite H; clear H

  | [ H : ?X ≈ ?Y                      |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ?X ≈ ?Y                      |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _, ?X ≈ ?Y                 |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _, ?X ≈ ?Y                 |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _, ?X _ ≈ ?Y _             |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _, ?X _ ≈ ?Y _             |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _ _, ?X ≈ ?Y               |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _ _, ?X ≈ ?Y               |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _ _, ?X _ ≈ ?Y _           |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _ _, ?X _ ≈ ?Y _           |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _ _, ?X _ _ ≈ ?Y _ _       |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _ _, ?X _ _ ≈ ?Y _ _       |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _ _ _, ?X ≈ ?Y             |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _ _ _, ?X ≈ ?Y             |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _ _ _, ?X _ ≈ ?Y _         |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _ _ _, ?X _ ≈ ?Y _         |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _ _ _, ?X _ _ ≈ ?Y _ _     |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _ _ _, ?X _ _ ≈ ?Y _ _     |- context[?Y] ] => srewrite_r H; clear H
  | [ H : ∀ _ _ _, ?X _ _ _ ≈ ?Y _ _ _ |- context[?Y] ] => rewrite <- !H; clear H
  | [ H : ∀ _ _ _, ?X _ _ _ ≈ ?Y _ _ _ |- context[?Y] ] => srewrite_r H; clear H
  end.


Class EqDec (A:Type) := {
  eqb : A -> A -> bool;
  eqb_leibniz : forall x y, eqb x y = true -> x = y
}.

#[local]
Instance unit_EqDec : EqDec unit := {
  eqb x y := true;
  eqb_leibniz x y H :=
    match x, y return x = y with
    | tt, tt => eq_refl tt
    end
}.

#[local, refine]
Instance unit_EqDec' : EqDec unit :=
  { eqb x y := true }.
Proof. intros [] []. reflexivity. Defined.

About unit_EqDec'.

Require Import Program.Tactics.

#[local]
Program Instance eq_bool : EqDec bool :=
  { eqb x y := if x then y else negb y }.
Next Obligation.
  destruct x, y; (discriminate || reflexivity).
Defined.

Definition neqb {A} {eqa: EqDec A} (x y:A) := negb (eqb x y).

Generalizable Variables A B C.

Definition neqb_implicit `{eqa: EqDec A} (x y:A) := negb (eqb x y).

#[local]
Program Instance prod_eqb `(EA: EqDec A, EB: EqDec B) : EqDec (A * B) :=
  { eqb x y := match x, y with
    | (la, ra), (lb, rb) => andb (eqb la lb) (eqb ra rb)
    end }.

Section EqDec_defs.
  Context `{EA: EqDec A}.

  #[global, program]
  Instance option_eqb : EqDec (option A) :=
    { eqb x y := match x, y with
      | Some x, Some y => eqb x y
      | None, None => true
      | _, _ => false
      end }.
  Admit Obligations.
End EqDec_defs.

About option_eqb.

Class Ord `(E: EqDec A) :=
  { le: A -> A -> bool }.

(* Class `(E: EqDec A) => Ord A :=
  { le : A -> A -> bool }. *)

Definition le_eqb `{Ord A} (x y:A) :=
  andb (le x y) (le y x).

Definition lt `{eqa: EqDec A, ! Ord eqa} (x y:A) :=
  andb (le x y) (neqb x y).

Require Import Relations.

Class Reflexive (A:Type) (R: relation A) :=
  reflexivity: forall x, R x x.

Class Transitive (A:Type) (R: relation A) :=
  transivity: forall x y z, R x y -> R y z -> R x z.

Class Preorder (A:Type) (R: relation A) :=
  { PreOrder_Reflexive :> Reflexive A R;
    PreOrder_Transitive :> Transitive A R }.

    (* https://coq.inria.fr/refman/addendum/type-classes.html *)


(* Taken from the VST repository *)
(* Andrew W. Appel and Stephen Yi-Hsien Lin,
    May 2013, October 2013, March 2014 *)

Require Recdef.
(*Require Import VST.floyd.coqlib3.
Require Import VST.floyd.sublist.*)
Require Import Cryptol.Bitvectors.
Require Import Cryptol.Coqlib.
Require Import Coq.Strings.String.
Require Import Coq.Strings.Ascii.
Require Import List.
(*Require Import sha.general_lemmas.*)

(*
(* THIS BLOCK OF STUFF is not needed to define SHA256,
  but is useful for reasoning about it *)
Definition LBLOCKz : Z := 16. (* length of a block, in 32-bit integers *)
Definition WORD : Z := 4.  (* length of a word, in bytes *)
Definition CBLOCKz : Z := (LBLOCKz * WORD)%Z. (* length of a block, in characters *)
Definition hi_part (z: Z) := Int.repr (z / Int.modulus).
Definition lo_part (z: Z) := Int.repr z.

Fixpoint little_endian_integer (contents: list int) : int :=
 match contents with
 | nil => Int.zero
 | c::cr => Int.or (Int.shl (little_endian_integer cr) (Int.repr 8)) c
 end.
Definition big_endian_integer (contents: list int) : int :=
   little_endian_integer (rev contents).
(* END OF "THIS BLOCK OF STUFF" *)
*)
Import ListNotations.

Lemma skipn_length:
  forall {A} n (al: list A),
    (length al >= n)%nat ->
    (length (skipn n al) = length al - n)%nat.
Proof.
 induction n; destruct al; simpl; intros; auto.
 apply IHn. omega.
Qed.

Lemma skipn_short :
  forall {A} n (l:list A),
    (length l <= n)%nat ->
    skipn n l = nil.
Proof.
  induction n; simpl; intros.
  destruct l; trivial. simpl in H. omega.
  destruct l; trivial.
  apply IHn. simpl in H. omega.
Qed.

(* PREPROCESSING: CONVERTING STRINGS TO PADDED MESSAGE BLOCKS *)

(*converting a string to a list of Z *)
Fixpoint str_to_Z (str : string) : list Z :=
  match str with
    |EmptyString => nil
    |String c s => Z.of_N (N_of_ascii c) :: str_to_Z s
    end.

(* Taken from general_lemmas *)
Definition Z_to_Int (a b c d : Z) : @Int 32 :=
  @or 32 (@or 32 (@or 32 (@shl 32 (repr a) (repr 24)) (@shl 32 (repr b) (repr 16)))
            (@shl 32 (repr c) (repr 8))) (repr d).

Fixpoint Zlist_to_intlist (nl: list Z) : list Int :=
  match nl with
  | h1::h2::h3::h4::t => Z_to_Int h1 h2 h3 h4 :: Zlist_to_intlist t
  | _ => nil
  end.

Definition Shr b x := shru x (@repr 32 b).

Fixpoint intlist_to_Zlist (l: list (@Int 32)) : list Z :=
  match l with
  | nil => nil
  | i::r =>
    unsigned (Shr 24 i) ::
                 unsigned (and (Shr 16 i) (repr 255)) ::
                 unsigned (and (Shr 8 i) (repr 255)) ::
                 unsigned (and i (repr 255)) ::
                 intlist_to_Zlist r
  end.

Definition generate_and_pad msg :=
  let n := Zlength msg in
   Zlist_to_intlist (msg ++ [128%Z]
                ++ list_repeat (Z.to_nat (-(n + 9) mod 64)) 0)
           ++ [repr (n * 8 / @modulus 32); repr (n * 8)].

(*ROUND FUNCTION*)

(*hardcoding the constants, first 32 bits of the fractional parts of the cube roots of the first 64 prime numbers*)
Definition K256 := map (@repr 32)
  [1116352408 ; 1899447441; 3049323471; 3921009573;
   961987163   ; 1508970993; 2453635748; 2870763221;
   3624381080; 310598401  ; 607225278  ; 1426881987;
   1925078388; 2162078206; 2614888103; 3248222580;
   3835390401; 4022224774; 264347078  ; 604807628;
   770255983  ; 1249150122; 1555081692; 1996064986;
   2554220882; 2821834349; 2952996808; 3210313671;
   3336571891; 3584528711; 113926993  ; 338241895;
   666307205  ; 773529912  ; 1294757372; 1396182291;
   1695183700; 1986661051; 2177026350; 2456956037;
   2730485921; 2820302411; 3259730800; 3345764771;
   3516065817; 3600352804; 4094571909; 275423344;
   430227734  ; 506948616  ; 659060556  ; 883997877;
   958139571  ; 1322822218; 1537002063; 1747873779;
   1955562222; 2024104815; 2227730452; 2361852424;
   2428436474; 2756734187; 3204031479; 3329325298].

(*functions used for round function*)
Definition Ch (x y z : @Int 32) : @Int 32 :=
  xor (and x y) (and (not x) z).

Definition Maj (x y z : @Int 32) : @Int 32 :=
  xor (xor (and x z) (and y z)) (and x y).

Definition Rotr b x := ror x (@repr 32 b).

Definition Sigma_0 (x : @Int 32) : @Int 32 :=
          xor (xor (Rotr 2 x) (Rotr 13 x)) (Rotr 22 x).
Definition Sigma_1 (x : @Int 32) : @Int 32 :=
          xor (xor (Rotr 6 x) (Rotr 11 x)) (Rotr 25 x).
Definition sigma_0 (x : @Int 32) : @Int 32 :=
          xor (xor (Rotr 7 x) (Rotr 18 x)) (Shr 3 x).
Definition sigma_1 (x : @Int 32) : @Int 32 :=
          xor (xor (Rotr 17 x) (Rotr 19 x)) (Shr 10 x).

(* word function *)
Function W (M: Z -> @Int 32) (t: Z) {measure Z.to_nat t} : @Int 32 :=
  if zlt t 16
  then M t
  else  (add (add (sigma_1 (W M (t-2))) (W M (t-7)))
               (add (sigma_0 (W M (t-15))) (W M (t-16)))).
Proof.
intros; apply Z2Nat.inj_lt; omega.
intros; apply Z2Nat.inj_lt; omega.
intros; apply Z2Nat.inj_lt; omega.
intros; apply Z2Nat.inj_lt; omega.
Qed.

(*registers that represent intermediate and final hash values*)
Definition registers := list (@Int 32).

(*initializing the values of registers, first thirty-two bits of the fractional
    parts of the square roots of the first eight prime numbers*)
Definition init_registers : registers :=
  map repr  [1779033703; 3144134277; 1013904242; 2773480762;
                        1359893119; 2600822924; 528734635; 1541459225].

Definition nthi (il: list (@Int 32)) (t: Z) := nth (Z.to_nat t) il Bitvectors.zero.

Definition rnd_function (x : registers) (k : @Int 32) (w : @Int 32) : registers:=
  match x with
  |  [a; b; c; d; e; f; g; h] =>
     let T1 := add (add (add (add h (Sigma_1 e)) (Ch e f g)) k) w in
     let T2 := add (Sigma_0 a) (Maj a b c) in
       [add T1 T2; a; b; c; add d T1; e; f; g]
  | _ => nil  (* impossible *)
  end.

Function Round  (regs: registers) (M: Z ->@Int 32) (t: Z)
        {measure (fun t => Z.to_nat(t+1)) t} : registers :=
 if zlt t 0 then regs
 else rnd_function (Round regs M (t-1)) (nthi K256 t) (W M t).
Proof. intros; apply Z2Nat.inj_lt; omega.
Qed.

(* Taken from verif_dotprod.v*)
Fixpoint map2 {A B C: Type} (f: A -> B -> C) (al: list A) (bl: list B) : list C :=
  match al, bl with
  | a::al', b::bl' => f a b :: map2 f al' bl'
  | _, _ => nil
  end.

Definition hash_block (r: registers) (block: list (@Int 32)) : registers :=
      map2 add r (Round r (nthi block) 63).

Function hash_blocks (r: registers) (msg: list (@Int 32)) {measure length msg} : registers :=
  match msg with
  | nil => r
  | _ => hash_blocks (hash_block r (firstn 16 msg)) (skipn 16 msg)
  end.
Proof.
  intros.
  destruct (lt_dec (length msg) 16).
  rewrite skipn_short. simpl; omega. subst msg. simpl in *. omega.
  rewrite <- teq; auto.
  rewrite skipn_length. simpl; omega.
  omega.
Qed.

Definition SHA_256 (str : list Z) : list Z :=
  intlist_to_Zlist (hash_blocks init_registers (generate_and_pad str)).


Require Import Hask.Ltac.
Require Import Hask.Data.Functor.

Generalizable All Variables.
Set Primitive Projections.
Set Universe Polymorphism.
Unset Transparent Obligations.

Class Contravariant (f : Type -> Type) := {
  contramap : forall {a b : Type}, (a -> b) -> f b -> f a
}.

Arguments contramap {f _ a b} _ x.

Infix ">$<" := contramap (at level 28, left associativity, only parsing).
Notation "x >&< f" :=
  (contramap f x) (at level 28, left associativity, only parsing).

Notation "contramap[ M ]  f" := (@contramap M _ _ _ f) (at level 9).
Notation "contramap[ M N ]  f" :=
  (@contramap (fun X => M (N X)) _ _ _ f) (at level 9).
Notation "contramap[ M N O ]  f" :=
  (@contramap (fun X => M (N (O X))) _ _ _ f) (at level 9).

Definition coerce `{Functor f} `{Contravariant f} {a b} : f a -> f b :=
  fmap (False_rect _) \o contramap (False_rect _).

#[export]
Instance Contravariant_Compose `{Functor F} `{Contravariant G} :
  Contravariant (F \o G) :=
{ contramap := fun A B => @fmap F _ (G B) (G A) \o @contramap G _ A B
}.

Require Import FunctionalExtensionality.

Module ContravariantLaws.

Include FunctorLaws.

Class ContravariantLaws (f : Type -> Type) `{Contravariant f} := {
  contramap_id   : forall a : Type, contramap (@id a) = id;
  contramap_comp : forall (a b c : Type) (f : b -> c) (g : a -> b),
    contramap g \o contramap f = contramap (f \o g)
}.

Corollary contramap_id_x `{ContravariantLaws f} :
  forall (a : Type) x, contramap (@id a) x = x.
Proof. intros; rewrite contramap_id. auto. Qed.

Corollary contramap_comp_x `{ContravariantLaws F} :
  forall (a b c : Type) (f : b -> c) (g : a -> b) x,
  contramap g (contramap f x) = contramap (fun y => f (g y)) x.
Proof.
  intros.
  replace (fun y : a => f (g y)) with (f \o g).
    rewrite <- contramap_comp.
    reflexivity.
  reflexivity.
Qed.

Corollary contramap_compose  `{Functor F} `{Contravariant G} :
  forall {X Y} (f : X -> Y),
    @fmap F _ (G Y) (G X) (@contramap G _ X Y f) =
    @contramap (F \o G) _ X Y f.
Proof. reflexivity. Qed.

#[export]
Program Instance ContravariantLaws_Compose
  `{FunctorLaws F} `{ContravariantLaws G} : ContravariantLaws (F \o G).
Obligation 1. (* contramap_id *)
  extensionality x.
  rewrite contramap_id, fmap_id.
  reflexivity.
Qed.
Obligation 2. (* contramap_comp *)
  extensionality x.
  rewrite fmap_comp, contramap_comp.
  reflexivity.
Qed.

End ContravariantLaws.


(* Copyright © 1998-2006
 * Henk Barendregt
 * Luís Cruz-Filipe
 * Herman Geuvers
 * Mariusz Giero
 * Rik van Ginneken
 * Dimitri Hendriks
 * Sébastien Hinderer
 * Bart Kirkels
 * Pierre Letouzey
 * Iris Loeb
 * Lionel Mamane
 * Milad Niqui
 * Russell O’Connor
 * Randy Pollack
 * Nickolay V. Shmyrev
 * Bas Spitters
 * Dan Synek
 * Freek Wiedijk
 * Jan Zwanenburg
 *
 * This work is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This work is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this work; if not, write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)
(* IrrCrit.v, v1.1, 27aug2004, Bart Kirkels *)

(** printing [=] %\ensuremath=% #=# *)
(** printing [+X*] %\ensuremath{+ X*}% #&+ X*;# *)

Require Export CoRN.model.Zmod.Zm.
Require Export CoRN.model.rings.Zring.
Require Export CoRN.algebra.CPoly_Degree.

(**
* An irreducibility criterion
Let [p] be a (positive) prime number. Our goal is to prove that if an integer
polynomial is irreducible over the prime field Fp, then it is irreducible over
Z.
*)

Variable p : positive.
Hypothesis Hprime : (Prime p).

Definition fp := (Fp p Hprime).

(**
** Integers modulo [p]
*)

Definition zfp (a:Z) := (a:fp).

Lemma fpeq_wd : forall a b:Z, a=b -> (zfp a)[=](zfp b).
Proof.
 intros a b heq.
 simpl.
 unfold zfp in *.
 unfold ZModeq in *.
 elim heq.
 auto with *.
Qed.

(**
** Integer polynomials over Fp
*)

Definition zx := (cpoly_cring Z_as_CRing).

Definition fpx := (cpoly_cring fp).

Fixpoint zxfpx (p:zx) : fpx :=
  match p with
  | cpoly_zero _ => (cpoly_zero fp : fpx)
  | cpoly_linear _ c p1 => (zfp c)[+X*](zxfpx p1)
  end.

Definition P (f g:zx):= f[=]g -> (zxfpx f)[=](zxfpx g).

Lemma fpxeq_wd : forall f g:zx, f[=]g -> (zxfpx f)[=](zxfpx g).
Proof.
 apply (cpoly_double_ind Z_as_CRing P); unfold P.
   induction p0 as [|c p0].
    trivial.
   intro H.
   astepl ((zfp c)[+X*](zxfpx p0)).
   apply (_linear_eq_zero fp).
   split.
    astepr (zfp 0).
    apply fpeq_wd.
    elim H.
    auto.
   apply IHp0.
   elim H.
   auto with *.
  induction p0 as [|c p0].
   trivial.
  intro H.
  astepr ((zfp c)[+X*](zxfpx p0)).
  apply (_zero_eq_linear fp).
  split.
   astepr (zfp 0).
   apply fpeq_wd.
   elim H.
   auto.
  apply IHp0.
  elim H.
  auto with *.
 intros p0 q c d H1 H2.
 astepr ((zfp d)[+X*](zxfpx q)).
 astepl ((zfp c)[+X*](zxfpx p0)).
 apply (_linear_eq_linear fp).
 split.
  apply fpeq_wd.
  elim H2.
  auto.
 apply H1.
 elim H2.
 auto.
Qed.

#[global]
Hint Resolve fpxeq_wd : algebra.

(**
** Lemmas
In this section we prove the lemmas we will need, about integer polynomials,
viewed over a prime field.
*)

Lemma mult_zero : forall (R:CRing)(f:cpoly_cring R),
(cpoly_mult_op R f (cpoly_zero R))[=](cpoly_zero R).
Proof.
 intros R f.
 simpl; apply cpoly_mult_zero.
Qed.

#[global]
Hint Resolve mult_zero : algebra.

Lemma fp_resp_zero : zxfpx(cpoly_zero Z_as_CRing)[=](cpoly_zero fp).
Proof.
 intuition.
Qed.

Lemma fpx_resp_mult_cr : forall (c:Z_as_CRing)(f:zx),
  (cpoly_mult_cr_cs fp (zxfpx f) (zfp c)) [=]
  (zxfpx (cpoly_mult_cr_cs _ f c)).
Proof.
 induction f as [|c0 f].
  intuition.
 astepr (zxfpx ((c[*]c0)[+X*](cpoly_mult_cr_cs _ f c))).
 astepr ((zfp (c[*]c0))[+X*](zxfpx (cpoly_mult_cr_cs _ f c))).
 astepr (((zfp c)[*](zfp c0))[+X*](zxfpx (cpoly_mult_cr_cs _ f c))).
 astepr (((zfp c)[*](zfp c0))[+X*](cpoly_mult_cr_cs fp (zxfpx f) (zfp c))).
 astepr (cpoly_mult_cr_cs fp ((zfp c0)[+X*](zxfpx f)) (zfp c)).
 intuition.
Qed.

#[global]
Hint Resolve fpx_resp_mult_cr : algebra.

Lemma fpx_resp_plus :  forall f g:zx,
  (cpoly_plus_op fp (zxfpx f) (zxfpx g))[=]
  (zxfpx (cpoly_plus_op _ f g)).
Proof.
 induction f as [|c f].
  intuition.
 induction g as [|c0 g].
  intuition.
 astepl (cpoly_plus fp (zxfpx (c[+X*]f)) (zxfpx (c0[+X*]g))).
 astepr (zxfpx (cpoly_plus_op _ (c[+X*]f) (c0[+X*]g))).
 astepr (zxfpx ((c[+]c0)[+X*](cpoly_plus_op _ f g))).
 astepr ((zfp (c[+]c0))[+X*](zxfpx (cpoly_plus_op _ f g))).
 astepl (((zfp c)[+](zfp c0))[+X*] (cpoly_plus_op fp (zxfpx f) (zxfpx g))).
 auto with *.
Qed.

#[global]
Hint Resolve fpx_resp_plus : algebra.

Lemma fpx_resp_mult : forall f g:zx,
  (cpoly_mult_op fp (zxfpx f) (zxfpx g)) [=]
  (zxfpx (cpoly_mult_op _ f g)).
Proof.
 induction f as [|c f].
  intro g.
  astepl (cpoly_mult_op fp (cpoly_zero fp)(zxfpx g)).
  astepl (cpoly_zero fp).
  astepr (zxfpx (cpoly_zero Z_as_CRing)).
  astepr (cpoly_zero fp); intuition.
 induction g as [|c0 g].
  astepl (cpoly_mult_op fp (zxfpx (c[+X*]f)) (cpoly_zero fp)).
  astepl (cpoly_zero fp).
  astepr (zxfpx (cpoly_zero Z_as_CRing));  try algebra.
  apply fpxeq_wd.
  apply eq_symmetric.
  apply (mult_zero Z_as_CRing).
 astepr (zxfpx (cpoly_mult_op Z_as_CRing (c[+X*]f) (c0[+X*]g))).
 astepl (cpoly_mult_op fp (zxfpx (c[+X*]f)) (zxfpx (c0[+X*]g))).
 astepr (zxfpx (cpoly_plus_op _ ((c[*]c0)[+X*](cpoly_mult_cr_cs _ g c))
   (([0]:Z_as_CRing)[+X*](cpoly_mult _ f (c0[+X*]g))))).
 astepr (zxfpx (((c[*]c0)[+]([0]:Z_as_CRing))[+X*](cpoly_plus_op _
   (cpoly_mult_cr_cs _ g c) (cpoly_mult _ f (c0[+X*]g))))).
 astepr (zxfpx ((c[*]c0)[+X*](cpoly_plus_op _ (cpoly_mult_cr_cs _ g c) (cpoly_mult _ f (c0[+X*]g))))).
 astepr ( (zfp c[*]c0) [+X*] (zxfpx (cpoly_plus_op _ (cpoly_mult_cr_cs _ g c)
   (cpoly_mult _ f (c0[+X*]g))))).
 astepl (cpoly_mult_op fp ((zfp c)[+X*](zxfpx f)) (zxfpx (c0[+X*]g))).
 astepl (cpoly_plus_op fp (cpoly_mult_cr_cs fp (zxfpx (c0[+X*]g)) (zfp c))
   ((zfp ([0]:Z_as_CRing))[+X*](cpoly_mult_op fp (zxfpx f) (zxfpx (c0[+X*]g))))).
 astepl (cpoly_plus_op fp (cpoly_mult_cr_cs fp ((zfp c0)[+X*](zxfpx g)) (zfp c))
   (([0]:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))).
 astepl (cpoly_plus_op fp (((zfp c)[*](zfp c0))[+X*](cpoly_mult_cr_cs fp (zxfpx g) (zfp c)))
   (([0]:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))).
 astepl (cpoly_plus_op fp ((zfp (c[*]c0))[+X*](zxfpx (cpoly_mult_cr_cs _ g c)))
   (([0]:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))).
 astepl ((zfp (c[*]c0)[+]([0]:fp))[+X*](cpoly_plus_op fp
   (zxfpx (cpoly_mult_cr_cs _ g c)) (zxfpx (cpoly_mult_op _ f (c0[+X*]g))))).
 intuition.
Qed.

#[global]
Hint Resolve fpx_resp_mult : algebra.

Lemma fpx_resp_coef : forall (f:zx)(n:nat), (zfp (nth_coeff n f))
  [=] (nth_coeff n (zxfpx f)).
Proof.
 induction f.
  intuition.
 induction n.
  intuition.
 astepl (zfp (nth_coeff n f)).
 astepr (nth_coeff n (zxfpx f)).
 apply (IHf n).
Qed.

#[global]
Hint Resolve fpx_resp_coef : algebra.

(**
** Working towards the criterion
*** Definitions
We prove the criterion for monic integers of degree greater than 1.
This property is first defined, so that reducibility can be defined next.
We then prove that a reducible integer polynomial is reducible over
Fp. Finally irreducibility is defined.
*)

Definition degree_ge_monic (R:CRing)(n:nat)(f:(cpoly_cring R)) :=
  {m:nat | (n >= m)%nat | monic m f}.

Lemma fpx_resp_deggemonic : forall (f:zx)(n:nat),
  degree_ge_monic _ n f -> degree_ge_monic _ n (zxfpx f).
Proof.
 intros f n; unfold degree_ge_monic.
 intro X; elim X.
 intros m Hm Hfmonm.
 exists m.
  exact Hm.
 elim Hfmonm.
 intros Hnthcoeff Hdegf.
 unfold monic.
 split.
  astepl (zfp (nth_coeff m f)).
  assert ([1][=]nth_coeff m f); intuition.
  simpl in H.
  rewrite <- H.
  intuition.
 red.
 intros.
 astepl (zfp (nth_coeff m0 f)).
 assert ([0][=]nth_coeff m0 f); intuition.
 simpl in H0.
 rewrite <- H0.
 intuition.
Qed.

#[global]
Hint Resolve fpx_resp_deggemonic : algebra.

Definition reducible (R:CRing)(f:(cpoly_cring R)) :=
  degree_ge_monic R 2%nat f and
  {g:(cpoly_cring R) | degree_ge_monic R 1%nat g |
    {h:(cpoly_cring R) | degree_ge_monic R 1%nat h |
      f[=](cpoly_mult_op R g h) }}.

Lemma fpx_resp_red : forall f:zx, (reducible _ f)->(reducible fp (zxfpx f)).
Proof.
 intros f Hfred; elim Hfred.
 intros Hfok Hfred2; elim Hfred2.
 intros g Hgok Hfred3; elim Hfred3.
 intros h Hhok Hfgh; unfold reducible.
 intuition.
 exists (zxfpx g).
  intuition.
 exists (zxfpx h).
  intuition.
 astepr (zxfpx (cpoly_mult_op _ g h)).
 apply fpxeq_wd.
 exact Hfgh.
Qed.

#[global]
Hint Resolve fpx_resp_red : algebra.

Definition irreducible (R:CRing)(f:(cpoly_cring R)) :=
  Not (reducible R f).

(**
*** The criterion
And now we can state and prove the irreducibility criterion.
*)

Theorem irrcrit : forall f:zx, (irreducible fp (zxfpx f)) ->
  (irreducible _ f).
Proof.
 unfold irreducible.
 intro f.
 cut ((reducible _ f) -> (reducible fp (zxfpx f))).
  intros X H X0.
  apply H.
  apply X.
  exact X0.
 apply fpx_resp_red.
Qed.


Require Import VerdiRaft.RaftState.
Require Import VerdiRaft.Raft.
Require Import VerdiRaft.CommonTheorems.

Section SpecLemmas.

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

  Lemma handleRequestVote_votedFor :
    forall pDst t cid lli llt d d' m,
      handleRequestVote pDst d t cid lli llt = (d', m) ->
      currentTerm d = currentTerm d' ->
      votedFor d = None \/ votedFor d = votedFor d'.
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat break_match; tuple_inversion; simpl in *; intuition; try discriminate;
    try solve [exfalso; do_bool; lia].
  Qed.

  Lemma handleRequestVote_cases :
    forall h h' t lli llt st st' m,
      handleRequestVote h st t h' lli llt = (st', m) ->
      st' = st \/
      st' = advanceCurrentTerm st t \/
      (st' = {[ advanceCurrentTerm st t with votedFor := Some h']} /\
       (votedFor st = None /\ currentTerm st = t \/ currentTerm st < t)).
  Proof using.
    unfold handleRequestVote.
    intros.
    repeat break_match; repeat find_inversion; intuition idtac.
    - simpl in *. discriminate.
    - unfold advanceCurrentTerm in *.
      break_if; simpl in *; do_bool; intuition.
  Qed.

  Lemma handleRequestVoteReply_term_votedFor_cases :
    forall me st src t v st',
      handleRequestVoteReply me st src t v = st' ->
      (currentTerm st' = currentTerm st /\
       votedFor st' = votedFor st) \/
      (currentTerm st < currentTerm st' /\
       votedFor st' = None).
  Proof using.
    intros.
    unfold handleRequestVoteReply, advanceCurrentTerm in *; repeat break_match;
    subst; do_bool; intuition.
  Qed.

  Lemma handleAppendEntries_same_term_votedFor_preserved :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      currentTerm st' = currentTerm st ->
      votedFor st' = votedFor st.
  Proof using.
    unfold handleAppendEntries, advanceCurrentTerm.
    intros.
    repeat break_match; repeat tuple_inversion; simpl in *;
      do_bool; auto; try lia.
  Qed.

  Lemma handleAppendEntriesReply_same_term_votedFor_preserved :
    forall h st h' t es r st' ms,
      handleAppendEntriesReply h st h' t es r = (st', ms) ->
      currentTerm st' = currentTerm st ->
      votedFor st' = votedFor st.
  Proof using.
    intros. unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; repeat tuple_inversion; simpl in *; do_bool; congruence.
  Qed.

  Lemma doGenericServer_currentTerm :
    forall h st os st' ms,
      doGenericServer h st = (os, st', ms) ->
      currentTerm st' = currentTerm st.
  Proof using.
    unfold doGenericServer.
    intros.
    repeat break_match; repeat find_inversion;
    use_applyEntries_spec; subst; simpl in *;
    auto.
  Qed.

  Lemma doLeader_currentTerm :
        forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      currentTerm st' = currentTerm st.
  Proof using.
    intros. unfold doLeader in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma handleAppendEntriesReply_currentTerm :
    forall h st h' t es r st' ms,
      handleAppendEntriesReply h st h' t es r = (st', ms) ->
      currentTerm st <= currentTerm st'.
  Proof using.
    intros. unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; tuple_inversion; do_bool; simpl; auto; lia.
  Qed.

  Lemma handleAppendEntries_currentTerm :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      currentTerm st <= currentTerm st'.
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; do_bool; auto.
  Qed.

  Lemma tryToBecomeLeader_currentTerm :
    forall h st out st' l,
      tryToBecomeLeader h st = (out, st', l) ->
      currentTerm st <= currentTerm st'.
  Proof using.
    unfold tryToBecomeLeader.
    intros.
    find_inversion. simpl.
    auto with arith.
  Qed.

  Lemma handleTimeout_currentTerm :
    forall h st out st' l,
      handleTimeout h st = (out, st', l) ->
      currentTerm st <= currentTerm st'.
  Proof using.
    unfold handleTimeout.
    intros.
    break_match; eauto using tryToBecomeLeader_currentTerm.
    find_inversion. simpl.
    auto with arith.
  Qed.

  Lemma haveNewEntries_not_empty :
    forall st es,
      haveNewEntries st es = true ->
      es <> [].
  Proof using.
    intros. unfold haveNewEntries, not_empty in *.
    do_bool. intuition. repeat break_match; congruence.
  Qed.

  Lemma advanceCurrentTerm_log :
    forall st t,
      log (advanceCurrentTerm st t) = log st.
  Proof using.
    intros.
    unfold advanceCurrentTerm. break_if; simpl in *; auto.
  Qed.

  Theorem handleAppendEntries_log :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      log st' = log st \/
      (currentTerm st <= t /\ es <> [] /\ pli = 0 /\ log st' = es) \/
      (currentTerm st <= t /\ es <> [] /\ pli <> 0 /\ exists e,
         In e (log st) /\
         eIndex e = pli /\
         eTerm e = plt) /\
      log st' = es ++ (removeAfterIndex (log st) pli).
  Proof using.
    intros. unfold handleAppendEntries in *.
    break_if; [find_inversion; subst; eauto|].
    break_if;
      [do_bool; break_if; find_inversion; subst;
       try find_apply_lem_hyp haveNewEntries_not_empty; intuition; simpl in *;
       eauto using advanceCurrentTerm_log|].
    break_if.
    - break_match; [|find_inversion; subst; eauto].
      break_if; [find_inversion; subst; eauto|].
      find_inversion; subst; simpl in *.
      right. right.
      find_apply_lem_hyp findAtIndex_elim. intuition; do_bool; eauto.
      find_apply_lem_hyp haveNewEntries_not_empty. congruence.
    - repeat break_match; find_inversion; subst; eauto.
      simpl in *. eauto using advanceCurrentTerm_log.
  Qed.

  Theorem handleAppendEntries_log_ind :
    forall {h st t n pli plt es ci st' ps},
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      forall (P : list entry -> Prop),
        P (log st) ->
        (pli = 0 -> P es) ->
        (forall e,
           pli <> 0 ->
           In e (log st) ->
           eIndex e = pli ->
           eTerm e = plt ->
           P (es ++ (removeAfterIndex (log st) pli))) ->
        P (log st').
  Proof using.
    intros.
    find_apply_lem_hyp handleAppendEntries_log.
    intuition; subst; try find_rewrite; auto.
    break_exists. intuition eauto.
  Qed.

  Lemma haveNewEntries_true :
    forall st es,
      haveNewEntries st es = true ->
      (es <> nil /\
       (findAtIndex (log st) (maxIndex es) = None \/
        exists e,
          findAtIndex (log st) (maxIndex es) = Some e /\
          eTerm e <> maxTerm es)).
  Proof using.
    intros.
    unfold haveNewEntries, not_empty in *.
    repeat break_match; do_bool; intuition eauto; try congruence.
    do_bool. eauto.
  Qed.

  Lemma advanceCurrentTerm_commitIndex :
    forall st t,
      commitIndex (advanceCurrentTerm st t) = commitIndex st.
  Proof using.
    intros.
    unfold advanceCurrentTerm. break_if; simpl in *; auto.
  Qed.

  Lemma some_none :
    forall A (x : A),
      Some x = None -> False.
  Proof using.
    congruence.
  Qed.

  Lemma advanceCurrentTerm_term :
    forall st t,
      currentTerm st <= t ->
      currentTerm (advanceCurrentTerm st t) = t.
  Proof using.
    intros. unfold advanceCurrentTerm in *.
    break_if; do_bool; intuition.
  Qed.

  Theorem handleAppendEntries_log_detailed :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      (commitIndex st' = commitIndex st /\ log st' = log st) \/
      (leaderId st' <> None /\
       currentTerm st' = t /\
       commitIndex st' = max (commitIndex st) (min ci (maxIndex es)) /\
       es <> nil /\
       pli = 0 /\ t >= currentTerm st /\ log st' = es /\
       (findAtIndex (log st) (maxIndex es) = None \/
        exists e,
          findAtIndex (log st) (maxIndex es) = Some e /\
          eTerm e <> maxTerm es)) \/
      (leaderId st' <> None /\
       currentTerm st' = t /\
       commitIndex st' = max (commitIndex st)
                             (min ci (maxIndex (es ++ (removeAfterIndex (log st) pli)))) /\
       es <> nil /\
        exists e,
         In e (log st) /\
         eIndex e = pli /\
         eTerm e = plt) /\
      t >= currentTerm st /\
      log st' = es ++ (removeAfterIndex (log st) pli) /\
      (findAtIndex (log st) (maxIndex es) = None \/
       exists e,
         findAtIndex (log st) (maxIndex es) = Some e /\
         eTerm e <> maxTerm es).
  Proof using.
    intros. unfold handleAppendEntries in *.
    break_if; [find_inversion; subst; eauto|].
    break_if;
      [do_bool; break_if; find_inversion; subst;
        try find_apply_lem_hyp haveNewEntries_true;
        simpl in *; intuition eauto using advanceCurrentTerm_log, advanceCurrentTerm_commitIndex, some_none, advanceCurrentTerm_term|].
    simpl in *. intuition eauto using advanceCurrentTerm_log, advanceCurrentTerm_commitIndex.
    break_match; [|find_inversion; subst; eauto].
    break_if; [find_inversion; subst; eauto|].
    break_if; [|find_inversion; subst; eauto using advanceCurrentTerm_log, advanceCurrentTerm_commitIndex].
    find_inversion; subst; simpl in *.
    right. right.
    find_apply_lem_hyp findAtIndex_elim.
    intuition; do_bool; find_apply_lem_hyp haveNewEntries_true;
    intuition eauto using advanceCurrentTerm_term; congruence.
  Qed.

  Lemma advanceCurrentTerm_currentTerm_leaderId :
    forall st t,
      currentTerm st < currentTerm (advanceCurrentTerm st t) \/
      leaderId (advanceCurrentTerm st t) = leaderId st.
  Proof using.
    intros.
    unfold advanceCurrentTerm in *.
    break_if; simpl in *; do_bool; auto.
  Qed.

  Lemma advanceCurrentTerm_currentTerm :
    forall st t,
      currentTerm st <= currentTerm (advanceCurrentTerm st t).
  Proof using.
    intros. unfold advanceCurrentTerm in *.
    break_if; simpl in *; do_bool; lia.
  Qed.

  Lemma handleRequestVote_currentTerm_monotonic :
    forall pDst t cid lli llt d d' m,
      handleRequestVote pDst d t cid lli llt = (d', m) ->
      currentTerm d <= currentTerm d'.
  Proof using.
    intros.
    unfold handleRequestVote in *.
    repeat break_match; find_inversion; subst; auto;
    simpl in *; apply advanceCurrentTerm_currentTerm.
  Qed.

  Lemma handleRequestVote_currentTerm_votedFor :
    forall pDst t cid lli llt d d' m,
      handleRequestVote pDst d t cid lli llt = (d', m) ->
      (currentTerm d < currentTerm d' \/
       (currentTerm d = currentTerm d' /\ votedFor d = None) \/
       (currentTerm d = currentTerm d' /\ votedFor d = votedFor d')).
  Proof using.
    intros.
    find_copy_apply_lem_hyp handleRequestVote_currentTerm_monotonic.
    find_apply_lem_hyp Nat.lt_eq_cases. intuition.
    right. find_apply_lem_hyp handleRequestVote_votedFor; intuition.
  Qed.

  Lemma handleRequestVoteReply_currentTerm' :
    forall h st h' t r st',
      handleRequestVoteReply h st h' t r = st' ->
      currentTerm st <= currentTerm st'.
  Proof using.
    intros. unfold handleRequestVoteReply in *.
    repeat break_match; subst; do_bool; intuition.
    apply advanceCurrentTerm_currentTerm.
  Qed.

  Lemma handleRequestVote_currentTerm :
    forall st h h' t lli llt st' m,
      handleRequestVote h st t h' lli llt = (st', m) ->
      currentTerm st <= currentTerm st'.
  Proof using.
    intros. unfold handleRequestVote in *.
    repeat break_match; tuple_inversion; do_bool;
      simpl; auto using advanceCurrentTerm_currentTerm.
  Qed.

  Theorem handleAppendEntries_currentTerm_leaderId :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      currentTerm st < currentTerm st' \/
      (currentTerm st <= currentTerm st' /\ (leaderId st' = leaderId st \/ leaderId st' <> None)).
  Proof using.
    intros. unfold handleAppendEntries in *.
    repeat break_match; find_inversion; simpl in *; auto; right;
    intuition eauto using advanceCurrentTerm_currentTerm; right; congruence.
  Qed.

  Lemma handleRequestVote_currentTerm_leaderId :
    forall h st t c li lt st' m,
      handleRequestVote h st t c li lt = (st', m) ->
      currentTerm st < currentTerm st' \/
      (currentTerm st = currentTerm st' /\ leaderId st' = leaderId st).
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat (break_match; try find_inversion; simpl in *; auto);
    do_bool; auto.
  Qed.

  Lemma handleRequestVoteReply_currentTerm_leaderId :
    forall h st h' t r st',
      handleRequestVoteReply h st h' t r = st' ->
      currentTerm st < currentTerm st' \/
      currentTerm st' = currentTerm st /\
      leaderId st' = leaderId st.
  Proof using.
    intros. unfold handleRequestVoteReply, advanceCurrentTerm in *.
    subst.
    repeat (break_match; try find_inversion; simpl in *; auto);
      do_bool; auto.
  Qed.

  Theorem handleClientRequest_log :
    forall h st client id c out st' ps,
      handleClientRequest h st client id c = (out, st', ps) ->
      ps = [] /\
      (log st' = log st \/
       exists e,
         log st' = e :: log st /\
         eIndex e = S (maxIndex (log st)) /\
         eTerm e = currentTerm st /\
         eClient e = client /\
         eInput e = c /\
         eId e = id /\
         type st = Leader).
  Proof using.
    intros. unfold handleClientRequest in *.
    break_match; find_inversion; subst; intuition.
    simpl in *. eauto 10.
  Qed.

  Lemma handleClientRequest_log_ind :
    forall {h st client id c out st' ps},
      handleClientRequest h st client id c = (out, st', ps) ->
      forall (P : list entry -> Prop),
        P (log st) ->
        (forall e, eIndex e = S (maxIndex (log st)) ->
                   eTerm e = currentTerm st ->
                   eClient e = client ->
                   eInput e = c ->
                   eId e = id ->
                   type st = Leader ->
                   P (e :: log st)) ->
        P (log st').
  Proof using.
    intros.
    find_apply_lem_hyp handleClientRequest_log.
    intuition; repeat find_rewrite; auto.
    break_exists. intuition. repeat find_rewrite. eauto.
  Qed.

  Lemma handleRequestVote_log :
    forall h st t candidate lli llt st' m,
      handleRequestVote h st t candidate lli llt = (st', m) ->
      log st' = log st.
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat break_match; find_inversion; subst; auto.
  Qed.

  Lemma handleTimeout_log_same :
    forall h d out d' l,
      handleTimeout h d = (out, d', l) ->
      log d' = log d.
  Proof using.
    unfold handleTimeout, tryToBecomeLeader.
    intros.
    repeat break_match; repeat find_inversion; auto.
  Qed.

  Lemma doGenericServer_log :
    forall h st os st' ps,
      doGenericServer h st = (os, st', ps) ->
      log st' = log st.
  Proof using.
    intros. unfold doGenericServer in *.
    repeat break_match; find_inversion;
    use_applyEntries_spec; simpl in *;
    subst; auto.
  Qed.

  Lemma handleRequestVoteReply_spec :
    forall h st h' t r st',
      st' = handleRequestVoteReply h st h' t r ->
      log st' = log st /\
      (forall v, In v (votesReceived st) -> In v (votesReceived st')) /\
      ((currentTerm st' = currentTerm st /\ type st' = type st)
       \/ type st' <> Candidate) /\
      (type st <> Leader /\ type st' = Leader ->
       (type st = Candidate /\ wonElection (dedup name_eq_dec
                                                 (votesReceived st')) = true)).
  Proof using.
    intros.
    unfold handleRequestVoteReply, advanceCurrentTerm in *.
    repeat break_match; try find_inversion; subst; simpl in *; intuition;
    do_bool; intuition; try right; congruence.
  Qed.

  Lemma handleRequestVoteReply_spec' :
    forall h st h' t r st',
      st' = handleRequestVoteReply h st h' t r ->
      log st' = log st /\
      (forall v, In v (votesReceived st) -> In v (votesReceived st')) /\
      (type st <> Leader /\ type st' = Leader ->
       (type st = Candidate /\ wonElection (dedup name_eq_dec
                                                 (votesReceived st')) = true) /\
       r = true /\
       currentTerm st' = currentTerm st /\
       currentTerm st = t /\
       votesReceived st' = (h' :: (votesReceived st))).
  Proof using.
    intros.
    unfold handleRequestVoteReply, advanceCurrentTerm in *.
    repeat break_match; try find_inversion; subst; simpl in *; intuition;
    do_bool; intuition; try right; congruence.
  Qed.

  Theorem handleTimeout_not_is_append_entries :
    forall h st st' ms m,
      handleTimeout h st = (st', ms) ->
      In m ms -> ~ is_append_entries (snd m).
  Proof using.
    intros. unfold handleTimeout, tryToBecomeLeader in *.
    break_match; find_inversion; subst; simpl in *; eauto;
    repeat (do_in_map; subst; simpl in *); intuition; break_exists; congruence.
  Qed.

  Lemma handleAppendEntries_type :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      type st' = Follower.
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma handleAppendEntries_type_term :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      (type st' = Follower /\ currentTerm st' >= currentTerm st).
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; do_bool; auto.
  Qed.

  Lemma handleAppendEntriesReply_type :
    forall h st h' t es r st' ms,
      handleAppendEntriesReply h st h' t es r = (st', ms) ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      type st' = Follower.
  Proof using.
    intros. unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma handleAppendEntriesReply_type_term :
    forall h st h' t es r st' ms,
      handleAppendEntriesReply h st h' t es r = (st', ms) ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      (type st' = Follower /\ currentTerm st' >= currentTerm st).
  Proof using.
    intros. unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; tuple_inversion; do_bool; intuition.
  Qed.

  Lemma handleRequestVote_type :
    forall st h h' t lli llt st' m,
      handleRequestVote h st t h' lli llt = (st', m) ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      type st' = Follower.
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma handleRequestVote_type_term :
    forall st h h' t lli llt st' m,
      handleRequestVote h st t h' lli llt = (st', m) ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      (type st' = Follower /\ currentTerm st' >= currentTerm st).
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat break_match; tuple_inversion; do_bool; auto.
  Qed.

  Lemma handleRequestVoteReply_type :
    forall h st h' t r st',
      handleRequestVoteReply h st h' t r = st' ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      (type st' = Follower /\ currentTerm st' > currentTerm st) \/
      (type st = Candidate /\ type st' = Leader /\ currentTerm st' = currentTerm st).
  Proof using.
    intros. unfold handleRequestVoteReply, advanceCurrentTerm in *.
    repeat break_match; subst; do_bool; intuition.
  Qed.

  Lemma handleClientRequest_type :
    forall h st client id c out st' l,
      handleClientRequest h st client id c = (out, st', l) ->
      type st' = type st /\ currentTerm st' = currentTerm st.
  Proof using.
    intros. unfold handleClientRequest in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma handleClientRequest_currentTerm :
    forall h st client id c out st' l,
      handleClientRequest h st client id c = (out, st', l) ->
      currentTerm st' = currentTerm st.
  Proof using.
    intros.
    find_apply_lem_hyp handleClientRequest_type.
    intuition.
  Qed.

  Lemma handleTimeout_type :
    forall h st out st' l,
      handleTimeout h st = (out, st', l) ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      type st' = Candidate.
  Proof using.
    intros. unfold handleTimeout, tryToBecomeLeader in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma handleTimeout_type_strong :
    forall h st out st' l,
      handleTimeout h st = (out, st', l) ->
      (type st' = type st /\ currentTerm st' = currentTerm st) \/
      (type st' = Candidate /\ currentTerm st' = S (currentTerm st)).
  Proof using.
    intros. unfold handleTimeout, tryToBecomeLeader in *.
    repeat break_match; find_inversion; simpl; intuition.
  Qed.

  Lemma doGenericServer_type :
    forall h st os st' ms,
      doGenericServer h st = (os, st', ms) ->
      type st' = type st /\ currentTerm st' = currentTerm st.
  Proof using.
    unfold doGenericServer.
    intros.
    repeat break_match; repeat find_inversion;
    use_applyEntries_spec; subst; simpl in *;
    auto.
  Qed.

  Lemma doLeader_type :
        forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      type st' = type st /\ currentTerm st' = currentTerm st.
  Proof using.
    intros. unfold doLeader in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma doLeader_log :
    forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      log st' = log st.
  Proof using.
    unfold doLeader. intros.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Lemma handleAppendEntriesReply_log :
    forall h st h' t es r st' ms,
      handleAppendEntriesReply h st h' t es r = (st', ms) ->
      log st' = log st.
  Proof using.
    unfold handleAppendEntriesReply, advanceCurrentTerm.
    intros.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Lemma handleRequestVoteReply_log :
    forall h st h' t r st',
      handleRequestVoteReply h st h' t r = st' ->
      log st' = log st.
  Proof using.
    intros.
    eapply handleRequestVoteReply_spec; eauto.
  Qed.

  Lemma handleRequestVoteReply_log_rewrite :
    forall h st h' t r,
      log (handleRequestVoteReply h st h' t r) = log st.
  Proof using.
    intros.
    erewrite handleRequestVoteReply_log; eauto.
  Qed.

  Lemma handleAppendEntriesReply_packets :
    forall h st from t es s st' ps,
      handleAppendEntriesReply h st from t es s = (st', ps) ->
      ps = [].
  Proof using.
    intros. unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; find_inversion; subst; auto.
  Qed.

  Lemma doGenericServer_packets :
    forall h st os st' ps,
      doGenericServer h st = (os, st', ps) ->
      ps = [].
  Proof using.
    intros. unfold doGenericServer in *.
    repeat break_match; find_inversion; simpl in *;
    subst; auto.
  Qed.

  Theorem handleAppendEntries_not_append_entries :
    forall h st t n pli plt es ci st' m,
      handleAppendEntries h st t n pli plt es ci = (st', m) ->
      ~ is_append_entries m.
  Proof using.
    intros. unfold handleAppendEntries in *.
    repeat break_match; find_inversion;
    intuition; break_exists; congruence.
  Qed.

  Lemma handleAppendEntries_clientCache:
    forall h st (d : raft_data)
      (m : msg) (t : term) (n : name) (pli : logIndex)
      (plt : term) (es : list entry) (ci : logIndex),
      handleAppendEntries h st t n pli plt es ci = (d, m) ->
      clientCache d = clientCache st.
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Lemma handleAppendEntriesReply_clientCache:
    forall h st (d : raft_data)
      (m : list (name * msg)) (t : nat) (es : list entry)
      (res : bool) h',
      handleAppendEntriesReply h st h' t es res = (d, m) ->
      clientCache d = clientCache st.
  Proof using.
    intros.
    unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat (break_match; try find_inversion; simpl in *; auto).
  Qed.

  Lemma advanceCurrentTerm_clientCache :
    forall st t,
      clientCache (advanceCurrentTerm st t) = clientCache st.
  Proof using.
    unfold advanceCurrentTerm. intros.
    break_if; auto.
  Qed.

  Theorem handleTimeout_clientCache :
    forall h st out st' ps,
      handleTimeout h st = (out, st', ps) ->
      clientCache st' = clientCache st.
  Proof using.
    intros. unfold handleTimeout, tryToBecomeLeader in *.
    break_match; find_inversion; subst; auto.
  Qed.

  Theorem handleClientRequest_clientCache:
  forall h st client id c out st' ps,
    handleClientRequest h st client id c = (out, st', ps) ->
    clientCache st' = clientCache st.
  Proof using.
    intros. unfold handleClientRequest in *.
    break_match; find_inversion; subst; auto.
  Qed.

  Lemma tryToBecomeLeader_clientCache :
    forall n st out st' ms,
      tryToBecomeLeader n st = (out, st', ms) ->
      clientCache st' = clientCache st.
  Proof using.
    unfold tryToBecomeLeader.
    intros. find_inversion. auto.
  Qed.

  Lemma handleRequestVote_clientCache :
    forall n st t c li lt st' ms,
      handleRequestVote n st t c li lt = (st', ms) ->
      clientCache st' = clientCache st.
  Proof using.
    unfold handleRequestVote.
    intros.
    repeat (break_match; try discriminate; repeat (find_inversion; simpl in *));
      auto using advanceCurrentTerm_clientCache.
  Qed.

  Lemma handleRequestVoteReply_clientCache :
    forall n st src t v,
      clientCache (handleRequestVoteReply n st src t v) = clientCache st.
  Proof using.
    unfold handleRequestVoteReply.
    intros. repeat break_match; simpl; auto using advanceCurrentTerm_clientCache.
  Qed.

  Lemma doLeader_clientCache :
        forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      clientCache st' = clientCache st.
  Proof using.
    intros. unfold doLeader in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma handleAppendEntries_stateMachine:
    forall h st (d : raft_data)
      (m : msg) (t : term) (n : name) (pli : logIndex)
      (plt : term) (es : list entry) (ci : logIndex),
      handleAppendEntries h st t n pli plt es ci = (d, m) ->
      stateMachine d = stateMachine st.
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Lemma handleAppendEntriesReply_stateMachine:
    forall h st (d : raft_data)
      (m : list (name * msg)) (t : nat) (es : list entry)
      (res : bool) h',
      handleAppendEntriesReply h st h' t es res = (d, m) ->
      stateMachine d = stateMachine st.
  Proof using.
    intros.
    unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat (break_match; try find_inversion; simpl in *; auto).
  Qed.

  Lemma advanceCurrentTerm_stateMachine :
    forall st t,
      stateMachine (advanceCurrentTerm st t) = stateMachine st.
  Proof using.
    unfold advanceCurrentTerm. intros.
    break_if; auto.
  Qed.

  Theorem handleTimeout_stateMachine :
    forall h st out st' ps,
      handleTimeout h st = (out, st', ps) ->
      stateMachine st' = stateMachine st.
  Proof using.
    intros. unfold handleTimeout, tryToBecomeLeader in *.
    break_match; find_inversion; subst; auto.
  Qed.

  Theorem handleClientRequest_stateMachine:
  forall h st client id c out st' ps,
    handleClientRequest h st client id c = (out, st', ps) ->
    stateMachine st' = stateMachine st.
  Proof using.
    intros. unfold handleClientRequest in *.
    break_match; find_inversion; subst; auto.
  Qed.

  Lemma tryToBecomeLeader_stateMachine :
    forall n st out st' ms,
      tryToBecomeLeader n st = (out, st', ms) ->
      stateMachine st' = stateMachine st.
  Proof using.
    unfold tryToBecomeLeader.
    intros. find_inversion. auto.
  Qed.

  Lemma handleRequestVote_stateMachine :
    forall n st t c li lt st' ms,
      handleRequestVote n st t c li lt = (st', ms) ->
      stateMachine st' = stateMachine st.
  Proof using.
    unfold handleRequestVote.
    intros.
    repeat (break_match; try discriminate; repeat (find_inversion; simpl in *));
      auto using advanceCurrentTerm_stateMachine.
  Qed.

  Lemma handleRequestVoteReply_stateMachine :
    forall n st src t v,
      stateMachine (handleRequestVoteReply n st src t v) = stateMachine st.
  Proof using.
    unfold handleRequestVoteReply.
    intros. repeat break_match; simpl; auto using advanceCurrentTerm_stateMachine.
  Qed.

  Lemma doLeader_stateMachine :
        forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      stateMachine st' = stateMachine st.
  Proof using.
    intros. unfold doLeader in *.
    repeat break_match; find_inversion; auto.
  Qed.

(* matchIndex *)
  Definition matchIndex_preserved st st' :=
    type st' = Leader ->
    (type st = Leader /\ matchIndex st' = matchIndex st /\ log st' = log st).

  Arguments matchIndex_preserved / _ _.

  Definition matchIndex_preserved_except_at_host h st st' :=
    type st' = Leader ->
    (type st = Leader /\
     forall h',
       h <> h' ->
       (assoc_default name_eq_dec (matchIndex st') h' 0) = (assoc_default name_eq_dec (matchIndex st) h') 0).

  Arguments matchIndex_preserved_except_at_host / _ _ _.

  Lemma handleAppendEntries_matchIndex_preserved:
    forall h st (d : raft_data)
      (m : msg) (t : term) (n : name) (pli : logIndex)
      (plt : term) (es : list entry) (ci : logIndex),
      handleAppendEntries h st t n pli plt es ci = (d, m) ->
      matchIndex_preserved st d.
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto; intros; congruence.
  Qed.

  Lemma handleAppendEntriesReply_matchIndex_leader_preserved:
    forall h st (d : raft_data)
      (m : list (name * msg)) (t : nat) (es : list entry)
      (res : bool) h',
      handleAppendEntriesReply h st h' t es res = (d, m) ->
      matchIndex_preserved_except_at_host h' st d.
  Proof using.
    intros.
    unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat (break_match; try find_inversion; simpl in *; auto);
      [|intros; congruence].
    intros. intuition.
    unfold assoc_default.
    repeat break_match; rewrite get_set_diff in *; repeat find_rewrite; congruence.
  Qed.

  Lemma advanceCurrentTerm_matchIndex_preserved :
    forall st t,
      matchIndex_preserved st (advanceCurrentTerm st t).
  Proof using.
    unfold advanceCurrentTerm. intros.
    break_if; simpl in *; auto; congruence.
  Qed.

  Theorem handleTimeout_matchIndex_preserved :
    forall h st out st' ps,
      handleTimeout h st = (out, st', ps) ->
      matchIndex_preserved st st'.
  Proof using.
    intros. unfold handleTimeout, tryToBecomeLeader in *.
    break_match; simpl in *; find_inversion; subst; simpl in *; auto; congruence.
  Qed.

  Theorem handleClientRequest_matchIndex_maxIndex:
  forall h st client id c out st' ps,
    handleClientRequest h st client id c = (out, st', ps) ->
    (maxIndex (log st') = maxIndex (log st) /\
     matchIndex st' = matchIndex st) \/
    (assoc_default name_eq_dec (matchIndex st') h 0) = maxIndex (log st').
  Proof using.
    intros. unfold handleClientRequest in *.
    break_match; find_inversion; subst; simpl in *; auto.
    unfold assoc_default. break_match;
    rewrite get_set_same in *; try congruence; find_inversion; auto.
  Qed.

  Theorem handleClientRequest_matchIndex :
    forall h st client id c out st' ps,
      handleClientRequest h st client id c = (out, st', ps) ->
      (maxIndex (log st') = maxIndex (log st) /\
       matchIndex st' = matchIndex st) \/
      matchIndex st' = assoc_set name_eq_dec (matchIndex st) h (maxIndex (log st')) /\
      maxIndex (log st') = S (maxIndex (log st)).
  Proof using.
    unfold handleClientRequest.
    intros.
    repeat break_match; repeat find_inversion; auto.
  Qed.

  Lemma tryToBecomeLeader_matchIndex_preserved :
    forall n st out st' ms,
      tryToBecomeLeader n st = (out, st', ms) ->
      matchIndex_preserved st st'.
  Proof using.
    unfold tryToBecomeLeader.
    intros. find_inversion. simpl; intros; auto; congruence.
  Qed.

  Lemma handleRequestVote_matchIndex_preserved :
    forall n st t c li lt st' ms,
      handleRequestVote n st t c li lt = (st', ms) ->
      matchIndex_preserved st st'.
  Proof using.
    unfold handleRequestVote, advanceCurrentTerm.
    intros.
    repeat (break_match; try discriminate; repeat (find_inversion; simpl in *)); auto.
  Qed.

  Lemma doGenericServer_matchIndex_preserved :
    forall h st os st' ps,
      doGenericServer h st = (os, st', ps) ->
      matchIndex_preserved st st'.
  Proof using.
    intros. unfold doGenericServer in *.
    repeat break_match; find_inversion;
    use_applyEntries_spec; simpl in *;
    subst; auto.
  Qed.

  Lemma handleRequestVoteReply_matchIndex :
    forall n st src t v,
      type (handleRequestVoteReply n st src t v) = Leader ->
      (type st = Leader /\ matchIndex (handleRequestVoteReply n st src t v) = matchIndex st) \/
      (assoc_default name_eq_dec (matchIndex (handleRequestVoteReply n st src t v)) n 0
       = maxIndex (log (handleRequestVoteReply n st src t v))).
  Proof using.
    unfold handleRequestVoteReply.
    intros.
    repeat break_match; simpl; auto using advanceCurrentTerm_matchIndex_preserved;
    simpl in *; try congruence.
    unfold assoc_default. simpl.
    repeat break_match; simpl in *; try congruence; find_inversion; auto.
  Qed.

  Lemma doLeader_matchIndex_preserved :
        forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      matchIndex_preserved st st'.
  Proof using.
    intros. unfold doLeader in *. simpl; intros.
    repeat break_match; find_inversion; auto; congruence.
  Qed.

  Lemma doLeader_lastApplied :
        forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      lastApplied st' = lastApplied st.
  Proof using.
    intros. unfold doLeader in *.
    repeat break_match; find_inversion; auto.
  Qed.
  Lemma handleRequestVote_no_append_entries :
    forall st h h' t lli llt st' m,
      handleRequestVote h st t h' lli llt = (st', m) ->
      ~ is_append_entries m.
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat break_match; find_inversion; subst; auto;
    intuition; break_exists; congruence.
  Qed.

  Theorem handleClientRequest_no_append_entries :
    forall h st client id c out st' ps m,
      handleClientRequest h st client id c = (out, st', ps) ->
      In m ps ->
      ~ is_append_entries (snd m).
  Proof using.
    intros. unfold handleClientRequest in *.
    repeat break_match; find_inversion; subst; auto;
    intuition; break_exists; congruence.
  Qed.

  Theorem handleClientRequest_packets :
    forall h st client id c out st' ps,
      handleClientRequest h st client id c = (out, st', ps) ->
      ps = [].
  Proof using.
    intros. unfold handleClientRequest in *.
    repeat break_match; repeat find_inversion; auto.
  Qed.

  Lemma handleTimeout_packets :
    forall h d out d' ps m,
      handleTimeout h d = (out, d', ps) ->
      In m ps ->
      ~ is_append_entries (snd m).
  Proof using.
    intros. unfold handleTimeout, tryToBecomeLeader in *.
    repeat break_match; find_inversion; subst; auto;
    intuition; break_exists;
    do_in_map; subst; simpl in *; congruence.
  Qed.

  Lemma doLeader_messages :
    forall st h os st' ms m t n pli plt es ci,
      doLeader st h = (os, st', ms) ->
      In m ms ->
      snd m = AppendEntries t n pli plt es ci ->
      t = currentTerm st /\
      log st' = log st /\
      type st = Leader /\
      ((plt = 0) \/
       ((exists e, findAtIndex (log st) pli = Some e /\
              eTerm e = plt))).
  Proof using.
    intros. unfold doLeader, advanceCommitIndex in *.
    break_match; try solve [find_inversion; simpl in *; intuition].
    break_if; try solve [find_inversion; simpl in *; intuition].
    find_inversion. simpl. do_in_map. subst.
    simpl in *. find_inversion. intuition.
    match goal with
      | |- context [pred ?x] =>
        remember (pred x) as index
    end. break_match; simpl in *.
    - right. eauto.
    - destruct index; intuition.
  Qed.

  Lemma doLeader_message_entries :
    forall st h os st' ms m t n pli plt es ci e,
      doLeader st h = (os, st', ms) ->
      In m ms ->
      snd m = AppendEntries t n pli plt es ci ->
      In e es ->
      In e (log st).
  Proof using.
    intros. unfold doLeader, advanceCommitIndex in *.
    break_match; try solve [find_inversion; simpl in *; intuition].
    break_if; try solve [find_inversion; simpl in *; intuition].
    find_inversion. simpl. do_in_map. subst.
    simpl in *. find_inversion.
    eauto using findGtIndex_in.
  Qed.

  Theorem handleAppendEntries_log_term_type :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      (log st' = log st /\ currentTerm st' = currentTerm st /\ type st' = type st) \/
      type st' = Follower.
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Theorem handleAppendEntries_votesReceived :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      votesReceived st' = votesReceived st.
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Theorem handleAppendEntriesReply_log_term_type :
    forall h st n t es r st' ps,
      handleAppendEntriesReply h st n t es r = (st', ps) ->
      (log st' = log st /\ currentTerm st' = currentTerm st /\ type st' = type st) \/
      type st' = Follower.
  Proof using.
    intros. unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Theorem handleAppendEntriesReply_votesReceived :
    forall h st n t es r st' ps,
      handleAppendEntriesReply h st n t es r = (st', ps) ->
      votesReceived st' = votesReceived st.
  Proof using.
    intros. unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Theorem handleRequestVote_log_term_type :
    forall h st t c li lt st' m,
      handleRequestVote h st t c li lt = (st', m) ->
      (log st' = log st /\ currentTerm st' = currentTerm st /\ type st' = type st) \/
      type st' = Follower.
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Theorem handleRequestVote_votesReceived :
    forall h st t c li lt st' m,
      handleRequestVote h st t c li lt = (st', m) ->
      votesReceived st' = votesReceived st.
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto.
  Qed.

  Theorem handleRequestVoteReply_log_term_type :
    forall h st t h' r st',
      type st' = Candidate ->
      handleRequestVoteReply h st h' t r = st' ->
      (log st' = log st /\ currentTerm st' = currentTerm st /\ type st' = type st).
  Proof using.
    intros. unfold handleRequestVoteReply, advanceCurrentTerm in *.
    repeat break_match; subst; simpl in *; auto; congruence.
  Qed.

  Theorem handleRequestVoteReply_votesReceived :
    forall h st t h' r v,
      In v (votesReceived (handleRequestVoteReply h st h' t r)) ->
      In v (votesReceived st) \/
      (r = true /\ v = h' /\ currentTerm (handleRequestVoteReply h st h' t r) = t).
  Proof using.
    intros. unfold handleRequestVoteReply, advanceCurrentTerm in *.
    repeat break_match; subst; simpl in *; do_bool; intuition.
  Qed.

  Theorem handleTimeout_log_term_type :
    forall h st out st' ps,
      handleTimeout h st = (out, st', ps) ->
      (log st' = log st /\ currentTerm st' = currentTerm st /\ type st' = type st) \/
      currentTerm st' = S (currentTerm st).
  Proof using.
    intros. unfold handleTimeout, tryToBecomeLeader in *.
    repeat break_match; find_inversion; simpl in *; intuition.
  Qed.

  Lemma handleClientRequest_candidate :
    forall h st client id c os st' m,
      handleClientRequest h st client id c = (os, st', m) ->
      type st' = Candidate ->
      st' = st.
  Proof using.
    intros.
    unfold handleClientRequest in *.
    repeat break_match; find_inversion; simpl in *; congruence.
  Qed.

  Lemma doLeader_candidate :
    forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      type st' = Candidate ->
      st' = st.
  Proof using.
    unfold doLeader, advanceCommitIndex in *.
    intros.
    repeat break_match; find_inversion; simpl in *; congruence.
  Qed.

  Lemma doLeader_term_votedFor :
    forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      currentTerm st' = currentTerm st /\
      votedFor st' = votedFor st.
  Proof using.
    unfold doLeader, advanceCommitIndex in *.
    intros.
    repeat break_match; find_inversion; simpl in *; intuition.
  Qed.

  Lemma doGenericServer_log_type_term_votesReceived :
    forall h st os st' ps,
      doGenericServer h st = (os, st', ps) ->
      log st' = log st /\
      type st' = type st /\
      currentTerm st' = currentTerm st /\
      votesReceived st' = votesReceived st /\
      votedFor st' = votedFor st.
  Proof using.
    intros. unfold doGenericServer in *.
    repeat break_match; find_inversion;
    use_applyEntries_spec; simpl in *;
    subst; auto.
  Qed.

  Lemma handleClientRequest_term_votedFor :
    forall h st client id c os st' m,
      handleClientRequest h st client id c = (os, st', m) ->
      type st' = type st /\
      currentTerm st' = currentTerm st /\
      votedFor st' = votedFor st.
  Proof using.
    intros.
    unfold handleClientRequest in *.
    repeat break_match; find_inversion; simpl in *; intuition.
  Qed.

  Theorem handleAppendEntries_term_votedFor :
    forall h st t n pli plt es ci st' ps h',
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      votedFor st' = Some h' ->
      currentTerm st' = currentTerm st /\ votedFor st' = votedFor st.
  Proof using.
    intros. unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto; congruence.
  Qed.

  Theorem handleAppendEntriesReply_term_votedFor :
    forall h st n t es r st' ps h',
      handleAppendEntriesReply h st n t es r = (st', ps) ->
      votedFor st' = Some h' ->
      currentTerm st' = currentTerm st /\ votedFor st' = votedFor st.
  Proof using.
    intros. unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; auto; congruence.
  Qed.

  Theorem handleRequestVoteReply_term_votedFor :
    forall h st t h' h'' r st',
      handleRequestVoteReply h st h' t r = st' ->
      votedFor st' = Some h'' ->
      currentTerm st' = currentTerm st /\ votedFor st' = votedFor st.
  Proof using.
    intros. unfold handleRequestVoteReply, advanceCurrentTerm in *.
    repeat break_match; subst; simpl in *; auto; congruence.
  Qed.

  Lemma handleRequestVote_reply_true:
    forall h h' st t lli llt st' t',
      handleRequestVote h st t h' lli llt =
      (st', RequestVoteReply t' true) ->
      votedFor st' = Some h' /\
      currentTerm st' = t'.
  Proof using.
    intros. unfold handleRequestVote, advanceCurrentTerm in *.
    repeat break_match; find_inversion; simpl in *; intuition.
  Qed.

  Lemma handleTimeout_messages:
    forall (out : list raft_output)
      (st : raft_data) (l : list (name * msg)) h
      (mi : logIndex) (mt : term) m st' t n,
      handleTimeout h st = (out, st', l) ->
      In m l ->
      snd m = RequestVote t n mi mt ->
      maxIndex (log st') = mi /\ maxTerm (log st') = mt /\ t = currentTerm st'.
  Proof using.
    intros.
    unfold handleTimeout, tryToBecomeLeader in *.
    repeat break_match; find_inversion; simpl in *; intuition;
    do_in_map; subst; simpl in *; find_inversion; auto.
  Qed.

  Lemma handleRequestVoteReply_currentTerm :
    forall h st h' t r x,
      x <= currentTerm st ->
      x <= currentTerm (handleRequestVoteReply h st h' t r).
  Proof using.
    intros. unfold handleRequestVoteReply, advanceCurrentTerm.
    repeat break_match; subst; simpl in *; auto; try lia.
    do_bool. lia.
  Qed.

  Lemma handleRequestVote_reply_true':
  forall (h : name)
    (h' : fin N)
    (st : RaftState.raft_data term name entry logIndex serverType data clientId output)
    (t lli llt : nat) (st' : raft_data) (t' : term),
    handleRequestVote h st t h' lli llt = (st', RequestVoteReply t' true) ->
    t' = t /\ currentTerm st' = t.
  Proof using.
    unfold handleRequestVote, advanceCurrentTerm in *.
    intros.
    repeat break_match; find_inversion; simpl in *; auto; try congruence;
    do_bool; try lia; eauto using Nat.le_antisymm.
  Qed.

End SpecLemmas.


Load LFindLoad.
From lfind Require Import LFind.
From QuickChick Require Import QuickChick.
From adtind Require Import goal33.

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.

Lemma conj27synthconj3 : forall  (lv0 : natural) (lv1 : natural) (lv2 : natural) (lv3 : natural), (@eq natural (plus (mult lv0 lv1) (plus lv1 (mult lv2 lv1))) (mult (Succ Zero) lv3)).
Admitted.
QuickChick conj27synthconj3.