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.
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.