From stdpp Require Import gmap mapset.
From iris.heap_lang Require Import proofmode notation.
From iris.algebra Require Import auth frac gset gmap excl.
From iris.base_logic Require Export invariants.
From iris.base_logic Require Import cancelable_invariants.
From iris.proofmode Require Import proofmode.
From iris.prelude Require Import options.

From iris_examples.spanning_tree Require Import graph.

(* children cofe *)
Canonical Structure chlO := leibnizO (option loc * option loc).
(* The graph monoid. *)
Definition graphN : namespace := nroot .@ "SPT_graph".
Definition graphUR : ucmra :=
  optionUR (prodR fracR (gmapR loc (exclR chlO))).
(* The monoid for talking about which nodes are marked.
These markings are duplicatable. *)
Definition markingUR : ucmra := gsetUR loc.

(** The CMRA we need. *)
Class graphG Σ := GraphG
  {
    graph_marking_inG :> inG Σ (authR markingUR);
    graph_marking_name : gname;
    graph_inG :> inG Σ (authR graphUR);
    graph_name : gname
  }.
(** The Functor we need. *)
(*Definition graphΣ : gFunctors := #[authΣ graphUR].*)

Section marking_definitions.
  Context `{irisGS heap_lang Σ, graphG Σ}.

  Definition is_marked (l : loc) : iProp Σ :=
    own graph_marking_name (◯ {[ l ]}).

  Global Instance marked_persistentP x : Persistent (is_marked x).
  Proof. apply _. Qed.

  Lemma dup_marked l : is_marked l ⊣⊢ is_marked l ∗ is_marked l.
  Proof.  by rewrite /is_marked -own_op -auth_frag_op idemp_L. Qed.

  Lemma new_marked {E} (m : markingUR) l :
  own graph_marking_name (● m) ={E}=∗
  own graph_marking_name (● (m ⋅ ({[l]} : gset loc))) ∗ is_marked l.
  Proof.
    iIntros "H". rewrite -own_op (comm _ m).
    iMod (own_update with "H") as "Y"; eauto.
    apply auth_update_alloc.
    setoid_replace ({[l]} : gset loc) with (({[l]} : gset loc) ⋅ ∅) at 2
      by (by rewrite right_id).
    apply op_local_update_discrete; auto.
  Qed.

  Lemma already_marked {E} (m : gset loc) l : l ∈ m →
    own graph_marking_name (● m) ={E}=∗
    own graph_marking_name (● m) ∗ is_marked l.
  Proof.
    iIntros (Hl) "Hm". iMod (new_marked with "Hm") as "[H1 H2]"; iFrame.
    rewrite gset_op (comm _ m) (subseteq_union_1_L {[l]} m); trivial.
    by apply elem_of_subseteq_singleton.
  Qed.

End marking_definitions.

(* The monoid representing graphs *)
Definition Gmon := gmapR loc (exclR chlO).

Definition excl_chlC_chl (ch : exclR chlO) : option (option loc * option loc) :=
  match ch with
  | Excl w => Some w
  | Excl_Bot => None
  end.

Definition Gmon_graph (G : Gmon) : graph loc := omap excl_chlC_chl G.

Definition Gmon_graph_dom (G : Gmon) :
  ✓ G → dom (gset loc) (Gmon_graph G) = dom (gset _) G.
Proof.
  intros Hvl; apply set_eq=> i. rewrite !elem_of_dom lookup_omap.
  specialize (Hvl i). split.
  - revert Hvl; case _ : (G !! i) => [[]|] //=; eauto.
    intros _ [? Hgi]; inversion Hgi.
  - intros Hgi; revert Hgi Hvl. intros [[] Hgi]; rewrite Hgi; inversion 1; eauto.
Qed.

Definition child_to_val (c : option loc) : val :=
  match c with
  | None => NONEV
  | Some l => SOMEV #l
  end.

(* convert the data of a node to a value in the heap *)
Definition children_to_val (ch : option loc * option loc) : val :=
  (child_to_val (ch.1), child_to_val (ch.2)).

Definition marked_graph := gmap loc (bool * (option loc * option loc)).
Identity Coercion marked_graph_gmap: marked_graph >-> gmap.

Definition of_graph_elem (G : Gmon) i v
  : option (bool * (option loc * option loc)) :=
  match Gmon_graph G !! i with
  | Some w => Some (true, w)
  | None => Some (false,v)
  end.

Definition of_graph (g : graph loc) (G : Gmon) : marked_graph :=
  map_imap (of_graph_elem G) g.

(* facts *)

Global Instance Gmon_graph_proper : Proper ((≡) ==> (=)) Gmon_graph.
Proof. solve_proper. Qed.

Lemma new_Gmon_dom (G : Gmon) x w :
  dom (gset loc) (G ⋅ {[x := w]}) = dom (gset loc) G ∪ {[x]}.
Proof. by rewrite dom_op dom_singleton_L. Qed.

Definition of_graph_empty (g : graph loc) :
  of_graph g ∅ = fmap (λ x, (false, x)) g.
Proof.
  apply: map_eq => i.
  rewrite map_lookup_imap /of_graph_elem lookup_fmap lookup_omap //.
Qed.

Lemma of_graph_dom_eq g G :
  ✓ G → dom (gset loc) g = dom (gset loc) (Gmon_graph G) →
  of_graph g G = fmap (λ x, (true, x) )(Gmon_graph G).
Proof.
  intros HGvl. rewrite Gmon_graph_dom // => Hd. apply map_eq => i.
  assert (Hd' : i ∈ dom (gset _) g ↔ i ∈ dom (gset _) G) by (by rewrite Hd).
  revert Hd'; clear Hd. specialize (HGvl i); revert HGvl.
  rewrite /of_graph /of_graph_elem /Gmon_graph map_lookup_imap lookup_fmap
    lookup_omap ?elem_of_dom.
  case _ : (g !! i); case _ : (G !! i) => [[]|] /=; inversion 1; eauto;
    intros [? ?];
    match goal with
      H : _ → @is_Some ?A None |- _ =>
       assert (Hcn : @is_Some A None) by eauto;
         destruct Hcn as [? Hcn]; inversion Hcn
    end.
Qed.

Section definitions.
  Context `{heapGS Σ, graphG Σ}.

  Definition own_graph (q : frac) (G : Gmon) : iProp Σ :=
    own graph_name (◯ (Some (q, G) : graphUR)).

  Global Instance own_graph_proper q : Proper ((≡) ==> (⊣⊢)) (own_graph q).
  Proof. solve_proper. Qed.

  Definition heap_owns (M : marked_graph) (markings : gmap loc loc) : iProp Σ :=
    ([∗ map] l ↦ v ∈ M, ∃ (m : loc), ⌜markings !! l = Some m⌝
       ∗ l ↦ (#m, children_to_val (v.2)) ∗ m ↦ #(LitBool (v.1)))%I.

  Definition graph_inv (g : graph loc) (markings : gmap loc loc) : iProp Σ :=
    (∃ (G : Gmon), own graph_name (● Some (1%Qp, G))
      ∗ own graph_marking_name (● dom (gset _) G)
      ∗ heap_owns (of_graph g G) markings ∗ ⌜strict_subgraph g (Gmon_graph G)⌝
    )%I.

  Global Instance graph_inv_timeless g Mrk : Timeless (graph_inv g Mrk).
  Proof. apply _. Qed.

  Context `{cinvG Σ}.
  Definition graph_ctx κ g Mrk : iProp Σ := cinv graphN κ (graph_inv g Mrk).

  Global Instance graph_ctx_persistent κ g Mrk : Persistent (graph_ctx κ g Mrk).
  Proof. apply _. Qed.

End definitions.

Notation "l [↦] v" := ({[l := Excl v]}) (at level 70, format "l  [↦]  v").

Typeclasses Opaque graph_ctx graph_inv own_graph.

Section graph_ctx_alloc.
  Context `{heapGS Σ, cinvG Σ, inG Σ (authR markingUR), inG Σ (authR graphUR)}.

  Lemma graph_ctx_alloc (E : coPset) (g : graph loc) (markings : gmap loc loc)
        (HNE : (nclose graphN) ⊆ E)
  : ([∗ map] l ↦ v ∈ g, ∃ (m : loc), ⌜markings !! l = Some m⌝
       ∗ l ↦ (#m, children_to_val v) ∗ m ↦ #false)
     ={E}=∗ ∃ (Ig : graphG Σ) (κ : gname), cinv_own κ 1 ∗ graph_ctx κ g markings
             ∗ own_graph 1%Qp ∅.
  Proof using Type*.
    iIntros "H1".
    iMod (own_alloc (● (∅ : markingUR))) as (mn) "H2"; first by apply auth_auth_valid.
    iMod (own_alloc (● (Some (1%Qp, ∅ : Gmon) : graphUR)
                      ⋅ ◯ (Some (1%Qp, ∅ : Gmon) : graphUR))) as (gn) "H3".
    { by apply auth_both_valid_discrete. }
    iDestruct "H3" as "[H31 H32]".
    set (Ig := GraphG _ _ mn _ gn).
    iExists Ig.
    iAssert (graph_inv g markings) with "[H1 H2 H31]" as "H".
    { unfold graph_inv. iExists ∅. rewrite dom_empty_L. iFrame "H2 H31".
      iSplitL; [|iPureIntro].
      - rewrite /heap_owns of_graph_empty  big_sepM_fmap; eauto.
      - rewrite /Gmon_graph omap_empty; apply strict_subgraph_empty. }
    iMod (cinv_alloc _ graphN with "[H]") as (κ) "[Hinv key]".
    { iNext. iExact "H". }
    iExists κ.
    rewrite /own_graph /graph_ctx //=; by iFrame.
  Qed.

End graph_ctx_alloc.

Lemma marked_was_unmarked (G : Gmon) x v :
  ✓ ({[x := Excl v]} ⋅ G) → G !! x = None.
Proof.
  intros H2; specialize (H2 x).
  revert H2; rewrite lookup_op lookup_singleton. intros H2.
    by rewrite (excl_validN_inv_l O _ _ (proj1 (cmra_valid_validN _) H2 O)).
Qed.

Lemma mark_update_lookup_base (G : Gmon) x v :
  ✓ ({[x := Excl v]} ⋅ G) → ({[x := Excl v]} ⋅ G) !! x = Some (Excl v).
Proof.
  intros H2; rewrite lookup_op lookup_singleton.
  erewrite marked_was_unmarked; eauto.
Qed.

Lemma mark_update_lookup_ne_base (G : Gmon) x i v :
  i ≠ x → ({[x := Excl v]} ⋅ G) !! i = G !! i.
Proof. intros H. by rewrite lookup_op lookup_singleton_ne //= left_id_L. Qed.

Lemma of_graph_dom g G : dom (gset loc) (of_graph g G) = dom (gset _) g.
Proof.
  apply set_eq=>i.
  rewrite ?elem_of_dom map_lookup_imap /of_graph_elem lookup_omap.
  case _ : (g !! i) => [x|]; case _ : (G !! i) => [[]|] //=; split;
  intros [? Hcn]; inversion Hcn; eauto.
Qed.

Lemma in_dom_of_graph (g : graph loc) (G : Gmon) x (b : bool) v :
  ✓ G → of_graph g G !! x = Some (b, v) → b ↔ x ∈ dom (gset _) G.
Proof.
  rewrite /of_graph /of_graph_elem map_lookup_imap lookup_omap elem_of_dom.
  intros Hvl; specialize (Hvl x); revert Hvl;
  case _ : (g !! x) => [?|]; case _ : (G !! x) => [[] ?|] //=;
    intros Hvl; inversion Hvl; try (inversion 1; subst); split;
    try (inversion 1; fail); try (intros [? Hcn]; inversion Hcn; fail);
    subst; eauto.
Qed.

Global Instance of_graph_proper g : Proper ((≡) ==> (=)) (of_graph g).
Proof. solve_proper. Qed.

Lemma mark_update_lookup (g : graph loc) (G : Gmon) x v :
  x ∈ dom (gset loc) g →
  ✓ ((x [↦] v) ⋅ G) → of_graph g ((x [↦] v) ⋅ G) !! x = Some (true, v).
Proof.
  rewrite elem_of_dom /is_Some. intros [w H1] H2.
  rewrite /of_graph /of_graph_elem map_lookup_imap H1 lookup_omap; simpl.
  rewrite mark_update_lookup_base; trivial.
Qed.

Lemma mark_update_lookup_ne (g : graph loc) (G : Gmon) x i v :
  i ≠ x → of_graph g ((x [↦] v) ⋅ G) !! i = (of_graph g G) !! i.
Proof.
  intros H. rewrite /of_graph /of_graph_elem ?map_lookup_imap ?lookup_omap; simpl.
  rewrite mark_update_lookup_ne_base //=.
Qed.

Section graph.
  Context `{heapGS Σ, graphG Σ}.

  Lemma own_graph_valid q G : own_graph q G ⊢ ✓ G.
  Proof.
    iIntros "H". unfold own_graph.
    by iDestruct (own_valid with "H") as %[_ ?]%auth_frag_valid.
  Qed.

  Lemma auth_own_graph_valid q G : own graph_name (● Some (q, G))  ⊢ ✓ G.
  Proof.
    iIntros "H". unfold own_graph.
    iDestruct (own_valid with "H") as %VAL.
    move : VAL => /auth_auth_valid [_ ?] //.
  Qed.

  Lemma whole_frac (G G' : Gmon):
    own graph_name (● Some (1%Qp, G)) ∗ own_graph 1 G' ⊢ ⌜G = G'⌝.
  Proof.
    iIntros "[H1 H2]". rewrite /own_graph.
    iCombine "H1" "H2" as "H".
    iDestruct (own_valid with "H") as %[H1 H2]%auth_both_valid_discrete.
    iPureIntro.
    apply option_included in H1; destruct H1 as [H1|H1]; [inversion H1|].
    destruct H1 as (u1 & u2 & Hu1 & Hu2 & H3);
      inversion Hu1; inversion Hu2; subst.
    destruct H3 as [[_ H31%leibniz_equiv]|H32]; auto.
    inversion H32 as [[q x] H4].
    inversion H4 as [H41 H42]; simpl in *.
    assert (✓ (1 ⋅ q)%Qp) by (rewrite -H41; done).
    exfalso; eapply exclusive_l; eauto; typeclasses eauto.
  Qed.

  Lemma graph_divide q G G' :
    own_graph q (G ⋅ G') ⊣⊢ own_graph (q / 2) G ∗ own_graph (q / 2) G'.
  Proof.
    replace q with ((q / 2) + (q / 2))%Qp at 1 by (by rewrite Qp_div_2).
      by rewrite /own_graph -own_op.
  Qed.

  Lemma mark_graph {E} (G : Gmon) q x w : G !! x = None →
    own graph_name (● Some (1%Qp, G)) ∗ own_graph q ∅
    ={E}=∗
    own graph_name (● Some (1%Qp, {[x := Excl w]} ⋅ G)) ∗ own_graph q (x [↦] w).
  Proof.
    iIntros (Hx) "H". rewrite -?own_op.
    iMod (own_update with "H") as "H'"; eauto.
    apply auth_update, option_local_update, prod_local_update;
      first done; simpl.
    rewrite -{2}[(x [↦] w)]right_id.
    apply op_local_update_discrete; auto.
    rewrite -insert_singleton_op; trivial. apply insert_valid; done.
  Qed.

  Lemma update_graph {E} (G : Gmon) q x w m :
    G !! x = None →
    own graph_name (● Some (1%Qp, {[x := Excl m]} ⋅ G))
       ∗ own_graph q (x [↦] m)
      ⊢ |={E}=> own graph_name (● Some (1%Qp, {[x := Excl w]} ⋅ G))
                  ∗ own_graph q (x [↦] w).
  Proof.
    iIntros (Hx) "H". rewrite -?own_op.
    iMod (own_update with "H") as "H'"; eauto.
    apply auth_update, option_local_update, prod_local_update;
      first done; simpl.
    rewrite -!insert_singleton_op; trivial.
    replace (<[x:=Excl w]> G) with (<[x:=Excl w]> (<[x:=Excl m]> G))
      by (by rewrite insert_insert).
    eapply singleton_local_update; first (by rewrite lookup_insert);
    apply exclusive_local_update; done.
  Qed.

  Lemma graph_pointsto_marked (G : Gmon) q x w :
    own graph_name (● Some (1%Qp, G)) ∗ own_graph q (x [↦] w)
      ⊢ ⌜G = {[x := Excl w]} ⋅ (delete x G)⌝.
  Proof.
    rewrite /own_graph -?own_op. iIntros "H".
    iDestruct (own_valid with "H") as %[H1 H2]%auth_both_valid_discrete.
    iPureIntro.
    apply option_included in H1; destruct H1 as [H1|H1]; [inversion H1|].
    destruct H1 as (u1 & u2 & Hu1 & Hu2 & H1);
      inversion Hu1; inversion Hu2; subst.
    destruct H1 as [[_ H11%leibniz_equiv]|H12]; simpl in *.
    + by rewrite -H11 delete_singleton right_id_L.
    + apply prod_included in H12; destruct H12 as [_ H12]; simpl in *.
      rewrite -insert_singleton_op ?insert_delete_insert; last by rewrite lookup_delete.
      apply: map_eq => i. apply leibniz_equiv, equiv_dist => n.
      destruct (decide (x = i)); subst;
        rewrite ?lookup_insert ?lookup_insert_ne //.
      apply singleton_included_l in H12. destruct H12 as [y [H31 H32]].
      rewrite H31 (Some_included_exclusive _ _ H32); try done.
      destruct H2 as [H21 H22]; simpl in H22.
      specialize (H22 i); revert H22; rewrite H31; done.
  Qed.

  Lemma graph_open (g :graph loc) (markings : gmap loc loc) (G : Gmon) x
  : x ∈ dom (gset _) g →
    own graph_name (● Some (1%Qp, G)) ∗ heap_owns (of_graph g G) markings ⊢
    own graph_name (● Some (1%Qp, G))
    ∗ heap_owns (delete x (of_graph g G)) markings
    ∗ (∃ u : bool * (option loc * option loc), ⌜of_graph g G !! x = Some u⌝
         ∗ ∃ (m : loc), ⌜markings !! x = Some m⌝ ∗ x ↦ (#m, children_to_val (u.2))
           ∗ m ↦ #(u.1)).
  Proof.
    iIntros (Hx) "(Hg & Ha)".
    assert (Hid : x ∈ dom (gset _) (of_graph g G)) by (by rewrite of_graph_dom).
    revert Hid; rewrite elem_of_dom /is_Some. intros [y Hy].
    rewrite /heap_owns -{1}(insert_id _ _ _ Hy) -insert_delete_insert.
    rewrite big_sepM_insert; [|apply lookup_delete_None; auto].
    iDestruct "Ha" as "[H $]". iFrame "Hg". iExists _; eauto.
  Qed.

  Lemma graph_close g markings G x :
    heap_owns (delete x (of_graph g G)) markings
    ∗ (∃ u : bool * (option loc * option loc), ⌜of_graph g G !! x = Some u⌝
        ∗ ∃ (m : loc), ⌜markings !! x = Some m⌝ ∗ x ↦ (#m, children_to_val (u.2))
            ∗ m ↦ #(u.1))
    ⊢ heap_owns (of_graph g G) markings.
  Proof.
    iIntros "[Ha Hl]". iDestruct "Hl" as (u) "[Hu Hl]". iDestruct "Hu" as %Hu.
    rewrite /heap_owns -{2}(insert_id _ _ _ Hu) -insert_delete_insert.
    rewrite big_sepM_insert; [|apply lookup_delete_None; auto]. by iFrame "Ha".
  Qed.

  Lemma marked_is_marked_in_auth (mr : gset loc) l :
    own graph_marking_name (● mr) ∗ is_marked l ⊢ ⌜l ∈ mr⌝.
  Proof.
    iIntros "H". unfold is_marked. rewrite -own_op.
    iDestruct (own_valid with "H") as %Hvl.
    move : Hvl => /auth_both_valid_discrete [[z Hvl'] _].
    iPureIntro.
    rewrite Hvl' /= !gset_op !elem_of_union elem_of_singleton; tauto.
  Qed.

  Lemma marked_is_marked_in_auth_sepS (mr : gset loc) m :
    own graph_marking_name (● mr) ∗ ([∗ set] l ∈ m, is_marked l) ⊢ ⌜m ⊆ mr⌝.
  Proof.
    iIntros "[Hmr Hm]". rewrite big_sepS_forall bi.pure_forall.
    iIntros (x). rewrite bi.pure_impl. iIntros (Hx).
    iApply marked_is_marked_in_auth.
    iFrame. by iApply "Hm".
  Qed.

End graph.

(* Graph properties *)

Lemma delete_marked g G x w :
  delete x (of_graph g G) = delete x (of_graph g ((x [↦] w) ⋅ G)).
Proof.
  apply: map_eq => i. destruct (decide (i = x)).
  - subst; by rewrite ?lookup_delete.
  - rewrite ?lookup_delete_ne //= /of_graph /of_graph_elem ?map_lookup_imap
      ?lookup_omap; case _ : (g !! i) => [v|] //=.
    by rewrite lookup_op lookup_singleton_ne //= left_id_L.
Qed.

Lemma in_dom_conv (G G' : Gmon) x : ✓ (G ⋅ G') → x ∈ dom (gset loc) (Gmon_graph G)
  → (Gmon_graph (G ⋅ G')) !! x = (Gmon_graph G) !! x.
Proof.
  intros HGG. specialize (HGG x). revert HGG.
  rewrite /get_left /Gmon_graph elem_of_dom /is_Some ?lookup_omap lookup_op.
  case _ : (G !! x) => [[]|]; case _ : (G' !! x) => [[]|]; do 2 inversion 1;
    simpl in *; auto; congruence.
Qed.
Lemma in_dom_conv' (G G' : Gmon) x: ✓(G ⋅ G') → x ∈ dom (gset loc) (Gmon_graph G')
  → (Gmon_graph (G ⋅ G')) !! x = (Gmon_graph G') !! x.
Proof. rewrite comm; apply in_dom_conv. Qed.
Lemma get_left_conv (G G' : Gmon) x xl : ✓ (G ⋅ G') →
  x ∈ dom (gset _) (Gmon_graph G) → get_left (Gmon_graph (G ⋅ G')) x = Some xl
  ↔ get_left (Gmon_graph G) x = Some xl.
Proof. intros. rewrite /get_left in_dom_conv; auto. Qed.
Lemma get_left_conv' (G G' : Gmon) x xl : ✓ (G ⋅ G') →
  x ∈ dom (gset _) (Gmon_graph G') → get_left (Gmon_graph (G ⋅ G')) x = Some xl
  ↔ get_left (Gmon_graph G') x = Some xl.
Proof. rewrite comm; apply get_left_conv. Qed.
Lemma get_right_conv (G G' : Gmon) x xl : ✓ (G ⋅ G') →
  x ∈ dom (gset _) (Gmon_graph G) → get_right (Gmon_graph (G ⋅ G')) x = Some xl
  ↔ get_right (Gmon_graph G) x = Some xl.
Proof. intros. rewrite /get_right in_dom_conv; auto. Qed.
Lemma get_right_conv' (G G' : Gmon) x xl : ✓ (G ⋅ G') →
  x ∈ dom (gset _) (Gmon_graph G') → get_right (Gmon_graph (G ⋅ G')) x = Some xl
  ↔ get_right (Gmon_graph G') x = Some xl.
Proof. rewrite comm; apply get_right_conv. Qed.

Lemma in_op_dom (G G' : Gmon) y : ✓(G ⋅ G') →
  y ∈ dom (gset loc) (Gmon_graph G) → y ∈ dom (gset loc) (Gmon_graph (G ⋅ G')).
Proof. refine (λ H x, _ x); rewrite ?elem_of_dom ?in_dom_conv ; eauto. Qed.
Lemma in_op_dom' (G G' : Gmon) y : ✓(G ⋅ G') →
  y ∈ dom (gset loc) (Gmon_graph G') → y ∈ dom (gset loc) (Gmon_graph (G ⋅ G')).
Proof. rewrite comm; apply in_op_dom. Qed.

Local Hint Resolve cmra_valid_op_l cmra_valid_op_r in_op_dom in_op_dom' : core.

Lemma in_op_dom_alt (G G' : Gmon) y : ✓(G ⋅ G') →
  y ∈ dom (gset loc) G → y ∈ dom (gset loc) (G ⋅ G').
Proof. intros HGG; rewrite -?Gmon_graph_dom; eauto. Qed.
Lemma in_op_dom_alt' (G G' : Gmon) y : ✓(G ⋅ G') →
  y ∈ dom (gset loc) G' → y ∈ dom (gset loc) (G ⋅ G').
Proof. intros HGG; rewrite -?Gmon_graph_dom; eauto. Qed.

Local Hint Resolve in_op_dom_alt in_op_dom_alt' : core.
Local Hint Extern 1 => eapply get_left_conv + eapply get_left_conv' +
  eapply get_right_conv + eapply get_right_conv' : core.

Local Hint Extern 1 (_ ∈ dom (gset loc) (Gmon_graph _)) =>
  erewrite Gmon_graph_dom : core.

Local Hint Resolve path_start path_end : core.

Lemma path_conv (G G' : Gmon) x y p :
  ✓ (G ⋅ G') → maximal (Gmon_graph G) → x ∈ dom (gset _) G →
  valid_path (Gmon_graph (G ⋅ G')) x y p → valid_path (Gmon_graph G) x y p.
Proof.
  intros Hv Hm. rewrite -Gmon_graph_dom //=; eauto. revert x y.
  induction p as [|[] p IHp]; inversion 2; subst; econstructor; eauto;
    try eapply IHp; try eapply Hm; eauto.
Qed.
Lemma path_conv_back (G G' : Gmon) x y p :
  ✓ (G ⋅ G') → x ∈ dom (gset _) G →
  valid_path (Gmon_graph G) x y p → valid_path (Gmon_graph (G ⋅ G')) x y p.
Proof.
  intros Hv. rewrite -Gmon_graph_dom //=; eauto. revert x y.
  induction p as [|[] p]; inversion 2; subst; econstructor; eauto.
Qed.
Lemma path_conv' (G G' : Gmon) x y p :
  ✓ (G ⋅ G') → maximal (Gmon_graph G') → x ∈ dom (gset _) G' →
  valid_path (Gmon_graph (G ⋅ G')) x y p → valid_path (Gmon_graph G') x y p.
Proof. rewrite comm; eapply path_conv. Qed.
Lemma path_conv_back' (G G' : Gmon) x y p :
  ✓ (G ⋅ G') → x ∈ dom (gset _) G' →
  valid_path (Gmon_graph G') x y p → valid_path (Gmon_graph (G ⋅ G')) x y p.
Proof. rewrite comm; apply path_conv_back. Qed.

Local Ltac in_dom_Gmon_graph :=
  rewrite Gmon_graph_dom //= ?dom_op ?elem_of_union ?dom_singleton
      ?elem_of_singleton.

Lemma get_left_singleton x vl vr :
  get_left (Gmon_graph (x [↦] (vl, vr))) x = vl.
Proof. rewrite /get_left /Gmon_graph lookup_omap lookup_singleton; done. Qed.
Lemma get_right_singleton x vl vr :
  get_right (Gmon_graph (x [↦] (vl, vr))) x = vr.
Proof. rewrite /get_right /Gmon_graph lookup_omap lookup_singleton; done. Qed.

Lemma graph_in_dom_op (G G' : Gmon) x :
  ✓ (G ⋅ G') → x ∈ dom (gset loc) G → x ∉ dom (gset _) G'.
Proof.
  intros HGG. specialize (HGG x). revert HGG. rewrite ?elem_of_dom lookup_op.
  case _ : (G !! x) => [[]|]; case _ : (G' !! x) => [[]|]; inversion 1;
  do 2 (intros [? Heq]; inversion Heq; clear Heq).
Qed.
Lemma graph_in_dom_op' (G G' : Gmon) x :
  ✓ (G ⋅ G') → x ∈ dom (gset loc) G' → x ∉ dom (gset _) G.
Proof. rewrite comm; apply graph_in_dom_op. Qed.
Lemma graph_op_path (G G' : Gmon) x z p :
  ✓ (G ⋅ G') → x ∈ dom (gset _) G → valid_path (Gmon_graph G') z x p → False.
Proof.
  intros ?? Hp%path_end; rewrite Gmon_graph_dom in Hp; eauto.
  eapply graph_in_dom_op; eauto.
Qed.
Lemma graph_op_path' (G G' : Gmon) x z p :
  ✓ (G ⋅ G') → x ∈ dom (gset _) G' → valid_path (Gmon_graph G) z x p → False.
Proof. rewrite comm; apply graph_op_path. Qed.

Lemma in_dom_singleton (x : loc) (w : chlO) :
  x ∈ dom (gset loc) (x [↦] w : gmap loc _).
Proof. by rewrite dom_singleton elem_of_singleton. Qed.

Local Hint Resolve graph_op_path graph_op_path' in_dom_singleton : core.

Lemma maximal_op (G G' : Gmon) : ✓ (G ⋅ G') → maximal (Gmon_graph G)
  → maximal (Gmon_graph G') → maximal (Gmon_graph (G ⋅ G')).
Proof.
  intros Hvl [_ HG] [_ HG']. split; trivial => x v.
  rewrite Gmon_graph_dom ?dom_op ?elem_of_union -?Gmon_graph_dom; eauto.
  intros [Hxl|Hxr].
  - erewrite get_left_conv, get_right_conv; eauto.
  - erewrite get_left_conv', get_right_conv'; eauto.
Qed.

Lemma maximal_op_singleton (G : Gmon) x vl vr :
  ✓ ((x [↦] (vl, vr)) ⋅ G) → maximal(Gmon_graph G) →
  match vl with | Some xl => xl ∈ dom (gset _) G | None => True end →
  match vr with | Some xr => xr ∈ dom (gset _) G | None => True end →
  maximal (Gmon_graph ((x [↦] (vl, vr)) ⋅ G)).
Proof.
  intros HGG [_ Hmx] Hvl Hvr; split; trivial => z v. in_dom_Gmon_graph.
  intros [Hv|Hv]; subst.
  - erewrite get_left_conv, get_right_conv, get_left_singleton,
          get_right_singleton; eauto.
    destruct vl as [xl|]; destruct vr as [xr|]; intros [Hl|Hr];
      try inversion Hl; try inversion Hr; subst; eauto.
  - erewrite get_left_conv', get_right_conv', <- Gmon_graph_dom; eauto.
Qed.

Local Hint Resolve maximal_op_singleton maximal_op get_left_singleton
  get_right_singleton : core.

Lemma maximally_marked_tree_both (G G' : Gmon) x xl xr :
  ✓ ((x [↦] (Some xl, Some xr)) ⋅ (G ⋅ G')) →
  xl ∈ dom (gset _) G → tree (Gmon_graph G) xl → maximal (Gmon_graph G) →
  xr ∈ dom (gset _) G' → tree (Gmon_graph G') xr → maximal (Gmon_graph G') →
  tree (Gmon_graph ((x [↦] (Some xl, Some xr)) ⋅ (G ⋅ G'))) x ∧
  maximal (Gmon_graph ((x [↦] (Some xl, Some xr)) ⋅ (G ⋅ G'))).
Proof.
  intros Hvl Hxl tl ml Hxr tr mr; split.
  - intros l. in_dom_Gmon_graph. intros [?|[HlG|HlG']]; first subst.
    + exists []; split.
      { constructor 1; trivial. in_dom_Gmon_graph; auto. }
      { intros p Hp. destruct p; inversion Hp as [| ? ? Hl Hpv| ? ? Hl Hpv];
          trivial; subst.
        - exfalso. apply get_left_conv in Hl; [| |in_dom_Gmon_graph]; eauto.
          rewrite get_left_singleton in Hl; inversion Hl; subst.
          apply path_conv' in Hpv; eauto.
        - exfalso. apply get_right_conv in Hl; [| |in_dom_Gmon_graph]; eauto.
          rewrite get_right_singleton in Hl; inversion Hl; subst.
          apply path_conv' in Hpv; eauto. }
   + edestruct tl as [q [qv Hq]]; eauto.
     exists (true :: q). split; [econstructor; eauto|].
     { eapply path_conv_back'; eauto; eapply path_conv_back; eauto. }
     { intros p Hp. destruct p; inversion Hp as [| ? ? Hl Hpv| ? ? Hl Hpv];
          trivial; subst.
        - exfalso; eapply path_conv_back in qv; eauto.
        - apply get_left_conv in Hl; eauto.
          rewrite get_left_singleton in Hl. inversion Hl; subst.
          apply path_conv', path_conv in Hpv; eauto. erewrite Hq; eauto.
        - exfalso. apply get_right_conv in Hl; eauto.
          rewrite get_right_singleton in Hl; inversion Hl; subst.
          do 2 apply path_conv' in Hpv; eauto. }
  + edestruct tr as [q [qv Hq]]; eauto.
     exists (false :: q). split; [econstructor; eauto|].
     { eapply path_conv_back'; eauto; eapply path_conv_back'; eauto. }
     { intros p Hp. destruct p; inversion Hp as [| ? ? Hl Hpv| ? ? Hl Hpv];
          trivial; subst.
        - exfalso; eapply path_conv_back' in qv; eauto.
        - exfalso. apply get_left_conv in Hl; eauto.
          rewrite get_left_singleton in Hl; inversion Hl; subst.
          apply path_conv', path_conv in Hpv; eauto.
        - apply get_right_conv in Hl; eauto.
          rewrite get_right_singleton in Hl. inversion Hl; subst.
          apply path_conv', path_conv' in Hpv; eauto. erewrite Hq; eauto. }
  - apply maximal_op_singleton; eauto.
Qed.

Lemma maximally_marked_tree_left (G : Gmon) x xl :
  ✓ ((x [↦] (Some xl, None)) ⋅ G) →
  xl ∈ dom (gset _) G → tree (Gmon_graph G) xl → maximal (Gmon_graph G) →
  tree (Gmon_graph ((x [↦] (Some xl, None)) ⋅ G)) x ∧
  maximal (Gmon_graph ((x [↦] (Some xl, None)) ⋅ G)).
Proof.
  intros Hvl Hxl tl ml; split.
  - intros l. in_dom_Gmon_graph. intros [?|HlG]; first subst.
    + exists []; split.
      { constructor 1; trivial. in_dom_Gmon_graph; auto. }
      { intros p Hp. destruct p; inversion Hp as [| ? ? Hl Hpv| ? ? Hl Hpv];
          trivial; subst.
        - exfalso. apply get_left_conv in Hl; [| |in_dom_Gmon_graph]; eauto.
          rewrite get_left_singleton in Hl; inversion Hl; subst.
          apply path_conv' in Hpv; eauto.
        - exfalso. apply get_right_conv in Hl; [| |in_dom_Gmon_graph]; eauto.
          rewrite get_right_singleton in Hl; inversion Hl. }
   + edestruct tl as [q [qv Hq]]; eauto.
     exists (true :: q). split; [econstructor; eauto|].
     { eapply path_conv_back'; eauto; eapply path_conv_back; eauto. }
     { intros p Hp. destruct p; inversion Hp as [| ? ? Hl Hpv| ? ? Hl Hpv];
          trivial; subst.
        - exfalso; eauto.
        - apply get_left_conv in Hl; eauto.
          rewrite get_left_singleton in Hl. inversion Hl; subst.
          apply path_conv' in Hpv; eauto. erewrite Hq; eauto.
        - exfalso. apply get_right_conv in Hl; eauto.
          rewrite get_right_singleton in Hl; inversion Hl. }
 - apply maximal_op_singleton; eauto.
Qed.

Lemma maximally_marked_tree_right (G : Gmon) x xr :
  ✓ ((x [↦] (None, Some xr)) ⋅ G) →
  xr ∈ dom (gset _) G → tree (Gmon_graph G) xr → maximal (Gmon_graph G) →
  tree (Gmon_graph ((x [↦] (None, Some xr)) ⋅ G)) x ∧
  maximal (Gmon_graph ((x [↦] (None, Some xr)) ⋅ G)).
Proof.
  intros Hvl Hxl tl ml; split.
  - intros l. in_dom_Gmon_graph. intros [?|HlG]; first subst.
    + exists []; split.
      { constructor 1; trivial. in_dom_Gmon_graph; auto. }
      { intros p Hp. destruct p; inversion Hp as [| ? ? Hl Hpv| ? ? Hl Hpv];
          trivial; subst.
        - exfalso. apply get_left_conv in Hl; [| |in_dom_Gmon_graph]; eauto.
          rewrite get_left_singleton in Hl; inversion Hl.
        - exfalso. apply get_right_conv in Hl; [| |in_dom_Gmon_graph]; eauto.
          rewrite get_right_singleton in Hl; inversion Hl; subst.
          apply path_conv' in Hpv; eauto. }
   + edestruct tl as [q [qv Hq]]; eauto.
     exists (false :: q). split; [econstructor; eauto|].
     { eapply path_conv_back'; eauto; eapply path_conv_back; eauto. }
     { intros p Hp. destruct p; inversion Hp as [| ? ? Hl Hpv| ? ? Hl Hpv];
          trivial; subst.
        - exfalso; eauto.
        - exfalso. apply get_left_conv in Hl; eauto.
          rewrite get_left_singleton in Hl; inversion Hl.
        - apply get_right_conv in Hl; eauto.
          rewrite get_right_singleton in Hl. inversion Hl; subst.
          apply path_conv' in Hpv; eauto. erewrite Hq; eauto. }
 - apply maximal_op_singleton; eauto.
Qed.

Lemma maximally_marked_tree_none (x : loc) :
  ✓ ((x [↦] (None, None)) : Gmon) →
  tree (Gmon_graph (x [↦] (None, None))) x ∧
  maximal (Gmon_graph (x [↦] (None, None))).
Proof.
  intros Hvl; split.
  - intros l. in_dom_Gmon_graph. intros ?; subst.
    + exists []; split.
      { constructor 1; trivial. in_dom_Gmon_graph; auto. }
      { intros p Hp. destruct p; inversion Hp as [| ? ? Hl Hpv| ? ? Hl Hpv];
          trivial; subst.
        - rewrite get_left_singleton in Hl; inversion Hl.
        - rewrite get_right_singleton in Hl; inversion Hl. }
 - split; trivial. intros z v. in_dom_Gmon_graph. intros ? [Hl|Hl]; subst.
    + rewrite get_left_singleton in Hl; inversion Hl.
    + rewrite get_right_singleton in Hl; inversion Hl.
Qed.

Lemma update_valid (G : Gmon) x v w : ✓ ((x [↦] v) ⋅ G) → ✓ ((x [↦] w) ⋅ G).
Proof.
  intros Hvl i; specialize (Hvl i); revert Hvl.
  rewrite ?lookup_op. destruct (decide (i = x)).
  - subst; rewrite ?lookup_singleton; case _ : (G !! x); done.
  - rewrite ?lookup_singleton_ne //=.
Qed.

Lemma of_graph_unmarked (g : graph loc) (G : Gmon) x v :
  of_graph g G !! x = Some (false, v) → g !! x = Some v.
Proof.
  rewrite map_lookup_imap /of_graph_elem lookup_omap.
  case _ : (g !! x); case _ : (G !! x) => [[]|]; by inversion 1.
Qed.
Lemma get_lr_disj (G G' : Gmon) i : ✓ (G ⋅ G') →
  (get_left (Gmon_graph (G ⋅ G')) i = get_left (Gmon_graph G) i ∧
   get_right (Gmon_graph (G ⋅ G')) i = get_right (Gmon_graph G) i ∧
   get_left (Gmon_graph G') i = None ∧
   get_right (Gmon_graph G') i = None) ∨
  (get_left (Gmon_graph (G ⋅ G')) i = get_left (Gmon_graph G') i ∧
   get_right (Gmon_graph (G ⋅ G')) i = get_right (Gmon_graph G') i ∧
   get_left (Gmon_graph G) i = None ∧
   get_right (Gmon_graph G) i = None).
Proof.
  intros Hvl. specialize (Hvl i). revert Hvl.
  rewrite /get_left /get_right /Gmon_graph ?lookup_omap ?lookup_op.
  case _ : (G !! i) => [[]|]; case _ : (G' !! i) => [[]|]; inversion 1;
    simpl; auto.
Qed.
Lemma mark_update_strict_subgraph (g : graph loc) (G G' : Gmon) : ✓ (G ⋅ G') →
  strict_subgraph g (Gmon_graph G) ∧ strict_subgraph g (Gmon_graph G') ↔
  strict_subgraph g (Gmon_graph (G ⋅ G')).
Proof.
  intros Hvl; split.
  - intros [HG HG'] i.
  destruct (get_lr_disj G G' i) as [(-> & -> & _ & _)|(-> & -> & _ & _)]; eauto.
  - intros HGG; split => i.
    + destruct (get_lr_disj G G' i) as [(<- & <- & _ & _)|(_ & _ & -> & ->)];
       eauto using strict_sub_children_None.
    + destruct (get_lr_disj G G' i) as [(_ & _ & -> & ->)|(<- & <- & _ & _)];
       eauto using strict_sub_children_None.
Qed.
Lemma strinct_subgraph_singleton (g : graph loc) x v :
  x ∈ dom (gset loc) g → (∀ w, g !! x = Some w → strict_sub_children w v)
  ↔ strict_subgraph g (Gmon_graph (x [↦] v)).
Proof.
  rewrite elem_of_dom; intros [u Hu]; split.
  - move => /(_ _ Hu) Hgw i.
    rewrite /get_left /get_right /Gmon_graph lookup_omap.
    destruct (decide (i = x)); subst.
    + by rewrite Hu lookup_singleton; simpl.
    + rewrite lookup_singleton_ne; auto. by case _ : (g !! i) => [[[?|] [?|]]|].
  - intros Hg w Hw; specialize (Hg x). destruct v as [v1 v2]; simpl. revert Hg.
    rewrite Hu in Hw; inversion Hw; subst.
    by rewrite get_left_singleton get_right_singleton /get_left /get_right Hu.
Qed.
Lemma mark_strict_subgraph (g : graph loc) (G : Gmon) x v :
  ✓ ((x [↦] v) ⋅ G) → x ∈ dom (gset loc) g →
  of_graph g G !! x = Some (false, v) → strict_subgraph g (Gmon_graph G) →
  strict_subgraph g (Gmon_graph ((x [↦] v) ⋅ G)).
Proof.
  intros Hvl Hdx Hx Hsg. apply mark_update_strict_subgraph; try split; eauto.
  eapply strinct_subgraph_singleton; erewrite ?of_graph_unmarked; eauto.
  inversion 1; auto using strict_sub_children_refl.
Qed.
Lemma update_strict_subgraph (g : graph loc) (G : Gmon) x v w :
  ✓ ((x [↦] v) ⋅ G) → x ∈ dom (gset loc) g →
  strict_subgraph g (Gmon_graph ((x [↦] w) ⋅ G)) →
  strict_sub_children w v →
  strict_subgraph g (Gmon_graph ((x [↦] v) ⋅ G)).
Proof.
  intros Hvl Hdx Hx Hsc1 Hsc2.
  apply mark_update_strict_subgraph in Hx; eauto using update_valid.
  destruct Hx as [Hx1 Hx2].
  apply mark_update_strict_subgraph; try split; try tauto.
  pose proof (proj1 (elem_of_dom _ _) Hdx) as [u Hu].
  eapply strinct_subgraph_singleton in Hx1; eauto.
  apply strinct_subgraph_singleton; trivial.
  intros u' Hu'; rewrite Hu in Hu'; inversion Hu'; subst.
  intuition eauto using strict_sub_children_trans.
Qed.


Require Import Lia IndefiniteDescription Arith.
From hahn Require Import Hahn.
Require Import AuxRel.
Require Import Labels.
Require Import Events.
Require Import Execution.
Require Import View.

Set Implicit Arguments.

Section SCOHDeclarative.

Variable G: execution.

Definition scoh_consistent :=
  SCpL G  /\
  irreflexive ((rf G)⁻¹ ⨾ (co G ⨾ (co G))) /\
  ⟪ PORF : irreflexive (hb G) ⟫.

Lemma hb_irr (CONS : scoh_consistent) : irreflexive (hb G).
Proof using. apply CONS. Qed.

Lemma scoh_rmw_atomicity (WF: Wf G) (CONS : scoh_consistent) :
  rmw_atomicity G.
Proof using.
  unfold scoh_consistent, rmw_atomicity in *; desc.
  rewrite wf_rfE, wf_rfD; ins; unfolder in *; ins; desf.
  destruct (classic (x = y)) as [|NEQ]; desf.
  { edestruct (CONS y). apply ct_step.
    basic_solver. }
  eapply (wf_co_total WF) in NEQ; ins; desf; ins.
  { splits; ins; intro; desf; eauto 10. }
  { edestruct (CONS x). apply ct_ct.
    exists y; split; apply t_step; basic_solver. }
  unfolder. splits; auto.
  apply wf_rfl in H0; ins.
Qed.

Lemma scoh_rf_irr (CONS : scoh_consistent) : irreflexive (rf G).
Proof using. rewrite rf_in_hb. by apply hb_irr. Qed.

Lemma rf_w_in_co (WF: Wf G) (CONS : scoh_consistent) :
  (rf G) ⨾ ⦗is_w⦘ ⊆ (co G).
Proof using.
  unfolder. intros x y [RF WY].
  destruct (classic (x = y)) as [|NEQ]; subst.
  { exfalso. eapply scoh_rf_irr; eauto. }
  apply (wf_rfE WF) in RF. unfolder in RF. desf.
  apply (wf_rfD WF) in RF0. unfolder in RF0. desf.
  edestruct (wf_co_total WF) with (a:=x) (b:=y) as [|HH]; eauto.
  1,2: unfolder; splits; eauto.
  { symmetry. by apply (wf_rfl WF). }
  exfalso.
  cdes CONS. eapply CONS0.
  apply ct_ct. eexists. split; apply ct_step.
  all: basic_solver.
Qed.

(* TODO: move to more appropriate place or replace with co_ninit. *)
Lemma co_init_r (WF: Wf G)
      x y (CO : co G x y) (INITY : is_init y) :
  False.
Proof.
  apply co_ninit in CO; auto. unfolder in CO. desf.
Qed.

End SCOHDeclarative.


From Paco Require Import paco.
From ITree Require Import ITree.
Require Import sflib.

Require Import StdlibExt IntegersExt.
Require Import SysSem.
Require Import SyncSysModel Executable.

Require Import MSteps FMSim FMSim_Switch.
Require Import PALSSystem.

Require Import RTSysEnv.
Require Import CProgEventSem.

Require Import BehavUtils SystemInvariant.

Require console ctrl dev.

Require Import AcStSystem.
Require Import SpecConsole SpecController SpecDevice.
Require Import CProgEventSem.

Require Import AcStRefinement.

Require Import ITreeTac.
Require Import ZArith Streams List Lia Bool.

(* Local Opaque Z.of_nat Z.to_nat. *)
(* Import ActiveStandby. *)

Set Nested Proofs Allowed.

Definition acst_sinv: system_invariant
                        (PALSSys.as_exec active_standby_system).
Admitted.

(* event in a period-trace *)
Definition event_in_ptrace (tid: Tid) (evt: event obsE)
           (ptr: list (events obsE)): Prop :=
  exists ptr_n,
    <<PTR_N: nth_error ptr tid = Some ptr_n>> /\
    <<EVT_IN_PTR_N: In evt ptr_n>>.

Definition event_in_trace (tid: Tid) (tm: Z) (evt: event obsE)
           (tr: list (list (Z * events obsE))): Prop :=
  exists tr_n es,
    <<TR_N: nth_error tr tid = Some tr_n>> /\
    <<ES_IN_TR_N: In (tm, es) tr_n>> /\
    <<EVT_IN_ES: In evt es>>.

Section SYS_INV.
  Let exec_sys: ExecutableSpec.t :=
    PALSSys.as_exec active_standby_system.
  Let prd: Z := ExecutableSpec.period exec_sys.
  Let nts: nat := length (ExecutableSpec.apps exec_sys).

  Definition went_wrong: abs_data _ acst_sinv -> Prop.
  Admitted.

  Definition start_control
    : abs_data _ acst_sinv -> Prop.
  Admitted.

  Inductive dchain
    : (abs_data _ acst_sinv) -> list (abs_data _ acst_sinv) -> Prop :=
  | DataChain_One
      d
      (WF_D: abs_data_wf _ _ d)
    : dchain d []
  | DataChain_Step
      d1 d2 ds
      (NEXT: abs_data_next _ acst_sinv d1 d2)
      (WF_D1: abs_data_wf _ _ d1)
      (REST_CHAIN: dchain d2 ds)
    : dchain d1 (d2 :: ds)
  .

  (* Lemma start_and_went_wrong_trace *)
  (*       tm0 d0 inbs0 lsts0 *)
  (*       tr d1 inbs1 lsts1 steps *)
  (*       (SYNC_TIME: (prd | tm0)%Z) *)
  (*       (SINV_STEPS: sinv_steps _ acst_sinv tm0 *)
  (*                               (d0, inbs0, lsts0) *)
  (*                               ((tr, d1, inbs1, lsts1) :: steps)) *)
  (*   : *)

End SYS_INV.

Section LIVENESS.
  Let exec_sys: ExecutableSpec.t :=
    PALSSys.as_exec active_standby_system.
  Let prd: Z := ExecutableSpec.period exec_sys.
  Let nts: nat := length (ExecutableSpec.apps exec_sys).

  Definition dev_wait
    : (abs_data _ acst_sinv) -> Tid ->
      nat(*demand*) -> nat(*wait_cnt*) -> Prop.
  Admitted.

  Definition dev_owner
    : (abs_data _ acst_sinv) -> Tid -> nat (*demand left*) -> Prop.
  Admitted.

  Definition dev_failed: abs_data _ acst_sinv -> Tid -> Prop.
  Admitted.

  Lemma dev_wait_advance
        (d d': abs_data _ acst_sinv)
        tid_dev dmd w
        (NEXT: abs_data_next _ _ d d')
        (WAIT_S_W: dev_wait d tid_dev dmd (S w))
        (WF_D: abs_data_wf _ acst_sinv d)
    : <<WENT_WRONG: went_wrong d'>> \/
      <<DEVICE_FAILED: dev_failed d' tid_dev>> \/
      <<DEV_WAIT_REDUCED: dev_wait d' tid_dev dmd w>>.
  Proof.
  Admitted.

  Lemma dev_wait_zero
        d tid_dev dmd
        (WAIT_ZERO: dev_wait d tid_dev dmd O)
        (WF_D: abs_data_wf _ acst_sinv d)
    : dev_owner d tid_dev dmd.
  Proof.
  Admitted.

  Lemma dev_wait_safe
        d tid_dev dmd w
        (WAIT: dev_wait d tid_dev dmd w)
        (WF_D: abs_data_wf _ acst_sinv d)
    : ~ went_wrong d.
  Proof.
  Admitted.

  Lemma dev_wait_not_failed
        d tid_dev dmd w
        (WAIT: dev_wait d tid_dev dmd w)
        (WF_D: abs_data_wf _ acst_sinv d)
    : ~ dev_failed d tid_dev.
  Proof.
  Admitted.

  Lemma dev_owner_advance
        d tid_dev dmd d'
        (OWNER: dev_owner d tid_dev (S dmd))
        (WF_D: abs_data_wf _ acst_sinv d)
        (NEXT: abs_data_next _ _ d d')
    : <<WENT_WRONG: went_wrong d'>> \/
      <<OWNER_REDUCED: dev_owner d tid_dev dmd>>.
  Proof.
  Admitted.

  Lemma dev_owner_safe
        d tid_dev dmd
        (WAIT: dev_owner d tid_dev dmd)
        (WF_D: abs_data_wf _ acst_sinv d)
    : ~ went_wrong d.
  Proof.
  Admitted.

  Inductive owner_dchain (tid_dev: Tid)
    : nat -> list (abs_data _ acst_sinv) -> Prop :=
  | OwnerDataChain_Base
      d0
      (OWNER_ZERO: dev_owner d0 tid_dev O)
      (WF_D0: abs_data_wf _ _ d0)
    : owner_dchain tid_dev O [d0]
  | OwnerDataChain_Cons
      dmd d ds
      (OWNER_N: dev_owner d tid_dev (S dmd))
      (WF_D0: abs_data_wf _ _ d)
      (OWNER_DATAS_REST: owner_dchain tid_dev dmd ds)
    : owner_dchain tid_dev (S dmd) (d :: ds)
  .

  (* Lemma demand_wait_start *)
  (*       d1 inbs1 lsts1 tm1 *)
  (*       tr lsts_out *)
  (*       tid_dev (dmd_raw: int) (dmd: nat) *)
  (*       d2 inbs2 lsts2 *)
  (*       (MATCH_LOCALS1: iForall2 *)
  (*                         (match_local _ acst_sinv tm1 d1) *)
  (*                         0 inbs1 lsts1) *)
  (*       (WF_D1: abs_data_wf _ _ d1) *)
  (*       (SAFE_D1: ~ went_wrong d1) *)
  (*       (LOCAL_STEPS: Forall4 (run_local exec_sys tm1) *)
  (*                             inbs1 lsts1 tr lsts_out) *)
  (*       (LOCAL_STATES': lsts2 = map fst lsts_out) *)
  (*       (INBS1: inbs2 = imap (fun tid _ => *)
  (*                               map (SNode.get_outbox_msg_by_dest *)
  (*                                      tid) (map snd lsts_out)) *)
  (*                            0 (repeat tt nts)) *)
  (*       (SAFE_TRACE: Forall safe_trace tr) *)
  (*       (DMD_POS: 0 < dmd) *)
  (*       (ACTUAL_DEMAND: dmd = Nat.min MAX_TIMEOUT (Z.to_nat (Int.signed dmd_raw))) *)
  (*       (EVT_IN_TR: event_in_trace tid_dev (Event (inl1 CheckDemand) dmd_raw) tr) *)
  (*       (MATCH_LOCALS2: iForall2 *)
  (*                         (match_local _ acst_sinv (tm1 + prd)%Z d2) *)
  (*                         0 inbs2 lsts2) *)
  (*       (WF_D2: abs_data_wf _ _ d2) *)
  (*   : exists wait_max, *)
  (*     <<WENT_WRONG: went_wrong d2>> \/ *)
  (*     <<WAIT_START: dev_wait d2 tid_dev wait_max dmd>> *)
  (* . *)
  (* Proof. *)
  (* Admitted. *)

  Lemma dchain_wait_to_owner
        d ds
        tid_dev (dmd: nat) w
        (DCHAIN: dchain d ds)
        (WAIT_START: dev_wait d tid_dev dmd w)
        (LEN_DS: dmd <= length ds)
    : exists ds_w d_wend ds',
      <<DCHAIN_DIV: d :: ds = ds_w ++ d_wend :: ds'>> /\
      <<LEN_DS_W: length ds_w <= w>> /\
      (<<WENT_WRONG: went_wrong d_wend>> \/
       <<DEV_FAILED: dev_failed d_wend tid_dev>> \/
       <<BECAME_OWNER: dev_owner d_wend tid_dev dmd>>).
  Proof.
  Admitted.

  Lemma dev_wait_dmd_le_max
        d tid_dev dmd w
        (WAIT: dev_wait d tid_dev dmd w)
    : dmd <= MAX_TIMEOUT.
  Proof.
  Admitted.

  Lemma owner_dchain_cases
        d tid_dev dmd
        (OWNER: dev_owner d tid_dev dmd)
    : forall ds
        (DS_LEN: dmd <= length ds)
        (DCHAIN: dchain d ds)
    ,
      Exists went_wrong ds \/
      Exists (flip dev_failed tid_dev) ds \/
      exists ds_use ds_rest,
        <<DS_DIV: d :: ds = ds_use ++ ds_rest>> /\
        <<USES: owner_dchain tid_dev dmd ds_use>>.
  Proof.
  Admitted.

  Lemma liveness_dchain_cases
        tid_dev
        d (dmd: nat) w
        (WAITING: dev_wait d tid_dev dmd w)
    : forall ds
        (DS_LEN: length ds = w + MAX_TIMEOUT)
        (DCHAIN: dchain d ds),
      ((* CTRL_FAILED *)
        Exists went_wrong ds) \/
      ((* DEV_FAILED *)
        Exists (flip dev_failed tid_dev) ds) \/
      ((* USE RESOURCE *)
        exists ds1 ds_use ds2,
          <<DS_DIV: d :: ds = ds1 ++ ds_use ++ ds2>> /\
          <<USES: owner_dchain tid_dev dmd ds_use>>)
  .
  Proof.
    i.
    hexploit dev_wait_dmd_le_max; eauto. intro DMD_LE_MAX.
    hexploit dchain_wait_to_owner; eauto.
    { nia. }
    i. des.
    { left.
      destruct ds_w.
      { simpl in DCHAIN_DIV. clarify.
        exfalso.
        hexploit dev_wait_safe; eauto.
        inv DCHAIN; done.
      }
      simpl in DCHAIN_DIV. clarify.
      apply Exists_exists.
      esplits.
      { apply in_or_app. right.
        simpl. left. eauto. }
      done.
    }
    { right. left.
      destruct ds_w.
      { simpl in DCHAIN_DIV. clarify.
        exfalso.
        hexploit dev_wait_not_failed; eauto.
        inv DCHAIN; done.
      }
      simpl in DCHAIN_DIV. clarify.
      apply Exists_exists.
      esplits.
      { apply in_or_app. right.
        simpl. left. eauto. }
      done.
    }

    assert (DCHAIN_WEND: dchain d_wend ds').
    { clear - DCHAIN_DIV DCHAIN.
      destruct ds_w as [|h t].
      { ss. clarify. }

      ss. clarify.
      depgen h.
      induction t as [| h' t' IH]; i; ss; clarify.
      { inv DCHAIN. ss. }
      inv DCHAIN.
      eauto.
    }

    hexploit owner_dchain_cases; eauto.
    { cut (length (d::ds) = length ds_w + S (length ds')).
      { s. nia. }
      rewrite DCHAIN_DIV.
      rewrite app_length. s. reflexivity.
    }
    assert (DS'_DS: forall x, In x ds' -> In x ds).
    { i. destruct ds_w; simpl in DCHAIN_DIV; clarify.
      apply in_or_app. right. right. eauto. }

    intros [WRONG | [DFAIL | OK]].
    - left.
      apply Exists_exists.
      apply Exists_exists in WRONG. des.
      esplits; eauto.
    - right. left.
      apply Exists_exists.
      apply Exists_exists in DFAIL. des.
      esplits; eauto.
    - des.
      right. right.
      esplits; eauto.
      rewrite DCHAIN_DIV.
      rewrite DS_DIV. eauto.
  Qed.

  Lemma dev_failed_trace_nil
        d tid_dev (tm: Z)
        inbs lsts tr lsts_out
        (DEV_FAILED: dev_failed d tid_dev)
        (SYNC_TIME: (prd | tm)%Z)
        (MATCH: iForall2 (match_local _ acst_sinv tm d)
                         O inbs lsts)
        (WF_D: abs_data_wf _ _ d)
        (* steps *)
        (LOCAL_STEPS: Forall4 (run_local exec_sys tm)
                              inbs lsts tr lsts_out)
    : forall e, ~ event_in_ptrace tid_dev e tr.
  Proof.
  Admitted.

  Lemma dev_owner_trace_use
        d tid_dev (tm: Z) (dmd: nat)
        inbs lsts tr lsts_out
        d' inbs' lsts'
        (OWNER: dev_owner d tid_dev (S dmd))
        (SYNC_TIME: (prd | tm)%Z)
        (MATCH: iForall2 (match_local _ acst_sinv tm d)
                         O inbs lsts)
        (WF_D: abs_data_wf _ _ d)
        (* steps *)
        (LOCAL_STEPS: Forall4 (run_local exec_sys tm)
                              inbs lsts tr lsts_out)
        (LOCAL_STATES': lsts' = map fst lsts_out)
        (INBS': inbs' = imap (fun tid _ =>
                                map (SNode.get_outbox_msg_by_dest
                                       tid) (map snd lsts_out))
                             0 (repeat tt nts))
        (MATCH1: iForall2 (match_local _ acst_sinv tm d')
                         O inbs' lsts')
        (WF_D': abs_data_wf _ _ d')
        (OWNER': dev_owner d' tid_dev dmd)
    : event_in_ptrace tid_dev (Event (inl1 UseResource) tt) tr.
  Proof.
  Admitted.

End LIVENESS.

Local Opaque Z.to_nat Z.of_nat.

Section LIVENESS_BEH.
  Let exec_sys :=
    (PALSSys.as_exec active_standby_system).
  Let prd := (ExecutableSpec.period exec_sys).
  Let nts := (length (ExecutableSpec.apps exec_sys)).

  Let PRD_POS: (0 < prd)%Z.
  Proof.
    change prd with (Z.of_nat period).
    change period with (Z.to_nat ActiveStandby.period).
    ss.
  Qed.

  Variable tm_init: Z.

  Let dsys: DSys.t := ExecutableSpec.as_dsys
                        exec_sys tm_init None.

  Let st_init := (0%Z, ExecutableSpec.sys_itree
                         exec_sys tm_init None).

  (* no events except console *)
  Definition trace_pre
             (tr: list (list (Z * events obsE))): Prop.
  Admitted.

  (* Definition start_ctrl_trace *)
  (*            (tr: list (list (Z * events obsE))): Prop. *)
  (* Admitted. *)

  Definition log_in_trace (tid: Tid) (tm:Z)
             (tr: list (list (Z * events obsE))): Prop :=
    exists (v: Z),
      event_in_trace tid tm (Event (inl1 (WriteLog v)) tt) tr.

  Inductive trace_ctrl_fsd
            (tm: Z)
            (tr: list (list (Z * events obsE)))
    : (bool?) -> Prop :=
    TraceCtrlFsd
      fsd
      (FST_FSD: fsd = Some true \/ log_in_trace tid_ctrl1 tm tr)
      (SND_FSD: fsd = Some false \/ log_in_trace tid_ctrl2 tm tr)
    : trace_ctrl_fsd tm tr fsd.
  (* | TraceCtrlFsd_Snd *)
  (*     (FST_OK: log_in_trace tid_ctrl1 tm tr) *)
  (*     (SND_FAILED: ~ log_in_trace tid_ctrl2 tm tr) *)
  (*   : trace_ctrl_fsd tm tr (Some false) *)
  (* | TraceCtrlFsd_None *)
  (*     (FST_OK: log_in_trace tid_ctrl1 tm tr) *)
  (*     (SND_OK: log_in_trace tid_ctrl2 tm tr) *)
  (*   : trace_ctrl_fsd tm tr None *)
  (* . *)

  Inductive fsd_le: bool? -> bool? -> Prop :=
  | FsdLe_Eq x
    : fsd_le x x
  | FsdLe_None x
    : fsd_le x None
  .

  Inductive fsd_next: bool? -> bool? -> Prop :=
  | FsdNext_None1 fsd
    : fsd_next None fsd
  | FsdNext_None2 fsd
    : fsd_next fsd None
  | FsdNext_eq sd
    : fsd_next (Some sd) (Some sd)
  .

  Lemma trace_ctrl_fsd_le
        tm tr fsd fsd'
        (FSD: trace_ctrl_fsd tm tr fsd)
        (LE: fsd_le fsd' fsd)
    : trace_ctrl_fsd tm tr fsd'.
  Proof.
    inv LE; ss.
    inv FSD.
    des; ss.
    econs; eauto.
  Qed.

  (* Inductive trace_ctrl_on *)
  (*   : Z * bool? -> Z * bool? (* exclusive *) -> *)
  (*     list (list (Z * events obsE)) -> Prop := *)
  (* | TraceCtrlOn_Base *)
  (*     tr tm fsd *)
  (*     (* (SYNC_TIME: (prd | tm)%Z) *) *)
  (*     (* (FAILED_SIDE: trace_ctrl_fsd tm tr fsd) *) *)
  (*   : trace_ctrl_on (tm, fsd) (tm, fsd) tr *)
  (* | TraceCtrlOn_Cons *)
  (*     tr tm fsd *)
  (*     fsd1 tm' fsd' *)
  (*     (SYNC_TIME: (prd | tm)%Z) *)
  (*     (FAILED_SIDE: trace_ctrl_fsd tm tr fsd) *)
  (*     (CTRL_ON_REST: trace_ctrl_on ((tm + prd)%Z, fsd1) *)
  (*                                  (tm', fsd') tr) *)
  (*     (FSD_LE: fsd_le fsd fsd1) *)
  (*   : trace_ctrl_on (tm, fsd) (tm', fsd') tr *)
  (* . *)

  Definition tid_c_of_side (sd: bool): Tid :=
    if sd then tid_ctrl1 else tid_ctrl2.

  Lemma trace_ctrl_fsd_Some
        tm tr fsd sd
        (FSD: trace_ctrl_fsd tm tr fsd)
        (FSD_SOME: fsd = Some sd)
    : log_in_trace (tid_c_of_side (negb sd)) tm tr.
  Proof.
    subst fsd.
    inv FSD. des; clarify.
    destruct sd; ss.
  Qed.

  Inductive trace_ctrl_on
             (tm_s tm_e: Z)
             (fsd_s fsd_e: bool?)
             (tr: list (list (Z * events obsE)))
    : Prop :=
    TraceCtrlOn
      (TM_S_SYNC: (prd | tm_s)%Z)
      (START_FST: trace_ctrl_fsd tm_s tr fsd_s)
      (CHAIN_EXISTS:
         forall tm1 sd
           (TM1_SYNC: (prd | tm1)%Z)
           (* (TM_NEXT: (tm2 = tm1 + prd)%Z) *)
           (TM1_LBND: (tm_s <= tm1 < tm_e)%Z)
           (* (TM2_UBND: (tm2 < tm_e)%Z) *)
           (OFF_AT_TM: ~ log_in_trace (tid_c_of_side sd) tm1 tr)
         ,
           <<ON_OTHER: log_in_trace (tid_c_of_side (negb sd)) tm1 tr>> /\
           ((* chain exists *)
             <<ON_OTHER_NEXT: log_in_trace (tid_c_of_side (negb sd)) (tm1 + prd)%Z tr>> \/
           (* last log *)
             <<LAST_TIME: (tm_e <= tm1 + prd)%Z>> /\
             <<LAST_FAILED_SIDE: fsd_e = Some sd>>))
  .

  Lemma divide_next_eq
        p a b
        (P_POS: (0 < p)%Z)
        (DIV1: (p | a)%Z)
        (DIV2: (p | b)%Z)
        (GT: (a < b <= a + prd)%Z)
    : (b = a + prd)%Z.
  Proof.
  Admitted.

  Lemma trace_ctrl_on_app
        tr tm_s tm_m tm_e
        fsd_s fsd_m fsd_m' fsd_e
        (ON1: trace_ctrl_on tm_s tm_m fsd_s fsd_m tr)
        (ON2: trace_ctrl_on tm_m tm_e fsd_m' fsd_e tr)
        (FSD_NEXT: fsd_next fsd_m fsd_m')
    : trace_ctrl_on tm_s tm_e fsd_s fsd_e tr.
  Proof.
    inv ON1.
    renames TM_S_SYNC START_FST CHAIN_EXISTS into
            TM_S_SYNC1 START_FST1 CHAIN_EXISTS1.
    inv ON2.

    econs; eauto. i.
    destruct (Z_lt_ge_dec tm1 tm_m) as [LT|GE].
    - hexploit CHAIN_EXISTS1; eauto.
      { nia. }
      i. des.
      { eauto. }

      assert (TM_M_EQ: (tm_m = tm1 + prd)%Z).
      { eapply divide_next_eq; eauto. }

      split; ss.
      left.
      subst fsd_m.

      inv FSD_NEXT.
      + inv START_FST. des; clarify.
        r. destruct sd; ss.
      + inv START_FST. des; clarify.
        destruct sd; ss.

    - hexploit CHAIN_EXISTS; eauto.
      nia.
  Qed.

  Definition device_task_id (tid: Tid): Prop :=
    tid = tid_dev1 \/ tid = tid_dev2 \/ tid = tid_dev3.

  Inductive trace_pos_demand
            (tid_dev: Tid) (tm: Z) (dmd: nat)
            (tr: list (list (Z * events obsE))): Prop :=
    TracePosDemand
      (dmd_i: int)
      (DEV_TASK_ID: device_task_id tid_dev)
      (RANGE_DEMAND: 0 < dmd <= MAX_TIMEOUT)
      (DMD_TO_NAT2: Z_to_nat2 (Int.signed dmd_i) = Some dmd)
      (DEMAND_EVT_IN_TRACE:
         event_in_trace tid_dev tm
                        (Event (inl1 CheckDemand) dmd_i) tr)
  .

  Lemma liveness_exec
        scnt_pre tr_pre st_pre
        tr_s st_s
        scnt1 tr1 st1
        tr_dmd st_w exec_w
        (STEPS_PRE: msteps dsys scnt_pre st_init tr_pre st_pre)
        (STEPS_CSTART: msteps dsys 1 st_pre tr_s st_s)
        (STEPS_ALIVE: msteps dsys scnt1 st_s tr1 st1)
        (STEPS_DEMAND: msteps dsys 1 st1 tr_dmd st_w)
        (PRE_TR: trace_pre tr_pre)
        (CSTART_TR: trace_ctrl_on tr1)
        (EXEC_ST: DSys.exec_state dsys st_w exec_w)
    : True.


(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University
  Copyright 2018 Luxembourg University

  This file is part of Velisarios.

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

  Velisarios 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 Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

*)

Require Export PBFTexecute4.
Require Export PBFTsame_states.

Section PBFTagreement.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { pbft_context : PBFTcontext      }.
  Context { pbft_auth    : PBFTauth         }.
  Context { pbft_keys    : PBFTinitial_keys }.
  Context { pbft_hash    : PBFThash         }.
  Context { pbft_hash_axioms : PBFThash_axioms  }.

  Lemma agreement :
    forall (eo : EventOrdering) (e1 e2 : Event) v1 v2 ts c j1 j2 r1 r2 a1 a2 i1 i2,
      authenticated_messages_were_sent_or_byz_usys eo PBFTsys
      -> PBFTcorrect_keys eo
      -> exists_at_most_f_faulty [e1,e2] F
      -> loc e1 = PBFTreplica i1
      -> loc e2 = PBFTreplica i2
      -> In (send_reply (mk_reply v1 ts c j1 r1 a1)) (output_system_on_event_ldata PBFTsys e1)
      -> In (send_reply (mk_reply v2 ts c j2 r2 a2)) (output_system_on_event_ldata PBFTsys e2)
      -> r1 = r2.
  Proof.
    introv sendbyz ckeys atmost eqloc1 eqloc2 out1 out2.

    applydup @output_system_on_event_ldata_implies_state_sm_on_event in out1 as h;
      [|introv; simpl in *; unfold PBFTsys, PBFTnstate; remember (loc e1); destruct n; ginv; eauto 3 with pbft; try apply replicas_never_stop].
    revert h; unfold PBFTnstate; rewrite eqloc1; introv h; exrepnd.

    applydup @output_system_on_event_ldata_implies_state_sm_on_event in out2 as z;
      [|introv; simpl in *; unfold PBFTsys, PBFTnstate; remember (loc e2); destruct n; ginv; eauto 3 with pbft; try apply replicas_never_stop].
    revert z; unfold PBFTnstate; rewrite eqloc2; introv z; exrepnd.

    pose proof (state_sm_before_event_some_between3 e1 e1 (PBFTreplicaSM i1) st) as q.
    repeat (autodimp q hyp); eauto 3 with eo; exrepnd.

    pose proof (state_sm_before_event_some_between3 e2 e2 (PBFTreplicaSM i2) st0) as w.
    repeat (autodimp w hyp); eauto 3 with eo; exrepnd.

    rename st into st1.
    rename st0 into st.
    rename s' into st2.
    rename s'0 into st0.

    eapply replies_from in out1; eauto.
    eapply replies_from in out2; eauto.
    exrepnd.

    subst.

    match goal with
    | [ H1 : committed_log _ _ = _, H2 : committed_log _ _ = _ |- _ ] =>
      rename H1 into com1; rename H2 into com2; dup com1 as com
    end.

    match goal with
    | [ H1 : find_first_reply _ _ _ = _, H2 : find_first_reply _ _ _ = _ |- _ ] =>
      rename H1 into ffr1; rename H2 into ffr2
    end.

    match goal with
    | [ H1 : find_last_reply_entry_corresponding_to_client _ _ = _,
             H2 : find_last_reply_entry_corresponding_to_client _ _ = _,
                  H3 : find_last_reply_entry_corresponding_to_client _ _ = _,
                       H4 : find_last_reply_entry_corresponding_to_client _ _ = _ |- _ ] =>
      rename H1 into fl1; rename H2 into fl2; rename H3 into fl3; rename H4 into fl4
    end.

    match goal with
    | [ H1 : reply2requests _ _ _ _ _ _ = _, H2 : reply2requests _ _ _ _ _ _ = _ |- _ ] =>
      rename H1 into r2rs1; rename H2 into r2rs2
    end.

    match goal with
    | [ H1 : request2info _ = _, H2 : request2info _ = _ |- _ ] =>
      rename H1 into r2i1; rename H2 into r2i2
    end.

    destruct (SeqNumDeq (next_to_execute st0) (next_to_execute st2)) as [d|d].

    {
      rewrite d in *.

      eapply PBFT_A_1_11_before in com;
        try exact com2; try (exact q0); try (exact w0); auto; eauto 3 with pbft eo;[].
      apply eq_digests_implies_eq_requests in com; subst.

      rewrite ffr1 in ffr2; ginv.

      pose proof (next_to_execute_from_before eo e1 e2 j1 j2 st2 st0) as u.
      repeat (autodimp u hyp);[].
      repnd.
      rewrite u0 in *.
      rewrite u in *.

      pose proof (same_states_if_same_next_to_execute eo e1 e2 j1 j2 st1 st) as v.
      repeat (autodimp v hyp); try (complete (allrw; tcsp));[].
      repnd.
      try rewrite v0 in *.
      try rewrite v in *.

      eapply matching_reply2requests_implies in r2rs1; try (exact r2rs2).
      repnd; subst.

      rewrite fl1 in *; ginv.
      rewrite fl2 in *; ginv.

      rewrite r2i1 in *; ginv.
      smash_pbft.
    }

    assert (seqnum2nat (next_to_execute st0) <> seqnum2nat (next_to_execute st2)) as d'.
    { intro xx; destruct d.
      destruct (next_to_execute st0), (next_to_execute st2); simpl in *; tcsp. }

    apply not_eq in d'; repndors;[|].

    {
      assert (next_to_execute st <= next_to_execute st2) as lenext by (allrw; simpl; omega).
      applydup next_to_execute_is_greater_than_one in z0; auto;[].

      rewrite <- ite_first_state_sm_on_event_as_before in q0.
      unfold ite_first in *.
      destruct (dec_isFirst e1) as [d1|d1]; ginv; subst; simpl in *;[].
      pose proof (last_reply_state_increases
                    eo (local_pred e1) j1 st2
                    (next_to_execute st)) as u.
      repeat (autodimp u hyp); autorewrite with eo; auto;
        try omega; eauto 3 with pbft eo;[].
      exrepnd.

      pose proof (same_states_if_same_next_to_execute eo e' e2 j j2 st' st) as v.
      repeat (autodimp v hyp); try (complete (allrw; auto)); eauto 4 with pbft eo;[].
      repnd.
      rewrite v in u0.

      applydup u0 in fl4.
      exrepnd.

      match goal with
      | [ H : context[reply2requests j1] |- _ ] => rename H into rep2req
      end.
      applydup reply2requests_implies_last_reply_state_extends in rep2req as ext.
      applydup ext in fl0.
      exrepnd.
      rewrite fl8 in *; ginv.

      assert (ts <= lre_timestamp e4) as lets by omega.

      autodimp fl5 hyp;[apply eq_nats_implies_eq_timestamps; omega|].
      autodimp fl9 hyp;[apply eq_nats_implies_eq_timestamps; omega|].
      autodimp out0 hyp;[apply eq_nats_implies_eq_timestamps; omega|].

      assert (lre_reply e4 = Some r1) as eqr1 by (pbft_dest_all x; try omega).

      assert (Some r1 = Some r2) as eqrs by congruence.
      ginv.
    }

    {
      assert (next_to_execute st1 <= next_to_execute st0) as lenext by (allrw; simpl; omega).
      applydup next_to_execute_is_greater_than_one in h0; auto;[].

      rewrite <- ite_first_state_sm_on_event_as_before in w0.
      unfold ite_first in *.
      destruct (dec_isFirst e2) as [d1|d1]; ginv; subst; simpl in *;[].
      pose proof (last_reply_state_increases
                    eo (local_pred e2) j2 st0
                    (next_to_execute st1)) as u.
      repeat (autodimp u hyp); autorewrite with eo; auto; try omega; eauto 3 with pbft eo;[].
      exrepnd.

      pose proof (same_states_if_same_next_to_execute eo e' e1 j j1 st' st1) as v.
      repeat (autodimp v hyp); try (complete (allrw; auto)); eauto 5 with pbft eo;[].
      repnd.
      rewrite v in u0.

      applydup u0 in fl2.
      exrepnd.

      match goal with
      | [ H : context[reply2requests j2] |- _ ] => rename H into rep2req
      end.
      applydup reply2requests_implies_last_reply_state_extends in rep2req as ext.
      applydup ext in fl0.
      exrepnd.
      rewrite fl8 in *; ginv.

      assert (ts <= lre_timestamp e0) as lets by omega.

      autodimp fl5 hyp;[apply eq_nats_implies_eq_timestamps; omega|].
      autodimp fl9 hyp;[apply eq_nats_implies_eq_timestamps; omega|].
      autodimp out14 hyp;[apply eq_nats_implies_eq_timestamps; omega|].

      assert (lre_reply e0 = Some r2) as eqr2 by (pbft_dest_all x; try omega).

      assert (Some r1 = Some r2) as eqrs by congruence.
      ginv.
    }
  Qed.

(*  Definition mk_reply
             (v : View)
             (t : Timestamp)
             (c : Client)
             (i : Rep)
             (r : PBFTresult)
             (a : Tokens) : Reply :=
    reply (bare_reply v t c i r) a.

  Lemma sent_replies_are_committed :
    forall (eo : EventOrdering) (e : Event) p dst st i,
      loc e = PBFTreplica i
      -> In (send_reply v t c i r) (output_system_on_event_ldata PBFTsys eo e)
      -> state_sm_on_event (PBFTreplicaSM i) eo e = Some st
      -> prepare_in_log p (log st) = true
      -> exists n,
          committed_log (request_data ) (log e).
  Proof.
  Qed.*)

(*
  Lemma in_check_send_replies_implies :
    forall i v ks
           (giop : option GeneratedInfo)
           (msgs : DirectedMsgs)
           (sn   : SeqNum)
           (m    : DirectedMsg)
           (st1 st2 : PBFTstate),
      check_send_replies i v ks giop st1 sn = (msgs, st2)
      -> In m msgs
      -> exists (prepop : option Prepare)
                (commop : option Commit)
                (entry : PBFTlogEntry),
          giop = Some (MkGeneratedInfo prepop commop entry)
          /\ is_committed_entry entry = true
          /\ m = send_check_ready check_ready (PBFTreplica i)
          /\ st2 = add_to_ready st1 sn.
  Proof.
    introv h j.
    unfold check_send_replies in h.
    destruct giop; simpl in *; tcsp.
    - destruct g.
      dest_cases x; ginv; simpl in *; tcsp.
      + inversion h; subst; clear h; simpl in *; repndors; subst; tcsp.
        eexists; eexists; eexists; dands; eauto.
      + inversion h; subst; clear h; simpl in *; tcsp.
    - inversion h; subst; simpl in *; tcsp.
  Qed.

  Lemma add_prepares_to_log_from_new_view_pre_prepares_returns_prep_comm_rep :
    forall (slf  : Rep)
           (pps  : list (Pre_prepare * PBFTdigest))
           (st1 st2 : PBFTstate)
           (msgs : DirectedMsgs)
           (m    : DirectedMsg),
      add_prepares_to_log_from_new_view_pre_prepares slf st1 pps = (st2, msgs)
      -> In m msgs
      -> (exists i p, m = MkDMsg i (PBFTprepare p))
         \/
         (exists i c, m = MkDMsg i (PBFTcommit c))
         \/
         (exists i r, m = MkDMsg i (PBFTcheck_ready r)).
  Proof.
    induction pps; introv e i; simpl in *; ginv.

    - inversion e; clear e; subst; simpl in *; tcsp.

    - dest_cases w; symmetry in Heqw.
      dest_cases x; symmetry in Heqx.
      inversion e; clear e; subst.
      apply in_app_iff in i; repndors.

      + unfold add_prepare_to_log_from_new_view_pre_prepare in Heqw.
        repnd; simpl in *.
        dest_cases y; symmetry in Heqy; simpl in *; tcsp;[|].

        * dest_cases u; symmetry in Hequ; simpl in *; tcsp;[].
          dest_cases v; symmetry in Heqv; simpl in *; tcsp;[].
          inversion Heqw; subst; clear Heqw.
          apply in_app_iff in i; repndors.

          { unfold check_broadcast_prepare in i.
            dest_cases q; subst; simpl in *.
            destruct q; simpl in *.
            dest_cases p; symmetry in Heqp; simpl in *; tcsp;[|].

            - inversion Heqv; subst; clear Heqv; simpl in *.
              dest_cases k; symmetry in Heqk; simpl in *; tcsp;[].
              dest_cases r; subst; simpl in *;tcsp;[|].

              + apply in_broadcast2others in i; exrepnd; subst; simpl in *.
                left.
                eexists; eexists; reflexivity.

              + apply in_broadcast2others in i; exrepnd; subst; simpl in *.
                left.
                eexists; eexists; reflexivity.

            - inversion Heqv; clear Heqv; subst; simpl in *.
              dest_cases k; symmetry in Heqk; simpl in *; tcsp.
              dest_cases r; symmetry in Heqr; simpl in *; tcsp;[|].

              + apply in_broadcast2others in i; exrepnd; subst; simpl in *.
                left.
                eexists; eexists; reflexivity.

              + apply in_broadcast2others in i; exrepnd; subst; simpl in *.
                left.
                eexists; eexists; reflexivity. }

          { unfold check_broadcast_commit in i.
            dest_cases q; symmetry in Heqq; subst; simpl in *; tcsp;[|].

            - destruct q; simpl in *.
              dest_cases k; symmetry in Heqk; simpl in *; tcsp;[|].

              + inversion Heqv; clear Heqv; subst; simpl in *.
                apply in_app_iff in i; simpl in *; repndors; tcsp.

                * dest_cases r; symmetry in Heqr; simpl in *; tcsp;[].
                  dest_cases p; subst; simpl in *; tcsp;[|].

                  { apply in_broadcast2others in i; exrepnd; subst.
                    right; left.
                    eexists; eexists; reflexivity. }

                  { apply in_broadcast2others in i; exrepnd; subst.
                    right; left.
                    eexists; eexists; reflexivity. }

                * subst; simpl in *.
                  right; right.
                  eexists; eexists; reflexivity.

              + inversion Heqv; clear Heqv; subst; simpl in *; tcsp.
                allrw app_nil_r.
                dest_cases q; symmetry in Heqq.
                dest_cases r; subst; simpl in *; tcsp;[|].

                * apply in_broadcast2others in i; exrepnd; subst; simpl in *.
                  right; left.
                  eexists; eexists; reflexivity.

                * apply in_broadcast2others in i; exrepnd; subst; simpl in *.
                  right; left.
                  eexists; eexists; reflexivity.

            - inversion Heqv; clear Heqv; subst; simpl in *; tcsp. }

        * inversion Heqw; clear Heqw; subst; simpl in *.
          apply in_broadcast2others in i; exrepnd; subst.
          left.
          eexists; eexists; reflexivity.

      + eapply IHpps in Heqx;[|eauto]; auto.
  Qed.

  Lemma update_state_new_view_returns_checkpoint :
    forall (slf  : Rep)
           (nv   : NewView)
           (st1 st2 : PBFTstate)
           (msgs : DirectedMsgs)
           (m    : DirectedMsg),
      update_state_new_view slf st1 nv = (st2, msgs)
      -> In m msgs
      -> (exists i c, m = MkDMsg i (PBFTcheckpoint c)).
  Proof.
    introv h i.
    unfold update_state_new_view in h.
    dest_cases w; symmetry in Heqw;[].
    dest_cases y; symmetry in Heqy;[|].

    - dest_cases z; subst; simpl in *;[|].

      + dest_cases x; symmetry in Heqx.
        inversion h; subst; clear h.
        unfold broadcast_checkpoint_op in i.
        dest_cases q; subst; simpl in *.
        apply in_broadcast2others in i; exrepnd; subst; simpl in *.
        exists o q; auto.

      + inversion h; subst; clear h; simpl in *; tcsp.

    - inversion h; subst; clear h; simpl in *; tcsp.
  Qed.

  (* replies are sent on receipt of check_ready messages *)
  Lemma send_reply_iff :
    forall (eo : EventOrdering) (e : Event) v t c i r a,
      In (send_reply (mk_reply v t c i r a)) (output_system_on_event_ldata PBFTsys eo e)
      <->
      (
        exists (n      : Rep)
               (cr     : CheckReady)
               (st st' : PBFTstate)
               (sns    : list SeqNum)
               (entry  : PBFTlogEntry)
               (reps   : list (option Reply))
               (smst   : PBFTsm_state)
               (lastr  : LastReplyState)
               (msgs   : DirectedMsgs),
          loc e = PBFTreplica n
          /\ trigger e = PBFTcheck_ready cr
          /\ state_sm_before_event (PBFTreplicaSM n) eo e = Some st
          /\ find_entry (log st) (next_to_execute st) = Some entry
          /\ reply2requests
               n
               (current_view st)
               (local_keys st)
               (log_entry2requests entry)
               (sm_state st)
               (last_reply_state st) = (reps, smst, lastr)
          /\ check_broadcast_checkpoint
               n
               (next_to_execute st)
               (current_view st)
               (local_keys st)
               (change_log_entry
                  (change_last_reply_state
                     (change_sm_state (increment_next_to_execute st) smst) lastr)
                  (add_replies2entry entry reps)) = (st', msgs)
          /\ ready st = next_to_execute st :: sns
          /\ In (mk_reply v t c i r a) (list_option2list reps)

      ).
  Proof.
    introv.
    rewrite in_output_system_on_event_ldata.
    split; intro h.

    - unfold PBFTsys in h.
      remember (loc e) as n; destruct n; simpl in *;
        unfold MStateMachine in *; ginv;
          [|apply MhaltedSM_output in h; tcsp];[].

      rw @loutput_sm_on_event_unroll2 in h; simpl in h.

      unfold PBFTreplica_update in h at 1; simpl in h.

      remember (trigger e) as trig; symmetry in Heqtrig.
      match goal with
      | [ H : context[option_map _ ?s] |- _ ] =>
        remember s as sop; symmetry in Heqsop; destruct sop; simpl in *; tcsp
      end.

      destruct trig; simpl in *; tcsp.

      + unfold PBFThandle_request in h; simpl in h.
        dest_all w.
        repndors; tcsp; ginv.

      + unfold PBFThandle_pre_prepare in h; simpl in *.
        dest_all w;[].

        apply in_app_iff in h; repndors;[|].

        * unfold check_broadcast_prepare in h.
          dest_all x.
          destruct x; simpl in *.
          fold DirectedMsgs in *.
          dest_all x.

        * apply in_app_iff in h;repndors;[|].

          { unfold check_broadcast_commit in h.
            dest_all x.
            destruct x; simpl in *.
            fold DirectedMsgs in *.
            dest_all x. }

          { match goal with
            | [ H : check_send_replies _ _ _ _ _ _ = _ |- _ ] =>
              eapply in_check_send_replies_implies in H;[|exact h]
            end.
            exrepnd; subst; simpl in *; ginv. }

      + unfold PBFThandle_prepare in h; simpl in *.
        dest_cases x; symmetry in Heqx; simpl in *;[].
        dest_cases y;[].
        dest_cases y; symmetry in Heqy; simpl in *;[].
        dest_cases z;[].
        dest_cases z; symmetry in Heqz; simpl in *;[].
        dest_cases w; symmetry in Heqw; simpl in *;[].
        dest_cases u; symmetry in Hequ; simpl in *;[].

        apply in_app_iff in h; repndors.

        { unfold check_broadcast_commit in h.
          destruct w0; simpl in *; tcsp;[].
          destruct g; simpl in *; tcsp;[].
          dest_cases d; symmetry in Heqd;[].
          dest_cases q; symmetry in Heqq; ginv;[|].

          { dest_cases t; simpl in *;[|].
            - apply in_broadcast2others in h; exrepnd; ginv.
            - apply in_broadcast2others in h; exrepnd; ginv. }

          { dest_cases t; simpl in *;[|].
            - apply in_broadcast2others in h; exrepnd; ginv.
            - apply in_broadcast2others in h; exrepnd; ginv. }
        }

        { eapply in_check_send_replies_implies in Hequ;[|exact h].
          exrepnd; subst; simpl in *; ginv. }

      + unfold PBFThandle_commit in h; simpl in *.
        dest_cases x; symmetry in Heqx; simpl in *;[].
        dest_cases y;[].
        dest_cases y; symmetry in Heqy; simpl in *;[].
        dest_cases z;[].
        dest_cases z; symmetry in Heqz; simpl in *;[].
        dest_cases w; symmetry in Heqw; simpl in *;[].
        dest_cases u; symmetry in Hequ; simpl in *;[].

        eapply in_check_send_replies_implies in Hequ;[|exact h].
        exrepnd; subst; simpl in *; ginv.

      + unfold PBFThandle_checkpoint in h.
        dest_cases x;[].
        dest_cases x; symmetry in Heqx; simpl in *;[].
        dest_cases y; symmetry in Heqy; simpl in *;[].
        dest_cases z; symmetry in Heqz; simpl in *;[].
        dest_cases w; symmetry in Heqw; simpl in *;[].
        dest_cases u; symmetry in Hequ; simpl in *;[].
        repndors; tcsp; ginv.

      + unfold PBFThandle_check_ready in h; simpl in *.
        dest_cases x; symmetry in Heqx; simpl in *;[].

        unfold find_and_execute_requests in Heqx.
        dest_cases w; symmetry in Heqw; repnd; ginv;[].

        unfold execute_requests in Heqw.
        remember (ready p) as rd; symmetry in Heqrd.
        destruct rd; [inversion Heqw; subst; simpl in *; tcsp|];[].

        dest_cases y; subst; simpl in *; tcsp;[|];
          [|inversion Heqw; subst; simpl in *; tcsp];[].

        dest_cases y; symmetry in Heqy; simpl in *; tcsp;[|];
          [|inversion Heqw; subst; simpl in *; tcsp];[].
        dest_cases u; symmetry in Hequ; repnd; simpl in *.
        dest_cases q; symmetry in Heqq.
        inversion Heqw; subst; clear Heqw; simpl in *.

        apply in_app_iff in h; simpl in *; repndors; ginv;[|].

        {
          apply in_map_iff in h; exrepnd.
          inversion h1; clear h1.
          remember (reply2client x) as cl.
          subst; simpl in *; GC.

          exists n c0 p w1 w0 y u2 u0 u1 q1.
          dands; auto.
        }

        {
          unfold check_broadcast_checkpoint in Heqq; simpl in *.
          dest_cases w; symmetry in Heqw; simpl in *; tcsp;[|].

          - dest_cases z; symmetry in Heqz; ginv.
            apply in_broadcast2others in h; exrepnd; ginv.

          - inversion Heqq; subst; simpl in *; tcsp.
        }

      + repndors; tcsp; ginv.

      + unfold PBFThandle_expired_timer in h.
        dest_cases x;[].
        dest_cases x; symmetry in Heqx; simpl in *;[].
        dest_cases y; symmetry in Heqy; simpl in *; tcsp;[|].

        * repnd; simpl in *.
          apply in_broadcast2others in h; exrepnd; ginv.

        * apply in_broadcast2others in h; exrepnd; ginv.

      + unfold PBFThandle_view_change in h.
        dest_cases x; simpl in *;[].
        dest_cases x; symmetry in Heqx; simpl in *;[].
        dest_cases y; symmetry in Heqy; simpl in *;[].
        dest_cases z; symmetry in Heqz; simpl in *;[].
        dest_cases q; symmetry in Heqq; simpl in *;[].
        repnd; simpl in *.
        dest_cases w; symmetry in Heqw; repnd; simpl in *;[].
        apply in_broadcast2others in h; exrepnd; ginv.

      + unfold PBFThandle_new_view in h.
        dest_cases x;[].
        dest_cases x; symmetry in Heqx; simpl in *;[].
        dest_cases y; symmetry in Heqy; simpl in *;[].
        dest_cases z; symmetry in Heqz; simpl in *;[].
        dest_cases w; symmetry in Heqw; simpl in *;[].
        dest_cases q; symmetry in Heqq; simpl in *;[].
        dest_cases u; symmetry in Hequ; simpl in *;[].
        dest_cases k; symmetry in Heqk; simpl in *;[].
        apply in_app_iff in h; repndors.

        * eapply add_prepares_to_log_from_new_view_pre_prepares_returns_prep_comm_rep in Hequ;[|exact h].
          repndors; exrepnd; ginv.

        * eapply update_state_new_view_returns_checkpoint in Heqk;[|eauto].
          exrepnd; ginv.

    - exrepnd.
      unfold PBFTsys.

      allrw; simpl.

      rw @loutput_sm_on_event_unroll2; simpl.

      unfold PBFTreplica_update at 1; simpl.
      allrw.
      fold DirectedMsgs in *.

      match goal with
      | [ |- context[option_map _ ?s] ] =>
        remember s as sop; symmetry in Heqsop; destruct sop; simpl in *; tcsp
      end;[].
      ginv.

      unfold PBFThandle_check_ready.
      unfold find_and_execute_requests.
      unfold execute_requests.
      allrw; simpl.

      dest_cases w.
      allrw; simpl.
      apply in_app_iff; simpl.

      left.
      apply in_map_iff; eexists; dands;[reflexivity|].
      auto.
  Qed.

  Definition hidden_check_broadcast_checkpoint
             (slf    : Rep)
             (sn     : SeqNum)
             (vn     : View)
             (keys   : local_key_map)
             (s      : PBFTstate)
             (s'     : PBFTstate)
             (msgs   : DirectedMsgs) : Prop
    := check_broadcast_checkpoint slf sn vn keys s = (s', msgs).

  Notation "'CHECK_BROADCAST_CHECKPOINT'" :=
    (hidden_check_broadcast_checkpoint _ _ _ _ _ _ _).

  Lemma hide_check_broadcast_checkpoint :
    forall slf sn vn keys s s' msgs,
      (check_broadcast_checkpoint slf sn vn keys s = (s', msgs))
      = hidden_check_broadcast_checkpoint slf sn vn keys s s' msgs.
  Proof. auto. Qed.

  Definition hidden_reply2requests
             (slf    : Rep)
             (view   : View)
             (keys   : local_key_map)
             (reqs   : list Request)
             (state  : PBFTsm_state)
             (lastr  : LastReplyState)
             (reps   : list (option Reply))
             (state' : PBFTsm_state)
             (lastr' : LastReplyState) : Prop
    := reply2requests slf view keys reqs state lastr = (reps, state', lastr').

  Notation "'REPLY2REQUESTS'" :=
    (hidden_reply2requests _ _ _ _ _ _ _ _ _).

  Lemma hide_reply2requests :
    forall slf view keys reqs state lastr reps state' lastr',
      (reply2requests slf view keys reqs state lastr = (reps, state', lastr'))
      = hidden_reply2requests slf view keys reqs state lastr reps state' lastr'.
  Proof. auto. Qed.

  Ltac hide_hyps :=
    repeat match goal with
           | [ H : check_broadcast_checkpoint _ _ _ _ _ = (_, _) |- _ ] =>
             rewrite hide_check_broadcast_checkpoint in H
           | [ H : reply2requests _ _ _ _ _ _ = (_, _, _) |- _ ] =>
             rewrite hide_reply2requests in H
           end.

  Ltac unhide_hyps :=
    repeat match goal with
           | [ H : hidden_check_broadcast_checkpoint _ _ _ _ _ _ _ |- _ ] =>
             rewrite <- hide_check_broadcast_checkpoint in H
           | [ H : hidden_check_broadcast_checkpoint _ _ _ _ _ _ _ _ _ |- _ ] =>
             rewrite <- hide_reply2requests in H
           end.

  Lemma in_reply2requests :
    forall slf view keys reqs state lastr rep reps state' lastr',
      reply2requests slf view keys reqs state lastr = (reps, state', lastr')
      -> In rep (list_option2list reps)
      ->
      exists (req : Request)
             (reqs1 reqs2 : list Request)
             (reps1 reps2 : list (option Reply))
             (state1 state2 : PBFTsm_state)
             (lastr1 lastr2 : LastReplyState),
        reqs = reqs1 ++ req :: reqs2
        /\ reply2requests slf view keys reqs1 state lastr = (reps1, state1, lastr1)
        /\ reply2request slf view keys req state1 lastr1 = (Some rep, state2, lastr2)
        /\ reply2requests slf view keys reqs2 state2 lastr2 = (reps2, state', lastr').
  Proof.
    induction reqs; introv e i; simpl in *; ginv; simpl in *; tcsp.
    dest_cases w; symmetry in Heqw; repnd.
    dest_cases y; symmetry in Heqy; repnd.
    ginv; simpl in *.
    dest_cases x; subst; simpl in *; repndors; subst; tcsp;[| |].

    - exists a ([] : list Request) reqs ([] : list (option Reply)) y2 state w0 lastr w1.
      simpl; dands; auto.

    - eapply IHreqs in Heqy;[|eauto]; clear IHreqs.
      exrepnd; subst.
      exists req (a :: reqs1) reqs2 (Some x :: reps1) reps2 state1 state2 lastr1 lastr2; simpl.
      allrw; simpl; dands; auto.

    - eapply IHreqs in Heqy;[|eauto]; clear IHreqs.
      exrepnd; subst.
      exists req (a :: reqs1) reqs2 (None :: reps1) reps2 state1 state2 lastr1 lastr2; simpl.
      allrw; simpl; dands; auto.
  Qed.

  Lemma eq_timestamps : forall t1 t2, timestamp2nat t1 = timestamp2nat t2 -> t1 = t2.
  Proof.
    introv; destruct t1, t2; simpl in *; auto.
  Qed.

  Lemma in_reply2request :
    forall slf view keys req state lastr rep state' lastr',
      reply2request slf view keys req state lastr = (Some rep, state', lastr')
      ->
      exists opr ts c entry result,
        request2info req = Some (opr, ts, c)
        /\ find_last_reply_entry_corresponding_to_client lastr c = Some entry
        /\ rep = reply (bare_reply view ts c slf result) (authenticate (PBFTmsg_bare_reply (bare_reply view ts c slf result)) keys)
        /\
        (
          (
            lre_timestamp entry < ts
            /\ PBFTsm_update c state opr = (result, state')
            /\ lastr' = update_last_reply_timestamp_and_result lastr c ts result
          )
          \/
          (
            lre_timestamp entry = ts
            /\ lre_reply entry = Some result
            /\ lastr' = lastr
            /\ state' = state
          )
        ).

  Proof.
    introv e.
    unfold reply2request in e.
    dest_all w;[|].

    - exists w0 w3 w2 w w1; dands; auto.

    - exists w0 w3 w2 w w5; dands; tcsp.
      right; dands; auto; try omega.
      apply eq_timestamps; omega.
  Qed.

  Lemma PBFTagreement :
    forall (eo : EventOrdering),
      authenticated_messages_were_sent_or_byz_usys eo PBFTsys
      -> internal_messages_were_sent_usys eo PBFTsys
      -> forall (e1 e2 : Event)
                (c     : Client)
                (t     : Timestamp)
                (v1 v2 : View)
                (i1 i2 : Rep)
                (r1 r2 : PBFTresult)
                (tok1 tok2 : Tokens),
        isCorrect e1
        -> isCorrect e2
        -> In (send_reply (mk_reply v1 t c i1 r1 tok1)) (output_system_on_event_ldata PBFTsys eo e1)
        -> In (send_reply (mk_reply v2 t c i2 r2 tok2)) (output_system_on_event_ldata PBFTsys eo e2)
        -> r1 = r2.
  Proof.
    introv sentbyz sentint isCor1 isCor2 send1 send2.

    destruct (PBFTresdeq r1 r2) as [d|d]; auto.
    assert False; tcsp.

    (* replies are sent in response to check-ready messages *)
    apply send_reply_iff in send1.
    apply send_reply_iff in send2.
    exrepnd.

    repeat match goal with
           | [ H : reply2requests _ _ _ _ _ _ = _ |- _ ] =>
             eapply in_reply2requests in  H;[|eauto];[]
           end.
    exrepnd.

    match goal with
    | [ H : reply2request _ _ _ _ _ _ = _ |- _ ] => apply in_reply2request in H
    end.

    SearchAbout reply2requests.

  (*
    hide_hyps.

    pose proof (sentint e2) as q.
    match goal with
    | [ H1 : trigger ?e = _ , H2 : context[is_internal_message (trigger ?e)] |- _ ] =>
      rewrite H1 in H2
    end.
    repeat (autodimp q hyp);[].
    exrepnd.
*)

  Qed.
*)

End PBFTagreement.


Require Import VerdiRaft.Raft.
Require Import VerdiRaft.CommonTheorems.
Require Import VerdiRaft.SpecLemmas.
Require Import VerdiRaft.RaftRefinementInterface.
Require Import VerdiRaft.CroniesTermInterface.

Require Import VerdiRaft.CroniesCorrectInterface.
Require Import VerdiRaft.CandidateEntriesInterface.

Require Import VerdiRaft.RefinementSpecLemmas.
Require Import VerdiRaft.RefinementCommonTheorems.

Local Arguments update {_} {_} _ _ _ _ _ : simpl never.

Require Import VerdiRaft.PrevLogCandidateEntriesTermInterface.

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

  Context {rri : raft_refinement_interface}.
  Context {cei : candidate_entries_interface}.
  Context {cti : cronies_term_interface}.
  Context {cci : cronies_correct_interface}.

  Lemma prevLog_candidateEntriesTerm_init :
    refined_raft_net_invariant_init prevLog_candidateEntriesTerm.
  Proof using.
    unfold refined_raft_net_invariant_init, prevLog_candidateEntriesTerm.
    simpl. intuition.
  Qed.

  Lemma candidateEntriesTerm_ext : forall t sigma sigma',
      (forall h, sigma' h = sigma h) ->
      candidateEntriesTerm t sigma ->
      candidateEntriesTerm t sigma'.
  Proof using.
    unfold candidateEntriesTerm.
    intros. break_exists_exists.
    repeat find_higher_order_rewrite. intuition.
  Qed.

  Lemma candidateEntriesTerm_same : forall st st' t,
       candidateEntriesTerm t st ->
       (forall h, cronies (fst (st' h)) = cronies (fst (st h))) ->
       (forall h, currentTerm (snd (st' h)) = currentTerm (snd (st h))) ->
       (forall h, type (snd (st' h)) = type (snd (st h))) ->
       candidateEntriesTerm t st'.
  Proof using.
    unfold candidateEntriesTerm.
    intros. break_exists_exists.
    repeat find_higher_order_rewrite.
    intuition.
  Qed.

  Lemma prevLog_candidateEntriesTerm_client_request :
    refined_raft_net_invariant_client_request prevLog_candidateEntriesTerm.
  Proof using.
    unfold refined_raft_net_invariant_client_request, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp. break_or_hyp.
    - eapply candidateEntriesTerm_ext; eauto.
      eapply candidateEntriesTerm_same; eauto; intros;
      update_destruct_simplify; auto.
      + now erewrite update_elections_data_client_request_cronies by eauto.
      + find_apply_lem_hyp handleClientRequest_type. intuition.
      + find_apply_lem_hyp handleClientRequest_type. intuition.
    - find_apply_lem_hyp in_map_iff. break_exists. break_and. subst. simpl in *.
      exfalso. eapply handleClientRequest_no_append_entries; eauto.
      find_rewrite. eauto 10.
  Qed.

  Lemma update_elections_data_timeout_cronies :
    forall h d out d' l t,
      handleTimeout h (snd d) = (out, d', l) ->
      cronies (update_elections_data_timeout h d) t = cronies (fst d) t \/
      (t = currentTerm d' /\ type d' = Candidate /\
       cronies (update_elections_data_timeout h d) t = votesReceived d').
  Proof using.
    unfold update_elections_data_timeout.
    intros.
    repeat break_match; repeat find_inversion; simpl; auto.
    break_match; auto.
  Qed.

  Lemma handleClientRequest_preserves_candidateEntriesTerm:
    forall net h d t out l,
      refined_raft_intermediate_reachable net ->
      handleTimeout h (snd (nwState net h)) = (out, d, l) ->
      candidateEntriesTerm t (nwState net) ->
      candidateEntriesTerm t
                           (update name_eq_dec (nwState net) h
                                   (update_elections_data_timeout h (nwState net h), d)).
  Proof using cti.
    unfold candidateEntriesTerm.
    intros.
    break_exists_exists. break_and.
    match goal with
    | [ H : handleTimeout _ _ = _ |- _ ] =>
      pose proof H;
        eapply update_elections_data_timeout_cronies with (t := t) in H
    end. break_or_hyp.
    - update_destruct_simplify; auto.
      find_copy_apply_lem_hyp handleTimeout_type_strong.
      intuition; repeat find_rewrite; auto.
      find_apply_lem_hyp wonElection_exists_voter.
      break_exists.
      find_apply_lem_hyp in_dedup_was_in.
      find_copy_apply_lem_hyp cronies_term_invariant; auto.
      simpl in *.
      lia.
    - update_destruct_simplify; auto.
      find_copy_apply_lem_hyp handleTimeout_type_strong.
      find_apply_lem_hyp wonElection_exists_voter.
      break_exists.
      find_apply_lem_hyp in_dedup_was_in.
      find_copy_apply_lem_hyp cronies_term_invariant; auto.
      intuition; subst; repeat find_rewrite; auto;
      simpl in *; lia.
  Qed.

  Lemma prevLog_candidateEntriesTerm_timeout :
    refined_raft_net_invariant_timeout prevLog_candidateEntriesTerm.
  Proof using cti.
    unfold refined_raft_net_invariant_timeout, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp. break_or_hyp.
    - eapply candidateEntriesTerm_ext; eauto.
      eapply handleClientRequest_preserves_candidateEntriesTerm; eauto.
    - find_apply_lem_hyp in_map_iff. break_exists. break_and.
      subst. simpl in *.
      exfalso. eapply handleTimeout_not_is_append_entries; eauto.
      find_rewrite. eauto 10.
  Qed.

  Lemma handleAppendEntries_preserves_candidateEntriesTerm :
    forall net h t n pli plt es ci d m t',
      handleAppendEntries h (snd (nwState net h)) t n pli plt es ci = (d, m) ->
      refined_raft_intermediate_reachable net ->
      candidateEntriesTerm t' (nwState net) ->
      candidateEntriesTerm t' (update name_eq_dec (nwState net) h
                                 (update_elections_data_appendEntries
                                    h
                                    (nwState net h) t n pli plt es ci, d)).
  Proof using.
    unfold candidateEntriesTerm.
    intros.
    break_exists_exists. break_and.
    update_destruct_simplify.
    - rewrite update_elections_data_appendEntries_cronies.
      find_apply_lem_hyp handleAppendEntries_type.
      intuition; subst; repeat find_rewrite; auto.
      discriminate.
    - intuition.
  Qed.

  Lemma prevLog_candidateEntriesTerm_append_entries :
    refined_raft_net_invariant_append_entries prevLog_candidateEntriesTerm.
  Proof using.
    unfold refined_raft_net_invariant_append_entries, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp. break_or_hyp.
    - find_eapply_lem_hyp app_cons_in_rest; [|solve[eauto]].
      eapply candidateEntriesTerm_ext; eauto.
      eapply handleAppendEntries_preserves_candidateEntriesTerm; eauto.
    - exfalso. eapply handleAppendEntries_not_append_entries; eauto.
      simpl in *. subst. eauto 10.
  Qed.

  Lemma handleAppendEntriesReply_preserves_candidateEntriesTerm :
  forall net h h' t es r st' ms t',
    handleAppendEntriesReply h (snd (nwState net h)) h' t es r = (st', ms) ->
    refined_raft_intermediate_reachable net ->
    candidateEntriesTerm t' (nwState net) ->
    candidateEntriesTerm t' (update name_eq_dec (nwState net) h (fst (nwState net h), st')).
  Proof using.
    unfold candidateEntriesTerm.
    intros. break_exists_exists.
    find_apply_lem_hyp handleAppendEntriesReply_type.
    update_destruct_simplify.
    - intuition; repeat find_rewrite; auto. discriminate.
    - auto.
  Qed.

  Lemma prevLog_candidateEntriesTerm_append_entries_reply :
    refined_raft_net_invariant_append_entries_reply prevLog_candidateEntriesTerm.
  Proof using.
    unfold refined_raft_net_invariant_append_entries_reply, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp. break_or_hyp.
    - find_eapply_lem_hyp app_cons_in_rest; [|solve[eauto]].
      eapply candidateEntriesTerm_ext; eauto.
      eauto using handleAppendEntriesReply_preserves_candidateEntriesTerm.
    - find_apply_lem_hyp in_map_iff. break_exists. break_and.
      find_apply_lem_hyp handleAppendEntriesReply_packets.
      subst. simpl in *. intuition.
  Qed.

  Lemma update_elections_data_requestVote_cronies_same :
    forall h h' t lli llt st,
      cronies (update_elections_data_requestVote h h' t h' lli llt st) =
      cronies (fst st).
  Proof using.
    unfold update_elections_data_requestVote.
    intros.
    repeat break_match; auto.
  Qed.

  Lemma advanceCurrentTerm_same_or_type_follower :
    forall st t,
      advanceCurrentTerm st t = st \/
      type (advanceCurrentTerm st t) = Follower.
  Proof using.
    unfold advanceCurrentTerm.
    intros. repeat break_match; auto.
  Qed.

  Lemma handleRV_advanceCurrentTerm_preserves_candidateEntriesTerm :
    forall net h h' t lli llt t',
      candidateEntriesTerm t' (nwState net) ->
      candidateEntriesTerm t'
                       (update name_eq_dec (nwState net) h
                               (update_elections_data_requestVote h h' t h' lli llt (nwState net h),
                                advanceCurrentTerm (snd (nwState net h)) t)).
  Proof using.
    unfold candidateEntriesTerm.
    intros.
    break_exists_exists.
    update_destruct_simplify; intuition.
    - now rewrite update_elections_data_requestVote_cronies_same.
    - intros.
      match goal with
      | [ H : context [advanceCurrentTerm ?st ?t] |- _ ] =>
        pose proof advanceCurrentTerm_same_or_type_follower st t
      end.
      intuition.
      + repeat find_rewrite. auto.
      + congruence.
  Qed.

  Lemma handleRequestVote_preserves_candidateEntriesTerm :
    forall net h h' t lli llt d t' m,
      handleRequestVote h (snd (nwState net h)) t h' lli llt = (d, m) ->
      candidateEntriesTerm t' (nwState net) ->
      candidateEntriesTerm t' (update name_eq_dec (nwState net) h
                                 (update_elections_data_requestVote
                                    h h' t h' lli llt (nwState net h), d)).
  Proof using.
    unfold candidateEntriesTerm.
    intros.
    break_exists_exists.
    update_destruct_simplify; intuition.
    - now rewrite update_elections_data_requestVote_cronies_same.
    - unfold handleRequestVote, advanceCurrentTerm in *.
      repeat break_match; do_bool; repeat find_inversion; simpl in *; break_and; try discriminate; auto.
  Qed.

  Lemma prevLog_candidateEntriesTerm_request_vote :
    refined_raft_net_invariant_request_vote prevLog_candidateEntriesTerm.
  Proof using.
    unfold refined_raft_net_invariant_request_vote, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp. break_or_hyp.
    - find_eapply_lem_hyp app_cons_in_rest; [|solve[eauto]].
      eapply candidateEntriesTerm_ext; eauto.
      eapply handleRequestVote_preserves_candidateEntriesTerm; eauto.
    - exfalso. eapply handleRequestVote_no_append_entries; eauto.
      simpl in *. subst. eauto 10.
  Qed.

  Lemma handleRequestVoteReply_preserves_candidateEntriesTerm :
    forall net h h' t r st' t',
      handleRequestVoteReply h (snd (nwState net h)) h' t r = st' ->
      refined_raft_intermediate_reachable net ->
      candidateEntriesTerm t' (nwState net) ->
      candidateEntriesTerm t' (update name_eq_dec (nwState net) h
                                 (update_elections_data_requestVoteReply h h' t r (nwState net h),
                                  st')).
  Proof using cci.
    unfold candidateEntriesTerm.
    intros.
    break_exists_exists.
    update_destruct_simplify; auto.
    break_and.
    unfold raft_data in *. simpl in *.
    unfold update_elections_data_requestVoteReply.
    match goal with
    | |- context [handleRequestVoteReply ?h ?st ?h' ?t ?r] =>
      remember (handleRequestVoteReply h st h' t r) as new_state
    end; find_copy_apply_lem_hyp handleRequestVoteReply_spec.
    repeat (break_match); intuition; repeat find_rewrite; intuition;
    simpl; break_if; auto.
    - find_apply_lem_hyp cronies_correct_invariant.
      unfold cronies_correct in *. intuition.
      unfold votes_received_leaders in *.
      match goal with
      | H :  Leader = _ |- _ =>
        symmetry in H
      end. find_apply_hyp_hyp.
      eapply wonElection_no_dup_in;
        eauto using NoDup_dedup, in_dedup_was_in, dedup_In.
    - destruct (serverType_eq_dec (type (snd (nwState net x))) Leader); intuition.
      find_apply_lem_hyp cronies_correct_invariant; auto.
      eapply wonElection_no_dup_in;
        eauto using NoDup_dedup, in_dedup_was_in, dedup_In.
  Qed.

  Lemma prevLog_candidateEntriesTerm_request_vote_reply :
    refined_raft_net_invariant_request_vote_reply prevLog_candidateEntriesTerm.
  Proof using cci.
    unfold refined_raft_net_invariant_request_vote_reply, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp.
    find_eapply_lem_hyp app_cons_in_rest; [|solve[eauto]].
    eapply candidateEntriesTerm_ext; eauto.
    subst.
    eapply handleRequestVoteReply_preserves_candidateEntriesTerm; eauto.
  Qed.

  Lemma doLeader_preserves_candidateEntriesTerm :
    forall net gd d h os d' ms t',
      nwState net h = (gd, d) ->
      doLeader d h = (os, d', ms) ->
      candidateEntriesTerm t' (nwState net) ->
      candidateEntriesTerm t' (update name_eq_dec (nwState net) h (gd, d')).
  Proof using.
    unfold candidateEntriesTerm.
    intros. break_exists_exists.
    break_and.
    update_destruct_simplify; auto.
    split.
    - match goal with
      | [ H : nwState ?net ?h = (?x, _) |- _ ] =>
        replace (x) with (fst (nwState net h)) in * by (rewrite H; auto)
      end.
      intuition.
    - match goal with
      | [ H : nwState ?net ?h = (_, ?x) |- _ ] =>
        replace (x) with (snd (nwState net h)) in * by (rewrite H; auto); clear H
      end.
      find_apply_lem_hyp doLeader_type.
      intuition. subst. repeat find_rewrite.
      auto.
  Qed.

  Lemma getNextIndex_ext :
    forall st st' h,
      nextIndex st' = nextIndex st ->
      log st' = log st ->
      getNextIndex st' h = getNextIndex st h.
  Proof using.
    unfold getNextIndex.
    intros.
    repeat find_rewrite.
    auto.
  Qed.

  Lemma replicaMessage_ext :
    forall st st' h h',
      nextIndex st' = nextIndex st ->
      log st' = log st ->
      currentTerm st' = currentTerm st ->
      commitIndex st' = commitIndex st ->
      replicaMessage st' h h' = replicaMessage st h h'.
  Proof using.
    unfold replicaMessage.
    intros.
    repeat break_match; repeat tuple_inversion; repeat find_rewrite;
    erewrite getNextIndex_ext in * by eauto; congruence.
  Qed.

  Lemma prevLog_candidateEntriesTerm_do_leader :
    refined_raft_net_invariant_do_leader prevLog_candidateEntriesTerm.
  Proof using cei.
    unfold refined_raft_net_invariant_do_leader, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp. break_or_hyp.
    - find_apply_hyp_hyp.
      eapply candidateEntriesTerm_ext; eauto.
      eapply doLeader_preserves_candidateEntriesTerm; eauto.
    - find_apply_lem_hyp in_map_iff. break_exists. break_and.
      subst. simpl in *.
      find_copy_eapply_lem_hyp doLeader_messages; eauto.
      break_and. intuition.
      + lia.
      + break_exists. break_and.
        red.
        find_apply_lem_hyp candidate_entries_invariant.
        unfold CandidateEntries, candidateEntries_host_invariant in *.
        find_apply_lem_hyp findAtIndex_elim. break_and.
        match goal with
        | [ H : nwState ?net ?h = (?y, ?x) |- _ ] =>
          replace (x) with (snd (nwState net h)) in * by (rewrite H; auto);
          replace (y) with (fst (nwState net h)) in * by (rewrite H; auto)
        end.

        eapply_prop_hyp In In.
        subst.
        find_eapply_lem_hyp (doLeader_preserves_candidateEntries); eauto.

        match goal with
        | [ H : nwState ?net ?h = (?y, ?x) |- _ ] => clear H
        end.

        unfold candidateEntries in *. break_exists_exists.
        find_higher_order_rewrite.
        update_destruct_simplify; auto.
  Qed.

  Lemma doGenericServer_preserves_candidateEntriesTerm :
    forall net gd d h os d' ms t,
      nwState net h = (gd, d) ->
      doGenericServer h d = (os, d', ms) ->
      candidateEntriesTerm t (nwState net) ->
      candidateEntriesTerm t (update name_eq_dec (nwState net) h (gd, d')).
  Proof using.
    intros.
    find_apply_lem_hyp doGenericServer_type. break_and.
    eapply candidateEntriesTerm_same; eauto.
    - intros. update_destruct_simplify; auto.
      find_rewrite. simpl. auto.
    - intros. update_destruct_simplify; auto.
      repeat find_rewrite.  auto.
    - intros. update_destruct_simplify; auto.
      repeat find_rewrite.  auto.
  Qed.

  Lemma prevLog_candidateEntriesTerm_do_generic_server :
    refined_raft_net_invariant_do_generic_server prevLog_candidateEntriesTerm.
  Proof using.
    unfold refined_raft_net_invariant_do_generic_server, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp. break_or_hyp.
    - eapply candidateEntriesTerm_ext; eauto.
      eapply doGenericServer_preserves_candidateEntriesTerm; eauto.
    - find_apply_lem_hyp in_map_iff. break_exists. break_and.
      subst. simpl in *.
      find_apply_lem_hyp doGenericServer_packets. subst. simpl in *. intuition.
  Qed.

  Lemma prevLog_candidateEntriesTerm_state_same_packet_subset :
    refined_raft_net_invariant_state_same_packet_subset prevLog_candidateEntriesTerm.
  Proof using.
    unfold refined_raft_net_invariant_state_same_packet_subset, prevLog_candidateEntriesTerm.
    simpl. intros.
    find_apply_hyp_hyp.
    eapply candidateEntriesTerm_ext with (sigma := (nwState net)).
    - auto.
    - eauto.
  Qed.

  Lemma prevLog_candidateEntriesTerm_reboot :
    refined_raft_net_invariant_reboot prevLog_candidateEntriesTerm.
  Proof using.
    unfold refined_raft_net_invariant_reboot, prevLog_candidateEntriesTerm, reboot.
    simpl. intros.
    eapply candidateEntriesTerm_ext; eauto.
    repeat find_rewrite.
    find_apply_hyp_hyp.
    unfold candidateEntriesTerm in *.
    break_exists_exists.
    update_destruct_simplify; auto.
    repeat find_rewrite.
    simpl in *. intuition.
    discriminate.
  Qed.

  Lemma prevLog_candidateEntriesTerm_invariant :
    forall net,
      refined_raft_intermediate_reachable net ->
      prevLog_candidateEntriesTerm net.
  Proof using cci cti cei rri.
    intros.
    apply refined_raft_net_invariant; auto.
    - apply prevLog_candidateEntriesTerm_init.
    - apply prevLog_candidateEntriesTerm_client_request.
    - apply prevLog_candidateEntriesTerm_timeout.
    - apply prevLog_candidateEntriesTerm_append_entries.
    - apply prevLog_candidateEntriesTerm_append_entries_reply.
    - apply prevLog_candidateEntriesTerm_request_vote.
    - apply prevLog_candidateEntriesTerm_request_vote_reply.
    - apply prevLog_candidateEntriesTerm_do_leader.
    - apply prevLog_candidateEntriesTerm_do_generic_server.
    - apply prevLog_candidateEntriesTerm_state_same_packet_subset.
    - apply prevLog_candidateEntriesTerm_reboot.
  Qed.

  Instance plceti : prevLog_candidateEntriesTerm_interface.
  Proof.
    constructor.
    apply prevLog_candidateEntriesTerm_invariant.
  Qed.
End PrevLogCandidateEntriesTerm.