aneris.examples.lock_server.lock_proof

From iris Require Import invariants.
From iris.algebra Require Import gmap frac agree frac_auth.
From iris.base_logic Require Export gen_heap.
From iris.base_logic.lib Require Export own saved_prop.
From iris.program_logic Require Export weakestpre.
From iris.proofmode Require Import tactics.
From stdpp Require Import base.
From aneris Require Import tactics proofmode notation adequacy.
From aneris.examples.lock_server Require Export lock.
From iris.bi.lib Require Import fractional.

Set Default Proof Using "Type".

Import Network.
Import String.
Import uPred.

Definition lkCmra : cmraT := (prodR fracR
                                    (agreeR (leibnizO (option socket_address)))).

Class lkG Σ := LkG { LkG_inG :> inG Σ lkCmra }.
Definition lkΣ : gFunctors := #[GFunctor lkCmra ].

Instance subG_lkΣ {Σ} : subG lkΣ Σ lkG Σ.
Proof. solve_inG. Qed.

Class lockG Σ := MLockG {
  lock_inG :> inG Σ lkCmra;
  lock_name : gname
}.

Section lock.
  Context `{lG : lockG Σ}
          `{dG : distG Σ}
          `{node : Network.node}.

  Definition ownLk :=
    own (A:= lkCmra) lock_name.

  Definition makeLkElem (q : Qp) (i : socket_address) : lkCmra :=
    (q, to_agree (Some i)).

  Definition makeLkElemNone (q : Qp) : lkCmra := (q, to_agree None).

  Definition lock_si R S : (socket_interp Σ) :=
    (λ msg, φ, ms_sender msg φ S
    (ms_body msg = "LOCK" ( m, ms_body m = "NO" S
       ms_body m = "YES" R ownLk (makeLkElem ¾ (ms_sender msg)) S -∗ φ m)
    ms_body msg = "RELEASE" R ownLk (makeLkElem ¾ (ms_sender msg))
     ( m, ms_body m = "RELEASED" S -∗ φ m)))%I.

  Arguments lock_si : simpl never.

  Definition handlerR R l :=
    ( v, l ↦[node] v
     (v = NONEV R ownLk (makeLkElemNone 1)
       a, v = SOMEV (LitV $ LitSocketAddress a) ownLk (makeLkElem ¼ a)))%I.

  Lemma lock_server_s R A S (addr : socket_address) :
    addr A ->
    {{{ R addr lock_si R S Fixed A
        FreePorts (ip_of_address addr) {[port_of_address addr]}
        ownLk (makeLkElemNone 1) IsNode node }}}
      node; lock_server #addr
    {{{ v, RET node;v; False}}}.
  Proof.
    iIntros (Haddress Φ)
            "(HR & #Hsi & #Hnetwork & Hip & Hauth & Hn) HΦ".
    wp_lam. wp_alloc l as "Hl". wp_let.
    wp_socket h as "Hsocket". wp_pures.
    destruct addr; subst.
    wp_apply (wp_socketbind_static with "[$Hnetwork $Hip $Hsocket]");
      simpl; try done.
    iDestruct 1 as (g) "(Hsocket & Hbind & Hrecs)". wp_seq.
    wp_apply (listen_spec (handlerR R l) (λ v, False)%I
                with "[] [-HΦ]"); last first; auto.
    - iFrame. iFrame "#". iExists (InjLV #()). iFrame. iLeft. by iFrame.
    - iLöb as "IH" forall (g).
      iIntros (m i Φ') "!# (HP & Hs & Hrm & Hm & _ & Hsipred) HΦ'".
      iDestruct "HP" as (v) "(Hl & Hdisj)".
      wp_rec. wp_let.
      iDestruct "Hsipred" as (si)
           "(#Hsp & HS & [[Hbody Hwand] | (Hbody & HR & Hown & Hwand)])".
      + (* Lock request *)
        simpl. iDestruct "Hbody" as %->. simpl. wp_pures.
        iDestruct "Hdisj" as "[[-> [HR Hown]]| H]".
        * (* Lock is free *)
          wp_load. wp_match. wp_store.
          iMod (own_update (A := lkCmra) _ _ (1%Qp, to_agree (Some _)) with "Hown")
            as "Hown".
          { by apply cmra_update_exclusive. }
          rewrite -{15}Qp_quarter_three_quarter.
          iDestruct "Hown" as "[Ho1 Ho2]".
          wp_apply (wp_send_to_bound _ "YES" h with "[HR Ho2 $Hs HS Hwand]");
            eauto; iFrame "#".
          -- iApply ("Hwand" $! _). simpl. iRight. iFrame; eauto.
          -- iIntros "[Hs _]". simpl. wp_seq.
             wp_apply (listen_spec (handlerR R l) (λ v, False)%I
                         with "[] [-HΦ']"); eauto; last first.
             { iFrame. iFrame "#". iExists _. iFrame. iRight. eauto. }
             { iApply "IH". }
             eauto.
        * (* Lock already taken *)
          iDestruct "H" as (a') "[#Hv Hown]".
          iSimplifyEq. wp_load. wp_match.
          wp_apply (wp_send_to_bound _ "NO" h with "[$Hs Hwand HS]"); eauto; iFrame "#".
          -- iApply ("Hwand" $! _). iLeft. by iFrame.
          -- iIntros "[Hs _]". simpl. wp_seq.
             wp_apply (listen_spec (handlerR R l) (λ v, False)%I
                         with "[] [-HΦ']"); eauto; last first.
             iFrame; iFrame "#". iExists _. iFrame. iRight. eauto.
             iApply "IH". eauto.
      + simpl. iDestruct "Hbody" as %->. wp_pures.
        iDestruct "Hdisj" as "[[-> [HR' Hown']] | H]".
        { iDestruct (own_valid_2 with "Hown Hown'") as %Hvalid.
          rewrite /makeLkElem /makeLkElemNone -pair_op in Hvalid.
          destruct Hvalid as [? _]. done. }
        iDestruct "H" as (a') "[#Hv Hown']". iSimplifyEq.
        iDestruct (own_valid_2 with "Hown Hown'") as
              %[_ Ho2%(agree_op_invL' (A := leibnizO (option _)))]. simplify_eq.
        iCombine "Hown'" "Hown" as "Hown". rewrite frac_op' Qp_quarter_three_quarter.
        iMod (own_update (A := lkCmra) _ _ (1%Qp, to_agree None) with "Hown")
            as "Hown".
        { by apply cmra_update_exclusive. }
        wp_store.
        wp_apply (wp_send_to_bound _ "RELEASED" h with "[HS $Hs Hwand]");
          eauto; iFrame "#"; iFrame.
        { iApply "Hwand". by iFrame. }
        iIntros "[Hs _]". wp_seq.
        wp_apply (listen_spec (handlerR R l) (λ v, False)%I
                    with "[] [-HΦ']"); eauto; last first.
        * iFrame; iFrame "#". iExists _. iFrame. iLeft. by iFrame.
        * iApply "IH".
        * eauto.
    - eauto.
  Qed.

End lock.