From 7981b0eab0790f1f75fc02d1482c3676815b9827 Mon Sep 17 00:00:00 2001 From: Yun-Sheng Chang Date: Fri, 22 Nov 2024 20:42:07 -0500 Subject: [PATCH] Destruct txn, replica, and group coordinators --- .../tulip/program/gcoord/gcoord_abort.v | 68 + .../program/gcoord/gcoord_attached_with.v | 62 + .../program/gcoord/gcoord_change_leader.v | 59 + .../tulip/program/gcoord/gcoord_commit.v | 73 + .../tulip/program/gcoord/gcoord_finalized.v | 37 + .../tulip/program/gcoord/gcoord_get_leader.v | 48 + .../gcoord/gcoord_next_prepare_action.v | 68 + .../tulip/program/gcoord/gcoord_prepare.v | 56 + .../program/gcoord/gcoord_prepare_session.v | 128 ++ .../gcoord_process_finalization_result.v | 33 + .../tulip/program/gcoord/gcoord_read.v | 56 + .../program/gcoord/gcoord_read_session.v | 53 + .../gcoord/gcoord_register_finalization.v | 36 + .../tulip/program/gcoord/gcoord_repr.v | 92 + .../tulip/program/gcoord/gcoord_send.v | 116 + .../program/gcoord/gcoord_value_responded.v | 40 + .../gcoord/gcoord_wait_until_prepare_done.v | 139 ++ .../gcoord/gcoord_wait_until_value_ready.v | 115 + .../tulip/program/gcoord/gpreparer_action.v | 150 ++ .../gcoord/gpreparer_collect_fast_decision.v | 38 + .../gcoord/gpreparer_collect_validation.v | 38 + .../tulip/program/gcoord/gpreparer_cquorum.v | 33 + .../tulip/program/gcoord/gpreparer_fquorum.v | 42 + .../program/gcoord/gpreparer_get_phase.v | 28 + .../tulip/program/gcoord/gpreparer_hcquorum.v | 40 + .../tulip/program/gcoord/gpreparer_in.v | 33 + .../gpreparer_process_fast_prepare_result.v | 123 ++ .../gcoord/gpreparer_process_prepare_result.v | 130 ++ .../gcoord/gpreparer_process_query_result.v | 31 + .../gpreparer_process_unprepare_result.v | 128 ++ .../gpreparer_process_validate_result.v | 71 + .../tulip/program/gcoord/gpreparer_ready.v | 48 + .../tulip/program/gcoord/gpreparer_repr.v | 200 ++ .../gcoord/gpreparer_try_become_preparing.v | 170 ++ .../gcoord/gpreparer_try_become_unpreparing.v | 148 ++ .../program/gcoord/gpreparer_try_fast_abort.v | 78 + .../gcoord/gpreparer_try_fast_prepare.v | 101 + .../program/gcoord/gpreparer_try_resign.v | 111 + .../program/gcoord/greader_clear_versions.v | 46 + .../tulip/program/gcoord/greader_cquorum.v | 33 + .../gcoord/greader_pick_latest_value.v | 146 ++ .../gcoord/greader_process_read_result.v | 256 +++ .../tulip/program/gcoord/greader_read.v | 35 + .../tulip/program/gcoord/greader_repr.v | 48 + .../tulip/program/gcoord/greader_responded.v | 65 + .../tulip/program/gcoord/group_coordinator.v | 1145 ---------- .../tulip/program/gcoord/group_preparer.v | 1592 -------------- .../tulip/program/gcoord/group_reader.v | 582 ----- src/program_proof/tulip/program/prelude.v | 6 + .../tulip/program/replica/replica.v | 1693 --------------- .../tulip/program/replica/replica_apply.v | 67 + .../program/replica/replica_apply_abort.v | 163 ++ .../program/replica/replica_apply_commit.v | 173 ++ .../program/replica/replica_fast_prepare.v | 276 +++ .../tulip/program/replica/replica_finalized.v | 113 + .../tulip/program/replica/replica_log.v | 47 + .../program/replica/replica_multiwrite.v | 128 ++ .../tulip/program/replica/replica_read.v | 195 ++ .../tulip/program/replica/replica_release.v | 72 + .../tulip/program/replica/replica_repr.v | 55 + .../tulip/program/replica/replica_start.v | 166 ++ .../program/replica/replica_terminated.v | 51 + .../program/replica/replica_try_accept.v | 126 ++ .../tulip/program/replica/replica_validate.v | 158 ++ src/program_proof/tulip/program/tuple/res.v | 9 + src/program_proof/tulip/program/tuple/tuple.v | 9 +- .../tulip/program/txn/key_to_group.v | 17 + src/program_proof/tulip/program/txn/proph.v | 35 + src/program_proof/tulip/program/txn/res.v | 50 + src/program_proof/tulip/program/txn/txn.v | 1917 ----------------- .../tulip/program/txn/txn_abort.v | 144 ++ .../tulip/program/txn/txn_begin.v | 21 + .../tulip/program/txn/txn_cancel.v | 93 + .../tulip/program/txn/txn_commit.v | 193 ++ .../tulip/program/txn/txn_delete.v | 37 + .../tulip/program/txn/txn_getwrs.v | 61 + .../tulip/program/txn/txn_prepare.v | 388 ++++ .../tulip/program/txn/txn_read.v | 119 + .../tulip/program/txn/txn_repr.v | 124 ++ .../tulip/program/txn/txn_reset.v | 29 + .../tulip/program/txn/txn_resetptgs.v | 29 + .../tulip/program/txn/txn_resetwrs.v | 75 + src/program_proof/tulip/program/txn/txn_run.v | 346 +++ .../tulip/program/txn/txn_setptgs.v | 161 ++ .../tulip/program/txn/txn_setwrs.v | 69 + .../tulip/program/txn/txn_write.v | 38 + .../tulip/program/txnlog/txnlog.v | 6 - 87 files changed, 7484 insertions(+), 6943 deletions(-) create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_abort.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_attached_with.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_change_leader.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_commit.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_finalized.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_get_leader.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_next_prepare_action.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_prepare.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_prepare_session.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_process_finalization_result.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_read.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_read_session.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_register_finalization.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_repr.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_send.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_value_responded.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_wait_until_prepare_done.v create mode 100644 src/program_proof/tulip/program/gcoord/gcoord_wait_until_value_ready.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_action.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_collect_fast_decision.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_collect_validation.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_cquorum.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_fquorum.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_get_phase.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_hcquorum.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_in.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_process_fast_prepare_result.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_process_prepare_result.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_process_query_result.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_process_unprepare_result.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_process_validate_result.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_ready.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_repr.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_try_become_preparing.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_try_become_unpreparing.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_try_fast_abort.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_try_fast_prepare.v create mode 100644 src/program_proof/tulip/program/gcoord/gpreparer_try_resign.v create mode 100644 src/program_proof/tulip/program/gcoord/greader_clear_versions.v create mode 100644 src/program_proof/tulip/program/gcoord/greader_cquorum.v create mode 100644 src/program_proof/tulip/program/gcoord/greader_pick_latest_value.v create mode 100644 src/program_proof/tulip/program/gcoord/greader_process_read_result.v create mode 100644 src/program_proof/tulip/program/gcoord/greader_read.v create mode 100644 src/program_proof/tulip/program/gcoord/greader_repr.v create mode 100644 src/program_proof/tulip/program/gcoord/greader_responded.v delete mode 100644 src/program_proof/tulip/program/gcoord/group_coordinator.v delete mode 100644 src/program_proof/tulip/program/gcoord/group_preparer.v delete mode 100644 src/program_proof/tulip/program/gcoord/group_reader.v delete mode 100644 src/program_proof/tulip/program/replica/replica.v create mode 100644 src/program_proof/tulip/program/replica/replica_apply.v create mode 100644 src/program_proof/tulip/program/replica/replica_apply_abort.v create mode 100644 src/program_proof/tulip/program/replica/replica_apply_commit.v create mode 100644 src/program_proof/tulip/program/replica/replica_fast_prepare.v create mode 100644 src/program_proof/tulip/program/replica/replica_log.v create mode 100644 src/program_proof/tulip/program/replica/replica_multiwrite.v create mode 100644 src/program_proof/tulip/program/replica/replica_read.v create mode 100644 src/program_proof/tulip/program/replica/replica_release.v create mode 100644 src/program_proof/tulip/program/replica/replica_start.v create mode 100644 src/program_proof/tulip/program/replica/replica_terminated.v create mode 100644 src/program_proof/tulip/program/replica/replica_try_accept.v create mode 100644 src/program_proof/tulip/program/tuple/res.v create mode 100644 src/program_proof/tulip/program/txn/key_to_group.v create mode 100644 src/program_proof/tulip/program/txn/proph.v create mode 100644 src/program_proof/tulip/program/txn/res.v delete mode 100644 src/program_proof/tulip/program/txn/txn.v create mode 100644 src/program_proof/tulip/program/txn/txn_abort.v create mode 100644 src/program_proof/tulip/program/txn/txn_begin.v create mode 100644 src/program_proof/tulip/program/txn/txn_cancel.v create mode 100644 src/program_proof/tulip/program/txn/txn_commit.v create mode 100644 src/program_proof/tulip/program/txn/txn_delete.v create mode 100644 src/program_proof/tulip/program/txn/txn_getwrs.v create mode 100644 src/program_proof/tulip/program/txn/txn_prepare.v create mode 100644 src/program_proof/tulip/program/txn/txn_read.v create mode 100644 src/program_proof/tulip/program/txn/txn_repr.v create mode 100644 src/program_proof/tulip/program/txn/txn_reset.v create mode 100644 src/program_proof/tulip/program/txn/txn_resetptgs.v create mode 100644 src/program_proof/tulip/program/txn/txn_resetwrs.v create mode 100644 src/program_proof/tulip/program/txn/txn_run.v create mode 100644 src/program_proof/tulip/program/txn/txn_setptgs.v create mode 100644 src/program_proof/tulip/program/txn/txn_setwrs.v create mode 100644 src/program_proof/tulip/program/txn/txn_write.v diff --git a/src/program_proof/tulip/program/gcoord/gcoord_abort.v b/src/program_proof/tulip/program/gcoord/gcoord_abort.v new file mode 100644 index 000000000..44d2477e5 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_abort.v @@ -0,0 +1,68 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_register_finalization gcoord_finalized gcoord_send + gcoord_get_leader gcoord_change_leader. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__Abort (gcoord : loc) (tsW : u64) gid γ : + let ts := uint.nat tsW in + safe_abort γ ts -∗ + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__Abort #gcoord #tsW + {{{ RET #(); True }}}. + Proof. + iIntros (ts) "#Habted #Hgcoord". + iIntros (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) Abort(ts uint64) { @*) + (*@ gcoord.RegisterFinalization(ts) @*) + (*@ @*) + wp_apply (wp_GroupCoordinator__RegisterFinalization with "Hgcoord"). + iNamed "Hgcoord". + wp_apply (wp_GroupCoordinator__GetLeader with "Hgcoord"). + iIntros (leader Hleader). + wp_apply wp_ref_to; first by auto. + iIntros (leaderP) "HleaderP". + wp_pures. + + (*@ var leader = gcoord.GetLeader() @*) + (*@ for !gcoord.Finalized(ts) { @*) + (*@ gcoord.SendAbort(leader, ts) @*) + (*@ primitive.Sleep(params.NS_RESEND_ABORT) @*) + (*@ // Retry with different leaders until success. @*) + (*@ leader = gcoord.ChangeLeader() @*) + (*@ } @*) + (*@ } @*) + set P := (λ _ : bool, ∃ leader' : u64, leaderP ↦[uint64T] #leader' ∗ ⌜leader' ∈ dom addrm⌝)%I. + wp_apply (wp_forBreak_cond P with "[] [$HleaderP]"); last first; first 1 last. + { done. } + { clear Φ. + iIntros (Φ) "!> HP HΦ". + wp_apply (wp_GroupCoordinator__Finalized with "[]"). + { iFrame "Hgcoord". } + iIntros (finalized) "_". + wp_pures. + destruct finalized; wp_pures. + { by iApply "HΦ". } + iDestruct "HP" as (leader') "[HleaderP %Hin]". + wp_load. + wp_apply (wp_GroupCoordinator__SendAbort with "Habted"). + { iFrame "Hgcoord". } + wp_apply wp_Sleep. + wp_apply (wp_GroupCoordinator__ChangeLeader). + { iFrame "Hgcoord". } + iIntros (leadernew Hleadernew). + wp_store. + iApply "HΦ". + by iFrame. + } + iIntros "_". + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_attached_with.v b/src/program_proof/tulip/program/gcoord/gcoord_attached_with.v new file mode 100644 index 000000000..47822c5f2 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_attached_with.v @@ -0,0 +1,62 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__attachedWith (gcoord : loc) (tsW : u64) tscur rids gid γ : + let ts := uint.nat tsW in + {{{ own_gcoord_core gcoord tscur gid rids γ }}} + GroupCoordinator__attachedWith #gcoord #tsW + {{{ (ok : bool), RET #ok; + if ok + then own_gcoord_core gcoord ts gid rids γ + else own_gcoord_core gcoord tscur gid rids γ + }}}. + Proof. + iIntros (ts Φ) "Hgcoord HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) attachedWith(ts uint64) bool { @*) + (*@ return gcoord.ts == ts @*) + (*@ } @*) + iNamed "Hgcoord". + rename tsW into tsargW. iNamed "Hts". + wp_loadField. + wp_pures. + case_bool_decide as Htsarg. + { iApply "HΦ". inv Htsarg. by iFrame "∗ # %". } + { iApply "HΦ". by iFrame "∗ # %". } + Qed. + + Theorem wp_GroupCoordinator__AttachedWith (gcoord : loc) (ts : u64) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__AttachedWith #gcoord #ts + {{{ (attached : bool), RET #attached; True }}}. + Proof. + iIntros "#Hgcoord" (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) AttachedWith(ts uint64) bool { @*) + (*@ gcoord.mu.Lock() @*) + (*@ b := gcoord.attachedWith(ts) @*) + (*@ gcoord.mu.Unlock() @*) + (*@ return b @*) + (*@ } @*) + do 2 iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + do 2 iNamed "Hgcoord". + wp_apply (wp_GroupCoordinator__attachedWith with "Hgcoord"). + iIntros (b) "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { iFrame "Hlock Hlocked". by destruct b; iFrame. } + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_change_leader.v b/src/program_proof/tulip/program/gcoord/gcoord_change_leader.v new file mode 100644 index 000000000..438aacb1d --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_change_leader.v @@ -0,0 +1,59 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__ChangeLeader (gcoord : loc) gid addrm γ : + is_gcoord_with_addrm gcoord gid addrm γ -∗ + {{{ True }}} + GroupCoordinator__ChangeLeader #gcoord + {{{ (leader : u64), RET #leader; ⌜leader ∈ dom addrm⌝ }}}. + Proof. + iIntros "#Hgcoord" (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) ChangeLeader() uint64 { @*) + (*@ gcoord.mu.Lock() @*) + (*@ leader := (gcoord.leader + 1) % uint64(len(gcoord.addrm)) @*) + (*@ gcoord.leader = leader @*) + (*@ gcoord.mu.Unlock() @*) + (*@ return leader @*) + (*@ } @*) + iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + do 3 iNamed "Hgcoord". iNamed "Hgfl". + iNamed "Haddrm". + do 2 wp_loadField. + wp_apply wp_slice_len. + wp_storeField. + iMod (readonly_load with "Hrps") as (q) "Hrpsro". + iDestruct (own_slice_small_sz with "Hrpsro") as %Hlenrps. + wp_loadField. + set idxleader' := word.modu _ _. + assert (Hltrps : (uint.nat idxleader' < length rps)%nat). + { assert (size (dom addrm) = length rps) as Hszaddrm. + { by rewrite Hdomaddrm size_list_to_set. } + rewrite word.unsigned_modu_nowrap; [word | lia]. + } + wp_apply (wp_Mutex__Unlock with "[-HΦ Hrpsro]"). + { iFrame "Hlock Hlocked Hts Hgrd Hgpp Hcomm ∗ %". + iPureIntro. + rewrite Hdomaddrm size_list_to_set; [lia | done]. + } + wp_pures. + wp_loadField. + assert (is_Some (rps !! uint.nat idxleader')) as [leader Hlead]. + { by apply lookup_lt_is_Some. } + wp_apply (wp_SliceGet with "[$Hrpsro]"). + { done. } + iIntros "_". + iApply "HΦ". + apply elem_of_list_lookup_2 in Hlead. + by rewrite Hdomaddrm elem_of_list_to_set. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_commit.v b/src/program_proof/tulip/program/gcoord/gcoord_commit.v new file mode 100644 index 000000000..6b8958100 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_commit.v @@ -0,0 +1,73 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_register_finalization gcoord_finalized gcoord_send + gcoord_get_leader gcoord_change_leader. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__Commit + (gcoord : loc) (tsW : u64) (pwrsP : loc) q (pwrs : dbmap) gid γ : + let ts := uint.nat tsW in + safe_commit γ gid ts pwrs -∗ + is_gcoord gcoord gid γ -∗ + {{{ own_map pwrsP q pwrs }}} + GroupCoordinator__Commit #gcoord #tsW #pwrsP + {{{ RET #(); own_map pwrsP q pwrs }}}. + Proof. + iIntros (ts) "#Hcmted #Hgcoord". + iIntros (Φ) "!> Hpwrs HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) Commit(ts uint64, pwrs tulip.KVMap) { @*) + (*@ gcoord.RegisterFinalization(ts) @*) + (*@ @*) + wp_apply (wp_GroupCoordinator__RegisterFinalization with "Hgcoord"). + iNamed "Hgcoord". + wp_apply (wp_GroupCoordinator__GetLeader with "Hgcoord"). + iIntros (leader Hleader). + wp_apply wp_ref_to; first by auto. + iIntros (leaderP) "HleaderP". + wp_pures. + + (*@ var leader = gcoord.GetLeader() @*) + (*@ for !gcoord.Finalized(ts) { @*) + (*@ gcoord.SendCommit(leader, ts, pwrs) @*) + (*@ primitive.Sleep(params.NS_RESEND_COMMIT) @*) + (*@ // Retry with different leaders until success. @*) + (*@ leader = gcoord.ChangeLeader() @*) + (*@ } @*) + (*@ } @*) + set P := (λ _ : bool, ∃ leader' : u64, + "HleaderP" ∷ leaderP ↦[uint64T] #leader' ∗ + "Hpwrs" ∷ own_map pwrsP q pwrs ∗ + "%Hinaddrm" ∷ ⌜leader' ∈ dom addrm⌝)%I. + wp_apply (wp_forBreak_cond P with "[] [$Hpwrs $HleaderP]"); last first; first 1 last. + { done. } + { clear Φ. + iIntros (Φ) "!> HP HΦ". + wp_apply (wp_GroupCoordinator__Finalized with "[]"). + { iFrame "Hgcoord". } + iIntros (finalized) "_". + wp_pures. + destruct finalized; wp_pures. + { by iApply "HΦ". } + iNamed "HP". + wp_load. + wp_apply (wp_GroupCoordinator__SendCommit with "Hcmted [] Hpwrs"). + { iFrame "Hgcoord". } + iIntros "Hpwrs". + wp_apply wp_Sleep. + wp_apply (wp_GroupCoordinator__ChangeLeader). + { iFrame "Hgcoord". } + iIntros (leadernew Hleadernew). + wp_store. + iApply "HΦ". + by iFrame. + } + iNamed 1. + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_finalized.v b/src/program_proof/tulip/program/gcoord/gcoord_finalized.v new file mode 100644 index 000000000..36bb8455c --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_finalized.v @@ -0,0 +1,37 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__Finalized (gcoord : loc) (tsW : u64) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__Finalized #gcoord #tsW + {{{ (finalized : bool), RET #finalized; True }}}. + Proof. + iIntros "#Hgcoord" (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) Finalized(ts uint64) bool { @*) + (*@ gcoord.mu.Lock() @*) + (*@ _, ok := gcoord.tsfinals[ts] @*) + (*@ gcoord.mu.Unlock() @*) + (*@ return !ok @*) + (*@ } @*) + do 2 iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + do 3 iNamed "Hgcoord". iNamed "Hgfl". + wp_loadField. + wp_apply (wp_MapGet with "Htsfinals"). + iIntros (v ok) "[%Hok Htsfinals]". + wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { by iFrame "Hlock Hlocked Hts Hgrd Hgpp Hcomm ∗ %". } + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_get_leader.v b/src/program_proof/tulip/program/gcoord/gcoord_get_leader.v new file mode 100644 index 000000000..51e4a1460 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_get_leader.v @@ -0,0 +1,48 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__GetLeader (gcoord : loc) gid addrm γ : + is_gcoord_with_addrm gcoord gid addrm γ -∗ + {{{ True }}} + GroupCoordinator__GetLeader #gcoord + {{{ (leader : u64), RET #leader; ⌜leader ∈ dom addrm⌝ }}}. + Proof. + iIntros "#Hgcoord" (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) GetLeader() uint64 { @*) + (*@ gcoord.mu.Lock() @*) + (*@ leader := gcoord.leader @*) + (*@ gcoord.mu.Unlock() @*) + (*@ return leader @*) + (*@ } @*) + iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + do 3 iNamed "Hgcoord". iNamed "Hgfl". + do 2 wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { by iFrame "Hlock Hlocked Hts Hgrd Hgpp Hcomm ∗ %". } + wp_pures. + iNamed "Haddrm". + wp_loadField. + iMod (readonly_load with "Hrps") as (q) "Hrpsro". + assert (is_Some (rps !! uint.nat idxleader)) as [leader Hlead]. + { apply lookup_lt_is_Some. + assert (length rps = size (dom addrm)); last word. + by rewrite Hdomaddrm size_list_to_set. + } + wp_apply (wp_SliceGet with "[$Hrpsro]"). + { done. } + iIntros "_". + iApply "HΦ". + iPureIntro. + apply elem_of_list_lookup_2 in Hlead. + by rewrite Hdomaddrm elem_of_list_to_set. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_next_prepare_action.v b/src/program_proof/tulip/program/gcoord/gcoord_next_prepare_action.v new file mode 100644 index 000000000..6c87fa3f8 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_next_prepare_action.v @@ -0,0 +1,68 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_attached_with gpreparer_repr gpreparer_action. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__NextPrepareAction + (gcoord : loc) (rid : u64) (tsW : u64) gid γ : + let ts := uint.nat tsW in + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__NextPrepareAction #gcoord #rid #tsW + {{{ (action : gppaction) (ok : bool), RET (#(gppaction_to_u64 action), #ok); + if ok then safe_gppaction γ ts gid action else True + }}}. + Proof. + iIntros (ts) "#Hgcoord". + iIntros (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) NextPrepareAction(rid uint64, ts uint64) (uint64, bool) { @*) + (*@ gcoord.mu.Lock() @*) + (*@ @*) + do 2 iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + do 2 iNamed "Hgcoord". + wp_apply (wp_GroupCoordinator__attachedWith with "Hgcoord"). + iIntros (ok) "Hgcoord". + wp_pures. + + (*@ if !gcoord.attachedWith(ts) { @*) + (*@ gcoord.mu.Unlock() @*) + (*@ return 0, false @*) + (*@ } @*) + (*@ @*) + destruct ok; wp_pures; last first. + { wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { by iFrame "Hlock Hlocked ∗". } + wp_pures. + (* [GPPFastPrepare] just a placeholder *) + by iApply ("HΦ" $! GPPFastPrepare). + } + + (*@ action := gcoord.gpp.action(rid) @*) + (*@ @*) + iNamed "Hgcoord". iNamed "Hgpp". + wp_loadField. + wp_apply (wp_GroupPreparer__action with "Hgpp"). + iIntros (action) "[Hgpp #Hsafea]". + wp_pures. + + (*@ gcoord.mu.Unlock() @*) + (*@ @*) + wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { by iFrame "Hlock Hlocked ∗". } + + (*@ return action, true @*) + (*@ } @*) + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_prepare.v b/src/program_proof/tulip/program/gcoord/gcoord_prepare.v new file mode 100644 index 000000000..2ffda711c --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_prepare.v @@ -0,0 +1,56 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_prepare_session gcoord_wait_until_prepare_done. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__Prepare + (gcoord : loc) (tsW : u64) (ptgsP : Slice.t) (pwrsP : loc) gid γ : + let ts := uint.nat tsW in + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__Prepare #gcoord #tsW (to_val ptgsP) #pwrsP + {{{ (phase : txnphase) (valid : bool), RET (#(txnphase_to_u64 phase), #valid); + if valid then safe_group_txnphase γ ts gid phase else True + }}}. + Proof. + iIntros (ts) "#Hgcoord". + iIntros (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) Prepare(ts uint64, ptgs []uint64, pwrs tulip.KVMap) (uint64, bool) { @*) + (*@ // Spawn a prepare session with each replica. @*) + (*@ for ridloop := range(gcoord.addrm) { @*) + (*@ rid := ridloop @*) + (*@ go func() { @*) + (*@ gcoord.PrepareSession(rid, ts, ptgs, pwrs) @*) + (*@ }() @*) + (*@ } @*) + (*@ @*) + iPoseProof "Hgcoord" as "Hgcoord'". + do 2 iNamed "Hgcoord". iNamed "Haddrm". + iRename "Hgcoord'" into "Hgcoord". + wp_loadField. + wp_apply (wp_MapIter_fold _ _ _ (λ _, True)%I with "Haddrm []"). + { done. } + { clear Φ. + iIntros (mx rid c Φ) "!> _ HΦ". + wp_pures. + wp_apply wp_fork. + { by wp_apply (wp_GroupCoordinator__PrepareSession with "Hgcoord"). } + by iApply "HΦ". + } + iIntros "_". + + (*@ st, valid := gcoord.WaitUntilPrepareDone(ts) @*) + (*@ return st, valid @*) + (*@ } @*) + wp_apply (wp_GroupCoordinator__WaitUntilPrepareDone with "Hgcoord"). + iIntros (phase valid) "#Hsafep". + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_prepare_session.v b/src/program_proof/tulip/program/gcoord/gcoord_prepare_session.v new file mode 100644 index 000000000..56f37da58 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_prepare_session.v @@ -0,0 +1,128 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_send gcoord_next_prepare_action. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__PrepareSession + (gcoord : loc) (rid : u64) (tsW : u64) (ptgsP : Slice.t) (pwrsP : loc) gid γ : + let ts := uint.nat tsW in + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__PrepareSession #gcoord #rid #tsW (to_val ptgsP) #pwrsP + {{{ RET #(); True }}}. + Proof. + iIntros (ts) "#Hgcoord". + iIntros (Φ) "!> _ HΦ". + wp_rec. wp_pures. + + (*@ func (gcoord *GroupCoordinator) PrepareSession(rid uint64, ts uint64, ptgs []uint64, pwrs map[string]tulip.Value) { @*) + (*@ for { @*) + (*@ @*) + wp_apply (wp_forBreak (λ _, True)%I with "[] []"); last first; first 1 last. + { done. } + { clear Φ. + + (*@ act, attached := gcoord.NextPrepareAction(rid, ts) @*) + (*@ @*) + iIntros (Φ) "!> _ HΦ". + wp_apply (wp_GroupCoordinator__NextPrepareAction with "Hgcoord"). + iIntros (action ok) "#Hsafea". + wp_pures. + + (*@ if !attached { @*) + (*@ break @*) + (*@ } @*) + (*@ @*) + destruct ok; wp_pures; last by iApply "HΦ". + + (*@ if act == GPP_FAST_PREPARE { @*) + (*@ gcoord.SendFastPrepare(rid, ts, pwrs, ptgs) @*) + (*@ } else if act == GPP_VALIDATE { @*) + (*@ gcoord.SendValidate(rid, ts, 1, pwrs, ptgs) @*) + (*@ } else if act == GPP_PREPARE { @*) + (*@ gcoord.SendPrepare(rid, ts, 1) @*) + (*@ } else if act == GPP_UNPREPARE { @*) + (*@ gcoord.SendUnprepare(rid, ts, 1) @*) + (*@ } else if act == GPP_QUERY { @*) + (*@ gcoord.SendQuery(rid, ts, 1) @*) + (*@ } else if act == GPP_REFRESH { @*) + (*@ // Keep sending keep-alive message until the transaction terminated. @*) + (*@ gcoord.SendRefresh(rid, ts, 1) @*) + (*@ } @*) + (*@ @*) + (*@ if act == GPP_REFRESH { @*) + (*@ primitive.Sleep(params.NS_SEND_REFRESH) @*) + (*@ } else { @*) + (*@ // The optimal time to sleep is the time required to arrive at a @*) + (*@ // prepare decision. Waking up too frequently means sending @*) + (*@ // unnecessary messages, too infrequently means longer latency when @*) + (*@ // messages are lost. @*) + (*@ // @*) + (*@ // This might not be optimal for slow-path prepare. Consider @*) + (*@ // optimize this with CV wait and timeout. @*) + (*@ primitive.Sleep(params.NS_RESEND_PREPARE) @*) + (*@ } @*) + (*@ } @*) + (*@ @*) + case_bool_decide as Hfp; wp_pures. + { wp_apply (wp_GroupCoordinator__SendFastPrepare with "Hgcoord"). + wp_pures. + rewrite Hfp /=. + case_bool_decide; first done. + wp_apply wp_Sleep. wp_pures. + by iApply "HΦ". + } + case_bool_decide as Hvd; wp_pures. + { wp_apply (wp_GroupCoordinator__SendValidate with "Hgcoord"). + wp_pures. + rewrite Hvd /=. + case_bool_decide; first done. + wp_apply wp_Sleep. wp_pures. + by iApply "HΦ". + } + case_bool_decide as Hprep; wp_pures. + { inv Hprep. destruct action; try done. simpl. + wp_apply (wp_GroupCoordinator__SendPrepare with "Hsafea Hgcoord"). + wp_pures. + wp_apply wp_Sleep. wp_pures. + by iApply "HΦ". + } + case_bool_decide as Hunprep; wp_pures. + { inv Hunprep. destruct action; try done. simpl. + wp_apply (wp_GroupCoordinator__SendUnprepare with "Hsafea Hgcoord"). + wp_pures. + wp_apply wp_Sleep. wp_pures. + by iApply "HΦ". + } + case_bool_decide as Hqr; wp_pures. + { wp_apply (wp_GroupCoordinator__SendQuery with "Hgcoord"). + wp_pures. + rewrite Hqr /=. + case_bool_decide; first done. + wp_apply wp_Sleep. wp_pures. + by iApply "HΦ". + } + case_bool_decide as Hrf; wp_pures. + { wp_apply (wp_GroupCoordinator__SendRefresh with "Hgcoord"). + wp_pures. + rewrite Hrf /=. + case_bool_decide; last done. + wp_apply wp_Sleep. wp_pures. + by iApply "HΦ". + } + case_bool_decide; first done. + wp_apply wp_Sleep. wp_pures. + by iApply "HΦ". + + (*@ // The coordinator is no longer associated with @ts, this could happen only @*) + (*@ // after the prepare decision for @ts on @rid is made. Hence, this session @*) + (*@ // can terminate. @*) + (*@ } @*) + } + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_process_finalization_result.v b/src/program_proof/tulip/program/gcoord/gcoord_process_finalization_result.v new file mode 100644 index 000000000..c5645884e --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_process_finalization_result.v @@ -0,0 +1,33 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__processFinalizationResult + (gcoord : loc) (ts : u64) (res : u64) rids : + {{{ own_gcoord_finalizer gcoord rids }}} + GroupCoordinator__processFinalizationResult #gcoord #ts #res + {{{ RET #(); own_gcoord_finalizer gcoord rids }}}. + Proof. + iIntros (Φ) "Hgcoord HΦ". + wp_rec. wp_pures. + + (*@ func (gcoord *GroupCoordinator) processFinalizationResult(ts uint64, res uint64) { @*) + (*@ if res == tulip.REPLICA_WRONG_LEADER { @*) + (*@ return @*) + (*@ } @*) + (*@ delete(gcoord.tsfinals, ts) @*) + (*@ } @*) + case_bool_decide as Hwrong; wp_pures. + { by iApply "HΦ". } + iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_MapDelete with "Htsfinals"). + iIntros "Htsfinals". + wp_pures. + iApply "HΦ". + by iFrame "∗ %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_read.v b/src/program_proof/tulip/program/gcoord/gcoord_read.v new file mode 100644 index 000000000..02e5b5f34 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_read.v @@ -0,0 +1,56 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_read_session gcoord_wait_until_value_ready. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__Read + (gcoord : loc) (tsW : u64) (key : string) gid γ : + let ts := uint.nat tsW in + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__Read #gcoord #tsW #(LitString key) + {{{ (value : dbval) (ok : bool), RET (dbval_to_val value, #ok); + if ok then fast_or_quorum_read γ key ts value else True + }}}. + Proof. + iIntros (ts) "#Hgcoord". + iIntros (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) Read(ts uint64, key string) (tulip.Value, bool) { @*) + (*@ // Spawn a session with each replica in the group. @*) + (*@ for ridloop := range(gcoord.addrm) { @*) + (*@ rid := ridloop @*) + (*@ go func() { @*) + (*@ gcoord.ReadSession(rid, ts, key) @*) + (*@ }() @*) + (*@ } @*) + (*@ @*) + iPoseProof "Hgcoord" as "Hgcoord'". + do 2 iNamed "Hgcoord". iNamed "Haddrm". + iRename "Hgcoord'" into "Hgcoord". + wp_loadField. + wp_apply (wp_MapIter_fold _ _ _ (λ _, True)%I with "Haddrm []"). + { done. } + { clear Φ. + iIntros (mx rid c Φ) "!> _ HΦ". + wp_pures. + wp_apply wp_fork. + { by wp_apply (wp_GroupCoordinator__ReadSession with "Hgcoord"). } + by iApply "HΦ". + } + iIntros "_". + + (*@ v, ok := gcoord.WaitUntilValueReady(ts, key) @*) + (*@ return v, ok @*) + (*@ } @*) + wp_apply (wp_GroupCoordinator__WaitUntilValueReady with "Hgcoord"). + iIntros (v ok) "#Hread". + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_read_session.v b/src/program_proof/tulip/program/gcoord/gcoord_read_session.v new file mode 100644 index 000000000..c82961c17 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_read_session.v @@ -0,0 +1,53 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_value_responded gcoord_attached_with gcoord_send. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__ReadSession + (gcoord : loc) (rid : u64) (ts : u64) (key : string) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__ReadSession #gcoord #rid #ts #(LitString key) + {{{ RET #(); True }}}. + Proof. + iIntros "#Hgcoord" (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) ReadSession(rid uint64, ts uint64, key string) { @*) + (*@ for !gcoord.ValueResponded(rid, key) && gcoord.AttachedWith(ts) { @*) + (*@ gcoord.SendRead(rid, ts, key) @*) + (*@ primitive.Sleep(params.NS_RESEND_READ) @*) + (*@ } @*) + (*@ @*) + wp_pures. + wp_apply (wp_forBreak_cond (λ _, True)%I with "[] []"); last first; first 1 last. + { done. } + { clear Φ. + iIntros (Φ) "!> _ HΦ". + wp_apply (wp_GroupCoordinator__ValueResponded with "Hgcoord"). + iIntros (resped) "_". + wp_pures. + destruct resped; wp_pures. + { by iApply "HΦ". } + wp_apply (wp_GroupCoordinator__AttachedWith with "Hgcoord"). + iIntros (attached) "_". + destruct attached; wp_pures; last first. + { by iApply "HΦ". } + wp_apply (wp_GroupCoordinator__SendRead with "Hgcoord"). + wp_apply wp_Sleep. + wp_pures. + by iApply "HΦ". + } + + (*@ // Either replica @rid has already responded with its value, or the value @*) + (*@ // for @key has already been determined. In either case, the corresponding @*) + (*@ // read session could terminate. @*) + (*@ } @*) + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_register_finalization.v b/src/program_proof/tulip/program/gcoord/gcoord_register_finalization.v new file mode 100644 index 000000000..7d5a55038 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_register_finalization.v @@ -0,0 +1,36 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__RegisterFinalization (gcoord : loc) (tsW : u64) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__RegisterFinalization #gcoord #tsW + {{{ RET #(); True }}}. + Proof. + iIntros "#Hgcoord" (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) RegisterFinalization(ts uint64) { @*) + (*@ gcoord.mu.Lock() @*) + (*@ gcoord.tsfinals[ts] = true @*) + (*@ gcoord.mu.Unlock() @*) + (*@ } @*) + do 2 iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + do 3 iNamed "Hgcoord". iNamed "Hgfl". + wp_loadField. + wp_apply (wp_MapInsert with "Htsfinals"); first done. + iIntros "Htsfinals". + wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { by iFrame "Hlock Hlocked Hts Hgrd Hgpp Hcomm ∗ %". } + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_repr.v b/src/program_proof/tulip/program/gcoord/gcoord_repr.v new file mode 100644 index 000000000..fc5e05315 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_repr.v @@ -0,0 +1,92 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + greader_repr gpreparer_repr. + +Section repr. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + (*@ type GroupCoordinator struct { @*) + (*@ // Replica addresses. Read-only. @*) + (*@ rps map[uint64]grove_ffi.Address @*) + (*@ // Mutex protecting fields below. @*) + (*@ mu *sync.Mutex @*) + (*@ // Condition variable used to notify arrival of responses. @*) + (*@ cv *sync.Cond @*) + (*@ // Timestamp of the currently active transaction. @*) + (*@ ts uint64 @*) + (*@ // ID of the replica believed to be the leader of this group. @*) + (*@ leader uint64 @*) + (*@ // Group reader. @*) + (*@ grd *GroupReader @*) + (*@ // Group preparer. @*) + (*@ gpp *GroupPreparer @*) + (*@ // IDs of the finalizing transactions. Using unit as range would suffice. @*) + (*@ tsfinals map[uint64]bool @*) + (*@ // Connections to replicas. @*) + (*@ conns map[uint64]grove_ffi.Connection @*) + (*@ } @*) + Definition own_gcoord_ts gcoord ts : iProp Σ := + ∃ (tsW : u64), + "HtsW" ∷ gcoord ↦[GroupCoordinator :: "ts"] #tsW ∗ + "%Hts" ∷ ⌜uint.nat tsW = ts⌝. + + Definition own_gcoord_greader gcoord ts γ : iProp Σ := + ∃ (grdP : loc), + "HgrdP" ∷ gcoord ↦[GroupCoordinator :: "grd"] #grdP ∗ + "Hgrd" ∷ own_greader grdP ts γ. + + Definition own_gcoord_gpreparer gcoord ts gid γ : iProp Σ := + ∃ (gppP : loc), + "HgppP" ∷ gcoord ↦[GroupCoordinator :: "gpp"] #gppP ∗ + "Hgpp" ∷ own_gpreparer gppP ts gid γ. + + Definition own_gcoord_finalizer gcoord (rids : gset u64) : iProp Σ := + ∃ (idxleader : u64) (tsfinalsP : loc) (tsfinals : gmap u64 bool), + "Hleader" ∷ gcoord ↦[GroupCoordinator :: "idxleader"] #idxleader ∗ + "HtsfinalsP" ∷ gcoord ↦[GroupCoordinator :: "tsfinals"] #tsfinalsP ∗ + "Htsfinals" ∷ own_map tsfinalsP (DfracOwn 1) tsfinals ∗ + "%Hleader" ∷ ⌜(uint.nat idxleader < size rids)⌝. + + Definition own_gcoord_core gcoord ts gid rids γ : iProp Σ := + "Hts" ∷ own_gcoord_ts gcoord ts ∗ + "Hgrd" ∷ own_gcoord_greader gcoord ts γ ∗ + "Hgpp" ∷ own_gcoord_gpreparer gcoord ts gid γ ∗ + "Hgfl" ∷ own_gcoord_finalizer gcoord rids. + + Definition own_gcoord_comm gcoord (addrm : gmap u64 chan) : iProp Σ := + ∃ (connsP : loc) (conns : gmap u64 (chan * chan)), + let connsV := fmap (λ x, connection_socket x.1 x.2) conns in + "HconnsP" ∷ gcoord ↦[GroupCoordinator :: "conns"] #connsP ∗ + "Hconns" ∷ map.own_map connsP (DfracOwn 1) (connsV, #()) ∗ + (* "#Htrmls" ∷ ([∗ map] x ∈ conns, is_terminal γ x.1) ∗ *) + "%Haddrpeers" ∷ ⌜map_Forall (λ rid x, addrm !! rid = Some x.2) conns⌝. + + Definition own_gcoord_with_ts gcoord addrm ts gid γ : iProp Σ := + "Hgcoord" ∷ own_gcoord_core gcoord ts gid (dom addrm) γ ∗ + "Hcomm" ∷ own_gcoord_comm gcoord addrm. + + Definition own_gcoord gcoord addrm gid γ : iProp Σ := + ∃ ts, "Hgcoord" ∷ own_gcoord_with_ts gcoord addrm ts gid γ. + + Definition is_gcoord_addrm gcoord (addrm : gmap u64 chan) : iProp Σ := + ∃ (addrmP : loc) (rpsP : Slice.t) (rps : list u64), + "#HaddrmP" ∷ readonly (gcoord ↦[GroupCoordinator :: "addrm"] #addrmP) ∗ + "#Haddrm" ∷ own_map addrmP DfracDiscarded addrm ∗ + "#HrpsP" ∷ readonly (gcoord ↦[GroupCoordinator :: "rps"] (to_val rpsP)) ∗ + "#Hrps" ∷ readonly (own_slice_small rpsP uint64T (DfracOwn 1) rps) ∗ + "%Hdomaddrm" ∷ ⌜dom addrm = list_to_set rps⌝ ∗ + "%Hnodup" ∷ ⌜NoDup rps⌝. + + Definition is_gcoord_with_addrm gcoord gid (addrm : gmap u64 chan) γ : iProp Σ := + ∃ (muP : loc) (cvP : loc), + "#HmuP" ∷ readonly (gcoord ↦[GroupCoordinator :: "mu"] #muP) ∗ + "#Hlock" ∷ is_lock tulipNS #muP (own_gcoord gcoord addrm gid γ) ∗ + "#HcvP" ∷ readonly (gcoord ↦[GroupCoordinator :: "cv"] #cvP) ∗ + "Hcv" ∷ is_cond cvP #muP ∗ + "#Haddrm" ∷ is_gcoord_addrm gcoord addrm. + + Definition is_gcoord gcoord gid γ : iProp Σ := + ∃ addrm, "Hgcoord" ∷ is_gcoord_with_addrm gcoord gid addrm γ. + +End repr. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_send.v b/src/program_proof/tulip/program/gcoord/gcoord_send.v new file mode 100644 index 000000000..120d979fd --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_send.v @@ -0,0 +1,116 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + + Theorem wp_GroupCoordinator__SendRead + (gcoord : loc) (rid : u64) (ts : u64) (key : string) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__SendRead #gcoord #rid #ts #(LitString key) + {{{ RET #(); True }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendRead(rid, ts uint64, key string) { @*) + (*@ gcoord.Send(rid, message.EncodeTxnRead(ts, key)) @*) + (*@ } @*) + Admitted. + + Theorem wp_GroupCoordinator__SendFastPrepare + (gcoord : loc) (rid : u64) (ts : u64) (pwrsP : loc) (ptgsP : Slice.t) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__SendFastPrepare #gcoord #rid #ts #pwrsP (to_val ptgsP) + {{{ RET #(); True }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendFastPrepare(rid, ts uint64, pwrs tulip.KVMap, ptgs []uint64) { @*) + (*@ gcoord.Send(rid, message.EncodeTxnFastPrepare(ts, pwrs, ptgs)) @*) + (*@ } @*) + Admitted. + + Theorem wp_GroupCoordinator__SendValidate + (gcoord : loc) (rid : u64) (ts : u64) (rank : u64) (pwrsP : loc) (ptgsP : Slice.t) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__SendValidate #gcoord #rid #ts #rank #pwrsP (to_val ptgsP) + {{{ RET #(); True }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendValidate(rid, ts, rank uint64, pwrs tulip.KVMap, ptgs []uint64) { @*) + (*@ } @*) + Admitted. + + Theorem wp_GroupCoordinator__SendPrepare + (gcoord : loc) (rid : u64) (tsW : u64) (rank : u64) gid γ : + let ts := uint.nat tsW in + is_group_prepare_proposal γ gid ts 1%nat true -∗ + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__SendPrepare #gcoord #rid #tsW #rank + {{{ RET #(); True }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendPrepare(rid, ts, rank uint64) { @*) + (*@ } @*) + Admitted. + + Theorem wp_GroupCoordinator__SendUnprepare + (gcoord : loc) (rid : u64) (tsW : u64) (rank : u64) gid γ : + let ts := uint.nat tsW in + is_group_prepare_proposal γ gid ts 1%nat false -∗ + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__SendUnprepare #gcoord #rid #tsW #rank + {{{ RET #(); True }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendUnprepare(rid, ts, rank uint64) { @*) + (*@ } @*) + Admitted. + + Theorem wp_GroupCoordinator__SendQuery + (gcoord : loc) (rid : u64) (ts : u64) (rank : u64) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__SendQuery #gcoord #rid #ts #rank + {{{ RET #(); True }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendQuery(rid, ts, rank uint64) { @*) + (*@ } @*) + Admitted. + + Theorem wp_GroupCoordinator__SendRefresh + (gcoord : loc) (rid : u64) (ts : u64) (rank : u64) gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__SendRefresh #gcoord #rid #ts #rank + {{{ RET #(); True }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendRefresh(rid, ts, rank uint64) { @*) + (*@ } @*) + Admitted. + + Theorem wp_GroupCoordinator__SendCommit + (gcoord : loc) (rid : u64) (tsW : u64) (pwrsP : loc) q (pwrs : dbmap) gid γ : + let ts := uint.nat tsW in + safe_commit γ gid ts pwrs -∗ + is_gcoord gcoord gid γ -∗ + {{{ own_map pwrsP q pwrs }}} + GroupCoordinator__SendCommit #gcoord #rid #tsW #pwrsP + {{{ RET #(); own_map pwrsP q pwrs }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendCommit(rid, ts uint64, pwrs tulip.KVMap) { @*) + (*@ } @*) + Admitted. + + Theorem wp_GroupCoordinator__SendAbort (gcoord : loc) (rid : u64) (tsW : u64) gid γ : + let ts := uint.nat tsW in + safe_abort γ ts -∗ + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__SendAbort #gcoord #rid #tsW + {{{ RET #(); True }}}. + Proof. + (*@ func (gcoord *GroupCoordinator) SendAbort(rid, ts uint64) { @*) + (*@ } @*) + Admitted. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_value_responded.v b/src/program_proof/tulip/program/gcoord/gcoord_value_responded.v new file mode 100644 index 000000000..44d6dab05 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_value_responded.v @@ -0,0 +1,40 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr greader_responded. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__ValueResponded gcoord (rid : u64) key gid γ : + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__ValueResponded #gcoord #rid #(LitString key) + {{{ (ok : bool), RET #ok; True }}}. + Proof. + iIntros "#Hgcoord" (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) ValueResponded(rid uint64, key string) bool { @*) + (*@ gcoord.mu.Lock() @*) + (*@ done := gcoord.grd.responded(rid, key) @*) + (*@ gcoord.mu.Unlock() @*) + (*@ return done @*) + (*@ } @*) + do 2 iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + do 3 iNamed "Hgcoord". iNamed "Hgrd". + wp_loadField. + wp_pures. + wp_apply (wp_GroupReader__responded with "Hgrd"). + iIntros (responded) "Hgrd". + wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { iFrame "Hlock Hlocked". by iFrame "∗ # %". } + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_wait_until_prepare_done.v b/src/program_proof/tulip/program/gcoord/gcoord_wait_until_prepare_done.v new file mode 100644 index 000000000..1ca2dcd68 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_wait_until_prepare_done.v @@ -0,0 +1,139 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_attached_with + gpreparer_repr gpreparer_ready gpreparer_get_phase. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__WaitUntilPrepareDone + (gcoord : loc) (tsW : u64) gid γ : + let ts := uint.nat tsW in + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__WaitUntilPrepareDone #gcoord #tsW + {{{ (tphase : txnphase) (valid : bool), RET (#(txnphase_to_u64 tphase), #valid); + if valid then safe_group_txnphase γ ts gid tphase else True + }}}. + Proof. + iIntros (ts) "#Hgcoord". + iIntros (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) WaitUntilPrepareDone(ts uint64) (uint64, bool) { @*) + (*@ var phase uint64 @*) + (*@ var valid bool @*) + (*@ @*) + wp_apply wp_ref_of_zero; first done. + iIntros (phaseP) "HphaseP". + wp_apply wp_ref_of_zero; first done. + iIntros (validP) "HvalidP". + + (*@ gcoord.mu.Lock() @*) + (*@ @*) + do 2 iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + wp_pures. + + (*@ for { @*) + (*@ @*) + set P := (λ (cont : bool), ∃ (pphase : gppphase) (valid : bool), + "Hgcoord" ∷ own_gcoord gcoord addrm gid γ ∗ + "HphaseP" ∷ phaseP ↦[uint64T] #(gppphase_to_u64 pphase) ∗ + "HvalidP" ∷ validP ↦[boolT] #valid ∗ + "Hlocked" ∷ locked #muP ∗ + "#Hsafep" ∷ (if (negb cont) && valid + then safe_gpreparer_phase γ ts gid pphase ∗ ⌜gpp_ready pphase⌝ + else True))%I. + wp_apply (wp_forBreak P with "[] [Hgcoord HphaseP HvalidP Hlocked]"); last first; first 1 last. + { iFrame. by iExists GPPValidating. } + { clear Φ. + + (*@ if !gcoord.attachedWith(ts) { @*) + (*@ valid = false @*) + (*@ break @*) + (*@ } @*) + (*@ @*) + iIntros (Φ) "!> HP HΦ". + iNamed "HP". + iDestruct"Hgcoord" as (tscur) "Hgcoord". + do 2 iNamed "Hgcoord". + wp_apply (wp_GroupCoordinator__attachedWith with "Hgcoord"). + iIntros (attached) "Hgcoord". + wp_pures. + destruct attached; wp_pures; last first. + { wp_store. iApply "HΦ". by iFrame. } + + (*@ ready := gcoord.gpp.ready() @*) + (*@ if ready { @*) + (*@ phase = gcoord.gpp.getPhase() @*) + (*@ valid = true @*) + (*@ break @*) + (*@ } @*) + (*@ @*) + iNamed "Hgcoord". do 2 iNamed "Hgpp". + wp_loadField. + wp_apply (wp_GroupPreparer__ready_external with "Hgpp"). + iIntros "Hgpp". + case_bool_decide; wp_pures. + { wp_loadField. + wp_apply (wp_GroupPreparer__getPhase with "Hgpp"). + iIntros "[Hgpp #Hsafegpp]". + do 2 wp_store. + iApply "HΦ". + by iFrame "∗ # %". + } + + (*@ gcoord.cv.Wait() @*) + (*@ } @*) + (*@ @*) + wp_loadField. + wp_apply (wp_Cond__Wait with "[-HΦ HphaseP HvalidP]"). + { by iFrame "Hcv Hlock Hlocked ∗ # %". } + iIntros "[Hlocked Hgcoord]". + wp_pures. + iApply "HΦ". + by iFrame. + } + subst P. iNamed 1. simpl. + + (*@ gcoord.mu.Unlock() @*) + (*@ @*) + wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ HphaseP HvalidP]"). + { by iFrame "Hlock Hlocked Hgcoord". } + + (*@ if !valid { @*) + (*@ // TXN_PREPARED here is just a placeholder. @*) + (*@ return tulip.TXN_PREPARED, false @*) + (*@ } @*) + (*@ @*) + wp_load. wp_pures. + destruct valid; wp_pures; last first. + { by iApply ("HΦ" $! TxnPrepared). } + iDestruct "Hsafep" as "[Hsafep %Hready]". + + (*@ if phase == GPP_COMMITTED { @*) + (*@ return tulip.TXN_COMMITTED, true @*) + (*@ } @*) + (*@ @*) + wp_load. wp_pures. + case_bool_decide; wp_pures. + { iApply ("HΦ" $! TxnCommitted). by destruct pphase. } + + (*@ if phase == GPP_ABORTED { @*) + (*@ return tulip.TXN_ABORTED, true @*) + (*@ } @*) + (*@ @*) + wp_load. wp_pures. + case_bool_decide; wp_pures. + { iApply ("HΦ" $! TxnAborted). by destruct pphase. } + + (*@ return tulip.TXN_PREPARED, true @*) + (*@ } @*) + iApply ("HΦ" $! TxnPrepared). by destruct pphase. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gcoord_wait_until_value_ready.v b/src/program_proof/tulip/program/gcoord/gcoord_wait_until_value_ready.v new file mode 100644 index 000000000..90eba3149 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gcoord_wait_until_value_ready.v @@ -0,0 +1,115 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gcoord_repr gcoord_attached_with greader_read. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupCoordinator__WaitUntilValueReady + (gcoord : loc) (tsW : u64) (key : string) gid γ : + let ts := uint.nat tsW in + is_gcoord gcoord gid γ -∗ + {{{ True }}} + GroupCoordinator__WaitUntilValueReady #gcoord #tsW #(LitString key) + {{{ (value : dbval) (valid : bool), RET (dbval_to_val value, #valid); + if valid then fast_or_quorum_read γ key ts value else True + }}}. + Proof. + iIntros (ts) "#Hgcoord". + iIntros (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (gcoord *GroupCoordinator) WaitUntilValueReady(ts uint64, key string) (tulip.Value, bool) { @*) + (*@ var value tulip.Value @*) + (*@ var valid bool @*) + (*@ @*) + wp_apply wp_ref_of_zero; first done. + iIntros (valueP) "HvalueP". + wp_apply wp_ref_of_zero; first done. + iIntros (validP) "HvalidP". + + (*@ gcoord.mu.Lock() @*) + (*@ @*) + do 2 iNamed "Hgcoord". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hgcoord]". + wp_pures. + + (*@ for { @*) + (*@ @*) + set P := (λ (cont : bool), ∃ (value : dbval) (valid : bool), + "Hgcoord" ∷ own_gcoord gcoord addrm gid γ ∗ + "HvalueP" ∷ valueP ↦[boolT * (stringT * unitT)%ht] dbval_to_val value ∗ + "HvalidP" ∷ validP ↦[boolT] #valid ∗ + "Hlocked" ∷ locked #muP ∗ + "#Hread" ∷ if (negb cont) && valid then fast_or_quorum_read γ key ts value else True)%I. + wp_apply (wp_forBreak P with "[] [Hgcoord HvalueP HvalidP Hlocked]"); last first; first 1 last. + { iFrame. by iExists None. } + { clear Φ. + + (*@ if !gcoord.attachedWith(ts) { @*) + (*@ valid = false @*) + (*@ break @*) + (*@ } @*) + (*@ @*) + iIntros (Φ) "!> HP HΦ". + iNamed "HP". + iDestruct"Hgcoord" as (tscur) "Hgcoord". + do 2 iNamed "Hgcoord". + wp_apply (wp_GroupCoordinator__attachedWith with "Hgcoord"). + iIntros (attached) "Hgcoord". + wp_pures. + destruct attached; wp_pures; last first. + { wp_store. iApply "HΦ". by iFrame. } + + (*@ v, ok := gcoord.grd.read(key) @*) + (*@ if ok { @*) + (*@ value = v @*) + (*@ valid = true @*) + (*@ break @*) + (*@ } @*) + (*@ @*) + iNamed "Hgcoord". iNamed "Hgrd". + wp_loadField. + wp_apply (wp_GroupReader__read with "Hgrd"). + iIntros (v ok) "[Hgrd #Hreadv]". + wp_pures. + destruct ok; wp_pures. + { wp_apply (wp_StoreAt with "HvalueP"). + { by destruct v; auto. } + iIntros "HvalueP". + wp_store. + iApply "HΦ". + by iFrame "∗ #". + } + + (*@ gcoord.cv.Wait() @*) + (*@ } @*) + (*@ @*) + wp_loadField. + wp_apply (wp_Cond__Wait with "[-HΦ HvalueP HvalidP]"). + { by iFrame "Hcv Hlock Hlocked ∗ # %". } + iIntros "[Hlocked Hgcoord]". + wp_pures. + iApply "HΦ". + by iFrame. + } + subst P. iNamed 1. + + (*@ gcoord.mu.Unlock() @*) + (*@ @*) + wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ HvalueP HvalidP]"). + { by iFrame "Hlock Hlocked Hgcoord". } + + (*@ return value, valid @*) + (*@ } @*) + do 2 wp_load. + wp_pures. + iApply "HΦ". + by destruct valid. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_action.v b/src/program_proof/tulip/program/gcoord/gpreparer_action.v new file mode 100644 index 000000000..1b3c593cf --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_action.v @@ -0,0 +1,150 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_in. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Definition safe_gppaction γ ts gid action : iProp Σ := + match action with + | GPPFastPrepare => True + | GPPValidate => True + | GPPPrepare => is_group_prepare_proposal γ gid ts 1%nat true + | GPPUnprepare => is_group_prepare_proposal γ gid ts 1%nat false + | GPPQuery => True + | GPPRefresh => True + end. + + #[global] + Instance gppaction_persistent γ ts gid action : + Persistent (safe_gppaction γ ts gid action). + Proof. destruct action; apply _. Defined. + + Theorem wp_GroupPreparer__action (gpp : loc) (rid : u64) γ ts gid : + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__action #gpp #rid + {{{ (action : gppaction), RET #(gppaction_to_u64 action); + own_gpreparer gpp ts gid γ ∗ + safe_gppaction γ ts gid action + }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) action(rid uint64) uint64 { @*) + (*@ // Validate the transaction through fast-path or slow-path. @*) + (*@ if gpp.phase == GPP_VALIDATING { @*) + (*@ // Check if the fast-path response for replica @rid is available. @*) + (*@ _, fresp := gpp.frespm[rid] @*) + (*@ if !fresp { @*) + (*@ // Have not received the fast-path response. @*) + (*@ return GPP_FAST_PREPARE @*) + (*@ } @*) + (*@ @*) + wp_pures. + wp_apply (wp_GroupPreparer__in _ GPPValidating with "Hgpp"). + iIntros (validting) "Hgpp". + destruct validting; wp_pures. + { iNamed "Hgpp". + iNamed "Hfrespm". + wp_loadField. + wp_apply (wp_MapGet with "Hfrespm"). + iIntros (b1 fresp) "[_ Hfrespm]". + wp_pures. + destruct fresp; wp_pures; last first. + { iApply ("HΦ" $! GPPFastPrepare). by iFrame "∗ # %". } + + (*@ // Check if the validation response for replica @rid is available. @*) + (*@ _, validated := gpp.vdm[rid] @*) + (*@ if !validated { @*) + (*@ // Previous attemp of validation fails; retry. @*) + (*@ return GPP_VALIDATE @*) + (*@ } @*) + (*@ @*) + iNamed "Hvdm". + wp_loadField. + wp_apply (wp_MapGet with "Hvdm"). + iIntros (b2 validated) "[_ Hvdm]". + wp_pures. + destruct validated; wp_pures; last first. + { iApply ("HΦ" $! GPPValidate). by iFrame "HfrespmP HvdmP ∗ # %". } + + (*@ // Successfully validated (in either fast-path or slow-path). @*) + (*@ return GPP_QUERY @*) + (*@ } @*) + (*@ @*) + { iApply ("HΦ" $! GPPQuery). by iFrame "HfrespmP HvdmP ∗ # %". } + } + + (*@ // Prepare the transaction through slow-path. @*) + (*@ if gpp.phase == GPP_PREPARING { @*) + (*@ _, prepared := gpp.srespm[rid] @*) + (*@ if !prepared { @*) + (*@ return GPP_PREPARE @*) + (*@ } @*) + (*@ return GPP_QUERY @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__in _ GPPPreparing with "Hgpp"). + iIntros (preparing) "Hgpp". + destruct preparing; wp_pures. + { iNamed "Hgpp". iNamed "Hsrespm". + wp_loadField. + wp_apply (wp_MapGet with "Hsrespm"). + iIntros (b prepared) "[_ Hsrespm]". + wp_pures. + destruct prepared; wp_pures; last first. + { iApply ("HΦ" $! GPPPrepare). + iDestruct "Hsafe" as "[Hqv Hppsl]". + iFrame "Hfrespm Hvdm ∗ # %". + by iFrame "∗ #". + } + iApply ("HΦ" $! GPPQuery). + iFrame "Hfrespm Hvdm ∗ # %". + by iFrame "∗ #". + } + + (*@ // Unprepare the transaction through slow-path. @*) + (*@ if gpp.phase == GPP_UNPREPARING { @*) + (*@ _, unprepared := gpp.srespm[rid] @*) + (*@ if !unprepared { @*) + (*@ return GPP_UNPREPARE @*) + (*@ } @*) + (*@ return GPP_QUERY @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__in _ GPPUnpreparing with "Hgpp"). + iIntros (unpreparing) "Hgpp". + destruct unpreparing; wp_pures. + { iNamed "Hgpp". iNamed "Hsrespm". + wp_loadField. + wp_apply (wp_MapGet with "Hsrespm"). + iIntros (b prepared) "[_ Hsrespm]". + wp_pures. + destruct prepared; wp_pures; last first. + { iApply ("HΦ" $! GPPUnprepare). + iFrame "Hfrespm Hvdm ∗ # %". + by iFrame "∗ #". + } + iApply ("HΦ" $! GPPQuery). + iFrame "Hfrespm Hvdm ∗ # %". + by iFrame "∗ #". + } + + (*@ // Backup coordinator exists, just wait for the result. @*) + (*@ if gpp.phase == GPP_WAITING { @*) + (*@ return GPP_QUERY @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__in _ GPPWaiting with "Hgpp"). + iIntros (waiting) "Hgpp". + destruct waiting; wp_pures. + { iApply ("HΦ" $! GPPQuery). by iFrame. } + + (*@ // The transaction has either prepared, committed, or aborted. @*) + (*@ return GPP_REFRESH @*) + (*@ } @*) + iApply ("HΦ" $! GPPRefresh). by iFrame. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_collect_fast_decision.v b/src/program_proof/tulip/program/gcoord/gpreparer_collect_fast_decision.v new file mode 100644 index 000000000..c28f1617b --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_collect_fast_decision.v @@ -0,0 +1,38 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gpreparer_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__collectFastDecision + (gpp : loc) (rid : u64) (b : bool) ts gid γ : + rid ∈ rids_all -> + is_replica_pdec_at_rank γ gid rid ts O b -∗ + (if b then is_replica_validated_ts γ gid rid ts else True) -∗ + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__collectFastDecision #gpp #rid #b + {{{ RET #(); own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Hrid) "#Hpdec #Hvd". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) collectFastDecision(rid uint64, b bool) { @*) + (*@ gpp.frespm[rid] = b @*) + (*@ } @*) + do 2 iNamed "Hgpp". iNamed "Hfrespm". + wp_loadField. + wp_apply (wp_MapInsert with "Hfrespm"); first done. + iIntros "Hfrespm". + wp_pures. + iApply "HΦ". + iFrame "∗ # %". + iModIntro. + iSplit. + { iApply (big_sepM_insert_2 with "[] Hfast"). iFrame "#". } + iPureIntro. + rewrite dom_insert_L. + set_solver. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_collect_validation.v b/src/program_proof/tulip/program/gcoord/gpreparer_collect_validation.v new file mode 100644 index 000000000..9dfed93c3 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_collect_validation.v @@ -0,0 +1,38 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gpreparer_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__collectValidation (gpp : loc) (rid : u64) phase ts gid γ : + rid ∈ rids_all -> + is_replica_validated_ts γ gid rid ts -∗ + {{{ own_gpreparer_with_phase gpp phase ts gid γ }}} + GroupPreparer__collectValidation #gpp #rid + {{{ RET #(); own_gpreparer_with_phase gpp phase ts gid γ }}}. + Proof. + iIntros (Hrid) "#Hvd". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) collectValidation(rid uint64) { @*) + (*@ gpp.vdm[rid] = true @*) + (*@ } @*) + iNamed "Hgpp". iNamed "Hvdm". + wp_loadField. + wp_apply (wp_MapInsert with "Hvdm"); first done. + iIntros "Hvdm". + wp_pures. + iApply "HΦ". + iFrame "Hfrespm ∗ # %". + iModIntro. + iSplit. + { rewrite /validation_responses dom_insert_L. + by iApply (big_sepS_insert_2 with "[] Hvalidation"). + } + iPureIntro. + rewrite dom_insert_L. + set_solver. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_cquorum.v b/src/program_proof/tulip/program/gcoord/gpreparer_cquorum.v new file mode 100644 index 000000000..a523f17ce --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_cquorum.v @@ -0,0 +1,33 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program Require Import quorum. +From Perennial.program_proof.tulip.program.gcoord Require Import gpreparer_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__cquorum (gpp : loc) (n : u64) : + {{{ own_gpreparer_nrps gpp }}} + GroupPreparer__cquorum #gpp #n + {{{ RET #(bool_decide (size rids_all / 2 < uint.Z n)); own_gpreparer_nrps gpp }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) cquorum(n uint64) bool { @*) + (*@ return quorum.ClassicQuorum(gpp.nrps) <= n @*) + (*@ } @*) + iNamed "Hgpp". + wp_loadField. + wp_apply wp_ClassicQuorum. + iIntros (x Hx). + wp_pures. + case_bool_decide as Hc1. + { case_bool_decide as Hc2; last word. + iApply "HΦ". by iFrame "∗ %". + } + { case_bool_decide as Hc2; first word. + iApply "HΦ". by iFrame "∗ %". + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_fquorum.v b/src/program_proof/tulip/program/gcoord/gpreparer_fquorum.v new file mode 100644 index 000000000..d76921aee --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_fquorum.v @@ -0,0 +1,42 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program Require Import quorum. +From Perennial.program_proof.tulip.program.gcoord Require Import gpreparer_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__fquorum (gpp : loc) (n : u64) : + {{{ own_gpreparer_nrps gpp }}} + GroupPreparer__fquorum #gpp #n + {{{ RET #(bool_decide (((3 * size rids_all + 3) / 4 ≤ uint.Z n) ∧ size rids_all ≠ O)); + own_gpreparer_nrps gpp + }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) fquorum(n uint64) bool { @*) + (*@ return quorum.FastQuorum(gpp.nrps) <= n @*) + (*@ } @*) + iNamed "Hgpp". + wp_loadField. + wp_apply wp_FastQuorum. + { rewrite size_rids_all in Hnrps. word. } + iIntros (x Hx). + wp_pures. + case_bool_decide as Hc1. + { case_bool_decide as Hc2; last word. + iApply "HΦ". by iFrame "∗ %". + } + { case_bool_decide as Hc2. + { exfalso. + apply Classical_Prop.not_and_or in Hc1. + destruct Hc1 as [Hc1 | Hz]; last first. + { rewrite size_rids_all in Hz. lia. } + word. + } + iApply "HΦ". by iFrame "∗ %". + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_get_phase.v b/src/program_proof/tulip/program/gcoord/gpreparer_get_phase.v new file mode 100644 index 000000000..b6d23b6b4 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_get_phase.v @@ -0,0 +1,28 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gpreparer_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__getPhase (gpp : loc) phase ts gid γ : + {{{ own_gpreparer_with_phase gpp phase ts gid γ }}} + GroupPreparer__getPhase #gpp + {{{ RET #(gppphase_to_u64 phase); + own_gpreparer_with_phase gpp phase ts gid γ ∗ + safe_gpreparer_phase γ ts gid phase + }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) getPhase() uint64 { @*) + (*@ return gpp.phase @*) + (*@ } @*) + iNamed "Hgpp". iNamed "Hphase". + wp_loadField. + rewrite Hphase. + iApply "HΦ". + by iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_hcquorum.v b/src/program_proof/tulip/program/gcoord/gpreparer_hcquorum.v new file mode 100644 index 000000000..71cd9633b --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_hcquorum.v @@ -0,0 +1,40 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program Require Import quorum. +From Perennial.program_proof.tulip.program.gcoord Require Import gpreparer_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__hcquorum (gpp : loc) (n : u64) : + {{{ own_gpreparer_nrps gpp }}} + GroupPreparer__hcquorum #gpp #n + {{{ RET #(bool_decide (size rids_all / 4 + 1 ≤ uint.Z n)); + own_gpreparer_nrps gpp + }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) hcquorum(n uint64) bool { @*) + (*@ return quorum.Half(quorum.ClassicQuorum(gpp.nrps)) <= n @*) + (*@ } @*) + iNamed "Hgpp". + wp_loadField. + wp_apply wp_ClassicQuorum. + iIntros (x Hx). + wp_apply wp_Half. + { clear -Hx. word. } + iIntros (y Hy). + wp_pures. + case_bool_decide as Hc1. + { case_bool_decide as Hc2; last first. + { exfalso. clear -Hnrps Hx Hy Hc1 Hc2. word. } + iApply "HΦ". by iFrame "∗ %". + } + { case_bool_decide as Hc2. + { exfalso. clear -Hnrps Hx Hy Hc1 Hc2. word. } + iApply "HΦ". by iFrame "∗ %". + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_in.v b/src/program_proof/tulip/program/gcoord/gpreparer_in.v new file mode 100644 index 000000000..b2183b706 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_in.v @@ -0,0 +1,33 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gpreparer_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__in (gpp : loc) (phase : gppphase) ts gid γ : + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__in #gpp #(gppphase_to_u64 phase) + {{{ (ok : bool), RET #ok; + if ok + then own_gpreparer_with_phase gpp phase ts gid γ + else own_gpreparer gpp ts gid γ + }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) in(phase uint64) bool { @*) + (*@ return gpp.phase == phase @*) + (*@ } @*) + rename phase into phasearg. + do 2 iNamed "Hgpp". iNamed "Hphase". + wp_loadField. + wp_pures. + iApply "HΦ". + case_bool_decide as Hok; last first. + { by iFrame "∗ # %". } + symmetry in Hok. inv Hok. + by iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_process_fast_prepare_result.v b/src/program_proof/tulip/program/gcoord/gpreparer_process_fast_prepare_result.v new file mode 100644 index 000000000..03a153b7a --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_process_fast_prepare_result.v @@ -0,0 +1,123 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_try_resign gpreparer_collect_fast_decision + gpreparer_try_fast_abort gpreparer_try_become_preparing + gpreparer_try_become_unpreparing gpreparer_try_fast_prepare + gpreparer_collect_validation gpreparer_in. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__processFastPrepareResult + (gpp : loc) (rid : u64) (res : rpres) ts gid γ : + gid ∈ gids_all -> + rid ∈ rids_all -> + fast_prepare_outcome γ gid rid ts res -∗ + know_tulip_inv γ -∗ + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__processFastPrepareResult #gpp #rid #(rpres_to_u64 res) + {{{ RET #(); own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Hgid Hrid) "#Hfp #Hinv". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) processFastPrepareResult(rid uint64, res uint64) { @*) + (*@ // Result is ready or a backup coordinator has become live. @*) + (*@ if gpp.tryResign(res) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). + { by destruct res. } + iIntros (resigned) "[Hgpp %Hresigned]". + destruct resigned; wp_pures. + { by iApply "HΦ". } + + (*@ // Fast-prepare fails; fast abort if possible. @*) + (*@ if res == tulip.REPLICA_FAILED_VALIDATION { @*) + (*@ gpp.collectFastDecision(rid, false) @*) + (*@ @*) + case_bool_decide as Hres; wp_pures. + { destruct res; try done. simpl. + wp_apply (wp_GroupPreparer__collectFastDecision with "Hfp [] Hgpp"). + { apply Hrid. } + { done. } + iIntros "Hgpp". + + (*@ aborted := gpp.tryFastAbort() @*) + (*@ if aborted { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__tryFastAbort with "Hgpp"). + iIntros (aborted) "Hgpp". + wp_pures. + destruct aborted; wp_pures. + { by iApply "HΦ". } + + (*@ if !gpp.in(GPP_VALIDATING) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__in _ GPPValidating with "Hgpp"). + iIntros (validating) "Hgpp". + destruct validating; wp_pures; last first. + { by iApply "HΦ". } + + (*@ gpp.tryBecomeUnpreparing() @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__tryBecomeUnpreparing with "Hinv Hgpp"). + { apply Hgid. } + iIntros "Hgpp". + wp_pures. + iApply "HΦ". + by iFrame. + } + (* Prove [res = ReplicaOK]. *) + destruct res; try done. + + (*@ // Fast-prepare succeeds; fast prepare if possible. @*) + (*@ gpp.collectFastDecision(rid, true) @*) + (*@ if gpp.tryFastPrepare() { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + iDestruct "Hfp" as "[Hvd Hpdec]". + wp_apply (wp_GroupPreparer__collectFastDecision with "Hpdec Hvd Hgpp"). + { apply Hrid. } + iIntros "Hgpp". + wp_apply (wp_GroupPreparer__tryFastPrepare with "Hgpp"). + iIntros (prepared) "Hgpp". + destruct prepared; wp_pures. + { by iApply "HΦ". } + + (*@ // Ignore the result if it's not in the validating phase. At this point, the @*) + (*@ // other possible phases are preparing and unpreparing. @*) + (*@ if !gpp.in(GPP_VALIDATING) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__in _ GPPValidating with "Hgpp"). + iIntros (validating) "Hgpp". + destruct validating; wp_pures; last first. + { by iApply "HΦ". } + + (*@ // Record success of validation and try to move to the preparing phase. @*) + (*@ gpp.collectValidation(rid) @*) + (*@ gpp.tryBecomePreparing() @*) + (*@ } @*) + wp_apply (wp_GroupPreparer__collectValidation with "Hvd Hgpp"). + { apply Hrid. } + iIntros "Hgpp". + wp_apply (wp_GroupPreparer__tryBecomePreparing with "Hinv Hgpp"). + { apply Hgid. } + iIntros "Hgpp". + wp_pures. + iApply "HΦ". + by iFrame. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_process_prepare_result.v b/src/program_proof/tulip/program/gcoord/gpreparer_process_prepare_result.v new file mode 100644 index 000000000..b977c65bb --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_process_prepare_result.v @@ -0,0 +1,130 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_try_resign gpreparer_in gpreparer_cquorum. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__processPrepareResult + (gpp : loc) (rid : u64) (res : rpres) ts gid γ : + rid ∈ rids_all -> + accept_outcome γ gid rid ts 1%nat true res -∗ + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__processPrepareResult #gpp #rid #(rpres_to_u64 res) + {{{ RET #(); own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Hrid) "#Hvd". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) processPrepareResult(rid uint64, res uint64) { @*) + (*@ // Result is ready or a backup coordinator has become live. @*) + (*@ if gpp.tryResign(res) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). + { by destruct res. } + iIntros (resigned) "[Hgpp %Hresigned]". + destruct resigned; wp_pures. + { by iApply "HΦ". } + (* Prove [res = ReplicaOK]. *) + destruct res; try done. simpl. + + (*@ // We might be able to prove this without an additional check. @*) + (*@ if !gpp.in(GPP_PREPARING) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__in _ GPPPreparing with "Hgpp"). + iIntros (preparing) "Hgpp". + destruct preparing; wp_pures; last first. + { by iApply "HΦ". } + + (*@ // Record success of preparing the replica and try to move to prepared. @*) + (*@ gpp.srespm[rid] = true @*) + (*@ @*) + iNamed "Hgpp". iNamed "Hsrespm". + wp_loadField. + wp_apply (wp_MapInsert with "Hsrespm"); first done. + iIntros "Hsrespm". + + (*@ // Count how many replicas have prepared. @*) + (*@ n := uint64(len(gpp.srespm)) @*) + (*@ @*) + wp_loadField. + wp_apply (wp_MapLen with "Hsrespm"). + iIntros "[%Hn Hsrespm]". + wp_pures. + + (*@ // Go to prepared phase if successful prepares reaches a classic quorum. @*) + (*@ if gpp.cquorum(n) { @*) + (*@ gpp.phase = GPP_PREPARED @*) + (*@ } @*) + (*@ } @*) + wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hq; wp_pures. + { iNamed "Hphase". + wp_storeField. + iApply "HΦ". + iAssert (own_gpreparer_phase gpp GPPPrepared)%I with "[HphaseP]" as "Hphase". + { by iFrame. } + simpl. + iDestruct (big_sepS_insert_2 rid with "[] Hslow") as "Hslow'". + { iFrame "Hvd". } + iAssert (own_gpreparer_srespm gpp GPPPrepared ts gid γ)%I + with "[HsrespmP Hsrespm]" as "Hsrespm". + { iFrame. simpl. + iExists ∅. (* just a placeholder *) + do 2 (iSplit; first done). + iPureIntro. + (* rewrite dom_insert_L. *) + clear -Hrid Hsincl. set_solver. + } + iModIntro. + iFrame "∗ # %". + simpl. + iDestruct "Hsafe" as "[Hqv _]". + iFrame "Hqv". + iExists 1%nat. + rewrite /quorum_pdec_at_rank /=. + set ridsq := _ ∪ _. + iExists ridsq. + iSplit; first done. + iPureIntro. + split. + { clear-Hsincl Hrid. set_solver. } + { rewrite /cquorum_size. + destruct (decide (rid ∈ dom srespm)) as [Hin | Hnotin]. + { assert (ridsq = dom srespm) as -> by set_solver. + rewrite size_dom. + apply elem_of_dom in Hin. + rewrite map_size_insert_Some in Hn Hq; last apply Hin. + clear -Hn Hq. word. + } + subst ridsq. + rewrite size_union; last set_solver. + rewrite size_singleton size_dom. + apply not_elem_of_dom in Hnotin. + rewrite map_size_insert_None in Hn Hq; last apply Hnotin. + clear -Hn Hq. word. + } + } + iApply "HΦ". + iAssert (own_gpreparer_srespm gpp GPPPreparing ts gid γ)%I + with "[HsrespmP Hsrespm]" as "Hsrespm". + { iFrame. simpl. + iSplit. + { rewrite dom_insert_L. + iApply (big_sepS_insert_2 with "[] Hslow"). + iFrame "Hvd". + } + iPureIntro. + rewrite dom_insert_L. + clear -Hrid Hsincl. set_solver. + } + by iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_process_query_result.v b/src/program_proof/tulip/program/gcoord/gpreparer_process_query_result.v new file mode 100644 index 000000000..705eff9f3 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_process_query_result.v @@ -0,0 +1,31 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_try_resign. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__processQueryResult + (gpp : loc) (rid : u64) (res : rpres) ts gid γ : + rid ∈ rids_all -> + query_outcome γ ts res -∗ + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__processQueryResult #gpp #rid #(rpres_to_u64 res) + {{{ RET #(); own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Hrid) "#Hquery". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) processQueryResult(rid uint64, res uint64) { @*) + (*@ // Result is ready or a backup coordinator has become live. @*) + (*@ gpp.tryResign(res) @*) + (*@ } @*) + wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). + { by destruct res. } + iIntros (resigned) "[Hgpp %Hresigned]". + wp_pures. + by iApply "HΦ". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_process_unprepare_result.v b/src/program_proof/tulip/program/gcoord/gpreparer_process_unprepare_result.v new file mode 100644 index 000000000..e54f2225e --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_process_unprepare_result.v @@ -0,0 +1,128 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_try_resign gpreparer_in gpreparer_cquorum. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__processUnprepareResult + (gpp : loc) (rid : u64) (res : rpres) ts gid γ : + rid ∈ rids_all -> + accept_outcome γ gid rid ts 1%nat false res -∗ + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__processUnprepareResult #gpp #rid #(rpres_to_u64 res) + {{{ RET #(); own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Hrid) "#Hvd". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) processUnprepareResult(rid uint64, res uint64) { @*) + (*@ // Result is ready or a backup coordinator has become live. @*) + (*@ if gpp.tryResign(res) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). + { by destruct res. } + iIntros (resigned) "[Hgpp %Hresigned]". + destruct resigned; wp_pures. + { by iApply "HΦ". } + (* Prove [res = ReplicaOK]. *) + destruct res; try done. simpl. + + (*@ // We might be able to prove this without an additional check. @*) + (*@ if !gpp.in(GPP_UNPREPARING) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__in _ GPPUnpreparing with "Hgpp"). + iIntros (unpreparing) "Hgpp". + destruct unpreparing; wp_pures; last first. + { by iApply "HΦ". } + + (*@ // Record success of unpreparing the replica and try to move to aborted. @*) + (*@ gpp.srespm[rid] = true @*) + (*@ @*) + iNamed "Hgpp". iNamed "Hsrespm". + wp_loadField. + wp_apply (wp_MapInsert with "Hsrespm"); first done. + iIntros "Hsrespm". + + (*@ // Count how many replicas have unprepared. @*) + (*@ n := uint64(len(gpp.srespm)) @*) + (*@ @*) + wp_loadField. + wp_apply (wp_MapLen with "Hsrespm"). + iIntros "[%Hn Hsrespm]". + wp_pures. + + (*@ // Go to aborted phase if successful unprepares reaches a classic quorum. @*) + (*@ if gpp.cquorum(n) { @*) + (*@ gpp.phase = GPP_ABORTED @*) + (*@ } @*) + (*@ } @*) + wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hq; wp_pures. + { iNamed "Hphase". + wp_storeField. + iApply "HΦ". + iAssert (own_gpreparer_phase gpp GPPAborted)%I with "[HphaseP]" as "Hphase". + { by iFrame. } + simpl. + iDestruct (big_sepS_insert_2 rid with "[] Hslow") as "Hslow'". + { iFrame "Hvd". } + iAssert (own_gpreparer_srespm gpp GPPAborted ts gid γ)%I + with "[HsrespmP Hsrespm]" as "Hsrespm". + { iFrame. simpl. + iExists ∅. (* just a placeholder *) + do 2 (iSplit; first done). + iPureIntro. + (* rewrite dom_insert_L. *) + clear -Hrid Hsincl. set_solver. + } + iModIntro. + iFrame "∗ # %". + iRight. + iExists 1%nat. + rewrite /quorum_pdec_at_rank /=. + set ridsq := _ ∪ _. + iExists ridsq. + iSplit; first done. + iPureIntro. + split. + { clear-Hsincl Hrid. set_solver. } + { rewrite /cquorum_size. + destruct (decide (rid ∈ dom srespm)) as [Hin | Hnotin]. + { assert (ridsq = dom srespm) as -> by set_solver. + rewrite size_dom. + apply elem_of_dom in Hin. + rewrite map_size_insert_Some in Hn Hq; last apply Hin. + clear -Hn Hq. word. + } + subst ridsq. + rewrite size_union; last set_solver. + rewrite size_singleton size_dom. + apply not_elem_of_dom in Hnotin. + rewrite map_size_insert_None in Hn Hq; last apply Hnotin. + clear -Hn Hq. word. + } + } + iApply "HΦ". + iAssert (own_gpreparer_srespm gpp GPPUnpreparing ts gid γ)%I + with "[HsrespmP Hsrespm]" as "Hsrespm". + { iFrame. simpl. + iSplit. + { rewrite dom_insert_L. + iApply (big_sepS_insert_2 with "[] Hslow"). + iFrame "Hvd". + } + iPureIntro. + rewrite dom_insert_L. + clear -Hrid Hsincl. set_solver. + } + by iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_process_validate_result.v b/src/program_proof/tulip/program/gcoord/gpreparer_process_validate_result.v new file mode 100644 index 000000000..d0be2b8c4 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_process_validate_result.v @@ -0,0 +1,71 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_try_resign gpreparer_in + gpreparer_collect_validation gpreparer_try_become_preparing. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__processValidateResult + (gpp : loc) (rid : u64) (res : rpres) ts gid γ : + gid ∈ gids_all -> + rid ∈ rids_all -> + validate_outcome γ gid rid ts res -∗ + know_tulip_inv γ -∗ + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__processValidateResult #gpp #rid #(rpres_to_u64 res) + {{{ RET #(); own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Hgid Hrid) "#Hvd #Hinv". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) processValidateResult(rid uint64, res uint64) { @*) + (*@ // Result is ready or a backup coordinator has become live. @*) + (*@ if gpp.tryResign(res) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). + { by destruct res. } + iIntros (resigned) "[Hgpp %Hresigned]". + destruct resigned; wp_pures. + { by iApply "HΦ". } + + (*@ // Validation fails; nothing to record. @*) + (*@ if res == tulip.REPLICA_FAILED_VALIDATION { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + case_bool_decide as Hres; wp_pures. + { by iApply "HΦ". } + (* Prove [res = ReplicaOK]. *) + destruct res; try done. + + (*@ // Skip if the coordiantor is not in the validating phase. At this point, @*) + (*@ // the other possible phases are preparing and unpreparing. @*) + (*@ if !gpp.in(GPP_VALIDATING) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_GroupPreparer__in _ GPPValidating with "Hgpp"). + iIntros (validating) "Hgpp". + destruct validating; wp_pures; last first. + { by iApply "HΦ". } + + (*@ // Record success of validation and try to move to the preparing phase. @*) + (*@ gpp.collectValidation(rid) @*) + (*@ gpp.tryBecomePreparing() @*) + (*@ } @*) + wp_apply (wp_GroupPreparer__collectValidation with "Hvd Hgpp"). + { apply Hrid. } + iIntros "Hgpp". + wp_apply (wp_GroupPreparer__tryBecomePreparing with "Hinv Hgpp"). + { apply Hgid. } + iIntros "Hgpp". + wp_pures. + iApply "HΦ". + by iFrame. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_ready.v b/src/program_proof/tulip/program/gcoord/gpreparer_ready.v new file mode 100644 index 000000000..a6324dc6b --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_ready.v @@ -0,0 +1,48 @@ +From Perennial.program_proof.tulip.invariance Require Import propose. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import gpreparer_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__ready (gpp : loc) phase : + {{{ own_gpreparer_phase gpp phase }}} + GroupPreparer__ready #gpp + {{{ RET #(bool_decide (gpp_ready phase)); own_gpreparer_phase gpp phase }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) ready() bool { @*) + (*@ return GPP_PREPARED <= gpp.phase @*) + (*@ } @*) + iNamed "Hgpp". + wp_loadField. + wp_pures. + rewrite /gppphase_to_u64 in Hphase. + rewrite /gpp_ready. + case_bool_decide as Hcond. + { case_bool_decide as Hret. + { iApply "HΦ". by iFrame. } + destruct phase; word. + } + { case_bool_decide as Hret; last first. + { iApply "HΦ". by iFrame. } + destruct phase; word. + } + Qed. + + Theorem wp_GroupPreparer__ready_external (gpp : loc) phase ts gid γ : + {{{ own_gpreparer_with_phase gpp phase ts gid γ }}} + GroupPreparer__ready #gpp + {{{ RET #(bool_decide (gpp_ready phase)); own_gpreparer_with_phase gpp phase ts gid γ }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + iNamed "Hgpp". + wp_apply (wp_GroupPreparer__ready with "Hphase"). + iIntros "Hphase". + iApply "HΦ". + by iFrame "∗ #". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_repr.v b/src/program_proof/tulip/program/gcoord/gpreparer_repr.v new file mode 100644 index 000000000..47dbe59ea --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_repr.v @@ -0,0 +1,200 @@ +From Perennial.program_proof.tulip.program Require Import prelude. + +Inductive gppphase := +| GPPValidating +| GPPPreparing +| GPPUnpreparing +| GPPWaiting +| GPPPrepared +| GPPCommitted +| GPPAborted. + +Definition gppphase_to_u64 phase := + match phase with + | GPPValidating => (W64 0) + | GPPPreparing => (W64 1) + | GPPUnpreparing => (W64 2) + | GPPWaiting => (W64 3) + | GPPPrepared => (W64 4) + | GPPCommitted => (W64 5) + | GPPAborted => (W64 6) + end. + +#[global] +Instance gppphase_to_u64_inj : + Inj eq eq gppphase_to_u64. +Proof. intros x y H. by destruct x, y. Defined. + +Inductive gppaction := +| GPPFastPrepare +| GPPValidate +| GPPPrepare +| GPPUnprepare +| GPPQuery +| GPPRefresh. + +Definition gppaction_to_u64 action := + match action with + | GPPFastPrepare => (W64 0) + | GPPValidate => (W64 1) + | GPPPrepare => (W64 2) + | GPPUnprepare => (W64 3) + | GPPQuery => (W64 4) + | GPPRefresh => (W64 5) + end. + +#[global] +Instance gppaction_to_u64_inj : + Inj eq eq gppaction_to_u64. +Proof. intros x y H. by destruct x, y. Defined. + +Definition gpp_ready phase := + match phase with + | GPPValidating => False + | GPPPreparing => False + | GPPUnpreparing => False + | GPPWaiting => False + | GPPPrepared => True + | GPPCommitted => True + | GPPAborted => True + end. + +#[global] +Instance gpp_ready_decision phase : + Decision (gpp_ready phase). +Proof. destruct phase; apply _. Defined. + +Section repr. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + (*@ type GroupPreparer struct { @*) + (*@ // Number of replicas. Read-only. @*) + (*@ nrps uint64 @*) + (*@ // Control phase. @*) + (*@ phase uint64 @*) + (*@ // Fast-path replica responses. @*) + (*@ frespm map[uint64]bool @*) + (*@ // Replicas validated. @*) + (*@ vdm map[uint64]bool @*) + (*@ // Slow-path replica responses. @*) + (*@ // NB: The range doesn't need to be bool, unit would suffice. @*) + (*@ srespm map[uint64]bool @*) + (*@ // @*) + (*@ // TODO: Merge @validated and @sresps @*) + (*@ // @phase = VALIDATING => records whether a certain replica is validated; @*) + (*@ // @phase = PREPARING / UNPREPARING => records prepared/unprepared. @*) + (*@ // @*) + (*@ } @*) + Definition own_gpreparer_nrps (gpp : loc) : iProp Σ := + ∃ (nrps : u64), + "Hnrps" ∷ gpp ↦[GroupPreparer :: "nrps"] #nrps ∗ + "%Hnrps" ∷ ⌜uint.nat nrps = size rids_all⌝. + + Definition own_gpreparer_phase (gpp : loc) (phase : gppphase) : iProp Σ := + ∃ (phaseW : u64), + "HphaseP" ∷ gpp ↦[GroupPreparer :: "phase"] #phaseW ∗ + "%Hphase" ∷ ⌜gppphase_to_u64 phase = phaseW⌝. + + Definition fast_prepare_responses γ ts gid (frespm : gmap u64 bool) : iProp Σ := + [∗ map] rid ↦ p ∈ frespm, + is_replica_pdec_at_rank γ gid rid ts O p ∗ + (if p then is_replica_validated_ts γ gid rid ts else True). + + Definition validation_responses γ ts gid (vdm : gmap u64 bool) : iProp Σ := + ([∗ set] rid ∈ dom vdm, is_replica_validated_ts γ gid rid ts). + + Definition slow_prepare_responses γ ts gid phase (srespm : gmap u64 bool) : iProp Σ := + match phase with + | GPPValidating => True + | GPPPreparing => + ([∗ set] rid ∈ dom srespm, is_replica_pdec_at_rank γ gid rid ts 1%nat true) + | GPPUnpreparing => + ([∗ set] rid ∈ dom srespm, is_replica_pdec_at_rank γ gid rid ts 1%nat false) + | GPPWaiting => True + | GPPPrepared => True + | GPPCommitted => True + | GPPAborted => True + end. + + #[global] + Instance slow_prepare_responses_persistent γ ts gid phase srespm : + Persistent (slow_prepare_responses γ ts gid phase srespm). + Proof. destruct phase; apply _. Defined. + + Definition safe_gpreparer_phase γ ts gid phase : iProp Σ := + match phase with + | GPPValidating => True + | GPPPreparing => + quorum_validated γ gid ts ∗ is_group_prepare_proposal γ gid ts 1%nat true + | GPPUnpreparing => is_group_prepare_proposal γ gid ts 1%nat false + | GPPWaiting => True + | GPPPrepared => + quorum_prepared γ gid ts ∗ quorum_validated γ gid ts + | GPPCommitted => ∃ wrs, is_txn_committed γ ts wrs + | GPPAborted => is_txn_aborted γ ts ∨ quorum_unprepared γ gid ts + end. + + #[global] + Instance safe_gpreparer_phase_persistent γ ts gid phase : + Persistent (safe_gpreparer_phase γ ts gid phase). + Proof. destruct phase; apply _. Defined. + + Definition slow_path_permission γ ts gid phase : iProp Σ := + match phase with + | GPPValidating => own_txn_client_token γ ts gid + | GPPPreparing => True + | GPPUnpreparing => True + | GPPWaiting => True + | GPPPrepared => True + | GPPCommitted => True + | GPPAborted => True + end. + + Definition own_gpreparer_frespm (gpp : loc) ts gid γ : iProp Σ := + ∃ (frespmP : loc) (frespm : gmap u64 bool), + "HfrespmP" ∷ gpp ↦[GroupPreparer :: "frespm"] #frespmP ∗ + "Hfrespm" ∷ own_map frespmP (DfracOwn 1) frespm ∗ + "#Hfast" ∷ fast_prepare_responses γ ts gid frespm ∗ + "%Hfincl" ∷ ⌜dom frespm ⊆ rids_all⌝. + + Definition own_gpreparer_vdm (gpp : loc) ts gid γ : iProp Σ := + ∃ (vdmP : loc) (vdm : gmap u64 bool), + "HvdmP" ∷ gpp ↦[GroupPreparer :: "vdm"] #vdmP ∗ + "Hvdm" ∷ own_map vdmP (DfracOwn 1) vdm ∗ + "#Hvalidation" ∷ validation_responses γ ts gid vdm ∗ + "%Hvincl" ∷ ⌜dom vdm ⊆ rids_all⌝. + + Definition own_srespm_map_conditional + phase srespmP (srespm : gmap u64 bool) : iProp Σ := + match phase with + | GPPValidating => True + | GPPPreparing => own_map srespmP (DfracOwn 1) srespm + | GPPUnpreparing => own_map srespmP (DfracOwn 1) srespm + | GPPWaiting => True + | GPPPrepared => True + | GPPCommitted => True + | GPPAborted => True + end. + + Definition own_gpreparer_srespm (gpp : loc) (phase : gppphase) ts gid γ : iProp Σ := + ∃ (srespmP : loc) (srespm : gmap u64 bool), + "HsrespmP" ∷ gpp ↦[GroupPreparer :: "srespm"] #srespmP ∗ + "Hsrespm" ∷ own_srespm_map_conditional phase srespmP srespm ∗ + "#Hslow" ∷ slow_prepare_responses γ ts gid phase srespm ∗ + "%Hsincl" ∷ ⌜dom srespm ⊆ rids_all⌝. + + Definition own_gpreparer_with_phase + (gpp : loc) (phase : gppphase) ts gid γ : iProp Σ := + "Hnrps" ∷ own_gpreparer_nrps gpp ∗ + "Hphase" ∷ own_gpreparer_phase gpp phase ∗ + "Hfrespm" ∷ own_gpreparer_frespm gpp ts gid γ ∗ + "Hvdm" ∷ own_gpreparer_vdm gpp ts gid γ ∗ + "Hsrespm" ∷ own_gpreparer_srespm gpp phase ts gid γ ∗ + "Htxncli" ∷ slow_path_permission γ ts gid phase ∗ + "#Hsafe" ∷ safe_gpreparer_phase γ ts gid phase. + + Definition own_gpreparer (gpp : loc) ts gid γ : iProp Σ := + ∃ (phase : gppphase), + "Hgpp" ∷ own_gpreparer_with_phase gpp phase ts gid γ. + +End repr. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_try_become_preparing.v b/src/program_proof/tulip/program/gcoord/gpreparer_try_become_preparing.v new file mode 100644 index 000000000..178caf790 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_try_become_preparing.v @@ -0,0 +1,170 @@ +From Perennial.program_proof.tulip.invariance Require Import propose. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.util Require Import count_bool_map. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_cquorum gpreparer_hcquorum. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__tryBecomePreparing (gpp : loc) ts gid γ : + gid ∈ gids_all -> + know_tulip_inv γ -∗ + {{{ own_gpreparer_with_phase gpp GPPValidating ts gid γ }}} + GroupPreparer__tryBecomePreparing #gpp + {{{ RET #(); own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Hgid) "#Hinv". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) tryBecomePreparing() { @*) + (*@ // Count how many replicas have validated. @*) + (*@ nvd := uint64(len(gpp.vdm)) @*) + (*@ if !gpp.cquorum(nvd) { @*) + (*@ // Cannot move to the PREPARING phase unless some classic quorum of @*) + (*@ // replicas successfully validate. @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + iNamed "Hgpp". iNamed "Hvdm". + wp_loadField. + wp_apply (wp_MapLen with "Hvdm"). + iIntros "[%Hnvdmnoof Hvdm]". + iAssert (own_gpreparer_vdm gpp ts gid γ)%I with "[HvdmP Hvdm]" as "Hvdm". + { iFrame "∗ # %". } + wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hnvd; wp_pures; last first. + { iApply "HΦ". by iFrame "∗ #". } + + (*@ // Count how many replicas have responded in the fast path. @*) + (*@ nresp := uint64(len(gpp.frespm)) @*) + (*@ if !gpp.cquorum(nresp) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + iNamed "Hfrespm". + wp_loadField. + wp_apply (wp_MapLen with "Hfrespm"). + iIntros "[%Hnrespmnoof Hfrespm]". + wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hnresp; wp_pures; last first. + { iApply "HΦ". by iFrame "∗ # %". } + + (*@ // Count how many replicas have prepared. @*) + (*@ nfp := util.CountBoolMap(gpp.frespm, true) @*) + (*@ if !gpp.hcquorum(nfp) { @*) + (*@ // Cannot move to the PREPARING phase unless half (i.e., celing(n / 2)) @*) + (*@ // of replicas in some classic quorum agrees to prepare. @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_loadField. + wp_apply (wp_CountBoolMap with "Hfrespm"). + iIntros (nfp) "[Hfrespm %Hnfp]". + wp_apply (wp_GroupPreparer__hcquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hhcq; wp_pures; last first. + { iApply "HΦ". by iFrame "∗ # %". } + (* Prove [safe_proposal γ gid ts 1%nat true] to propose [true] at rank 1 for [ts]. *) + iAssert (safe_proposal γ gid ts 1%nat true)%I as "#Hsafepsl". + { simpl. + iDestruct (big_sepM_sep with "Hfast") as "[Hpdecx _]". + rewrite /is_replica_pdec_at_rank. + iDestruct (big_sepM_exists_sepM2 with "Hpdecx") as (bm) "Hpdecy". + iDestruct (big_sepM2_and with "Hpdecy") as "[Hpdec Hacpt]". + iDestruct (big_sepM2_pure with "Hacpt") as %[_ Hacpt]. + iDestruct (big_sepM2_dom with "Hpdec") as %Hdombm. + assert (Hcq : cquorum rids_all (dom bm)). + { rewrite -Hdombm. + split; first apply Hfincl. + rewrite /cquorum_size size_dom. + clear -Hnresp. word. + } + iExists bm. + set sc := size rids_all. + simpl. + assert (latest_before_quorum 1 bm = O) as ->. + { unshelve epose proof (latest_before_quorum_lt bm 1%nat _ _) as Hltone. + { rewrite -dom_empty_iff_L. by eapply cquorum_non_empty_q. } + { done. } + lia. + } + iSplit. + { iApply (big_sepM2_sepM_impl with "Hpdec"); first done. + iIntros (rid b l1 l2 Hb Hl1 Hl2) "!> #Hlb". + rewrite Hl1 in Hl2. by inv Hl2. + } + iSplit; first done. + iPureIntro. + split; first apply Hcq. + split. + { intros k l Hl. + assert (is_Some (frespm !! k)) as [b Hb]. + { by rewrite -elem_of_dom Hdombm elem_of_dom. } + specialize (Hacpt _ _ _ Hb Hl). + apply lookup_lt_Some in Hacpt. + clear -Hacpt. lia. + } + simpl. + assert (Heq : (uint.nat nfp ≤ nfast bm true)%nat). + { rewrite Hnfp /nfast -2!size_dom. + apply subseteq_size. + intros x Hx. + apply elem_of_dom in Hx as [b Hb]. + apply map_lookup_filter_Some in Hb as [Hb Heq]. + simpl in Heq. subst b. + assert (is_Some (bm !! x)) as [l Hl]. + { by rewrite -elem_of_dom -Hdombm elem_of_dom. } + specialize (Hacpt _ _ _ Hb Hl). + apply elem_of_dom. + exists l. + by apply map_lookup_filter_Some. + } + clear -Hhcq Heq. word. + } + + (*@ gpp.srespm = make(map[uint64]bool) @*) + (*@ gpp.phase = GPP_PREPARING @*) + (*@ @*) + iNamed "Hsrespm". + wp_apply wp_NewMap. + iClear "Hsrespm". + iIntros (srespmP') "Hsrespm". + wp_storeField. + iNamed "Hphase". + simpl. + wp_storeField. + iAssert (own_gpreparer_frespm gpp ts gid γ)%I + with "[HfrespmP Hfrespm]" as "Hfrespm". + { iFrame "∗ # %". } + iAssert (own_gpreparer_phase gpp GPPPreparing)%I + with "[HphaseP]" as "Hphase". + { by iFrame. } + iAssert (own_gpreparer_srespm gpp GPPPreparing ts gid γ)%I + with "[HsrespmP Hsrespm]" as "Hsrespm". + { iFrame. by rewrite /= dom_empty_L big_sepS_empty. } + + (*@ // Logical action: Propose. @*) + (*@ } @*) + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + simpl. + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". + { apply Hgid. } + iMod (group_inv_propose with "Hsafepsl [Htxncli] Hgroup") as "[Hgroup #Hppsl]". + { done. } + { by rewrite /exclusive_proposal /=. } + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iApply "HΦ". + iFrame "∗ #". + iPureIntro. + split; first apply Hvincl. + rewrite /cquorum_size size_dom. + clear -Hnvd. word. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_try_become_unpreparing.v b/src/program_proof/tulip/program/gcoord/gpreparer_try_become_unpreparing.v new file mode 100644 index 000000000..cf4ee9837 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_try_become_unpreparing.v @@ -0,0 +1,148 @@ +From Perennial.program_proof.tulip.invariance Require Import propose. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.util Require Import count_bool_map. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_cquorum gpreparer_hcquorum. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__tryBecomeUnpreparing (gpp : loc) ts gid γ : + gid ∈ gids_all -> + know_tulip_inv γ -∗ + {{{ own_gpreparer_with_phase gpp GPPValidating ts gid γ }}} + GroupPreparer__tryBecomeUnpreparing #gpp + {{{ RET #(); own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Hgid) "#Hinv". + iIntros (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) tryBecomeUnpreparing() { @*) + (*@ // Count how many replicas have responded in the fast path. @*) + (*@ nresp := uint64(len(gpp.frespm)) @*) + (*@ if !gpp.cquorum(nresp) { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + iNamed "Hgpp". + iNamed "Hfrespm". + wp_loadField. + wp_apply (wp_MapLen with "Hfrespm"). + iIntros "[%Hnrespmnoof Hfrespm]". + wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hnresp; wp_pures; last first. + { iApply "HΦ". by iFrame "∗ # %". } + + (*@ // Count how many replicas have unprepared. @*) + (*@ nfu := util.CountBoolMap(gpp.frespm, false) @*) + (*@ if !gpp.hcquorum(nfu) { @*) + (*@ // Cannot move to the UNPREPARING phase unless half of replicas in some @*) + (*@ // classic quorum agrees to unprepare. @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_loadField. + wp_apply (wp_CountBoolMap with "Hfrespm"). + iIntros (nfp) "[Hfrespm %Hnfp]". + wp_apply (wp_GroupPreparer__hcquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hhcq; wp_pures; last first. + { iApply "HΦ". by iFrame "∗ # %". } + (* Prove [safe_proposal γ gid ts 1%nat true] to propose [true] at rank 1 for [ts]. *) + iAssert (safe_proposal γ gid ts 1%nat false)%I as "#Hsafepsl". + { simpl. + iDestruct (big_sepM_sep with "Hfast") as "[Hpdecx _]". + rewrite /is_replica_pdec_at_rank. + iDestruct (big_sepM_exists_sepM2 with "Hpdecx") as (bm) "Hpdecy". + iDestruct (big_sepM2_and with "Hpdecy") as "[Hpdec Hacpt]". + iDestruct (big_sepM2_pure with "Hacpt") as %[_ Hacpt]. + iDestruct (big_sepM2_dom with "Hpdec") as %Hdombm. + assert (Hcq : cquorum rids_all (dom bm)). + { rewrite -Hdombm. + split; first apply Hfincl. + rewrite /cquorum_size size_dom. + clear -Hnresp. word. + } + iExists bm. + set sc := size rids_all. + simpl. + assert (latest_before_quorum 1 bm = O) as ->. + { unshelve epose proof (latest_before_quorum_lt bm 1%nat _ _) as Hltone. + { rewrite -dom_empty_iff_L. by eapply cquorum_non_empty_q. } + { done. } + lia. + } + iSplit. + { iApply (big_sepM2_sepM_impl with "Hpdec"); first done. + iIntros (rid b l1 l2 Hb Hl1 Hl2) "!> #Hlb". + rewrite Hl1 in Hl2. by inv Hl2. + } + iSplit; first done. + iPureIntro. + split; first apply Hcq. + split. + { intros k l Hl. + assert (is_Some (frespm !! k)) as [b Hb]. + { by rewrite -elem_of_dom Hdombm elem_of_dom. } + specialize (Hacpt _ _ _ Hb Hl). + apply lookup_lt_Some in Hacpt. + clear -Hacpt. lia. + } + simpl. + assert (Heq : (uint.nat nfp ≤ nfast bm false)%nat). + { rewrite Hnfp /nfast -2!size_dom. + apply subseteq_size. + intros x Hx. + apply elem_of_dom in Hx as [b Hb]. + apply map_lookup_filter_Some in Hb as [Hb Heq]. + simpl in Heq. subst b. + assert (is_Some (bm !! x)) as [l Hl]. + { by rewrite -elem_of_dom -Hdombm elem_of_dom. } + specialize (Hacpt _ _ _ Hb Hl). + apply elem_of_dom. + exists l. + by apply map_lookup_filter_Some. + } + clear -Hhcq Heq. word. + } + + (*@ gpp.srespm = make(map[uint64]bool) @*) + (*@ gpp.phase = GPP_UNPREPARING @*) + (*@ @*) + iNamed "Hsrespm". + wp_apply wp_NewMap. + iClear "Hsrespm". + iIntros (srespmP') "Hsrespm". + wp_storeField. + iNamed "Hphase". + simpl. + wp_storeField. + iAssert (own_gpreparer_frespm gpp ts gid γ)%I + with "[HfrespmP Hfrespm]" as "Hfrespm". + { iFrame "∗ # %". } + iAssert (own_gpreparer_phase gpp GPPUnpreparing)%I + with "[HphaseP]" as "Hphase". + { by iFrame. } + iAssert (own_gpreparer_srespm gpp GPPUnpreparing ts gid γ)%I + with "[HsrespmP Hsrespm]" as "Hsrespm". + { iFrame. by rewrite /= dom_empty_L big_sepS_empty. } + + (*@ // Logical action: Propose. @*) + (*@ } @*) + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + simpl. + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". + { apply Hgid. } + iMod (group_inv_propose with "Hsafepsl [Htxncli] Hgroup") as "[Hgroup #Hppsl]". + { done. } + { by rewrite /exclusive_proposal /=. } + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iApply "HΦ". + by iFrame "∗ #". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_try_fast_abort.v b/src/program_proof/tulip/program/gcoord/gpreparer_try_fast_abort.v new file mode 100644 index 000000000..d749290ef --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_try_fast_abort.v @@ -0,0 +1,78 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.util Require Import count_bool_map. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_fquorum. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__tryFastAbort (gpp : loc) ts gid γ : + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__tryFastAbort #gpp + {{{ (aborted : bool), RET #aborted; own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) tryFastAbort() bool { @*) + (*@ // Count how many replicas have fast unprepared. @*) + (*@ n := util.CountBoolMap(gpp.frespm, false) @*) + (*@ @*) + do 2 iNamed "Hgpp". iNamed "Hfrespm". + wp_loadField. + wp_apply (wp_CountBoolMap with "Hfrespm"). + iIntros (n) "[Hfrespm %Hn]". + iAssert (own_gpreparer_frespm gpp ts gid γ)%I + with "[HfrespmP Hfrespm]" as "Hfrespm". + { by iFrame "∗ # %". } + + (*@ // Move to the ABORTED phase if obtaining a fast quorum of fast unprepares. @*) + (*@ if gpp.fquorum(n) { @*) + (*@ gpp.phase = GPP_ABORTED @*) + (*@ return true @*) + (*@ } @*) + (*@ return false @*) + (*@ } @*) + wp_apply (wp_GroupPreparer__fquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hfq; wp_pures. + { iNamed "Hphase". + wp_storeField. + iApply "HΦ". + iModIntro. + iExists GPPAborted. + iFrame "∗ #". + iSplit; first done. + iSplitL "Hsrespm". + { iNamed "Hsrespm". by iFrame "∗ %". } + iSplit; first done. + iRight. + iExists O. + rewrite /quorum_pdec_at_rank. + case_decide; last done. + set frespmq := filter _ _ in Hn. + iExists (dom frespmq). + iSplit; last first. + { iPureIntro. + split. + { etrans; last apply Hfincl. apply dom_filter_subseteq. } + { destruct Hfq as [Hfq Hnz]. + split; last done. + rewrite size_dom. + clear -Hfq Hn. word. + } + } + rewrite /fast_prepare_responses. + iDestruct (big_sepM_subseteq _ _ frespmq with "Hfast") as "Hfastq". + { apply map_filter_subseteq. } + rewrite big_sepS_big_sepM. + iApply (big_sepM_mono with "Hfastq"). + iIntros (rid b Hb) "[Hpdec _]". + apply map_lookup_filter_Some in Hb as [_ Hb]. simpl in Hb. + by subst b. + } + iApply "HΦ". + by iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_try_fast_prepare.v b/src/program_proof/tulip/program/gcoord/gpreparer_try_fast_prepare.v new file mode 100644 index 000000000..691221120 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_try_fast_prepare.v @@ -0,0 +1,101 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.util Require Import count_bool_map. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_fquorum. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupPreparer__tryFastPrepare (gpp : loc) ts gid γ : + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__tryFastPrepare #gpp + {{{ (prepared : bool), RET #prepared; own_gpreparer gpp ts gid γ }}}. + Proof. + iIntros (Φ) "Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) tryFastPrepare() bool { @*) + (*@ // Count how many replicas have fast prepared. @*) + (*@ n := util.CountBoolMap(gpp.frespm, true) @*) + (*@ @*) + do 2 iNamed "Hgpp". iNamed "Hfrespm". + wp_loadField. + wp_apply (wp_CountBoolMap with "Hfrespm"). + iIntros (n) "[Hfrespm %Hn]". + iAssert (own_gpreparer_frespm gpp ts gid γ)%I + with "[HfrespmP Hfrespm]" as "Hfrespm". + { by iFrame "∗ # %". } + + (*@ // Move to the PREPARED phase if obtaining a fast quorum of fast prepares. @*) + (*@ if gpp.fquorum(n) { @*) + (*@ gpp.phase = GPP_PREPARED @*) + (*@ return true @*) + (*@ } @*) + (*@ return false @*) + (*@ } @*) + wp_apply (wp_GroupPreparer__fquorum with "Hnrps"). + iIntros "Hnrps". + case_bool_decide as Hfq; wp_pures. + { iNamed "Hphase". + wp_storeField. + iApply "HΦ". + iModIntro. + iExists GPPPrepared. + iFrame "∗ #". + iSplit; first done. + iSplitL "Hsrespm". + { iNamed "Hsrespm". by iFrame "∗ %". } + iSplit; first done. + set frespmq := filter _ _ in Hn. + iSplit. + { (* Prove [quorum_prepared]. *) + iExists O. + rewrite /quorum_pdec_at_rank. + case_decide; last done. + iExists (dom frespmq). + iSplit; last first. + { iPureIntro. + split. + { etrans; last apply Hfincl. apply dom_filter_subseteq. } + { destruct Hfq as [Hfq Hnz]. + split; last done. + rewrite size_dom. + clear -Hfq Hn. word. + } + } + rewrite /fast_prepare_responses. + iDestruct (big_sepM_subseteq _ _ frespmq with "Hfast") as "Hfastq". + { apply map_filter_subseteq. } + rewrite big_sepS_big_sepM. + iApply (big_sepM_mono with "Hfastq"). + iIntros (rid b Hb) "[Hpdec _]". + apply map_lookup_filter_Some in Hb as [_ Hb]. simpl in Hb. + by subst b. + } + { (* Prove [quorum_validated]. *) + iExists (dom frespmq). + iSplit; last first. + { iPureIntro. + split. + { etrans; last apply Hfincl. apply dom_filter_subseteq. } + { destruct Hfq as [Hfq Hnz]. + rewrite /cquorum_size size_dom. + clear -Hfq Hn Hnz. word. + } + } + rewrite /fast_prepare_responses. + iDestruct (big_sepM_subseteq _ _ frespmq with "Hfast") as "Hfastq". + { apply map_filter_subseteq. } + iDestruct (big_sepM_sep with "Hfastq") as "[_ Hvdq]". + rewrite big_sepS_big_sepM. + iApply (big_sepM_mono with "Hvdq"). + iIntros (rid b Hb) "Hvd". + apply map_lookup_filter_Some in Hb as [_ Hb]. simpl in Hb. + by subst b. + } + } + iApply "HΦ". + by iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/gpreparer_try_resign.v b/src/program_proof/tulip/program/gcoord/gpreparer_try_resign.v new file mode 100644 index 000000000..188179623 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/gpreparer_try_resign.v @@ -0,0 +1,111 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import + gpreparer_repr gpreparer_ready. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Definition try_resign_requirement γ ts (res : rpres) : iProp Σ := + match res with + | ReplicaOK => True + | ReplicaCommittedTxn => (∃ wrs, is_txn_committed γ ts wrs) + | ReplicaAbortedTxn => is_txn_aborted γ ts + | ReplicaStaleCoordinator => True + | ReplicaFailedValidation => True + | ReplicaInvalidRank => True + | ReplicaWrongLeader => True + end. + + #[global] + Instance try_resign_requirement_persistent γ ts res : + Persistent (try_resign_requirement γ ts res). + Proof. destruct res; apply _. Defined. + + Definition not_finalizing_rpres (res : rpres) := + match res with + | ReplicaOK => True + | ReplicaCommittedTxn => False + | ReplicaAbortedTxn => False + | ReplicaStaleCoordinator => False + | ReplicaFailedValidation => True + | ReplicaInvalidRank => True + | ReplicaWrongLeader => True + end. + + Theorem wp_GroupPreparer__tryResign (gpp : loc) (res : rpres) ts gid γ : + try_resign_requirement γ ts res -∗ + {{{ own_gpreparer gpp ts gid γ }}} + GroupPreparer__tryResign #gpp #(rpres_to_u64 res) + {{{ (resigned : bool), RET #resigned; + own_gpreparer gpp ts gid γ ∗ + ⌜if resigned then True else not_finalizing_rpres res⌝ + }}}. + Proof. + iIntros "#Hreq" (Φ) "!> Hgpp HΦ". + wp_rec. + + (*@ func (gpp *GroupPreparer) tryResign(res uint64) bool { @*) + (*@ if gpp.ready() { @*) + (*@ return true @*) + (*@ } @*) + (*@ @*) + do 2 iNamed "Hgpp". + wp_apply (wp_GroupPreparer__ready with "Hphase"). + iIntros "Hphase". + case_bool_decide as Hready; wp_pures. + { iApply "HΦ". by iFrame. } + + (*@ if res == tulip.REPLICA_COMMITTED_TXN { @*) + (*@ gpp.phase = GPP_COMMITTED @*) + (*@ return true @*) + (*@ } @*) + (*@ @*) + case_bool_decide as Hcmted; wp_pures. + { iNamed "Hphase". + destruct res; try done. + wp_storeField. + iApply "HΦ". + iModIntro. + iSplit; last done. + iExists GPPCommitted. + iFrame "∗ # %". + iSplit; first done. + iNamed "Hsrespm". + by iFrame "∗ %". + } + + (*@ if res == tulip.REPLICA_ABORTED_TXN { @*) + (*@ gpp.phase = GPP_ABORTED @*) + (*@ return true @*) + (*@ } @*) + (*@ @*) + case_bool_decide as Habted; wp_pures. + { iNamed "Hphase". + destruct res; try done. + wp_storeField. + iApply "HΦ". + iModIntro. + iSplit; last done. + iExists GPPAborted. + iFrame "∗ # %". + iSplit; first done. + iNamed "Hsrespm". + by iFrame "∗ %". + } + + (*@ if res == tulip.REPLICA_STALE_COORDINATOR { @*) + (*@ return true @*) + (*@ } @*) + (*@ @*) + case_bool_decide as Hstale; wp_pures. + { iApply "HΦ". by iFrame. } + + (*@ return false @*) + (*@ } @*) + iApply "HΦ". + iFrame "∗ # %". + iPureIntro. + by destruct res. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/greader_clear_versions.v b/src/program_proof/tulip/program/gcoord/greader_clear_versions.v new file mode 100644 index 000000000..b671178b3 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/greader_clear_versions.v @@ -0,0 +1,46 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import greader_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupReader__clearVersions (grd : loc) (key : string) qreadm ts γ : + {{{ own_greader_qreadm grd qreadm ts γ }}} + GroupReader__clearVersions #grd #(LitString key) + {{{ RET #(); own_greader_qreadm grd (delete key qreadm) ts γ }}}. + Proof. + iIntros (Φ) "Hgrd HΦ". + wp_rec. + + (*@ func (grd *GroupReader) clearVersions(key string) { @*) + (*@ delete(grd.qreadm, key) @*) + (*@ } @*) + iNamed "Hgrd". + wp_loadField. + wp_apply (wp_MapDelete with "HqreadmM"). + iIntros "HqreadmM". + wp_pures. + iDestruct (big_sepM2_dom with "Hqreadm") as %Hdomqreadm. + iApply "HΦ". + destruct (decide (key ∈ dom qreadm)) as [Hin | Hnotin]; last first. + { apply not_elem_of_dom in Hnotin. + rewrite delete_notin; last apply Hnotin. + assert (Hnone : qreadmM !! key = None). + { by rewrite -not_elem_of_dom Hdomqreadm not_elem_of_dom. } + rewrite /map_del delete_notin; last apply Hnone. + by iFrame "∗ # %". + } + assert (is_Some (qreadmM !! key)) as [p Hp]. + { by rewrite -elem_of_dom Hdomqreadm. } + apply elem_of_dom in Hin as [m Hm]. + iDestruct (big_sepM2_delete with "Hqreadm") as "[_ Hqreadm]". + { apply Hp. } + { apply Hm. } + iDestruct (big_sepM_delete with "Hqread") as "[_ Hqread']". + { apply Hm. } + iFrame "∗ # %". + iPureIntro. + by apply map_Forall_delete. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/greader_cquorum.v b/src/program_proof/tulip/program/gcoord/greader_cquorum.v new file mode 100644 index 000000000..4cde51f62 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/greader_cquorum.v @@ -0,0 +1,33 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program Require Import quorum. +From Perennial.program_proof.tulip.program.gcoord Require Import greader_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupReader__cquorum (grd : loc) (n : u64) : + {{{ own_greader_nrps grd }}} + GroupReader__cquorum #grd #n + {{{ RET #(bool_decide (size rids_all / 2 < uint.Z n)); own_greader_nrps grd }}}. + Proof. + iIntros (Φ) "Hgrd HΦ". + wp_rec. + + (*@ func (grd *GroupReader) cquorum(n uint64) bool { @*) + (*@ return quorum.ClassicQuorum(grd.nrps) <= n @*) + (*@ } @*) + iNamed "Hgrd". + wp_loadField. + wp_apply wp_ClassicQuorum. + iIntros (x Hx). + wp_pures. + case_bool_decide as Hc1. + { case_bool_decide as Hc2; last word. + iApply "HΦ". by iFrame "∗ %". + } + { case_bool_decide as Hc2; first word. + iApply "HΦ". by iFrame "∗ %". + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/greader_pick_latest_value.v b/src/program_proof/tulip/program/gcoord/greader_pick_latest_value.v new file mode 100644 index 000000000..a5035b724 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/greader_pick_latest_value.v @@ -0,0 +1,146 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program Require Import quorum. +From Perennial.program_proof.tulip.program.gcoord Require Import greader_repr. + +Local Ltac Zify.zify_post_hook ::= Z.div_mod_to_equations. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupReader__pickLatestValue (grd : loc) (key : string) qreadm verm ts γ : + qreadm !! key = Some verm -> + cquorum_size rids_all (dom verm) -> + {{{ own_greader_qreadm grd qreadm ts γ }}} + GroupReader__pickLatestValue #grd #(LitString key) + {{{ (value : dbval), RET (dbval_to_val value); + own_greader_qreadm grd qreadm ts γ ∗ quorum_read γ key ts value + }}}. + Proof. + iIntros (Hqread Hqsize Φ) "Hgrd HΦ". + wp_rec. + + (*@ func (grd *GroupReader) pickLatestValue(key string) tulip.Value { @*) + (*@ var lts uint64 @*) + (*@ var value tulip.Value @*) + (*@ @*) + wp_apply wp_ref_of_zero; first done. + iIntros (ltsP) "HltsP". + wp_apply wp_ref_of_zero; first done. + iIntros (valueP) "HvalueP". + + (*@ verm := grd.qreadm[key] @*) + (*@ @*) + iNamed "Hgrd". + wp_loadField. + wp_apply (wp_MapGet with "HqreadmM"). + iIntros (vermP ok) "[%Hok HqreadmM]". + wp_pures. + destruct ok; last first. + { iDestruct (big_sepM2_dom with "Hqreadm") as %Hdomqreadm. + apply map_get_false in Hok as [Hnone _]. + rewrite -not_elem_of_dom Hdomqreadm in Hnone. + by apply elem_of_dom_2 in Hqread. + } + apply map_get_true in Hok. + iDestruct (big_sepM2_lookup_acc with "Hqreadm") as "[Hverm HqreadmC]". + { apply Hok. } + { apply Hqread. } + + (*@ for _, ver := range(verm) { @*) + (*@ if lts <= ver.Timestamp { @*) + (*@ value = ver.Value @*) + (*@ lts = ver.Timestamp @*) + (*@ } @*) + (*@ } @*) + (*@ @*) + set P := (λ (mx : gmap u64 (u64 * dbval)), + ∃ (lts : u64) (value : dbval), + "HltsP" ∷ ltsP ↦[uint64T] #lts ∗ + "HvalueP" ∷ valueP ↦[boolT * (stringT * unitT)%ht] (dbval_to_val value) ∗ + "%Hlargest" ∷ ⌜map_Forall (λ _ x, uint.Z x.1 ≤ uint.Z lts) mx⌝ ∗ + "%Hin" ∷ ⌜if decide (mx = ∅) + then lts = U64 0 + else map_Exists (λ _ x, x = (lts, value)) mx⌝)%I. + wp_apply (wp_MapIter_fold _ _ _ P with "Hverm [HltsP HvalueP]"). + { iExists _, None. by iFrame. } + { clear Φ. + iIntros (mx rid [t v] Φ) "!> [HP %Hmx] HΦ". + iNamed "HP". + wp_load. + wp_pures. + case_bool_decide as Horder; wp_pures. + { wp_apply (wp_StoreAt with "HvalueP"). + { destruct v; by auto. } + iIntros "HvalueP". + wp_store. + iApply "HΦ". + subst P. + iFrame. + iPureIntro. + split. + { intros rid' [t' v'] Hv'. simpl. + destruct (decide (rid' = rid)) as [-> | Hne]. + { rewrite lookup_insert in Hv'. by inv Hv'. } + rewrite lookup_insert_ne in Hv'; last done. + specialize (Hlargest _ _ Hv'). simpl in Hlargest. + clear -Hlargest Horder. lia. + } + { destruct (decide (<[rid:=(t, v)]> mx = ∅)) as [He | Hne]. + { by apply insert_non_empty in He. } + by apply map_Exists_insert_2_1. + } + } + iApply "HΦ". + subst P. + iFrame. + iPureIntro. + split. + { apply map_Forall_insert_2; last done. + simpl. lia. + } + { case_decide as Hmxe. + { clear -Horder Hin. word. } + case_decide as Hinsert. + { by apply insert_non_empty in Hinsert. } + destruct Hmx as [Hmx _]. + by apply map_Exists_insert_2_2. + } + } + iIntros "[Hverm HP]". + subst P. iNamed "HP". + wp_pures. + wp_load. + + (*@ return value @*) + (*@ } @*) + iApply "HΦ". + iDestruct ("HqreadmC" with "Hverm") as "HqreadmC". + iFrame "∗ # %". + iDestruct (big_sepM_lookup with "Hqread") as "Hqreadkey"; first apply Hqread. + case_decide as Hverm. + { exfalso. + rewrite -dom_empty_iff_L -size_empty_iff_L in Hverm. + clear -Hqsize Hverm. rewrite /cquorum_size in Hqsize. lia. + } + destruct Hin as (rid & [t v] & Hvermrid & Htv). + inv Htv. + iDestruct (big_sepM_lookup with "Hqreadkey") as "Hlver"; first apply Hvermrid. + iNamed "Hlver". + iFrame "Hv %". + iModIntro. + iExists (dom verm). + iSplit. + { rewrite big_sepS_big_sepM. + iApply (big_sepM_mono with "Hqreadkey"). + iIntros (r [t v] Htv). + iNamed 1. simpl. + iApply (read_promise_weaken_lb with "Hioa"). + specialize (Hlargest _ _ Htv). simpl in Hlargest. + clear -Hlargest. lia. + } + iPureIntro. + by specialize (Hvrids _ _ Hqread). + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/greader_process_read_result.v b/src/program_proof/tulip/program/gcoord/greader_process_read_result.v new file mode 100644 index 000000000..f7a0994bb --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/greader_process_read_result.v @@ -0,0 +1,256 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program Require Import quorum. +From Perennial.program_proof.tulip.program.gcoord Require Import + greader_repr greader_cquorum greader_pick_latest_value greader_clear_versions. + +Local Ltac Zify.zify_post_hook ::= Z.div_mod_to_equations. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupReader__processReadResult + grd (rid : u64) (key : string) (ver : u64 * dbval) ts γ : + rid ∈ rids_all -> + fast_or_slow_read γ rid key (uint.nat ver.1) ts ver.2 -∗ + {{{ own_greader grd ts γ }}} + GroupReader__processReadResult #grd #rid #(LitString key) (u64_dbval_to_val ver) + {{{ RET #(); own_greader grd ts γ }}}. + Proof. + iIntros (Hrid) "#Hfsread". + iIntros (Φ) "!> Hgrd HΦ". + wp_rec. + + (*@ func (grd *GroupReader) processReadResult(rid uint64, key string, ver tulip.Version) { @*) + (*@ _, final := grd.valuem[key] @*) + (*@ if final { @*) + (*@ // The final value is already determined. @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + iNamed "Hgrd". iNamed "Hvaluem". iNamed "Hqreadm". + wp_loadField. + wp_apply (wp_MapGet with "Hvaluem"). + iIntros (v final) "[%Hfinal Hvaluem]". + wp_pures. + destruct final; wp_pures. + { iApply "HΦ". by iFrame "∗ # %". } + + (*@ if ver.Timestamp == 0 { @*) + (*@ // Fast-path read: set the final value and clean up the read versions. @*) + (*@ grd.valuem[key] = ver.Value @*) + (*@ delete(grd.qreadm, key) @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + iDestruct (big_sepM2_dom with "Hqreadm") as %Hdomqreadm. + destruct ver as [rts value]. + case_bool_decide as Hrts; simpl in Hrts; wp_pures. + { wp_loadField. + wp_apply (wp_MapInsert with "Hvaluem"); first done. + iIntros "Hvaluem". + wp_loadField. + wp_apply (wp_MapDelete with "HqreadmM"). + iIntros "HqreadmM". + wp_pures. + iApply "HΦ". + iAssert ([∗ map] p;m ∈ delete key qreadmM; delete key qreadm, own_map p (DfracOwn 1) m)%I + with "[Hqreadm]" as "Hqreadm". + { destruct (decide (key ∈ dom qreadm)) as [Hin | Hnotin]. + { apply elem_of_dom in Hin as [qread Hqread]. + by iDestruct (big_sepM2_delete_r with "Hqreadm") as (p) "(_ & _ & Hqreadm)". + } + assert (Hnone : qreadmM !! key = None). + { by rewrite -not_elem_of_dom Hdomqreadm. } + apply not_elem_of_dom in Hnotin. + do 2 (rewrite delete_notin; last done). + done. + } + iFrame "∗ # %". + iModIntro. + iSplit. + { rewrite /fast_or_slow_read. + inv Hrts. + case_decide as Hcase; last first. + { simpl in Hcase. clear -Hcase. word. } + simpl. + iApply (big_sepM_insert_2 with "[] Hfinal"). + iFrame "Hfsread". + } + { iSplit. + { destruct (decide (key ∈ dom qreadm)) as [Hin | Hnotin]; last first. + { apply not_elem_of_dom in Hnotin. + by rewrite delete_notin. + } + apply elem_of_dom in Hin as [qread Hqread]. + by iDestruct (big_sepM_delete with "Hqread") as "[_ ?]". + } + { iPureIntro. + by apply map_Forall_delete. + } + } + } + + (*@ qread, ok := grd.qreadm[key] @*) + (*@ if !ok { @*) + (*@ // The very first version arrives. Initialize a new map with the version @*) + (*@ // received. @*) + (*@ verm := make(map[uint64]tulip.Version) @*) + (*@ verm[rid] = ver @*) + (*@ grd.qreadm[key] = verm @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_loadField. + wp_apply (wp_MapGet with "HqreadmM"). + iIntros (qreadP ok) "[%Hok HqreadmM]". + wp_pures. + destruct ok; wp_pures; last first. + { wp_apply (wp_NewMap u64 (u64 * dbval)). + iIntros (vermP) "Hverm". + wp_apply (wp_MapInsert with "Hverm"); first by auto. + iIntros "Hverm". + wp_loadField. + wp_apply (wp_MapInsert with "HqreadmM"); first by auto. + iIntros "HqreadmM". + wp_pures. + iApply "HΦ". + apply map_get_false in Hok as [HqreadmM _]. + assert (Hqreadm : qreadm !! key = None). + { by rewrite -not_elem_of_dom -Hdomqreadm not_elem_of_dom. } + iDestruct (big_sepM2_insert_2 _ _ _ key with "[Hverm] Hqreadm") as "Hqreadm". + { iFrame "Hverm". } + iFrame "∗ # %". + iModIntro. + iSplit. + { iApply (big_sepM_insert_2 with "[] Hqread"). + rewrite /map_insert insert_empty big_sepM_singleton. + rewrite /fast_or_slow_read. + case_decide as Hslow; simpl in Hslow. + { exfalso. clear -Hrts Hslow. apply u64_val_ne in Hrts. word. } + done. + } + { iPureIntro. + apply map_Forall_insert_2; last done. + rewrite /map_insert insert_empty dom_singleton_L. + clear -Hrid. set_solver. + } + } + + (*@ _, responded := qread[rid] @*) + (*@ if responded { @*) + (*@ // The replica has already responded with its latest version. @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + apply map_get_true in Hok. + assert (is_Some (qreadm !! key)) as [qread Hqread]. + { by rewrite -elem_of_dom -Hdomqreadm elem_of_dom. } + iDestruct (big_sepM2_delete _ _ _ key with "Hqreadm") as "[Hqr Hqreadm]". + { apply Hok. } + { apply Hqread. } + wp_apply (wp_MapGet with "Hqr"). + clear Hfinal v. + iIntros (v responded) "[%Hresponded Hqr]". + wp_pures. + destruct responded; wp_pures. + { iDestruct (big_sepM2_insert_2 _ _ _ key with "[Hqr] Hqreadm") as "Hqreadm". + { iFrame "Hqr". } + do 2 (rewrite insert_delete; last done). + iApply "HΦ". + by iFrame "∗ # %". + } + + (*@ // Record the version responded by the replica. @*) + (*@ qread[rid] = ver @*) + (*@ grd.qreadm[key] = qread @*) + (*@ @*) + wp_apply (wp_MapInsert with "Hqr"); first done. + iIntros "Hqr". + wp_loadField. + wp_apply (wp_MapInsert with "HqreadmM"); first done. + iIntros "HqreadmM". + rewrite /map_insert. + set qread' := insert _ _ qread. + iDestruct (big_sepM_lookup with "Hqread") as "Hqreadprev"; first apply Hqread. + iDestruct (big_sepM_insert_2 _ _ key qread' with "[] Hqread") + as "Hqread'". + { simpl. + iApply (big_sepM_insert_2 with "[] Hqreadprev"). + rewrite /fast_or_slow_read. + case_decide as Hslow; simpl in Hslow. + { exfalso. clear -Hrts Hslow. apply u64_val_ne in Hrts. word. } + done. + } + set qreadm' := insert _ _ qreadm. + assert (Hvrids' : map_Forall (λ _ m, dom m ⊆ rids_all) qreadm'). + { apply map_Forall_insert_2; last done. + rewrite dom_insert_L. + specialize (Hvrids _ _ Hqread). simpl in Hvrids. + clear -Hrid Hvrids. set_solver. + } + + (*@ // Count the responses from replicas. @*) + (*@ n := uint64(len(qread)) @*) + (*@ if !grd.cquorum(n) { @*) + (*@ // Cannot determine the final value without a classic quorum of @*) + (*@ // versions. @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_MapLen with "Hqr"). + iIntros "[%Hsz Hqr]". + apply map_get_false in Hresponded as [Hresponded _]. + rewrite map_size_insert_None in Hsz *; last apply Hresponded. + wp_pures. + wp_apply (wp_GroupReader__cquorum with "Hnrps"). + iIntros "Hnrps". + (* this additional step avoids some unwanted computation *) + set sc := size rids_all. + wp_pures. + case_bool_decide as Hsize; wp_pures; last first. + { iDestruct (big_sepM2_insert_2 _ _ _ key with "[Hqr] Hqreadm") as "Hqreadm". + { iFrame "Hqr". } + rewrite 2!insert_delete_insert. + iApply "HΦ". + by iFrame "∗ # %". + } + + (*@ // With enough versions, choose the latest one to be the final value. @*) + (*@ latest := grd.pickLatestValue(key) @*) + (*@ grd.valuem[key] = latest @*) + (*@ @*) + iDestruct (big_sepM2_insert_2 _ _ _ key with "[Hqr] Hqreadm") as "Hqreadm". + { simpl. iFrame "Hqr". } + rewrite 2!insert_delete_insert. + iAssert (own_greader_qreadm grd qreadm' ts γ)%I + with "[HqreadmP HqreadmM Hqreadm]" as "Hqreadm". + { by iFrame "∗ # %". } + wp_apply (wp_GroupReader__pickLatestValue with "Hqreadm"). + { apply lookup_insert. } + { rewrite /cquorum_size. + rewrite dom_insert_L size_union; last first. + { apply not_elem_of_dom in Hresponded. clear -Hresponded. set_solver. } + rewrite size_singleton size_dom. + clear -Hsz Hsize. lia. + } + iIntros (latest) "[Hqreadm #Hqr]". + wp_loadField. + wp_apply (wp_MapInsert with "Hvaluem"); first done. + iIntros "Hvaluem". + + (*@ // The thread that determines the final value for @key also clears the @*) + (*@ // versions collected for @key. @*) + (*@ grd.clearVersions(key) @*) + (*@ } @*) + wp_apply (wp_GroupReader__clearVersions with "Hqreadm"). + iIntros "Hqreadm". + wp_pures. + iApply "HΦ". + iFrame "∗ # %". + iModIntro. + iApply (big_sepM_insert_2 with "[] Hfinal"). + by iRight. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/greader_read.v b/src/program_proof/tulip/program/gcoord/greader_read.v new file mode 100644 index 000000000..16f5e0ffe --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/greader_read.v @@ -0,0 +1,35 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import greader_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupReader__read (grd : loc) (key : string) ts γ : + {{{ own_greader grd ts γ }}} + GroupReader__read #grd #(LitString key) + {{{ (v : dbval) (ok : bool), RET (dbval_to_val v, #ok); + own_greader grd ts γ ∗ + if ok then fast_or_quorum_read γ key ts v else True + }}}. + Proof. + iIntros (Φ) "Hgrd HΦ". + wp_rec. + + (*@ func (grd *GroupReader) read(key string) (tulip.Value, bool) { @*) + (*@ v, ok := grd.valuem[key] @*) + (*@ return v, ok @*) + (*@ } @*) + iNamed "Hgrd". iNamed "Hvaluem". + wp_loadField. + wp_apply (wp_MapGet with "Hvaluem"). + iIntros (v ok) "[%Hok Hvaluem]". + wp_pures. + iApply "HΦ". + iFrame "∗ #". + destruct ok; last done. + apply map_get_true in Hok. + by iApply (big_sepM_lookup with "Hfinal"). + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/greader_repr.v b/src/program_proof/tulip/program/gcoord/greader_repr.v new file mode 100644 index 000000000..9f6381ed7 --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/greader_repr.v @@ -0,0 +1,48 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.invariance Require Import read. + +Local Ltac Zify.zify_post_hook ::= Z.div_mod_to_equations. + +Section repr. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + (*@ type GroupReader struct { @*) + (*@ // Number of replicas. Read-only. @*) + (*@ nrps uint64 @*) + (*@ // Cached read set. Exists for performance reason; could have an interface @*) + (*@ // to create a transaction that does not cache reads. @*) + (*@ valuem map[string]tulip.Value @*) + (*@ // Versions responded by each replica for each key. Instead of using a @*) + (*@ // single map[uint64]Version for the current key being read, this design allows @*) + (*@ // supporting more sophisticated "async-read" in future. @*) + (*@ qreadm map[string]map[uint64]tulip.Version @*) + (*@ } @*) + Definition own_greader_valuem + (grd : loc) (valuem : gmap dbkey dbval) (ts : nat) γ : iProp Σ := + ∃ (valuemP : loc), + "HvaluemP" ∷ grd ↦[GroupReader :: "valuem"] #valuemP ∗ + "Hvaluem" ∷ own_map valuemP (DfracOwn 1) valuem ∗ + "#Hfinal" ∷ ([∗ map] k ↦ v ∈ valuem, fast_or_quorum_read γ k ts v). + + Definition own_greader_qreadm + (grd : loc) (qreadm : gmap dbkey (gmap u64 (u64 * dbval))) (ts : nat) γ : iProp Σ := + ∃ (qreadmP : loc) (qreadmM : gmap dbkey loc) , + "HqreadmP" ∷ grd ↦[GroupReader :: "qreadm"] #qreadmP ∗ + "HqreadmM" ∷ own_map qreadmP (DfracOwn 1) qreadmM ∗ + "Hqreadm" ∷ ([∗ map] k ↦ p; m ∈ qreadmM; qreadm, own_map p (DfracOwn 1) m) ∗ + "#Hqread" ∷ ([∗ map] k ↦ m ∈ qreadm, + [∗ map] rid ↦ ver ∈ m, slow_read γ rid k (uint.nat ver.1) ts ver.2) ∗ + "%Hvrids" ∷ ⌜map_Forall (λ _ m, dom m ⊆ rids_all) qreadm⌝. + + Definition own_greader_nrps (grd : loc) : iProp Σ := + ∃ (nrps : u64), + "Hnrps" ∷ grd ↦[GroupReader :: "nrps"] #nrps ∗ + "%Hnrps" ∷ ⌜uint.nat nrps = size rids_all⌝. + + Definition own_greader (grd : loc) (ts : nat) γ : iProp Σ := + ∃ (valuem : gmap dbkey dbval) (qreadm : gmap dbkey (gmap u64 (u64 * dbval))), + "Hvaluem" ∷ own_greader_valuem grd valuem ts γ ∗ + "Hqreadm" ∷ own_greader_qreadm grd qreadm ts γ ∗ + "Hnrps" ∷ own_greader_nrps grd. + +End repr. diff --git a/src/program_proof/tulip/program/gcoord/greader_responded.v b/src/program_proof/tulip/program/gcoord/greader_responded.v new file mode 100644 index 000000000..1a2addc7f --- /dev/null +++ b/src/program_proof/tulip/program/gcoord/greader_responded.v @@ -0,0 +1,65 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.gcoord Require Import greader_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_GroupReader__responded (grd : loc) (rid : u64) (key : string) ts γ : + {{{ own_greader grd ts γ }}} + GroupReader__responded #grd #rid #(LitString key) + {{{ (responded : bool), RET #responded; own_greader grd ts γ }}}. + Proof. + iIntros (Φ) "Hgrd HΦ". + wp_rec. + + (*@ func (grd *GroupReader) responded(rid uint64, key string) bool { @*) + (*@ _, final := grd.valuem[key] @*) + (*@ if final { @*) + (*@ // The final value is already determined. @*) + (*@ return true @*) + (*@ } @*) + (*@ @*) + iNamed "Hgrd". iNamed "Hvaluem". + wp_loadField. + wp_apply (wp_MapGet with "Hvaluem"). + iIntros (v final) "[%Hfinal Hvaluem]". + wp_pures. + destruct final; wp_pures. + { iApply "HΦ". by iFrame "∗ # %". } + + (*@ qread, ok := grd.qreadm[key] @*) + (*@ if !ok { @*) + (*@ return false @*) + (*@ } @*) + (*@ @*) + iNamed "Hqreadm". + wp_loadField. + wp_apply (wp_MapGet with "HqreadmM"). + iIntros (qreadP ok) "[%Hok HqreadmM]". + wp_pures. + destruct ok; wp_pures; last first. + { iApply "HΦ". by iFrame "∗ # %". } + + (*@ _, responded := qread[rid] @*) + (*@ if responded { @*) + (*@ // The replica has already responded with its latest version. @*) + (*@ return true @*) + (*@ } @*) + (*@ return false @*) + (*@ } @*) + apply map_get_true in Hok. + iDestruct (big_sepM2_dom with "Hqreadm") as %Hdomqreadm. + assert (is_Some (qreadm !! key)) as [qread Hqread]. + { by rewrite -elem_of_dom -Hdomqreadm elem_of_dom. } + iDestruct (big_sepM2_lookup_acc with "Hqreadm") as "[Hqr HqreadmC]". + { apply Hok. } + { apply Hqread. } + wp_apply (wp_MapGet with "Hqr"). + clear Hfinal v. + iIntros (v responded) "[%Hresponded Hqr]". + wp_pures. + iDestruct ("HqreadmC" with "Hqr") as "Hqreadm". + by destruct responded; wp_pures; iApply "HΦ"; iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/gcoord/group_coordinator.v b/src/program_proof/tulip/program/gcoord/group_coordinator.v deleted file mode 100644 index 9de775985..000000000 --- a/src/program_proof/tulip/program/gcoord/group_coordinator.v +++ /dev/null @@ -1,1145 +0,0 @@ -From Perennial.program_proof.tulip.invariance Require Import read. -From Perennial.program_proof.tulip.program Require Import prelude. -From Perennial.program_proof.tulip.program Require Import prelude group_reader group_preparer. - -(* Local Ltac Zify.zify_post_hook ::= Z.div_mod_to_equations. *) - -Section repr. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - (*@ type GroupCoordinator struct { @*) - (*@ // Replica addresses. Read-only. @*) - (*@ rps map[uint64]grove_ffi.Address @*) - (*@ // Mutex protecting fields below. @*) - (*@ mu *sync.Mutex @*) - (*@ // Condition variable used to notify arrival of responses. @*) - (*@ cv *sync.Cond @*) - (*@ // Timestamp of the currently active transaction. @*) - (*@ ts uint64 @*) - (*@ // ID of the replica believed to be the leader of this group. @*) - (*@ leader uint64 @*) - (*@ // Group reader. @*) - (*@ grd *GroupReader @*) - (*@ // Group preparer. @*) - (*@ gpp *GroupPreparer @*) - (*@ // IDs of the finalizing transactions. Using unit as range would suffice. @*) - (*@ tsfinals map[uint64]bool @*) - (*@ // Connections to replicas. @*) - (*@ conns map[uint64]grove_ffi.Connection @*) - (*@ } @*) - Definition own_gcoord_ts gcoord ts : iProp Σ := - ∃ (tsW : u64), - "HtsW" ∷ gcoord ↦[GroupCoordinator :: "ts"] #tsW ∗ - "%Hts" ∷ ⌜uint.nat tsW = ts⌝. - - Definition own_gcoord_greader gcoord ts γ : iProp Σ := - ∃ (grdP : loc), - "HgrdP" ∷ gcoord ↦[GroupCoordinator :: "grd"] #grdP ∗ - "Hgrd" ∷ own_greader grdP ts γ. - - Definition own_gcoord_gpreparer gcoord ts gid γ : iProp Σ := - ∃ (gppP : loc), - "HgppP" ∷ gcoord ↦[GroupCoordinator :: "gpp"] #gppP ∗ - "Hgpp" ∷ own_gpreparer gppP ts gid γ. - - Definition own_gcoord_finalizer gcoord (rids : gset u64) : iProp Σ := - ∃ (idxleader : u64) (tsfinalsP : loc) (tsfinals : gmap u64 bool), - "Hleader" ∷ gcoord ↦[GroupCoordinator :: "idxleader"] #idxleader ∗ - "HtsfinalsP" ∷ gcoord ↦[GroupCoordinator :: "tsfinals"] #tsfinalsP ∗ - "Htsfinals" ∷ own_map tsfinalsP (DfracOwn 1) tsfinals ∗ - "%Hleader" ∷ ⌜(uint.nat idxleader < size rids)⌝. - - Definition own_gcoord_core gcoord ts gid rids γ : iProp Σ := - "Hts" ∷ own_gcoord_ts gcoord ts ∗ - "Hgrd" ∷ own_gcoord_greader gcoord ts γ ∗ - "Hgpp" ∷ own_gcoord_gpreparer gcoord ts gid γ ∗ - "Hgfl" ∷ own_gcoord_finalizer gcoord rids. - - Definition own_gcoord_comm gcoord (addrm : gmap u64 chan) : iProp Σ := - ∃ (connsP : loc) (conns : gmap u64 (chan * chan)), - let connsV := fmap (λ x, connection_socket x.1 x.2) conns in - "HconnsP" ∷ gcoord ↦[GroupCoordinator :: "conns"] #connsP ∗ - "Hconns" ∷ map.own_map connsP (DfracOwn 1) (connsV, #()) ∗ - (* "#Htrmls" ∷ ([∗ map] x ∈ conns, is_terminal γ x.1) ∗ *) - "%Haddrpeers" ∷ ⌜map_Forall (λ rid x, addrm !! rid = Some x.2) conns⌝. - - Definition own_gcoord_with_ts gcoord addrm ts gid γ : iProp Σ := - "Hgcoord" ∷ own_gcoord_core gcoord ts gid (dom addrm) γ ∗ - "Hcomm" ∷ own_gcoord_comm gcoord addrm. - - Definition own_gcoord gcoord addrm gid γ : iProp Σ := - ∃ ts, "Hgcoord" ∷ own_gcoord_with_ts gcoord addrm ts gid γ. - - Definition is_gcoord_addrm gcoord (addrm : gmap u64 chan) : iProp Σ := - ∃ (addrmP : loc) (rpsP : Slice.t) (rps : list u64), - "#HaddrmP" ∷ readonly (gcoord ↦[GroupCoordinator :: "addrm"] #addrmP) ∗ - "#Haddrm" ∷ own_map addrmP DfracDiscarded addrm ∗ - "#HrpsP" ∷ readonly (gcoord ↦[GroupCoordinator :: "rps"] (to_val rpsP)) ∗ - "#Hrps" ∷ readonly (own_slice_small rpsP uint64T (DfracOwn 1) rps) ∗ - "%Hdomaddrm" ∷ ⌜dom addrm = list_to_set rps⌝ ∗ - "%Hnodup" ∷ ⌜NoDup rps⌝. - - Definition is_gcoord_with_addrm gcoord gid (addrm : gmap u64 chan) γ : iProp Σ := - ∃ (muP : loc) (cvP : loc), - "#HmuP" ∷ readonly (gcoord ↦[GroupCoordinator :: "mu"] #muP) ∗ - "#Hlock" ∷ is_lock tulipNS #muP (own_gcoord gcoord addrm gid γ) ∗ - "#HcvP" ∷ readonly (gcoord ↦[GroupCoordinator :: "cv"] #cvP) ∗ - "Hcv" ∷ is_cond cvP #muP ∗ - "#Haddrm" ∷ is_gcoord_addrm gcoord addrm. - - Definition is_gcoord gcoord gid γ : iProp Σ := - ∃ addrm, "Hgcoord" ∷ is_gcoord_with_addrm gcoord gid addrm γ. - -End repr. - -Section program. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - Theorem wp_GroupCoordinator__attachedWith (gcoord : loc) (tsW : u64) tscur rids gid γ : - let ts := uint.nat tsW in - {{{ own_gcoord_core gcoord tscur gid rids γ }}} - GroupCoordinator__attachedWith #gcoord #tsW - {{{ (ok : bool), RET #ok; - if ok - then own_gcoord_core gcoord ts gid rids γ - else own_gcoord_core gcoord tscur gid rids γ - }}}. - Proof. - iIntros (ts Φ) "Hgcoord HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) attachedWith(ts uint64) bool { @*) - (*@ return gcoord.ts == ts @*) - (*@ } @*) - iNamed "Hgcoord". - rename tsW into tsargW. iNamed "Hts". - wp_loadField. - wp_pures. - case_bool_decide as Htsarg. - { iApply "HΦ". inv Htsarg. by iFrame "∗ # %". } - { iApply "HΦ". by iFrame "∗ # %". } - Qed. - - Theorem wp_GroupCoordinator__AttachedWith (gcoord : loc) (ts : u64) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__AttachedWith #gcoord #ts - {{{ (attached : bool), RET #attached; True }}}. - Proof. - iIntros "#Hgcoord" (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) AttachedWith(ts uint64) bool { @*) - (*@ gcoord.mu.Lock() @*) - (*@ b := gcoord.attachedWith(ts) @*) - (*@ gcoord.mu.Unlock() @*) - (*@ return b @*) - (*@ } @*) - do 2 iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - do 2 iNamed "Hgcoord". - wp_apply (wp_GroupCoordinator__attachedWith with "Hgcoord"). - iIntros (b) "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { iFrame "Hlock Hlocked". by destruct b; iFrame. } - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__ValueResponded gcoord (rid : u64) key gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__ValueResponded #gcoord #rid #(LitString key) - {{{ (ok : bool), RET #ok; True }}}. - Proof. - iIntros "#Hgcoord" (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) ValueResponded(rid uint64, key string) bool { @*) - (*@ gcoord.mu.Lock() @*) - (*@ done := gcoord.grd.responded(rid, key) @*) - (*@ gcoord.mu.Unlock() @*) - (*@ return done @*) - (*@ } @*) - do 2 iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - do 3 iNamed "Hgcoord". iNamed "Hgrd". - wp_loadField. - wp_pures. - wp_apply (wp_GroupReader__responded with "Hgrd"). - iIntros (responded) "Hgrd". - wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { iFrame "Hlock Hlocked". by iFrame "∗ # %". } - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__WaitUntilValueReady - (gcoord : loc) (tsW : u64) (key : string) gid γ : - let ts := uint.nat tsW in - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__WaitUntilValueReady #gcoord #tsW #(LitString key) - {{{ (value : dbval) (valid : bool), RET (dbval_to_val value, #valid); - if valid then fast_or_quorum_read γ key ts value else True - }}}. - Proof. - iIntros (ts) "#Hgcoord". - iIntros (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) WaitUntilValueReady(ts uint64, key string) (tulip.Value, bool) { @*) - (*@ var value tulip.Value @*) - (*@ var valid bool @*) - (*@ @*) - wp_apply wp_ref_of_zero; first done. - iIntros (valueP) "HvalueP". - wp_apply wp_ref_of_zero; first done. - iIntros (validP) "HvalidP". - - (*@ gcoord.mu.Lock() @*) - (*@ @*) - do 2 iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - wp_pures. - - (*@ for { @*) - (*@ @*) - set P := (λ (cont : bool), ∃ (value : dbval) (valid : bool), - "Hgcoord" ∷ own_gcoord gcoord addrm gid γ ∗ - "HvalueP" ∷ valueP ↦[boolT * (stringT * unitT)%ht] dbval_to_val value ∗ - "HvalidP" ∷ validP ↦[boolT] #valid ∗ - "Hlocked" ∷ locked #muP ∗ - "#Hread" ∷ if (negb cont) && valid then fast_or_quorum_read γ key ts value else True)%I. - wp_apply (wp_forBreak P with "[] [Hgcoord HvalueP HvalidP Hlocked]"); last first; first 1 last. - { iFrame. by iExists None. } - { clear Φ. - - (*@ if !gcoord.attachedWith(ts) { @*) - (*@ valid = false @*) - (*@ break @*) - (*@ } @*) - (*@ @*) - iIntros (Φ) "!> HP HΦ". - iNamed "HP". - iDestruct"Hgcoord" as (tscur) "Hgcoord". - do 2 iNamed "Hgcoord". - wp_apply (wp_GroupCoordinator__attachedWith with "Hgcoord"). - iIntros (attached) "Hgcoord". - wp_pures. - destruct attached; wp_pures; last first. - { wp_store. iApply "HΦ". by iFrame. } - - (*@ v, ok := gcoord.grd.read(key) @*) - (*@ if ok { @*) - (*@ value = v @*) - (*@ valid = true @*) - (*@ break @*) - (*@ } @*) - (*@ @*) - iNamed "Hgcoord". iNamed "Hgrd". - wp_loadField. - wp_apply (wp_GroupReader__read with "Hgrd"). - iIntros (v ok) "[Hgrd #Hreadv]". - wp_pures. - destruct ok; wp_pures. - { wp_apply (wp_StoreAt with "HvalueP"). - { by destruct v; auto. } - iIntros "HvalueP". - wp_store. - iApply "HΦ". - by iFrame "∗ #". - } - - (*@ gcoord.cv.Wait() @*) - (*@ } @*) - (*@ @*) - wp_loadField. - wp_apply (wp_Cond__Wait with "[-HΦ HvalueP HvalidP]"). - { by iFrame "Hcv Hlock Hlocked ∗ # %". } - iIntros "[Hlocked Hgcoord]". - wp_pures. - iApply "HΦ". - by iFrame. - } - subst P. iNamed 1. - - (*@ gcoord.mu.Unlock() @*) - (*@ @*) - wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ HvalueP HvalidP]"). - { by iFrame "Hlock Hlocked Hgcoord". } - - (*@ return value, valid @*) - (*@ } @*) - do 2 wp_load. - wp_pures. - iApply "HΦ". - by destruct valid. - Qed. - - Theorem wp_GroupCoordinator__SendRead - (gcoord : loc) (rid : u64) (ts : u64) (key : string) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__SendRead #gcoord #rid #ts #(LitString key) - {{{ RET #(); True }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendRead(rid, ts uint64, key string) { @*) - (*@ gcoord.Send(rid, message.EncodeTxnRead(ts, key)) @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__ReadSession - (gcoord : loc) (rid : u64) (ts : u64) (key : string) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__ReadSession #gcoord #rid #ts #(LitString key) - {{{ RET #(); True }}}. - Proof. - iIntros "#Hgcoord" (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) ReadSession(rid uint64, ts uint64, key string) { @*) - (*@ for !gcoord.ValueResponded(rid, key) && gcoord.AttachedWith(ts) { @*) - (*@ gcoord.SendRead(rid, ts, key) @*) - (*@ primitive.Sleep(params.NS_RESEND_READ) @*) - (*@ } @*) - (*@ @*) - wp_pures. - wp_apply (wp_forBreak_cond (λ _, True)%I with "[] []"); last first; first 1 last. - { done. } - { clear Φ. - iIntros (Φ) "!> _ HΦ". - wp_apply (wp_GroupCoordinator__ValueResponded with "Hgcoord"). - iIntros (resped) "_". - wp_pures. - destruct resped; wp_pures. - { by iApply "HΦ". } - wp_apply (wp_GroupCoordinator__AttachedWith with "Hgcoord"). - iIntros (attached) "_". - destruct attached; wp_pures; last first. - { by iApply "HΦ". } - wp_apply (wp_GroupCoordinator__SendRead with "Hgcoord"). - wp_apply wp_Sleep. - wp_pures. - by iApply "HΦ". - } - - (*@ // Either replica @rid has already responded with its value, or the value @*) - (*@ // for @key has already been determined. In either case, the corresponding @*) - (*@ // read session could terminate. @*) - (*@ } @*) - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__Read - (gcoord : loc) (tsW : u64) (key : string) gid γ : - let ts := uint.nat tsW in - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__Read #gcoord #tsW #(LitString key) - {{{ (value : dbval) (ok : bool), RET (dbval_to_val value, #ok); - if ok then fast_or_quorum_read γ key ts value else True - }}}. - Proof. - iIntros (ts) "#Hgcoord". - iIntros (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) Read(ts uint64, key string) (tulip.Value, bool) { @*) - (*@ // Spawn a session with each replica in the group. @*) - (*@ for ridloop := range(gcoord.addrm) { @*) - (*@ rid := ridloop @*) - (*@ go func() { @*) - (*@ gcoord.ReadSession(rid, ts, key) @*) - (*@ }() @*) - (*@ } @*) - (*@ @*) - iPoseProof "Hgcoord" as "Hgcoord'". - do 2 iNamed "Hgcoord". iNamed "Haddrm". - iRename "Hgcoord'" into "Hgcoord". - wp_loadField. - wp_apply (wp_MapIter_fold _ _ _ (λ _, True)%I with "Haddrm []"). - { done. } - { clear Φ. - iIntros (mx rid c Φ) "!> _ HΦ". - wp_pures. - wp_apply wp_fork. - { by wp_apply (wp_GroupCoordinator__ReadSession with "Hgcoord"). } - by iApply "HΦ". - } - iIntros "_". - - (*@ v, ok := gcoord.WaitUntilValueReady(ts, key) @*) - (*@ return v, ok @*) - (*@ } @*) - wp_apply (wp_GroupCoordinator__WaitUntilValueReady with "Hgcoord"). - iIntros (v ok) "#Hread". - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__NextPrepareAction - (gcoord : loc) (rid : u64) (tsW : u64) gid γ : - let ts := uint.nat tsW in - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__NextPrepareAction #gcoord #rid #tsW - {{{ (action : gppaction) (ok : bool), RET (#(gppaction_to_u64 action), #ok); - if ok then safe_gppaction γ ts gid action else True - }}}. - Proof. - iIntros (ts) "#Hgcoord". - iIntros (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) NextPrepareAction(rid uint64, ts uint64) (uint64, bool) { @*) - (*@ gcoord.mu.Lock() @*) - (*@ @*) - do 2 iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - do 2 iNamed "Hgcoord". - wp_apply (wp_GroupCoordinator__attachedWith with "Hgcoord"). - iIntros (ok) "Hgcoord". - wp_pures. - - (*@ if !gcoord.attachedWith(ts) { @*) - (*@ gcoord.mu.Unlock() @*) - (*@ return 0, false @*) - (*@ } @*) - (*@ @*) - destruct ok; wp_pures; last first. - { wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { by iFrame "Hlock Hlocked ∗". } - wp_pures. - (* [GPPFastPrepare] just a placeholder *) - by iApply ("HΦ" $! GPPFastPrepare). - } - - (*@ action := gcoord.gpp.action(rid) @*) - (*@ @*) - iNamed "Hgcoord". iNamed "Hgpp". - wp_loadField. - wp_apply (wp_GroupPreparer__action with "Hgpp"). - iIntros (action) "[Hgpp #Hsafea]". - wp_pures. - - (*@ gcoord.mu.Unlock() @*) - (*@ @*) - wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { by iFrame "Hlock Hlocked ∗". } - - (*@ return action, true @*) - (*@ } @*) - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__WaitUntilPrepareDone - (gcoord : loc) (tsW : u64) gid γ : - let ts := uint.nat tsW in - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__WaitUntilPrepareDone #gcoord #tsW - {{{ (tphase : txnphase) (valid : bool), RET (#(txnphase_to_u64 tphase), #valid); - if valid then safe_group_txnphase γ ts gid tphase else True - }}}. - Proof. - iIntros (ts) "#Hgcoord". - iIntros (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) WaitUntilPrepareDone(ts uint64) (uint64, bool) { @*) - (*@ var phase uint64 @*) - (*@ var valid bool @*) - (*@ @*) - wp_apply wp_ref_of_zero; first done. - iIntros (phaseP) "HphaseP". - wp_apply wp_ref_of_zero; first done. - iIntros (validP) "HvalidP". - - (*@ gcoord.mu.Lock() @*) - (*@ @*) - do 2 iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - wp_pures. - - (*@ for { @*) - (*@ @*) - set P := (λ (cont : bool), ∃ (pphase : gppphase) (valid : bool), - "Hgcoord" ∷ own_gcoord gcoord addrm gid γ ∗ - "HphaseP" ∷ phaseP ↦[uint64T] #(gppphase_to_u64 pphase) ∗ - "HvalidP" ∷ validP ↦[boolT] #valid ∗ - "Hlocked" ∷ locked #muP ∗ - "#Hsafep" ∷ (if (negb cont) && valid - then safe_gpreparer_phase γ ts gid pphase ∗ ⌜gpp_ready pphase⌝ - else True))%I. - wp_apply (wp_forBreak P with "[] [Hgcoord HphaseP HvalidP Hlocked]"); last first; first 1 last. - { iFrame. by iExists GPPValidating. } - { clear Φ. - - (*@ if !gcoord.attachedWith(ts) { @*) - (*@ valid = false @*) - (*@ break @*) - (*@ } @*) - (*@ @*) - iIntros (Φ) "!> HP HΦ". - iNamed "HP". - iDestruct"Hgcoord" as (tscur) "Hgcoord". - do 2 iNamed "Hgcoord". - wp_apply (wp_GroupCoordinator__attachedWith with "Hgcoord"). - iIntros (attached) "Hgcoord". - wp_pures. - destruct attached; wp_pures; last first. - { wp_store. iApply "HΦ". by iFrame. } - - (*@ ready := gcoord.gpp.ready() @*) - (*@ if ready { @*) - (*@ phase = gcoord.gpp.getPhase() @*) - (*@ valid = true @*) - (*@ break @*) - (*@ } @*) - (*@ @*) - iNamed "Hgcoord". do 2 iNamed "Hgpp". - wp_loadField. - wp_apply (wp_GroupPreparer__ready_external with "Hgpp"). - iIntros "Hgpp". - case_bool_decide; wp_pures. - { wp_loadField. - wp_apply (wp_GroupPreparer__getPhase with "Hgpp"). - iIntros "[Hgpp #Hsafegpp]". - do 2 wp_store. - iApply "HΦ". - by iFrame "∗ # %". - } - - (*@ gcoord.cv.Wait() @*) - (*@ } @*) - (*@ @*) - wp_loadField. - wp_apply (wp_Cond__Wait with "[-HΦ HphaseP HvalidP]"). - { by iFrame "Hcv Hlock Hlocked ∗ # %". } - iIntros "[Hlocked Hgcoord]". - wp_pures. - iApply "HΦ". - by iFrame. - } - subst P. iNamed 1. simpl. - - (*@ gcoord.mu.Unlock() @*) - (*@ @*) - wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ HphaseP HvalidP]"). - { by iFrame "Hlock Hlocked Hgcoord". } - - (*@ if !valid { @*) - (*@ // TXN_PREPARED here is just a placeholder. @*) - (*@ return tulip.TXN_PREPARED, false @*) - (*@ } @*) - (*@ @*) - wp_load. wp_pures. - destruct valid; wp_pures; last first. - { by iApply ("HΦ" $! TxnPrepared). } - iDestruct "Hsafep" as "[Hsafep %Hready]". - - (*@ if phase == GPP_COMMITTED { @*) - (*@ return tulip.TXN_COMMITTED, true @*) - (*@ } @*) - (*@ @*) - wp_load. wp_pures. - case_bool_decide; wp_pures. - { iApply ("HΦ" $! TxnCommitted). by destruct pphase. } - - (*@ if phase == GPP_ABORTED { @*) - (*@ return tulip.TXN_ABORTED, true @*) - (*@ } @*) - (*@ @*) - wp_load. wp_pures. - case_bool_decide; wp_pures. - { iApply ("HΦ" $! TxnAborted). by destruct pphase. } - - (*@ return tulip.TXN_PREPARED, true @*) - (*@ } @*) - iApply ("HΦ" $! TxnPrepared). by destruct pphase. - Qed. - - Theorem wp_GroupCoordinator__SendFastPrepare - (gcoord : loc) (rid : u64) (ts : u64) (pwrsP : loc) (ptgsP : Slice.t) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__SendFastPrepare #gcoord #rid #ts #pwrsP (to_val ptgsP) - {{{ RET #(); True }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendFastPrepare(rid, ts uint64, pwrs tulip.KVMap, ptgs []uint64) { @*) - (*@ gcoord.Send(rid, message.EncodeTxnFastPrepare(ts, pwrs, ptgs)) @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__SendValidate - (gcoord : loc) (rid : u64) (ts : u64) (rank : u64) (pwrsP : loc) (ptgsP : Slice.t) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__SendValidate #gcoord #rid #ts #rank #pwrsP (to_val ptgsP) - {{{ RET #(); True }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendValidate(rid, ts, rank uint64, pwrs tulip.KVMap, ptgs []uint64) { @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__SendPrepare - (gcoord : loc) (rid : u64) (tsW : u64) (rank : u64) gid γ : - let ts := uint.nat tsW in - is_group_prepare_proposal γ gid ts 1%nat true -∗ - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__SendPrepare #gcoord #rid #tsW #rank - {{{ RET #(); True }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendPrepare(rid, ts, rank uint64) { @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__SendUnprepare - (gcoord : loc) (rid : u64) (tsW : u64) (rank : u64) gid γ : - let ts := uint.nat tsW in - is_group_prepare_proposal γ gid ts 1%nat false -∗ - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__SendUnprepare #gcoord #rid #tsW #rank - {{{ RET #(); True }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendUnprepare(rid, ts, rank uint64) { @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__SendQuery - (gcoord : loc) (rid : u64) (ts : u64) (rank : u64) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__SendQuery #gcoord #rid #ts #rank - {{{ RET #(); True }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendQuery(rid, ts, rank uint64) { @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__SendRefresh - (gcoord : loc) (rid : u64) (ts : u64) (rank : u64) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__SendRefresh #gcoord #rid #ts #rank - {{{ RET #(); True }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendRefresh(rid, ts, rank uint64) { @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__SendCommit - (gcoord : loc) (rid : u64) (tsW : u64) (pwrsP : loc) q (pwrs : dbmap) gid γ : - let ts := uint.nat tsW in - safe_commit γ gid ts pwrs -∗ - is_gcoord gcoord gid γ -∗ - {{{ own_map pwrsP q pwrs }}} - GroupCoordinator__SendCommit #gcoord #rid #tsW #pwrsP - {{{ RET #(); own_map pwrsP q pwrs }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendCommit(rid, ts uint64, pwrs tulip.KVMap) { @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__SendAbort (gcoord : loc) (rid : u64) (tsW : u64) gid γ : - let ts := uint.nat tsW in - safe_abort γ ts -∗ - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__SendAbort #gcoord #rid #tsW - {{{ RET #(); True }}}. - Proof. - (*@ func (gcoord *GroupCoordinator) SendAbort(rid, ts uint64) { @*) - (*@ } @*) - Admitted. - - Theorem wp_GroupCoordinator__PrepareSession - (gcoord : loc) (rid : u64) (tsW : u64) (ptgsP : Slice.t) (pwrsP : loc) gid γ : - let ts := uint.nat tsW in - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__PrepareSession #gcoord #rid #tsW (to_val ptgsP) #pwrsP - {{{ RET #(); True }}}. - Proof. - iIntros (ts) "#Hgcoord". - iIntros (Φ) "!> _ HΦ". - wp_rec. wp_pures. - - (*@ func (gcoord *GroupCoordinator) PrepareSession(rid uint64, ts uint64, ptgs []uint64, pwrs map[string]tulip.Value) { @*) - (*@ for { @*) - (*@ @*) - wp_apply (wp_forBreak (λ _, True)%I with "[] []"); last first; first 1 last. - { done. } - { clear Φ. - - (*@ act, attached := gcoord.NextPrepareAction(rid, ts) @*) - (*@ @*) - iIntros (Φ) "!> _ HΦ". - wp_apply (wp_GroupCoordinator__NextPrepareAction with "Hgcoord"). - iIntros (action ok) "#Hsafea". - wp_pures. - - (*@ if !attached { @*) - (*@ break @*) - (*@ } @*) - (*@ @*) - destruct ok; wp_pures; last by iApply "HΦ". - - (*@ if act == GPP_FAST_PREPARE { @*) - (*@ gcoord.SendFastPrepare(rid, ts, pwrs, ptgs) @*) - (*@ } else if act == GPP_VALIDATE { @*) - (*@ gcoord.SendValidate(rid, ts, 1, pwrs, ptgs) @*) - (*@ } else if act == GPP_PREPARE { @*) - (*@ gcoord.SendPrepare(rid, ts, 1) @*) - (*@ } else if act == GPP_UNPREPARE { @*) - (*@ gcoord.SendUnprepare(rid, ts, 1) @*) - (*@ } else if act == GPP_QUERY { @*) - (*@ gcoord.SendQuery(rid, ts, 1) @*) - (*@ } else if act == GPP_REFRESH { @*) - (*@ // Keep sending keep-alive message until the transaction terminated. @*) - (*@ gcoord.SendRefresh(rid, ts, 1) @*) - (*@ } @*) - (*@ @*) - (*@ if act == GPP_REFRESH { @*) - (*@ primitive.Sleep(params.NS_SEND_REFRESH) @*) - (*@ } else { @*) - (*@ // The optimal time to sleep is the time required to arrive at a @*) - (*@ // prepare decision. Waking up too frequently means sending @*) - (*@ // unnecessary messages, too infrequently means longer latency when @*) - (*@ // messages are lost. @*) - (*@ // @*) - (*@ // This might not be optimal for slow-path prepare. Consider @*) - (*@ // optimize this with CV wait and timeout. @*) - (*@ primitive.Sleep(params.NS_RESEND_PREPARE) @*) - (*@ } @*) - (*@ } @*) - (*@ @*) - case_bool_decide as Hfp; wp_pures. - { wp_apply (wp_GroupCoordinator__SendFastPrepare with "Hgcoord"). - wp_pures. - rewrite Hfp /=. - case_bool_decide; first done. - wp_apply wp_Sleep. wp_pures. - by iApply "HΦ". - } - case_bool_decide as Hvd; wp_pures. - { wp_apply (wp_GroupCoordinator__SendValidate with "Hgcoord"). - wp_pures. - rewrite Hvd /=. - case_bool_decide; first done. - wp_apply wp_Sleep. wp_pures. - by iApply "HΦ". - } - case_bool_decide as Hprep; wp_pures. - { inv Hprep. destruct action; try done. simpl. - wp_apply (wp_GroupCoordinator__SendPrepare with "Hsafea Hgcoord"). - wp_pures. - wp_apply wp_Sleep. wp_pures. - by iApply "HΦ". - } - case_bool_decide as Hunprep; wp_pures. - { inv Hunprep. destruct action; try done. simpl. - wp_apply (wp_GroupCoordinator__SendUnprepare with "Hsafea Hgcoord"). - wp_pures. - wp_apply wp_Sleep. wp_pures. - by iApply "HΦ". - } - case_bool_decide as Hqr; wp_pures. - { wp_apply (wp_GroupCoordinator__SendQuery with "Hgcoord"). - wp_pures. - rewrite Hqr /=. - case_bool_decide; first done. - wp_apply wp_Sleep. wp_pures. - by iApply "HΦ". - } - case_bool_decide as Hrf; wp_pures. - { wp_apply (wp_GroupCoordinator__SendRefresh with "Hgcoord"). - wp_pures. - rewrite Hrf /=. - case_bool_decide; last done. - wp_apply wp_Sleep. wp_pures. - by iApply "HΦ". - } - case_bool_decide; first done. - wp_apply wp_Sleep. wp_pures. - by iApply "HΦ". - - (*@ // The coordinator is no longer associated with @ts, this could happen only @*) - (*@ // after the prepare decision for @ts on @rid is made. Hence, this session @*) - (*@ // can terminate. @*) - (*@ } @*) - } - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__Prepare - (gcoord : loc) (tsW : u64) (ptgsP : Slice.t) (pwrsP : loc) gid γ : - let ts := uint.nat tsW in - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__Prepare #gcoord #tsW (to_val ptgsP) #pwrsP - {{{ (phase : txnphase) (valid : bool), RET (#(txnphase_to_u64 phase), #valid); - if valid then safe_group_txnphase γ ts gid phase else True - }}}. - Proof. - iIntros (ts) "#Hgcoord". - iIntros (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) Prepare(ts uint64, ptgs []uint64, pwrs tulip.KVMap) (uint64, bool) { @*) - (*@ // Spawn a prepare session with each replica. @*) - (*@ for ridloop := range(gcoord.addrm) { @*) - (*@ rid := ridloop @*) - (*@ go func() { @*) - (*@ gcoord.PrepareSession(rid, ts, ptgs, pwrs) @*) - (*@ }() @*) - (*@ } @*) - (*@ @*) - iPoseProof "Hgcoord" as "Hgcoord'". - do 2 iNamed "Hgcoord". iNamed "Haddrm". - iRename "Hgcoord'" into "Hgcoord". - wp_loadField. - wp_apply (wp_MapIter_fold _ _ _ (λ _, True)%I with "Haddrm []"). - { done. } - { clear Φ. - iIntros (mx rid c Φ) "!> _ HΦ". - wp_pures. - wp_apply wp_fork. - { by wp_apply (wp_GroupCoordinator__PrepareSession with "Hgcoord"). } - by iApply "HΦ". - } - iIntros "_". - - (*@ st, valid := gcoord.WaitUntilPrepareDone(ts) @*) - (*@ return st, valid @*) - (*@ } @*) - wp_apply (wp_GroupCoordinator__WaitUntilPrepareDone with "Hgcoord"). - iIntros (phase valid) "#Hsafep". - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__GetLeader (gcoord : loc) gid addrm γ : - is_gcoord_with_addrm gcoord gid addrm γ -∗ - {{{ True }}} - GroupCoordinator__GetLeader #gcoord - {{{ (leader : u64), RET #leader; ⌜leader ∈ dom addrm⌝ }}}. - Proof. - iIntros "#Hgcoord" (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) GetLeader() uint64 { @*) - (*@ gcoord.mu.Lock() @*) - (*@ leader := gcoord.leader @*) - (*@ gcoord.mu.Unlock() @*) - (*@ return leader @*) - (*@ } @*) - iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - do 3 iNamed "Hgcoord". iNamed "Hgfl". - do 2 wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { by iFrame "Hlock Hlocked Hts Hgrd Hgpp Hcomm ∗ %". } - wp_pures. - iNamed "Haddrm". - wp_loadField. - iMod (readonly_load with "Hrps") as (q) "Hrpsro". - assert (is_Some (rps !! uint.nat idxleader)) as [leader Hlead]. - { apply lookup_lt_is_Some. - assert (length rps = size (dom addrm)); last word. - by rewrite Hdomaddrm size_list_to_set. - } - wp_apply (wp_SliceGet with "[$Hrpsro]"). - { done. } - iIntros "_". - iApply "HΦ". - iPureIntro. - apply elem_of_list_lookup_2 in Hlead. - by rewrite Hdomaddrm elem_of_list_to_set. - Qed. - - Theorem wp_GroupCoordinator__ChangeLeader (gcoord : loc) gid addrm γ : - is_gcoord_with_addrm gcoord gid addrm γ -∗ - {{{ True }}} - GroupCoordinator__ChangeLeader #gcoord - {{{ (leader : u64), RET #leader; ⌜leader ∈ dom addrm⌝ }}}. - Proof. - iIntros "#Hgcoord" (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) ChangeLeader() uint64 { @*) - (*@ gcoord.mu.Lock() @*) - (*@ leader := (gcoord.leader + 1) % uint64(len(gcoord.addrm)) @*) - (*@ gcoord.leader = leader @*) - (*@ gcoord.mu.Unlock() @*) - (*@ return leader @*) - (*@ } @*) - iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - do 3 iNamed "Hgcoord". iNamed "Hgfl". - iNamed "Haddrm". - do 2 wp_loadField. - wp_apply wp_slice_len. - wp_storeField. - iMod (readonly_load with "Hrps") as (q) "Hrpsro". - iDestruct (own_slice_small_sz with "Hrpsro") as %Hlenrps. - wp_loadField. - set idxleader' := word.modu _ _. - assert (Hltrps : (uint.nat idxleader' < length rps)%nat). - { assert (size (dom addrm) = length rps) as Hszaddrm. - { by rewrite Hdomaddrm size_list_to_set. } - rewrite word.unsigned_modu_nowrap; [word | lia]. - } - wp_apply (wp_Mutex__Unlock with "[-HΦ Hrpsro]"). - { iFrame "Hlock Hlocked Hts Hgrd Hgpp Hcomm ∗ %". - iPureIntro. - rewrite Hdomaddrm size_list_to_set; [lia | done]. - } - wp_pures. - wp_loadField. - assert (is_Some (rps !! uint.nat idxleader')) as [leader Hlead]. - { by apply lookup_lt_is_Some. } - wp_apply (wp_SliceGet with "[$Hrpsro]"). - { done. } - iIntros "_". - iApply "HΦ". - apply elem_of_list_lookup_2 in Hlead. - by rewrite Hdomaddrm elem_of_list_to_set. - Qed. - - Theorem wp_GroupCoordinator__processFinalizationResult - (gcoord : loc) (ts : u64) (res : u64) rids : - {{{ own_gcoord_finalizer gcoord rids }}} - GroupCoordinator__processFinalizationResult #gcoord #ts #res - {{{ RET #(); own_gcoord_finalizer gcoord rids }}}. - Proof. - iIntros (Φ) "Hgcoord HΦ". - wp_rec. wp_pures. - - (*@ func (gcoord *GroupCoordinator) processFinalizationResult(ts uint64, res uint64) { @*) - (*@ if res == tulip.REPLICA_WRONG_LEADER { @*) - (*@ return @*) - (*@ } @*) - (*@ delete(gcoord.tsfinals, ts) @*) - (*@ } @*) - case_bool_decide as Hwrong; wp_pures. - { by iApply "HΦ". } - iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_MapDelete with "Htsfinals"). - iIntros "Htsfinals". - wp_pures. - iApply "HΦ". - by iFrame "∗ %". - Qed. - - Theorem wp_GroupCoordinator__Finalized (gcoord : loc) (tsW : u64) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__Finalized #gcoord #tsW - {{{ (finalized : bool), RET #finalized; True }}}. - Proof. - iIntros "#Hgcoord" (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) Finalized(ts uint64) bool { @*) - (*@ gcoord.mu.Lock() @*) - (*@ _, ok := gcoord.tsfinals[ts] @*) - (*@ gcoord.mu.Unlock() @*) - (*@ return !ok @*) - (*@ } @*) - do 2 iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - do 3 iNamed "Hgcoord". iNamed "Hgfl". - wp_loadField. - wp_apply (wp_MapGet with "Htsfinals"). - iIntros (v ok) "[%Hok Htsfinals]". - wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { by iFrame "Hlock Hlocked Hts Hgrd Hgpp Hcomm ∗ %". } - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__RegisterFinalization (gcoord : loc) (tsW : u64) gid γ : - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__RegisterFinalization #gcoord #tsW - {{{ RET #(); True }}}. - Proof. - iIntros "#Hgcoord" (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) RegisterFinalization(ts uint64) { @*) - (*@ gcoord.mu.Lock() @*) - (*@ gcoord.tsfinals[ts] = true @*) - (*@ gcoord.mu.Unlock() @*) - (*@ } @*) - do 2 iNamed "Hgcoord". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hgcoord]". - do 3 iNamed "Hgcoord". iNamed "Hgfl". - wp_loadField. - wp_apply (wp_MapInsert with "Htsfinals"); first done. - iIntros "Htsfinals". - wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { by iFrame "Hlock Hlocked Hts Hgrd Hgpp Hcomm ∗ %". } - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__Commit - (gcoord : loc) (tsW : u64) (pwrsP : loc) q (pwrs : dbmap) gid γ : - let ts := uint.nat tsW in - safe_commit γ gid ts pwrs -∗ - is_gcoord gcoord gid γ -∗ - {{{ own_map pwrsP q pwrs }}} - GroupCoordinator__Commit #gcoord #tsW #pwrsP - {{{ RET #(); own_map pwrsP q pwrs }}}. - Proof. - iIntros (ts) "#Hcmted #Hgcoord". - iIntros (Φ) "!> Hpwrs HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) Commit(ts uint64, pwrs tulip.KVMap) { @*) - (*@ gcoord.RegisterFinalization(ts) @*) - (*@ @*) - wp_apply (wp_GroupCoordinator__RegisterFinalization with "Hgcoord"). - iNamed "Hgcoord". - wp_apply (wp_GroupCoordinator__GetLeader with "Hgcoord"). - iIntros (leader Hleader). - wp_apply wp_ref_to; first by auto. - iIntros (leaderP) "HleaderP". - wp_pures. - - (*@ var leader = gcoord.GetLeader() @*) - (*@ for !gcoord.Finalized(ts) { @*) - (*@ gcoord.SendCommit(leader, ts, pwrs) @*) - (*@ primitive.Sleep(params.NS_RESEND_COMMIT) @*) - (*@ // Retry with different leaders until success. @*) - (*@ leader = gcoord.ChangeLeader() @*) - (*@ } @*) - (*@ } @*) - set P := (λ _ : bool, ∃ leader' : u64, - "HleaderP" ∷ leaderP ↦[uint64T] #leader' ∗ - "Hpwrs" ∷ own_map pwrsP q pwrs ∗ - "%Hinaddrm" ∷ ⌜leader' ∈ dom addrm⌝)%I. - wp_apply (wp_forBreak_cond P with "[] [$Hpwrs $HleaderP]"); last first; first 1 last. - { done. } - { clear Φ. - iIntros (Φ) "!> HP HΦ". - wp_apply (wp_GroupCoordinator__Finalized with "[]"). - { iFrame "Hgcoord". } - iIntros (finalized) "_". - wp_pures. - destruct finalized; wp_pures. - { by iApply "HΦ". } - iNamed "HP". - wp_load. - wp_apply (wp_GroupCoordinator__SendCommit with "Hcmted [] Hpwrs"). - { iFrame "Hgcoord". } - iIntros "Hpwrs". - wp_apply wp_Sleep. - wp_apply (wp_GroupCoordinator__ChangeLeader). - { iFrame "Hgcoord". } - iIntros (leadernew Hleadernew). - wp_store. - iApply "HΦ". - by iFrame. - } - iNamed 1. - wp_pures. - by iApply "HΦ". - Qed. - - Theorem wp_GroupCoordinator__Abort (gcoord : loc) (tsW : u64) gid γ : - let ts := uint.nat tsW in - safe_abort γ ts -∗ - is_gcoord gcoord gid γ -∗ - {{{ True }}} - GroupCoordinator__Abort #gcoord #tsW - {{{ RET #(); True }}}. - Proof. - iIntros (ts) "#Habted #Hgcoord". - iIntros (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (gcoord *GroupCoordinator) Abort(ts uint64) { @*) - (*@ gcoord.RegisterFinalization(ts) @*) - (*@ @*) - wp_apply (wp_GroupCoordinator__RegisterFinalization with "Hgcoord"). - iNamed "Hgcoord". - wp_apply (wp_GroupCoordinator__GetLeader with "Hgcoord"). - iIntros (leader Hleader). - wp_apply wp_ref_to; first by auto. - iIntros (leaderP) "HleaderP". - wp_pures. - - (*@ var leader = gcoord.GetLeader() @*) - (*@ for !gcoord.Finalized(ts) { @*) - (*@ gcoord.SendAbort(leader, ts) @*) - (*@ primitive.Sleep(params.NS_RESEND_ABORT) @*) - (*@ // Retry with different leaders until success. @*) - (*@ leader = gcoord.ChangeLeader() @*) - (*@ } @*) - (*@ } @*) - set P := (λ _ : bool, ∃ leader' : u64, leaderP ↦[uint64T] #leader' ∗ ⌜leader' ∈ dom addrm⌝)%I. - wp_apply (wp_forBreak_cond P with "[] [$HleaderP]"); last first; first 1 last. - { done. } - { clear Φ. - iIntros (Φ) "!> HP HΦ". - wp_apply (wp_GroupCoordinator__Finalized with "[]"). - { iFrame "Hgcoord". } - iIntros (finalized) "_". - wp_pures. - destruct finalized; wp_pures. - { by iApply "HΦ". } - iDestruct "HP" as (leader') "[HleaderP %Hin]". - wp_load. - wp_apply (wp_GroupCoordinator__SendAbort with "Habted"). - { iFrame "Hgcoord". } - wp_apply wp_Sleep. - wp_apply (wp_GroupCoordinator__ChangeLeader). - { iFrame "Hgcoord". } - iIntros (leadernew Hleadernew). - wp_store. - iApply "HΦ". - by iFrame. - } - iIntros "_". - wp_pures. - by iApply "HΦ". - Qed. - -End program. diff --git a/src/program_proof/tulip/program/gcoord/group_preparer.v b/src/program_proof/tulip/program/gcoord/group_preparer.v deleted file mode 100644 index bb18f49ce..000000000 --- a/src/program_proof/tulip/program/gcoord/group_preparer.v +++ /dev/null @@ -1,1592 +0,0 @@ -From Perennial.program_proof.tulip.invariance Require Import propose. -From Perennial.program_proof.tulip.program Require Import prelude. -From Perennial.program_proof.tulip.program Require Import quorum count_bool_map. - -Local Ltac Zify.zify_post_hook ::= Z.div_mod_to_equations. - -Inductive gppphase := -| GPPValidating -| GPPPreparing -| GPPUnpreparing -| GPPWaiting -| GPPPrepared -| GPPCommitted -| GPPAborted. - -Definition gppphase_to_u64 phase := - match phase with - | GPPValidating => (W64 0) - | GPPPreparing => (W64 1) - | GPPUnpreparing => (W64 2) - | GPPWaiting => (W64 3) - | GPPPrepared => (W64 4) - | GPPCommitted => (W64 5) - | GPPAborted => (W64 6) - end. - -#[global] -Instance gppphase_to_u64_inj : - Inj eq eq gppphase_to_u64. -Proof. intros x y H. by destruct x, y. Defined. - -Inductive gppaction := -| GPPFastPrepare -| GPPValidate -| GPPPrepare -| GPPUnprepare -| GPPQuery -| GPPRefresh. - -Definition gppaction_to_u64 action := - match action with - | GPPFastPrepare => (W64 0) - | GPPValidate => (W64 1) - | GPPPrepare => (W64 2) - | GPPUnprepare => (W64 3) - | GPPQuery => (W64 4) - | GPPRefresh => (W64 5) - end. - -#[global] -Instance gppaction_to_u64_inj : - Inj eq eq gppaction_to_u64. -Proof. intros x y H. by destruct x, y. Defined. - -Definition gpp_ready phase := - match phase with - | GPPValidating => False - | GPPPreparing => False - | GPPUnpreparing => False - | GPPWaiting => False - | GPPPrepared => True - | GPPCommitted => True - | GPPAborted => True - end. - -#[global] -Instance gpp_ready_decision phase : - Decision (gpp_ready phase). -Proof. destruct phase; apply _. Defined. - -Section repr. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - (*@ type GroupPreparer struct { @*) - (*@ // Number of replicas. Read-only. @*) - (*@ nrps uint64 @*) - (*@ // Control phase. @*) - (*@ phase uint64 @*) - (*@ // Fast-path replica responses. @*) - (*@ frespm map[uint64]bool @*) - (*@ // Replicas validated. @*) - (*@ vdm map[uint64]bool @*) - (*@ // Slow-path replica responses. @*) - (*@ // NB: The range doesn't need to be bool, unit would suffice. @*) - (*@ srespm map[uint64]bool @*) - (*@ // @*) - (*@ // TODO: Merge @validated and @sresps @*) - (*@ // @phase = VALIDATING => records whether a certain replica is validated; @*) - (*@ // @phase = PREPARING / UNPREPARING => records prepared/unprepared. @*) - (*@ // @*) - (*@ } @*) - Definition own_gpreparer_nrps (gpp : loc) : iProp Σ := - ∃ (nrps : u64), - "Hnrps" ∷ gpp ↦[GroupPreparer :: "nrps"] #nrps ∗ - "%Hnrps" ∷ ⌜uint.nat nrps = size rids_all⌝. - - Definition own_gpreparer_phase (gpp : loc) (phase : gppphase) : iProp Σ := - ∃ (phaseW : u64), - "HphaseP" ∷ gpp ↦[GroupPreparer :: "phase"] #phaseW ∗ - "%Hphase" ∷ ⌜gppphase_to_u64 phase = phaseW⌝. - - Definition fast_prepare_responses γ ts gid (frespm : gmap u64 bool) : iProp Σ := - [∗ map] rid ↦ p ∈ frespm, - is_replica_pdec_at_rank γ gid rid ts O p ∗ - (if p then is_replica_validated_ts γ gid rid ts else True). - - Definition validation_responses γ ts gid (vdm : gmap u64 bool) : iProp Σ := - ([∗ set] rid ∈ dom vdm, is_replica_validated_ts γ gid rid ts). - - Definition slow_prepare_responses γ ts gid phase (srespm : gmap u64 bool) : iProp Σ := - match phase with - | GPPValidating => True - | GPPPreparing => - ([∗ set] rid ∈ dom srespm, is_replica_pdec_at_rank γ gid rid ts 1%nat true) - | GPPUnpreparing => - ([∗ set] rid ∈ dom srespm, is_replica_pdec_at_rank γ gid rid ts 1%nat false) - | GPPWaiting => True - | GPPPrepared => True - | GPPCommitted => True - | GPPAborted => True - end. - - #[global] - Instance slow_prepare_responses_persistent γ ts gid phase srespm : - Persistent (slow_prepare_responses γ ts gid phase srespm). - Proof. destruct phase; apply _. Defined. - - Definition safe_gpreparer_phase γ ts gid phase : iProp Σ := - match phase with - | GPPValidating => True - | GPPPreparing => - quorum_validated γ gid ts ∗ is_group_prepare_proposal γ gid ts 1%nat true - | GPPUnpreparing => is_group_prepare_proposal γ gid ts 1%nat false - | GPPWaiting => True - | GPPPrepared => - quorum_prepared γ gid ts ∗ quorum_validated γ gid ts - | GPPCommitted => ∃ wrs, is_txn_committed γ ts wrs - | GPPAborted => is_txn_aborted γ ts ∨ quorum_unprepared γ gid ts - end. - - #[global] - Instance safe_gpreparer_phase_persistent γ ts gid phase : - Persistent (safe_gpreparer_phase γ ts gid phase). - Proof. destruct phase; apply _. Defined. - - Definition slow_path_permission γ ts gid phase : iProp Σ := - match phase with - | GPPValidating => own_txn_client_token γ ts gid - | GPPPreparing => True - | GPPUnpreparing => True - | GPPWaiting => True - | GPPPrepared => True - | GPPCommitted => True - | GPPAborted => True - end. - - Definition own_gpreparer_frespm (gpp : loc) ts gid γ : iProp Σ := - ∃ (frespmP : loc) (frespm : gmap u64 bool), - "HfrespmP" ∷ gpp ↦[GroupPreparer :: "frespm"] #frespmP ∗ - "Hfrespm" ∷ own_map frespmP (DfracOwn 1) frespm ∗ - "#Hfast" ∷ fast_prepare_responses γ ts gid frespm ∗ - "%Hfincl" ∷ ⌜dom frespm ⊆ rids_all⌝. - - Definition own_gpreparer_vdm (gpp : loc) ts gid γ : iProp Σ := - ∃ (vdmP : loc) (vdm : gmap u64 bool), - "HvdmP" ∷ gpp ↦[GroupPreparer :: "vdm"] #vdmP ∗ - "Hvdm" ∷ own_map vdmP (DfracOwn 1) vdm ∗ - "#Hvalidation" ∷ validation_responses γ ts gid vdm ∗ - "%Hvincl" ∷ ⌜dom vdm ⊆ rids_all⌝. - - Definition own_srespm_map_conditional - phase srespmP (srespm : gmap u64 bool) : iProp Σ := - match phase with - | GPPValidating => True - | GPPPreparing => own_map srespmP (DfracOwn 1) srespm - | GPPUnpreparing => own_map srespmP (DfracOwn 1) srespm - | GPPWaiting => True - | GPPPrepared => True - | GPPCommitted => True - | GPPAborted => True - end. - - Definition own_gpreparer_srespm (gpp : loc) (phase : gppphase) ts gid γ : iProp Σ := - ∃ (srespmP : loc) (srespm : gmap u64 bool), - "HsrespmP" ∷ gpp ↦[GroupPreparer :: "srespm"] #srespmP ∗ - "Hsrespm" ∷ own_srespm_map_conditional phase srespmP srespm ∗ - "#Hslow" ∷ slow_prepare_responses γ ts gid phase srespm ∗ - "%Hsincl" ∷ ⌜dom srespm ⊆ rids_all⌝. - - Definition own_gpreparer_with_phase - (gpp : loc) (phase : gppphase) ts gid γ : iProp Σ := - "Hnrps" ∷ own_gpreparer_nrps gpp ∗ - "Hphase" ∷ own_gpreparer_phase gpp phase ∗ - "Hfrespm" ∷ own_gpreparer_frespm gpp ts gid γ ∗ - "Hvdm" ∷ own_gpreparer_vdm gpp ts gid γ ∗ - "Hsrespm" ∷ own_gpreparer_srespm gpp phase ts gid γ ∗ - "Htxncli" ∷ slow_path_permission γ ts gid phase ∗ - "#Hsafe" ∷ safe_gpreparer_phase γ ts gid phase. - - Definition own_gpreparer (gpp : loc) ts gid γ : iProp Σ := - ∃ (phase : gppphase), - "Hgpp" ∷ own_gpreparer_with_phase gpp phase ts gid γ. - -End repr. - -Section program. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - Theorem wp_GroupPreparer__cquorum (gpp : loc) (n : u64) : - {{{ own_gpreparer_nrps gpp }}} - GroupPreparer__cquorum #gpp #n - {{{ RET #(bool_decide (size rids_all / 2 < uint.Z n)); own_gpreparer_nrps gpp }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) cquorum(n uint64) bool { @*) - (*@ return quorum.ClassicQuorum(gpp.nrps) <= n @*) - (*@ } @*) - iNamed "Hgpp". - wp_loadField. - wp_apply wp_ClassicQuorum. - iIntros (x Hx). - wp_pures. - case_bool_decide as Hc1. - { case_bool_decide as Hc2; last word. - iApply "HΦ". by iFrame "∗ %". - } - { case_bool_decide as Hc2; first word. - iApply "HΦ". by iFrame "∗ %". - } - Qed. - - Theorem wp_GroupPreparer__fquorum (gpp : loc) (n : u64) : - {{{ own_gpreparer_nrps gpp }}} - GroupPreparer__fquorum #gpp #n - {{{ RET #(bool_decide (((3 * size rids_all + 3) / 4 ≤ uint.Z n) ∧ size rids_all ≠ O)); - own_gpreparer_nrps gpp - }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) fquorum(n uint64) bool { @*) - (*@ return quorum.FastQuorum(gpp.nrps) <= n @*) - (*@ } @*) - iNamed "Hgpp". - wp_loadField. - wp_apply wp_FastQuorum. - { rewrite size_rids_all in Hnrps. word. } - iIntros (x Hx). - wp_pures. - case_bool_decide as Hc1. - { case_bool_decide as Hc2; last word. - iApply "HΦ". by iFrame "∗ %". - } - { case_bool_decide as Hc2. - { exfalso. - apply Classical_Prop.not_and_or in Hc1. - destruct Hc1 as [Hc1 | Hz]; last first. - { rewrite size_rids_all in Hz. lia. } - word. - } - iApply "HΦ". by iFrame "∗ %". - } - Qed. - - Theorem wp_GroupPreparer__hcquorum (gpp : loc) (n : u64) : - {{{ own_gpreparer_nrps gpp }}} - GroupPreparer__hcquorum #gpp #n - {{{ RET #(bool_decide (size rids_all / 4 + 1 ≤ uint.Z n)); - own_gpreparer_nrps gpp - }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) hcquorum(n uint64) bool { @*) - (*@ return quorum.Half(quorum.ClassicQuorum(gpp.nrps)) <= n @*) - (*@ } @*) - iNamed "Hgpp". - wp_loadField. - wp_apply wp_ClassicQuorum. - iIntros (x Hx). - wp_apply wp_Half. - { clear -Hx. word. } - iIntros (y Hy). - wp_pures. - case_bool_decide as Hc1. - { case_bool_decide as Hc2; last first. - { exfalso. clear -Hnrps Hx Hy Hc1 Hc2. word. } - iApply "HΦ". by iFrame "∗ %". - } - { case_bool_decide as Hc2. - { exfalso. clear -Hnrps Hx Hy Hc1 Hc2. word. } - iApply "HΦ". by iFrame "∗ %". - } - Qed. - - Theorem wp_GroupPreparer__ready (gpp : loc) phase : - {{{ own_gpreparer_phase gpp phase }}} - GroupPreparer__ready #gpp - {{{ RET #(bool_decide (gpp_ready phase)); own_gpreparer_phase gpp phase }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) ready() bool { @*) - (*@ return GPP_PREPARED <= gpp.phase @*) - (*@ } @*) - iNamed "Hgpp". - wp_loadField. - wp_pures. - rewrite /gppphase_to_u64 in Hphase. - rewrite /gpp_ready. - case_bool_decide as Hcond. - { case_bool_decide as Hret. - { iApply "HΦ". by iFrame. } - destruct phase; word. - } - { case_bool_decide as Hret; last first. - { iApply "HΦ". by iFrame. } - destruct phase; word. - } - Qed. - - Theorem wp_GroupPreparer__ready_external (gpp : loc) phase ts gid γ : - {{{ own_gpreparer_with_phase gpp phase ts gid γ }}} - GroupPreparer__ready #gpp - {{{ RET #(bool_decide (gpp_ready phase)); own_gpreparer_with_phase gpp phase ts gid γ }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - iNamed "Hgpp". - wp_apply (wp_GroupPreparer__ready with "Hphase"). - iIntros "Hphase". - iApply "HΦ". - by iFrame "∗ #". - Qed. - - Definition try_resign_requirement γ ts (res : rpres) : iProp Σ := - match res with - | ReplicaOK => True - | ReplicaCommittedTxn => (∃ wrs, is_txn_committed γ ts wrs) - | ReplicaAbortedTxn => is_txn_aborted γ ts - | ReplicaStaleCoordinator => True - | ReplicaFailedValidation => True - | ReplicaInvalidRank => True - | ReplicaWrongLeader => True - end. - - #[global] - Instance try_resign_requirement_persistent γ ts res : - Persistent (try_resign_requirement γ ts res). - Proof. destruct res; apply _. Defined. - - Definition not_finalizing_rpres (res : rpres) := - match res with - | ReplicaOK => True - | ReplicaCommittedTxn => False - | ReplicaAbortedTxn => False - | ReplicaStaleCoordinator => False - | ReplicaFailedValidation => True - | ReplicaInvalidRank => True - | ReplicaWrongLeader => True - end. - - Theorem wp_GroupPreparer__tryResign (gpp : loc) (res : rpres) ts gid γ : - try_resign_requirement γ ts res -∗ - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__tryResign #gpp #(rpres_to_u64 res) - {{{ (resigned : bool), RET #resigned; - own_gpreparer gpp ts gid γ ∗ - ⌜if resigned then True else not_finalizing_rpres res⌝ - }}}. - Proof. - iIntros "#Hreq" (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) tryResign(res uint64) bool { @*) - (*@ if gpp.ready() { @*) - (*@ return true @*) - (*@ } @*) - (*@ @*) - do 2 iNamed "Hgpp". - wp_apply (wp_GroupPreparer__ready with "Hphase"). - iIntros "Hphase". - case_bool_decide as Hready; wp_pures. - { iApply "HΦ". by iFrame. } - - (*@ if res == tulip.REPLICA_COMMITTED_TXN { @*) - (*@ gpp.phase = GPP_COMMITTED @*) - (*@ return true @*) - (*@ } @*) - (*@ @*) - case_bool_decide as Hcmted; wp_pures. - { iNamed "Hphase". - destruct res; try done. - wp_storeField. - iApply "HΦ". - iModIntro. - iSplit; last done. - iExists GPPCommitted. - iFrame "∗ # %". - iSplit; first done. - iNamed "Hsrespm". - by iFrame "∗ %". - } - - (*@ if res == tulip.REPLICA_ABORTED_TXN { @*) - (*@ gpp.phase = GPP_ABORTED @*) - (*@ return true @*) - (*@ } @*) - (*@ @*) - case_bool_decide as Habted; wp_pures. - { iNamed "Hphase". - destruct res; try done. - wp_storeField. - iApply "HΦ". - iModIntro. - iSplit; last done. - iExists GPPAborted. - iFrame "∗ # %". - iSplit; first done. - iNamed "Hsrespm". - by iFrame "∗ %". - } - - (*@ if res == tulip.REPLICA_STALE_COORDINATOR { @*) - (*@ return true @*) - (*@ } @*) - (*@ @*) - case_bool_decide as Hstale; wp_pures. - { iApply "HΦ". by iFrame. } - - (*@ return false @*) - (*@ } @*) - iApply "HΦ". - iFrame "∗ # %". - iPureIntro. - by destruct res. - Qed. - - Theorem wp_GroupPreparer__tryFastAbort (gpp : loc) ts gid γ : - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__tryFastAbort #gpp - {{{ (aborted : bool), RET #aborted; own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) tryFastAbort() bool { @*) - (*@ // Count how many replicas have fast unprepared. @*) - (*@ n := util.CountBoolMap(gpp.frespm, false) @*) - (*@ @*) - do 2 iNamed "Hgpp". iNamed "Hfrespm". - wp_loadField. - wp_apply (wp_CountBoolMap with "Hfrespm"). - iIntros (n) "[Hfrespm %Hn]". - iAssert (own_gpreparer_frespm gpp ts gid γ)%I - with "[HfrespmP Hfrespm]" as "Hfrespm". - { by iFrame "∗ # %". } - - (*@ // Move to the ABORTED phase if obtaining a fast quorum of fast unprepares. @*) - (*@ if gpp.fquorum(n) { @*) - (*@ gpp.phase = GPP_ABORTED @*) - (*@ return true @*) - (*@ } @*) - (*@ return false @*) - (*@ } @*) - wp_apply (wp_GroupPreparer__fquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hfq; wp_pures. - { iNamed "Hphase". - wp_storeField. - iApply "HΦ". - iModIntro. - iExists GPPAborted. - iFrame "∗ #". - iSplit; first done. - iSplitL "Hsrespm". - { iNamed "Hsrespm". by iFrame "∗ %". } - iSplit; first done. - iRight. - iExists O. - rewrite /quorum_pdec_at_rank. - case_decide; last done. - set frespmq := filter _ _ in Hn. - iExists (dom frespmq). - iSplit; last first. - { iPureIntro. - split. - { etrans; last apply Hfincl. apply dom_filter_subseteq. } - { destruct Hfq as [Hfq Hnz]. - split; last done. - rewrite size_dom. - clear -Hfq Hn. word. - } - } - rewrite /fast_prepare_responses. - iDestruct (big_sepM_subseteq _ _ frespmq with "Hfast") as "Hfastq". - { apply map_filter_subseteq. } - rewrite big_sepS_big_sepM. - iApply (big_sepM_mono with "Hfastq"). - iIntros (rid b Hb) "[Hpdec _]". - apply map_lookup_filter_Some in Hb as [_ Hb]. simpl in Hb. - by subst b. - } - iApply "HΦ". - by iFrame "∗ # %". - Qed. - - Theorem wp_GroupPreparer__tryFastPrepare (gpp : loc) ts gid γ : - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__tryFastPrepare #gpp - {{{ (prepared : bool), RET #prepared; own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) tryFastPrepare() bool { @*) - (*@ // Count how many replicas have fast prepared. @*) - (*@ n := util.CountBoolMap(gpp.frespm, true) @*) - (*@ @*) - do 2 iNamed "Hgpp". iNamed "Hfrespm". - wp_loadField. - wp_apply (wp_CountBoolMap with "Hfrespm"). - iIntros (n) "[Hfrespm %Hn]". - iAssert (own_gpreparer_frespm gpp ts gid γ)%I - with "[HfrespmP Hfrespm]" as "Hfrespm". - { by iFrame "∗ # %". } - - (*@ // Move to the PREPARED phase if obtaining a fast quorum of fast prepares. @*) - (*@ if gpp.fquorum(n) { @*) - (*@ gpp.phase = GPP_PREPARED @*) - (*@ return true @*) - (*@ } @*) - (*@ return false @*) - (*@ } @*) - wp_apply (wp_GroupPreparer__fquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hfq; wp_pures. - { iNamed "Hphase". - wp_storeField. - iApply "HΦ". - iModIntro. - iExists GPPPrepared. - iFrame "∗ #". - iSplit; first done. - iSplitL "Hsrespm". - { iNamed "Hsrespm". by iFrame "∗ %". } - iSplit; first done. - set frespmq := filter _ _ in Hn. - iSplit. - { (* Prove [quorum_prepared]. *) - iExists O. - rewrite /quorum_pdec_at_rank. - case_decide; last done. - iExists (dom frespmq). - iSplit; last first. - { iPureIntro. - split. - { etrans; last apply Hfincl. apply dom_filter_subseteq. } - { destruct Hfq as [Hfq Hnz]. - split; last done. - rewrite size_dom. - clear -Hfq Hn. word. - } - } - rewrite /fast_prepare_responses. - iDestruct (big_sepM_subseteq _ _ frespmq with "Hfast") as "Hfastq". - { apply map_filter_subseteq. } - rewrite big_sepS_big_sepM. - iApply (big_sepM_mono with "Hfastq"). - iIntros (rid b Hb) "[Hpdec _]". - apply map_lookup_filter_Some in Hb as [_ Hb]. simpl in Hb. - by subst b. - } - { (* Prove [quorum_validated]. *) - iExists (dom frespmq). - iSplit; last first. - { iPureIntro. - split. - { etrans; last apply Hfincl. apply dom_filter_subseteq. } - { destruct Hfq as [Hfq Hnz]. - rewrite /cquorum_size size_dom. - clear -Hfq Hn Hnz. word. - } - } - rewrite /fast_prepare_responses. - iDestruct (big_sepM_subseteq _ _ frespmq with "Hfast") as "Hfastq". - { apply map_filter_subseteq. } - iDestruct (big_sepM_sep with "Hfastq") as "[_ Hvdq]". - rewrite big_sepS_big_sepM. - iApply (big_sepM_mono with "Hvdq"). - iIntros (rid b Hb) "Hvd". - apply map_lookup_filter_Some in Hb as [_ Hb]. simpl in Hb. - by subst b. - } - } - iApply "HΦ". - by iFrame "∗ # %". - Qed. - - Theorem wp_GroupPreparer__tryBecomePreparing (gpp : loc) ts gid γ : - gid ∈ gids_all -> - know_tulip_inv γ -∗ - {{{ own_gpreparer_with_phase gpp GPPValidating ts gid γ }}} - GroupPreparer__tryBecomePreparing #gpp - {{{ RET #(); own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Hgid) "#Hinv". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) tryBecomePreparing() { @*) - (*@ // Count how many replicas have validated. @*) - (*@ nvd := uint64(len(gpp.vdm)) @*) - (*@ if !gpp.cquorum(nvd) { @*) - (*@ // Cannot move to the PREPARING phase unless some classic quorum of @*) - (*@ // replicas successfully validate. @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - iNamed "Hgpp". iNamed "Hvdm". - wp_loadField. - wp_apply (wp_MapLen with "Hvdm"). - iIntros "[%Hnvdmnoof Hvdm]". - iAssert (own_gpreparer_vdm gpp ts gid γ)%I with "[HvdmP Hvdm]" as "Hvdm". - { iFrame "∗ # %". } - wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hnvd; wp_pures; last first. - { iApply "HΦ". by iFrame "∗ #". } - - (*@ // Count how many replicas have responded in the fast path. @*) - (*@ nresp := uint64(len(gpp.frespm)) @*) - (*@ if !gpp.cquorum(nresp) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - iNamed "Hfrespm". - wp_loadField. - wp_apply (wp_MapLen with "Hfrespm"). - iIntros "[%Hnrespmnoof Hfrespm]". - wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hnresp; wp_pures; last first. - { iApply "HΦ". by iFrame "∗ # %". } - - (*@ // Count how many replicas have prepared. @*) - (*@ nfp := util.CountBoolMap(gpp.frespm, true) @*) - (*@ if !gpp.hcquorum(nfp) { @*) - (*@ // Cannot move to the PREPARING phase unless half (i.e., celing(n / 2)) @*) - (*@ // of replicas in some classic quorum agrees to prepare. @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_loadField. - wp_apply (wp_CountBoolMap with "Hfrespm"). - iIntros (nfp) "[Hfrespm %Hnfp]". - wp_apply (wp_GroupPreparer__hcquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hhcq; wp_pures; last first. - { iApply "HΦ". by iFrame "∗ # %". } - (* Prove [safe_proposal γ gid ts 1%nat true] to propose [true] at rank 1 for [ts]. *) - iAssert (safe_proposal γ gid ts 1%nat true)%I as "#Hsafepsl". - { simpl. - iDestruct (big_sepM_sep with "Hfast") as "[Hpdecx _]". - rewrite /is_replica_pdec_at_rank. - iDestruct (big_sepM_exists_sepM2 with "Hpdecx") as (bm) "Hpdecy". - iDestruct (big_sepM2_and with "Hpdecy") as "[Hpdec Hacpt]". - iDestruct (big_sepM2_pure with "Hacpt") as %[_ Hacpt]. - iDestruct (big_sepM2_dom with "Hpdec") as %Hdombm. - assert (Hcq : cquorum rids_all (dom bm)). - { rewrite -Hdombm. - split; first apply Hfincl. - rewrite /cquorum_size size_dom. - clear -Hnresp. word. - } - iExists bm. - set sc := size rids_all. - simpl. - assert (latest_before_quorum 1 bm = O) as ->. - { unshelve epose proof (latest_before_quorum_lt bm 1%nat _ _) as Hltone. - { rewrite -dom_empty_iff_L. by eapply cquorum_non_empty_q. } - { done. } - lia. - } - iSplit. - { iApply (big_sepM2_sepM_impl with "Hpdec"); first done. - iIntros (rid b l1 l2 Hb Hl1 Hl2) "!> #Hlb". - rewrite Hl1 in Hl2. by inv Hl2. - } - iSplit; first done. - iPureIntro. - split; first apply Hcq. - split. - { intros k l Hl. - assert (is_Some (frespm !! k)) as [b Hb]. - { by rewrite -elem_of_dom Hdombm elem_of_dom. } - specialize (Hacpt _ _ _ Hb Hl). - apply lookup_lt_Some in Hacpt. - clear -Hacpt. lia. - } - simpl. - assert (Heq : (uint.nat nfp ≤ nfast bm true)%nat). - { rewrite Hnfp /nfast -2!size_dom. - apply subseteq_size. - intros x Hx. - apply elem_of_dom in Hx as [b Hb]. - apply map_lookup_filter_Some in Hb as [Hb Heq]. - simpl in Heq. subst b. - assert (is_Some (bm !! x)) as [l Hl]. - { by rewrite -elem_of_dom -Hdombm elem_of_dom. } - specialize (Hacpt _ _ _ Hb Hl). - apply elem_of_dom. - exists l. - by apply map_lookup_filter_Some. - } - clear -Hhcq Heq. word. - } - - (*@ gpp.srespm = make(map[uint64]bool) @*) - (*@ gpp.phase = GPP_PREPARING @*) - (*@ @*) - iNamed "Hsrespm". - wp_apply wp_NewMap. - iClear "Hsrespm". - iIntros (srespmP') "Hsrespm". - wp_storeField. - iNamed "Hphase". - simpl. - wp_storeField. - iAssert (own_gpreparer_frespm gpp ts gid γ)%I - with "[HfrespmP Hfrespm]" as "Hfrespm". - { iFrame "∗ # %". } - iAssert (own_gpreparer_phase gpp GPPPreparing)%I - with "[HphaseP]" as "Hphase". - { by iFrame. } - iAssert (own_gpreparer_srespm gpp GPPPreparing ts gid γ)%I - with "[HsrespmP Hsrespm]" as "Hsrespm". - { iFrame. by rewrite /= dom_empty_L big_sepS_empty. } - - (*@ // Logical action: Propose. @*) - (*@ } @*) - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - simpl. - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". - { apply Hgid. } - iMod (group_inv_propose with "Hsafepsl [Htxncli] Hgroup") as "[Hgroup #Hppsl]". - { done. } - { by rewrite /exclusive_proposal /=. } - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iApply "HΦ". - iFrame "∗ #". - iPureIntro. - split; first apply Hvincl. - rewrite /cquorum_size size_dom. - clear -Hnvd. word. - Qed. - - Theorem wp_GroupPreparer__tryBecomeUnpreparing (gpp : loc) ts gid γ : - gid ∈ gids_all -> - know_tulip_inv γ -∗ - {{{ own_gpreparer_with_phase gpp GPPValidating ts gid γ }}} - GroupPreparer__tryBecomeUnpreparing #gpp - {{{ RET #(); own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Hgid) "#Hinv". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) tryBecomeUnpreparing() { @*) - (*@ // Count how many replicas have responded in the fast path. @*) - (*@ nresp := uint64(len(gpp.frespm)) @*) - (*@ if !gpp.cquorum(nresp) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - iNamed "Hgpp". - iNamed "Hfrespm". - wp_loadField. - wp_apply (wp_MapLen with "Hfrespm"). - iIntros "[%Hnrespmnoof Hfrespm]". - wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hnresp; wp_pures; last first. - { iApply "HΦ". by iFrame "∗ # %". } - - (*@ // Count how many replicas have unprepared. @*) - (*@ nfu := util.CountBoolMap(gpp.frespm, false) @*) - (*@ if !gpp.hcquorum(nfu) { @*) - (*@ // Cannot move to the UNPREPARING phase unless half of replicas in some @*) - (*@ // classic quorum agrees to unprepare. @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_loadField. - wp_apply (wp_CountBoolMap with "Hfrespm"). - iIntros (nfp) "[Hfrespm %Hnfp]". - wp_apply (wp_GroupPreparer__hcquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hhcq; wp_pures; last first. - { iApply "HΦ". by iFrame "∗ # %". } - (* Prove [safe_proposal γ gid ts 1%nat true] to propose [true] at rank 1 for [ts]. *) - iAssert (safe_proposal γ gid ts 1%nat false)%I as "#Hsafepsl". - { simpl. - iDestruct (big_sepM_sep with "Hfast") as "[Hpdecx _]". - rewrite /is_replica_pdec_at_rank. - iDestruct (big_sepM_exists_sepM2 with "Hpdecx") as (bm) "Hpdecy". - iDestruct (big_sepM2_and with "Hpdecy") as "[Hpdec Hacpt]". - iDestruct (big_sepM2_pure with "Hacpt") as %[_ Hacpt]. - iDestruct (big_sepM2_dom with "Hpdec") as %Hdombm. - assert (Hcq : cquorum rids_all (dom bm)). - { rewrite -Hdombm. - split; first apply Hfincl. - rewrite /cquorum_size size_dom. - clear -Hnresp. word. - } - iExists bm. - set sc := size rids_all. - simpl. - assert (latest_before_quorum 1 bm = O) as ->. - { unshelve epose proof (latest_before_quorum_lt bm 1%nat _ _) as Hltone. - { rewrite -dom_empty_iff_L. by eapply cquorum_non_empty_q. } - { done. } - lia. - } - iSplit. - { iApply (big_sepM2_sepM_impl with "Hpdec"); first done. - iIntros (rid b l1 l2 Hb Hl1 Hl2) "!> #Hlb". - rewrite Hl1 in Hl2. by inv Hl2. - } - iSplit; first done. - iPureIntro. - split; first apply Hcq. - split. - { intros k l Hl. - assert (is_Some (frespm !! k)) as [b Hb]. - { by rewrite -elem_of_dom Hdombm elem_of_dom. } - specialize (Hacpt _ _ _ Hb Hl). - apply lookup_lt_Some in Hacpt. - clear -Hacpt. lia. - } - simpl. - assert (Heq : (uint.nat nfp ≤ nfast bm false)%nat). - { rewrite Hnfp /nfast -2!size_dom. - apply subseteq_size. - intros x Hx. - apply elem_of_dom in Hx as [b Hb]. - apply map_lookup_filter_Some in Hb as [Hb Heq]. - simpl in Heq. subst b. - assert (is_Some (bm !! x)) as [l Hl]. - { by rewrite -elem_of_dom -Hdombm elem_of_dom. } - specialize (Hacpt _ _ _ Hb Hl). - apply elem_of_dom. - exists l. - by apply map_lookup_filter_Some. - } - clear -Hhcq Heq. word. - } - - (*@ gpp.srespm = make(map[uint64]bool) @*) - (*@ gpp.phase = GPP_UNPREPARING @*) - (*@ @*) - iNamed "Hsrespm". - wp_apply wp_NewMap. - iClear "Hsrespm". - iIntros (srespmP') "Hsrespm". - wp_storeField. - iNamed "Hphase". - simpl. - wp_storeField. - iAssert (own_gpreparer_frespm gpp ts gid γ)%I - with "[HfrespmP Hfrespm]" as "Hfrespm". - { iFrame "∗ # %". } - iAssert (own_gpreparer_phase gpp GPPUnpreparing)%I - with "[HphaseP]" as "Hphase". - { by iFrame. } - iAssert (own_gpreparer_srespm gpp GPPUnpreparing ts gid γ)%I - with "[HsrespmP Hsrespm]" as "Hsrespm". - { iFrame. by rewrite /= dom_empty_L big_sepS_empty. } - - (*@ // Logical action: Propose. @*) - (*@ } @*) - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - simpl. - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". - { apply Hgid. } - iMod (group_inv_propose with "Hsafepsl [Htxncli] Hgroup") as "[Hgroup #Hppsl]". - { done. } - { by rewrite /exclusive_proposal /=. } - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iApply "HΦ". - by iFrame "∗ #". - Qed. - - Theorem wp_GroupPreparer__collectFastDecision - (gpp : loc) (rid : u64) (b : bool) ts gid γ : - rid ∈ rids_all -> - is_replica_pdec_at_rank γ gid rid ts O b -∗ - (if b then is_replica_validated_ts γ gid rid ts else True) -∗ - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__collectFastDecision #gpp #rid #b - {{{ RET #(); own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Hrid) "#Hpdec #Hvd". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) collectFastDecision(rid uint64, b bool) { @*) - (*@ gpp.frespm[rid] = b @*) - (*@ } @*) - do 2 iNamed "Hgpp". iNamed "Hfrespm". - wp_loadField. - wp_apply (wp_MapInsert with "Hfrespm"); first done. - iIntros "Hfrespm". - wp_pures. - iApply "HΦ". - iFrame "∗ # %". - iModIntro. - iSplit. - { iApply (big_sepM_insert_2 with "[] Hfast"). iFrame "#". } - iPureIntro. - rewrite dom_insert_L. - set_solver. - Qed. - - Theorem wp_GroupPreparer__collectValidation (gpp : loc) (rid : u64) phase ts gid γ : - rid ∈ rids_all -> - is_replica_validated_ts γ gid rid ts -∗ - {{{ own_gpreparer_with_phase gpp phase ts gid γ }}} - GroupPreparer__collectValidation #gpp #rid - {{{ RET #(); own_gpreparer_with_phase gpp phase ts gid γ }}}. - Proof. - iIntros (Hrid) "#Hvd". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) collectValidation(rid uint64) { @*) - (*@ gpp.vdm[rid] = true @*) - (*@ } @*) - iNamed "Hgpp". iNamed "Hvdm". - wp_loadField. - wp_apply (wp_MapInsert with "Hvdm"); first done. - iIntros "Hvdm". - wp_pures. - iApply "HΦ". - iFrame "Hfrespm ∗ # %". - iModIntro. - iSplit. - { rewrite /validation_responses dom_insert_L. - by iApply (big_sepS_insert_2 with "[] Hvalidation"). - } - iPureIntro. - rewrite dom_insert_L. - set_solver. - Qed. - - Theorem wp_GroupPreparer__in (gpp : loc) (phase : gppphase) ts gid γ : - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__in #gpp #(gppphase_to_u64 phase) - {{{ (ok : bool), RET #ok; - if ok - then own_gpreparer_with_phase gpp phase ts gid γ - else own_gpreparer gpp ts gid γ - }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) in(phase uint64) bool { @*) - (*@ return gpp.phase == phase @*) - (*@ } @*) - rename phase into phasearg. - do 2 iNamed "Hgpp". iNamed "Hphase". - wp_loadField. - wp_pures. - iApply "HΦ". - case_bool_decide as Hok; last first. - { by iFrame "∗ # %". } - symmetry in Hok. inv Hok. - by iFrame "∗ # %". - Qed. - - Theorem wp_GroupPreparer__processFastPrepareResult - (gpp : loc) (rid : u64) (res : rpres) ts gid γ : - gid ∈ gids_all -> - rid ∈ rids_all -> - fast_prepare_outcome γ gid rid ts res -∗ - know_tulip_inv γ -∗ - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__processFastPrepareResult #gpp #rid #(rpres_to_u64 res) - {{{ RET #(); own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Hgid Hrid) "#Hfp #Hinv". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) processFastPrepareResult(rid uint64, res uint64) { @*) - (*@ // Result is ready or a backup coordinator has become live. @*) - (*@ if gpp.tryResign(res) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). - { by destruct res. } - iIntros (resigned) "[Hgpp %Hresigned]". - destruct resigned; wp_pures. - { by iApply "HΦ". } - - (*@ // Fast-prepare fails; fast abort if possible. @*) - (*@ if res == tulip.REPLICA_FAILED_VALIDATION { @*) - (*@ gpp.collectFastDecision(rid, false) @*) - (*@ @*) - case_bool_decide as Hres; wp_pures. - { destruct res; try done. simpl. - wp_apply (wp_GroupPreparer__collectFastDecision with "Hfp [] Hgpp"). - { apply Hrid. } - { done. } - iIntros "Hgpp". - - (*@ aborted := gpp.tryFastAbort() @*) - (*@ if aborted { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__tryFastAbort with "Hgpp"). - iIntros (aborted) "Hgpp". - wp_pures. - destruct aborted; wp_pures. - { by iApply "HΦ". } - - (*@ if !gpp.in(GPP_VALIDATING) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__in _ GPPValidating with "Hgpp"). - iIntros (validating) "Hgpp". - destruct validating; wp_pures; last first. - { by iApply "HΦ". } - - (*@ gpp.tryBecomeUnpreparing() @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__tryBecomeUnpreparing with "Hinv Hgpp"). - { apply Hgid. } - iIntros "Hgpp". - wp_pures. - iApply "HΦ". - by iFrame. - } - (* Prove [res = ReplicaOK]. *) - destruct res; try done. - - (*@ // Fast-prepare succeeds; fast prepare if possible. @*) - (*@ gpp.collectFastDecision(rid, true) @*) - (*@ if gpp.tryFastPrepare() { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - iDestruct "Hfp" as "[Hvd Hpdec]". - wp_apply (wp_GroupPreparer__collectFastDecision with "Hpdec Hvd Hgpp"). - { apply Hrid. } - iIntros "Hgpp". - wp_apply (wp_GroupPreparer__tryFastPrepare with "Hgpp"). - iIntros (prepared) "Hgpp". - destruct prepared; wp_pures. - { by iApply "HΦ". } - - (*@ // Ignore the result if it's not in the validating phase. At this point, the @*) - (*@ // other possible phases are preparing and unpreparing. @*) - (*@ if !gpp.in(GPP_VALIDATING) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__in _ GPPValidating with "Hgpp"). - iIntros (validating) "Hgpp". - destruct validating; wp_pures; last first. - { by iApply "HΦ". } - - (*@ // Record success of validation and try to move to the preparing phase. @*) - (*@ gpp.collectValidation(rid) @*) - (*@ gpp.tryBecomePreparing() @*) - (*@ } @*) - wp_apply (wp_GroupPreparer__collectValidation with "Hvd Hgpp"). - { apply Hrid. } - iIntros "Hgpp". - wp_apply (wp_GroupPreparer__tryBecomePreparing with "Hinv Hgpp"). - { apply Hgid. } - iIntros "Hgpp". - wp_pures. - iApply "HΦ". - by iFrame. - Qed. - - Theorem wp_GroupPreparer__processValidateResult - (gpp : loc) (rid : u64) (res : rpres) ts gid γ : - gid ∈ gids_all -> - rid ∈ rids_all -> - validate_outcome γ gid rid ts res -∗ - know_tulip_inv γ -∗ - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__processValidateResult #gpp #rid #(rpres_to_u64 res) - {{{ RET #(); own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Hgid Hrid) "#Hvd #Hinv". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) processValidateResult(rid uint64, res uint64) { @*) - (*@ // Result is ready or a backup coordinator has become live. @*) - (*@ if gpp.tryResign(res) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). - { by destruct res. } - iIntros (resigned) "[Hgpp %Hresigned]". - destruct resigned; wp_pures. - { by iApply "HΦ". } - - (*@ // Validation fails; nothing to record. @*) - (*@ if res == tulip.REPLICA_FAILED_VALIDATION { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - case_bool_decide as Hres; wp_pures. - { by iApply "HΦ". } - (* Prove [res = ReplicaOK]. *) - destruct res; try done. - - (*@ // Skip if the coordiantor is not in the validating phase. At this point, @*) - (*@ // the other possible phases are preparing and unpreparing. @*) - (*@ if !gpp.in(GPP_VALIDATING) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__in _ GPPValidating with "Hgpp"). - iIntros (validating) "Hgpp". - destruct validating; wp_pures; last first. - { by iApply "HΦ". } - - (*@ // Record success of validation and try to move to the preparing phase. @*) - (*@ gpp.collectValidation(rid) @*) - (*@ gpp.tryBecomePreparing() @*) - (*@ } @*) - wp_apply (wp_GroupPreparer__collectValidation with "Hvd Hgpp"). - { apply Hrid. } - iIntros "Hgpp". - wp_apply (wp_GroupPreparer__tryBecomePreparing with "Hinv Hgpp"). - { apply Hgid. } - iIntros "Hgpp". - wp_pures. - iApply "HΦ". - by iFrame. - Qed. - - Theorem wp_GroupPreparer__processPrepareResult - (gpp : loc) (rid : u64) (res : rpres) ts gid γ : - rid ∈ rids_all -> - accept_outcome γ gid rid ts 1%nat true res -∗ - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__processPrepareResult #gpp #rid #(rpres_to_u64 res) - {{{ RET #(); own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Hrid) "#Hvd". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) processPrepareResult(rid uint64, res uint64) { @*) - (*@ // Result is ready or a backup coordinator has become live. @*) - (*@ if gpp.tryResign(res) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). - { by destruct res. } - iIntros (resigned) "[Hgpp %Hresigned]". - destruct resigned; wp_pures. - { by iApply "HΦ". } - (* Prove [res = ReplicaOK]. *) - destruct res; try done. simpl. - - (*@ // We might be able to prove this without an additional check. @*) - (*@ if !gpp.in(GPP_PREPARING) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__in _ GPPPreparing with "Hgpp"). - iIntros (preparing) "Hgpp". - destruct preparing; wp_pures; last first. - { by iApply "HΦ". } - - (*@ // Record success of preparing the replica and try to move to prepared. @*) - (*@ gpp.srespm[rid] = true @*) - (*@ @*) - iNamed "Hgpp". iNamed "Hsrespm". - wp_loadField. - wp_apply (wp_MapInsert with "Hsrespm"); first done. - iIntros "Hsrespm". - - (*@ // Count how many replicas have prepared. @*) - (*@ n := uint64(len(gpp.srespm)) @*) - (*@ @*) - wp_loadField. - wp_apply (wp_MapLen with "Hsrespm"). - iIntros "[%Hn Hsrespm]". - wp_pures. - - (*@ // Go to prepared phase if successful prepares reaches a classic quorum. @*) - (*@ if gpp.cquorum(n) { @*) - (*@ gpp.phase = GPP_PREPARED @*) - (*@ } @*) - (*@ } @*) - wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hq; wp_pures. - { iNamed "Hphase". - wp_storeField. - iApply "HΦ". - iAssert (own_gpreparer_phase gpp GPPPrepared)%I with "[HphaseP]" as "Hphase". - { by iFrame. } - simpl. - iDestruct (big_sepS_insert_2 rid with "[] Hslow") as "Hslow'". - { iFrame "Hvd". } - iAssert (own_gpreparer_srespm gpp GPPPrepared ts gid γ)%I - with "[HsrespmP Hsrespm]" as "Hsrespm". - { iFrame. simpl. - iExists ∅. (* just a placeholder *) - do 2 (iSplit; first done). - iPureIntro. - (* rewrite dom_insert_L. *) - clear -Hrid Hsincl. set_solver. - } - iModIntro. - iFrame "∗ # %". - simpl. - iDestruct "Hsafe" as "[Hqv _]". - iFrame "Hqv". - iExists 1%nat. - rewrite /quorum_pdec_at_rank /=. - set ridsq := _ ∪ _. - iExists ridsq. - iSplit; first done. - iPureIntro. - split. - { clear-Hsincl Hrid. set_solver. } - { rewrite /cquorum_size. - destruct (decide (rid ∈ dom srespm)) as [Hin | Hnotin]. - { assert (ridsq = dom srespm) as -> by set_solver. - rewrite size_dom. - apply elem_of_dom in Hin. - rewrite map_size_insert_Some in Hn Hq; last apply Hin. - clear -Hn Hq. word. - } - subst ridsq. - rewrite size_union; last set_solver. - rewrite size_singleton size_dom. - apply not_elem_of_dom in Hnotin. - rewrite map_size_insert_None in Hn Hq; last apply Hnotin. - clear -Hn Hq. word. - } - } - iApply "HΦ". - iAssert (own_gpreparer_srespm gpp GPPPreparing ts gid γ)%I - with "[HsrespmP Hsrespm]" as "Hsrespm". - { iFrame. simpl. - iSplit. - { rewrite dom_insert_L. - iApply (big_sepS_insert_2 with "[] Hslow"). - iFrame "Hvd". - } - iPureIntro. - rewrite dom_insert_L. - clear -Hrid Hsincl. set_solver. - } - by iFrame "∗ # %". - Qed. - - Theorem wp_GroupPreparer__processUnprepareResult - (gpp : loc) (rid : u64) (res : rpres) ts gid γ : - rid ∈ rids_all -> - accept_outcome γ gid rid ts 1%nat false res -∗ - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__processUnprepareResult #gpp #rid #(rpres_to_u64 res) - {{{ RET #(); own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Hrid) "#Hvd". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) processUnprepareResult(rid uint64, res uint64) { @*) - (*@ // Result is ready or a backup coordinator has become live. @*) - (*@ if gpp.tryResign(res) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). - { by destruct res. } - iIntros (resigned) "[Hgpp %Hresigned]". - destruct resigned; wp_pures. - { by iApply "HΦ". } - (* Prove [res = ReplicaOK]. *) - destruct res; try done. simpl. - - (*@ // We might be able to prove this without an additional check. @*) - (*@ if !gpp.in(GPP_UNPREPARING) { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__in _ GPPUnpreparing with "Hgpp"). - iIntros (unpreparing) "Hgpp". - destruct unpreparing; wp_pures; last first. - { by iApply "HΦ". } - - (*@ // Record success of unpreparing the replica and try to move to aborted. @*) - (*@ gpp.srespm[rid] = true @*) - (*@ @*) - iNamed "Hgpp". iNamed "Hsrespm". - wp_loadField. - wp_apply (wp_MapInsert with "Hsrespm"); first done. - iIntros "Hsrespm". - - (*@ // Count how many replicas have unprepared. @*) - (*@ n := uint64(len(gpp.srespm)) @*) - (*@ @*) - wp_loadField. - wp_apply (wp_MapLen with "Hsrespm"). - iIntros "[%Hn Hsrespm]". - wp_pures. - - (*@ // Go to aborted phase if successful unprepares reaches a classic quorum. @*) - (*@ if gpp.cquorum(n) { @*) - (*@ gpp.phase = GPP_ABORTED @*) - (*@ } @*) - (*@ } @*) - wp_apply (wp_GroupPreparer__cquorum with "Hnrps"). - iIntros "Hnrps". - case_bool_decide as Hq; wp_pures. - { iNamed "Hphase". - wp_storeField. - iApply "HΦ". - iAssert (own_gpreparer_phase gpp GPPAborted)%I with "[HphaseP]" as "Hphase". - { by iFrame. } - simpl. - iDestruct (big_sepS_insert_2 rid with "[] Hslow") as "Hslow'". - { iFrame "Hvd". } - iAssert (own_gpreparer_srespm gpp GPPAborted ts gid γ)%I - with "[HsrespmP Hsrespm]" as "Hsrespm". - { iFrame. simpl. - iExists ∅. (* just a placeholder *) - do 2 (iSplit; first done). - iPureIntro. - (* rewrite dom_insert_L. *) - clear -Hrid Hsincl. set_solver. - } - iModIntro. - iFrame "∗ # %". - iRight. - iExists 1%nat. - rewrite /quorum_pdec_at_rank /=. - set ridsq := _ ∪ _. - iExists ridsq. - iSplit; first done. - iPureIntro. - split. - { clear-Hsincl Hrid. set_solver. } - { rewrite /cquorum_size. - destruct (decide (rid ∈ dom srespm)) as [Hin | Hnotin]. - { assert (ridsq = dom srespm) as -> by set_solver. - rewrite size_dom. - apply elem_of_dom in Hin. - rewrite map_size_insert_Some in Hn Hq; last apply Hin. - clear -Hn Hq. word. - } - subst ridsq. - rewrite size_union; last set_solver. - rewrite size_singleton size_dom. - apply not_elem_of_dom in Hnotin. - rewrite map_size_insert_None in Hn Hq; last apply Hnotin. - clear -Hn Hq. word. - } - } - iApply "HΦ". - iAssert (own_gpreparer_srespm gpp GPPUnpreparing ts gid γ)%I - with "[HsrespmP Hsrespm]" as "Hsrespm". - { iFrame. simpl. - iSplit. - { rewrite dom_insert_L. - iApply (big_sepS_insert_2 with "[] Hslow"). - iFrame "Hvd". - } - iPureIntro. - rewrite dom_insert_L. - clear -Hrid Hsincl. set_solver. - } - by iFrame "∗ # %". - Qed. - - Theorem wp_GroupPreparer__processQueryResult - (gpp : loc) (rid : u64) (res : rpres) ts gid γ : - rid ∈ rids_all -> - query_outcome γ ts res -∗ - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__processQueryResult #gpp #rid #(rpres_to_u64 res) - {{{ RET #(); own_gpreparer gpp ts gid γ }}}. - Proof. - iIntros (Hrid) "#Hquery". - iIntros (Φ) "!> Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) processQueryResult(rid uint64, res uint64) { @*) - (*@ // Result is ready or a backup coordinator has become live. @*) - (*@ gpp.tryResign(res) @*) - (*@ } @*) - wp_apply (wp_GroupPreparer__tryResign with "[] Hgpp"). - { by destruct res. } - iIntros (resigned) "[Hgpp %Hresigned]". - wp_pures. - by iApply "HΦ". - Qed. - - Definition safe_gppaction γ ts gid action : iProp Σ := - match action with - | GPPFastPrepare => True - | GPPValidate => True - | GPPPrepare => is_group_prepare_proposal γ gid ts 1%nat true - | GPPUnprepare => is_group_prepare_proposal γ gid ts 1%nat false - | GPPQuery => True - | GPPRefresh => True - end. - - #[global] - Instance gppaction_persistent γ ts gid action : - Persistent (safe_gppaction γ ts gid action). - Proof. destruct action; apply _. Defined. - - Theorem wp_GroupPreparer__action (gpp : loc) (rid : u64) γ ts gid : - {{{ own_gpreparer gpp ts gid γ }}} - GroupPreparer__action #gpp #rid - {{{ (action : gppaction), RET #(gppaction_to_u64 action); - own_gpreparer gpp ts gid γ ∗ - safe_gppaction γ ts gid action - }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) action(rid uint64) uint64 { @*) - (*@ // Validate the transaction through fast-path or slow-path. @*) - (*@ if gpp.phase == GPP_VALIDATING { @*) - (*@ // Check if the fast-path response for replica @rid is available. @*) - (*@ _, fresp := gpp.frespm[rid] @*) - (*@ if !fresp { @*) - (*@ // Have not received the fast-path response. @*) - (*@ return GPP_FAST_PREPARE @*) - (*@ } @*) - (*@ @*) - wp_pures. - wp_apply (wp_GroupPreparer__in _ GPPValidating with "Hgpp"). - iIntros (validting) "Hgpp". - destruct validting; wp_pures. - { iNamed "Hgpp". - iNamed "Hfrespm". - wp_loadField. - wp_apply (wp_MapGet with "Hfrespm"). - iIntros (b1 fresp) "[_ Hfrespm]". - wp_pures. - destruct fresp; wp_pures; last first. - { iApply ("HΦ" $! GPPFastPrepare). by iFrame "∗ # %". } - - (*@ // Check if the validation response for replica @rid is available. @*) - (*@ _, validated := gpp.vdm[rid] @*) - (*@ if !validated { @*) - (*@ // Previous attemp of validation fails; retry. @*) - (*@ return GPP_VALIDATE @*) - (*@ } @*) - (*@ @*) - iNamed "Hvdm". - wp_loadField. - wp_apply (wp_MapGet with "Hvdm"). - iIntros (b2 validated) "[_ Hvdm]". - wp_pures. - destruct validated; wp_pures; last first. - { iApply ("HΦ" $! GPPValidate). by iFrame "HfrespmP HvdmP ∗ # %". } - - (*@ // Successfully validated (in either fast-path or slow-path). @*) - (*@ return GPP_QUERY @*) - (*@ } @*) - (*@ @*) - { iApply ("HΦ" $! GPPQuery). by iFrame "HfrespmP HvdmP ∗ # %". } - } - - (*@ // Prepare the transaction through slow-path. @*) - (*@ if gpp.phase == GPP_PREPARING { @*) - (*@ _, prepared := gpp.srespm[rid] @*) - (*@ if !prepared { @*) - (*@ return GPP_PREPARE @*) - (*@ } @*) - (*@ return GPP_QUERY @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__in _ GPPPreparing with "Hgpp"). - iIntros (preparing) "Hgpp". - destruct preparing; wp_pures. - { iNamed "Hgpp". iNamed "Hsrespm". - wp_loadField. - wp_apply (wp_MapGet with "Hsrespm"). - iIntros (b prepared) "[_ Hsrespm]". - wp_pures. - destruct prepared; wp_pures; last first. - { iApply ("HΦ" $! GPPPrepare). - iDestruct "Hsafe" as "[Hqv Hppsl]". - iFrame "Hfrespm Hvdm ∗ # %". - by iFrame "∗ #". - } - iApply ("HΦ" $! GPPQuery). - iFrame "Hfrespm Hvdm ∗ # %". - by iFrame "∗ #". - } - - (*@ // Unprepare the transaction through slow-path. @*) - (*@ if gpp.phase == GPP_UNPREPARING { @*) - (*@ _, unprepared := gpp.srespm[rid] @*) - (*@ if !unprepared { @*) - (*@ return GPP_UNPREPARE @*) - (*@ } @*) - (*@ return GPP_QUERY @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__in _ GPPUnpreparing with "Hgpp"). - iIntros (unpreparing) "Hgpp". - destruct unpreparing; wp_pures. - { iNamed "Hgpp". iNamed "Hsrespm". - wp_loadField. - wp_apply (wp_MapGet with "Hsrespm"). - iIntros (b prepared) "[_ Hsrespm]". - wp_pures. - destruct prepared; wp_pures; last first. - { iApply ("HΦ" $! GPPUnprepare). - iFrame "Hfrespm Hvdm ∗ # %". - by iFrame "∗ #". - } - iApply ("HΦ" $! GPPQuery). - iFrame "Hfrespm Hvdm ∗ # %". - by iFrame "∗ #". - } - - (*@ // Backup coordinator exists, just wait for the result. @*) - (*@ if gpp.phase == GPP_WAITING { @*) - (*@ return GPP_QUERY @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_GroupPreparer__in _ GPPWaiting with "Hgpp"). - iIntros (waiting) "Hgpp". - destruct waiting; wp_pures. - { iApply ("HΦ" $! GPPQuery). by iFrame. } - - (*@ // The transaction has either prepared, committed, or aborted. @*) - (*@ return GPP_REFRESH @*) - (*@ } @*) - iApply ("HΦ" $! GPPRefresh). by iFrame. - Qed. - - Theorem wp_GroupPreparer__getPhase (gpp : loc) phase ts gid γ : - {{{ own_gpreparer_with_phase gpp phase ts gid γ }}} - GroupPreparer__getPhase #gpp - {{{ RET #(gppphase_to_u64 phase); - own_gpreparer_with_phase gpp phase ts gid γ ∗ - safe_gpreparer_phase γ ts gid phase - }}}. - Proof. - iIntros (Φ) "Hgpp HΦ". - wp_rec. - - (*@ func (gpp *GroupPreparer) getPhase() uint64 { @*) - (*@ return gpp.phase @*) - (*@ } @*) - iNamed "Hgpp". iNamed "Hphase". - wp_loadField. - rewrite Hphase. - iApply "HΦ". - by iFrame "∗ # %". - Qed. - -End program. diff --git a/src/program_proof/tulip/program/gcoord/group_reader.v b/src/program_proof/tulip/program/gcoord/group_reader.v deleted file mode 100644 index cc06b1bc6..000000000 --- a/src/program_proof/tulip/program/gcoord/group_reader.v +++ /dev/null @@ -1,582 +0,0 @@ -From Perennial.program_proof.tulip.program Require Import prelude. -From Perennial.program_proof.tulip.program Require Import quorum. -From Perennial.program_proof.tulip.invariance Require Import read. - -Local Ltac Zify.zify_post_hook ::= Z.div_mod_to_equations. - -Section repr. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - (*@ type GroupReader struct { @*) - (*@ // Number of replicas. Read-only. @*) - (*@ nrps uint64 @*) - (*@ // Cached read set. Exists for performance reason; could have an interface @*) - (*@ // to create a transaction that does not cache reads. @*) - (*@ valuem map[string]tulip.Value @*) - (*@ // Versions responded by each replica for each key. Instead of using a @*) - (*@ // single map[uint64]Version for the current key being read, this design allows @*) - (*@ // supporting more sophisticated "async-read" in future. @*) - (*@ qreadm map[string]map[uint64]tulip.Version @*) - (*@ } @*) - Definition own_greader_valuem - (grd : loc) (valuem : gmap dbkey dbval) (ts : nat) γ : iProp Σ := - ∃ (valuemP : loc), - "HvaluemP" ∷ grd ↦[GroupReader :: "valuem"] #valuemP ∗ - "Hvaluem" ∷ own_map valuemP (DfracOwn 1) valuem ∗ - "#Hfinal" ∷ ([∗ map] k ↦ v ∈ valuem, fast_or_quorum_read γ k ts v). - - Definition own_greader_qreadm - (grd : loc) (qreadm : gmap dbkey (gmap u64 (u64 * dbval))) (ts : nat) γ : iProp Σ := - ∃ (qreadmP : loc) (qreadmM : gmap dbkey loc) , - "HqreadmP" ∷ grd ↦[GroupReader :: "qreadm"] #qreadmP ∗ - "HqreadmM" ∷ own_map qreadmP (DfracOwn 1) qreadmM ∗ - "Hqreadm" ∷ ([∗ map] k ↦ p; m ∈ qreadmM; qreadm, own_map p (DfracOwn 1) m) ∗ - "#Hqread" ∷ ([∗ map] k ↦ m ∈ qreadm, - [∗ map] rid ↦ ver ∈ m, slow_read γ rid k (uint.nat ver.1) ts ver.2) ∗ - "%Hvrids" ∷ ⌜map_Forall (λ _ m, dom m ⊆ rids_all) qreadm⌝. - - Definition own_greader_nrps (grd : loc) : iProp Σ := - ∃ (nrps : u64), - "Hnrps" ∷ grd ↦[GroupReader :: "nrps"] #nrps ∗ - "%Hnrps" ∷ ⌜uint.nat nrps = size rids_all⌝. - - Definition own_greader (grd : loc) (ts : nat) γ : iProp Σ := - ∃ (valuem : gmap dbkey dbval) (qreadm : gmap dbkey (gmap u64 (u64 * dbval))), - "Hvaluem" ∷ own_greader_valuem grd valuem ts γ ∗ - "Hqreadm" ∷ own_greader_qreadm grd qreadm ts γ ∗ - "Hnrps" ∷ own_greader_nrps grd. - -End repr. - -Section program. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - Theorem wp_GroupReader__cquorum (grd : loc) (n : u64) : - {{{ own_greader_nrps grd }}} - GroupReader__cquorum #grd #n - {{{ RET #(bool_decide (size rids_all / 2 < uint.Z n)); own_greader_nrps grd }}}. - Proof. - iIntros (Φ) "Hgrd HΦ". - wp_rec. - - (*@ func (grd *GroupReader) cquorum(n uint64) bool { @*) - (*@ return quorum.ClassicQuorum(grd.nrps) <= n @*) - (*@ } @*) - iNamed "Hgrd". - wp_loadField. - wp_apply wp_ClassicQuorum. - iIntros (x Hx). - wp_pures. - case_bool_decide as Hc1. - { case_bool_decide as Hc2; last word. - iApply "HΦ". by iFrame "∗ %". - } - { case_bool_decide as Hc2; first word. - iApply "HΦ". by iFrame "∗ %". - } - Qed. - - Theorem wp_GroupReader__pickLatestValue (grd : loc) (key : string) qreadm verm ts γ : - qreadm !! key = Some verm -> - cquorum_size rids_all (dom verm) -> - {{{ own_greader_qreadm grd qreadm ts γ }}} - GroupReader__pickLatestValue #grd #(LitString key) - {{{ (value : dbval), RET (dbval_to_val value); - own_greader_qreadm grd qreadm ts γ ∗ quorum_read γ key ts value - }}}. - Proof. - iIntros (Hqread Hqsize Φ) "Hgrd HΦ". - wp_rec. - - (*@ func (grd *GroupReader) pickLatestValue(key string) tulip.Value { @*) - (*@ var lts uint64 @*) - (*@ var value tulip.Value @*) - (*@ @*) - wp_apply wp_ref_of_zero; first done. - iIntros (ltsP) "HltsP". - wp_apply wp_ref_of_zero; first done. - iIntros (valueP) "HvalueP". - - (*@ verm := grd.qreadm[key] @*) - (*@ @*) - iNamed "Hgrd". - wp_loadField. - wp_apply (wp_MapGet with "HqreadmM"). - iIntros (vermP ok) "[%Hok HqreadmM]". - wp_pures. - destruct ok; last first. - { iDestruct (big_sepM2_dom with "Hqreadm") as %Hdomqreadm. - apply map_get_false in Hok as [Hnone _]. - rewrite -not_elem_of_dom Hdomqreadm in Hnone. - by apply elem_of_dom_2 in Hqread. - } - apply map_get_true in Hok. - iDestruct (big_sepM2_lookup_acc with "Hqreadm") as "[Hverm HqreadmC]". - { apply Hok. } - { apply Hqread. } - - (*@ for _, ver := range(verm) { @*) - (*@ if lts <= ver.Timestamp { @*) - (*@ value = ver.Value @*) - (*@ lts = ver.Timestamp @*) - (*@ } @*) - (*@ } @*) - (*@ @*) - set P := (λ (mx : gmap u64 (u64 * dbval)), - ∃ (lts : u64) (value : dbval), - "HltsP" ∷ ltsP ↦[uint64T] #lts ∗ - "HvalueP" ∷ valueP ↦[boolT * (stringT * unitT)%ht] (dbval_to_val value) ∗ - "%Hlargest" ∷ ⌜map_Forall (λ _ x, uint.Z x.1 ≤ uint.Z lts) mx⌝ ∗ - "%Hin" ∷ ⌜if decide (mx = ∅) - then lts = U64 0 - else map_Exists (λ _ x, x = (lts, value)) mx⌝)%I. - wp_apply (wp_MapIter_fold _ _ _ P with "Hverm [HltsP HvalueP]"). - { iExists _, None. by iFrame. } - { clear Φ. - iIntros (mx rid [t v] Φ) "!> [HP %Hmx] HΦ". - iNamed "HP". - wp_load. - wp_pures. - case_bool_decide as Horder; wp_pures. - { wp_apply (wp_StoreAt with "HvalueP"). - { destruct v; by auto. } - iIntros "HvalueP". - wp_store. - iApply "HΦ". - subst P. - iFrame. - iPureIntro. - split. - { intros rid' [t' v'] Hv'. simpl. - destruct (decide (rid' = rid)) as [-> | Hne]. - { rewrite lookup_insert in Hv'. by inv Hv'. } - rewrite lookup_insert_ne in Hv'; last done. - specialize (Hlargest _ _ Hv'). simpl in Hlargest. - clear -Hlargest Horder. lia. - } - { destruct (decide (<[rid:=(t, v)]> mx = ∅)) as [He | Hne]. - { by apply insert_non_empty in He. } - by apply map_Exists_insert_2_1. - } - } - iApply "HΦ". - subst P. - iFrame. - iPureIntro. - split. - { apply map_Forall_insert_2; last done. - simpl. lia. - } - { case_decide as Hmxe. - { clear -Horder Hin. word. } - case_decide as Hinsert. - { by apply insert_non_empty in Hinsert. } - destruct Hmx as [Hmx _]. - by apply map_Exists_insert_2_2. - } - } - iIntros "[Hverm HP]". - subst P. iNamed "HP". - wp_pures. - wp_load. - - (*@ return value @*) - (*@ } @*) - iApply "HΦ". - iDestruct ("HqreadmC" with "Hverm") as "HqreadmC". - iFrame "∗ # %". - iDestruct (big_sepM_lookup with "Hqread") as "Hqreadkey"; first apply Hqread. - case_decide as Hverm. - { exfalso. - rewrite -dom_empty_iff_L -size_empty_iff_L in Hverm. - clear -Hqsize Hverm. rewrite /cquorum_size in Hqsize. lia. - } - destruct Hin as (rid & [t v] & Hvermrid & Htv). - inv Htv. - iDestruct (big_sepM_lookup with "Hqreadkey") as "Hlver"; first apply Hvermrid. - iNamed "Hlver". - iFrame "Hv %". - iModIntro. - iExists (dom verm). - iSplit. - { rewrite big_sepS_big_sepM. - iApply (big_sepM_mono with "Hqreadkey"). - iIntros (r [t v] Htv). - iNamed 1. simpl. - iApply (read_promise_weaken_lb with "Hioa"). - specialize (Hlargest _ _ Htv). simpl in Hlargest. - clear -Hlargest. lia. - } - iPureIntro. - by specialize (Hvrids _ _ Hqread). - Qed. - - Theorem wp_GroupReader__read (grd : loc) (key : string) ts γ : - {{{ own_greader grd ts γ }}} - GroupReader__read #grd #(LitString key) - {{{ (v : dbval) (ok : bool), RET (dbval_to_val v, #ok); - own_greader grd ts γ ∗ - if ok then fast_or_quorum_read γ key ts v else True - }}}. - Proof. - iIntros (Φ) "Hgrd HΦ". - wp_rec. - - (*@ func (grd *GroupReader) read(key string) (tulip.Value, bool) { @*) - (*@ v, ok := grd.valuem[key] @*) - (*@ return v, ok @*) - (*@ } @*) - iNamed "Hgrd". iNamed "Hvaluem". - wp_loadField. - wp_apply (wp_MapGet with "Hvaluem"). - iIntros (v ok) "[%Hok Hvaluem]". - wp_pures. - iApply "HΦ". - iFrame "∗ #". - destruct ok; last done. - apply map_get_true in Hok. - by iApply (big_sepM_lookup with "Hfinal"). - Qed. - - Theorem wp_GroupReader__responded (grd : loc) (rid : u64) (key : string) ts γ : - {{{ own_greader grd ts γ }}} - GroupReader__responded #grd #rid #(LitString key) - {{{ (responded : bool), RET #responded; own_greader grd ts γ }}}. - Proof. - iIntros (Φ) "Hgrd HΦ". - wp_rec. - - (*@ func (grd *GroupReader) responded(rid uint64, key string) bool { @*) - (*@ _, final := grd.valuem[key] @*) - (*@ if final { @*) - (*@ // The final value is already determined. @*) - (*@ return true @*) - (*@ } @*) - (*@ @*) - iNamed "Hgrd". iNamed "Hvaluem". - wp_loadField. - wp_apply (wp_MapGet with "Hvaluem"). - iIntros (v final) "[%Hfinal Hvaluem]". - wp_pures. - destruct final; wp_pures. - { iApply "HΦ". by iFrame "∗ # %". } - - (*@ qread, ok := grd.qreadm[key] @*) - (*@ if !ok { @*) - (*@ return false @*) - (*@ } @*) - (*@ @*) - iNamed "Hqreadm". - wp_loadField. - wp_apply (wp_MapGet with "HqreadmM"). - iIntros (qreadP ok) "[%Hok HqreadmM]". - wp_pures. - destruct ok; wp_pures; last first. - { iApply "HΦ". by iFrame "∗ # %". } - - (*@ _, responded := qread[rid] @*) - (*@ if responded { @*) - (*@ // The replica has already responded with its latest version. @*) - (*@ return true @*) - (*@ } @*) - (*@ return false @*) - (*@ } @*) - apply map_get_true in Hok. - iDestruct (big_sepM2_dom with "Hqreadm") as %Hdomqreadm. - assert (is_Some (qreadm !! key)) as [qread Hqread]. - { by rewrite -elem_of_dom -Hdomqreadm elem_of_dom. } - iDestruct (big_sepM2_lookup_acc with "Hqreadm") as "[Hqr HqreadmC]". - { apply Hok. } - { apply Hqread. } - wp_apply (wp_MapGet with "Hqr"). - clear Hfinal v. - iIntros (v responded) "[%Hresponded Hqr]". - wp_pures. - iDestruct ("HqreadmC" with "Hqr") as "Hqreadm". - by destruct responded; wp_pures; iApply "HΦ"; iFrame "∗ # %". - Qed. - - Theorem wp_GroupReader__clearVersions (grd : loc) (key : string) qreadm ts γ : - {{{ own_greader_qreadm grd qreadm ts γ }}} - GroupReader__clearVersions #grd #(LitString key) - {{{ RET #(); own_greader_qreadm grd (delete key qreadm) ts γ }}}. - Proof. - iIntros (Φ) "Hgrd HΦ". - wp_rec. - - (*@ func (grd *GroupReader) clearVersions(key string) { @*) - (*@ delete(grd.qreadm, key) @*) - (*@ } @*) - iNamed "Hgrd". - wp_loadField. - wp_apply (wp_MapDelete with "HqreadmM"). - iIntros "HqreadmM". - wp_pures. - iDestruct (big_sepM2_dom with "Hqreadm") as %Hdomqreadm. - iApply "HΦ". - destruct (decide (key ∈ dom qreadm)) as [Hin | Hnotin]; last first. - { apply not_elem_of_dom in Hnotin. - rewrite delete_notin; last apply Hnotin. - assert (Hnone : qreadmM !! key = None). - { by rewrite -not_elem_of_dom Hdomqreadm not_elem_of_dom. } - rewrite /map_del delete_notin; last apply Hnone. - by iFrame "∗ # %". - } - assert (is_Some (qreadmM !! key)) as [p Hp]. - { by rewrite -elem_of_dom Hdomqreadm. } - apply elem_of_dom in Hin as [m Hm]. - iDestruct (big_sepM2_delete with "Hqreadm") as "[_ Hqreadm]". - { apply Hp. } - { apply Hm. } - iDestruct (big_sepM_delete with "Hqread") as "[_ Hqread']". - { apply Hm. } - iFrame "∗ # %". - iPureIntro. - by apply map_Forall_delete. - Qed. - - Theorem wp_GroupReader__processReadResult - grd (rid : u64) (key : string) (ver : u64 * dbval) ts γ : - rid ∈ rids_all -> - fast_or_slow_read γ rid key (uint.nat ver.1) ts ver.2 -∗ - {{{ own_greader grd ts γ }}} - GroupReader__processReadResult #grd #rid #(LitString key) (u64_dbval_to_val ver) - {{{ RET #(); own_greader grd ts γ }}}. - Proof. - iIntros (Hrid) "#Hfsread". - iIntros (Φ) "!> Hgrd HΦ". - wp_rec. - - (*@ func (grd *GroupReader) processReadResult(rid uint64, key string, ver tulip.Version) { @*) - (*@ _, final := grd.valuem[key] @*) - (*@ if final { @*) - (*@ // The final value is already determined. @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - iNamed "Hgrd". iNamed "Hvaluem". iNamed "Hqreadm". - wp_loadField. - wp_apply (wp_MapGet with "Hvaluem"). - iIntros (v final) "[%Hfinal Hvaluem]". - wp_pures. - destruct final; wp_pures. - { iApply "HΦ". by iFrame "∗ # %". } - - (*@ if ver.Timestamp == 0 { @*) - (*@ // Fast-path read: set the final value and clean up the read versions. @*) - (*@ grd.valuem[key] = ver.Value @*) - (*@ delete(grd.qreadm, key) @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - iDestruct (big_sepM2_dom with "Hqreadm") as %Hdomqreadm. - destruct ver as [rts value]. - case_bool_decide as Hrts; simpl in Hrts; wp_pures. - { wp_loadField. - wp_apply (wp_MapInsert with "Hvaluem"); first done. - iIntros "Hvaluem". - wp_loadField. - wp_apply (wp_MapDelete with "HqreadmM"). - iIntros "HqreadmM". - wp_pures. - iApply "HΦ". - iAssert ([∗ map] p;m ∈ delete key qreadmM; delete key qreadm, own_map p (DfracOwn 1) m)%I - with "[Hqreadm]" as "Hqreadm". - { destruct (decide (key ∈ dom qreadm)) as [Hin | Hnotin]. - { apply elem_of_dom in Hin as [qread Hqread]. - by iDestruct (big_sepM2_delete_r with "Hqreadm") as (p) "(_ & _ & Hqreadm)". - } - assert (Hnone : qreadmM !! key = None). - { by rewrite -not_elem_of_dom Hdomqreadm. } - apply not_elem_of_dom in Hnotin. - do 2 (rewrite delete_notin; last done). - done. - } - iFrame "∗ # %". - iModIntro. - iSplit. - { rewrite /fast_or_slow_read. - inv Hrts. - case_decide as Hcase; last first. - { simpl in Hcase. clear -Hcase. word. } - simpl. - iApply (big_sepM_insert_2 with "[] Hfinal"). - iFrame "Hfsread". - } - { iSplit. - { destruct (decide (key ∈ dom qreadm)) as [Hin | Hnotin]; last first. - { apply not_elem_of_dom in Hnotin. - by rewrite delete_notin. - } - apply elem_of_dom in Hin as [qread Hqread]. - by iDestruct (big_sepM_delete with "Hqread") as "[_ ?]". - } - { iPureIntro. - by apply map_Forall_delete. - } - } - } - - (*@ qread, ok := grd.qreadm[key] @*) - (*@ if !ok { @*) - (*@ // The very first version arrives. Initialize a new map with the version @*) - (*@ // received. @*) - (*@ verm := make(map[uint64]tulip.Version) @*) - (*@ verm[rid] = ver @*) - (*@ grd.qreadm[key] = verm @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_loadField. - wp_apply (wp_MapGet with "HqreadmM"). - iIntros (qreadP ok) "[%Hok HqreadmM]". - wp_pures. - destruct ok; wp_pures; last first. - { wp_apply (wp_NewMap u64 (u64 * dbval)). - iIntros (vermP) "Hverm". - wp_apply (wp_MapInsert with "Hverm"); first by auto. - iIntros "Hverm". - wp_loadField. - wp_apply (wp_MapInsert with "HqreadmM"); first by auto. - iIntros "HqreadmM". - wp_pures. - iApply "HΦ". - apply map_get_false in Hok as [HqreadmM _]. - assert (Hqreadm : qreadm !! key = None). - { by rewrite -not_elem_of_dom -Hdomqreadm not_elem_of_dom. } - iDestruct (big_sepM2_insert_2 _ _ _ key with "[Hverm] Hqreadm") as "Hqreadm". - { iFrame "Hverm". } - iFrame "∗ # %". - iModIntro. - iSplit. - { iApply (big_sepM_insert_2 with "[] Hqread"). - rewrite /map_insert insert_empty big_sepM_singleton. - rewrite /fast_or_slow_read. - case_decide as Hslow; simpl in Hslow. - { exfalso. clear -Hrts Hslow. apply u64_val_ne in Hrts. word. } - done. - } - { iPureIntro. - apply map_Forall_insert_2; last done. - rewrite /map_insert insert_empty dom_singleton_L. - clear -Hrid. set_solver. - } - } - - (*@ _, responded := qread[rid] @*) - (*@ if responded { @*) - (*@ // The replica has already responded with its latest version. @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - apply map_get_true in Hok. - assert (is_Some (qreadm !! key)) as [qread Hqread]. - { by rewrite -elem_of_dom -Hdomqreadm elem_of_dom. } - iDestruct (big_sepM2_delete _ _ _ key with "Hqreadm") as "[Hqr Hqreadm]". - { apply Hok. } - { apply Hqread. } - wp_apply (wp_MapGet with "Hqr"). - clear Hfinal v. - iIntros (v responded) "[%Hresponded Hqr]". - wp_pures. - destruct responded; wp_pures. - { iDestruct (big_sepM2_insert_2 _ _ _ key with "[Hqr] Hqreadm") as "Hqreadm". - { iFrame "Hqr". } - do 2 (rewrite insert_delete; last done). - iApply "HΦ". - by iFrame "∗ # %". - } - - (*@ // Record the version responded by the replica. @*) - (*@ qread[rid] = ver @*) - (*@ grd.qreadm[key] = qread @*) - (*@ @*) - wp_apply (wp_MapInsert with "Hqr"); first done. - iIntros "Hqr". - wp_loadField. - wp_apply (wp_MapInsert with "HqreadmM"); first done. - iIntros "HqreadmM". - rewrite /map_insert. - set qread' := insert _ _ qread. - iDestruct (big_sepM_lookup with "Hqread") as "Hqreadprev"; first apply Hqread. - iDestruct (big_sepM_insert_2 _ _ key qread' with "[] Hqread") - as "Hqread'". - { simpl. - iApply (big_sepM_insert_2 with "[] Hqreadprev"). - rewrite /fast_or_slow_read. - case_decide as Hslow; simpl in Hslow. - { exfalso. clear -Hrts Hslow. apply u64_val_ne in Hrts. word. } - done. - } - set qreadm' := insert _ _ qreadm. - assert (Hvrids' : map_Forall (λ _ m, dom m ⊆ rids_all) qreadm'). - { apply map_Forall_insert_2; last done. - rewrite dom_insert_L. - specialize (Hvrids _ _ Hqread). simpl in Hvrids. - clear -Hrid Hvrids. set_solver. - } - - (*@ // Count the responses from replicas. @*) - (*@ n := uint64(len(qread)) @*) - (*@ if !grd.cquorum(n) { @*) - (*@ // Cannot determine the final value without a classic quorum of @*) - (*@ // versions. @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_MapLen with "Hqr"). - iIntros "[%Hsz Hqr]". - apply map_get_false in Hresponded as [Hresponded _]. - rewrite map_size_insert_None in Hsz *; last apply Hresponded. - wp_pures. - wp_apply (wp_GroupReader__cquorum with "Hnrps"). - iIntros "Hnrps". - (* this additional step avoids some unwanted computation *) - set sc := size rids_all. - wp_pures. - case_bool_decide as Hsize; wp_pures; last first. - { iDestruct (big_sepM2_insert_2 _ _ _ key with "[Hqr] Hqreadm") as "Hqreadm". - { iFrame "Hqr". } - rewrite 2!insert_delete_insert. - iApply "HΦ". - by iFrame "∗ # %". - } - - (*@ // With enough versions, choose the latest one to be the final value. @*) - (*@ latest := grd.pickLatestValue(key) @*) - (*@ grd.valuem[key] = latest @*) - (*@ @*) - iDestruct (big_sepM2_insert_2 _ _ _ key with "[Hqr] Hqreadm") as "Hqreadm". - { simpl. iFrame "Hqr". } - rewrite 2!insert_delete_insert. - iAssert (own_greader_qreadm grd qreadm' ts γ)%I - with "[HqreadmP HqreadmM Hqreadm]" as "Hqreadm". - { by iFrame "∗ # %". } - wp_apply (wp_GroupReader__pickLatestValue with "Hqreadm"). - { apply lookup_insert. } - { rewrite /cquorum_size. - rewrite dom_insert_L size_union; last first. - { apply not_elem_of_dom in Hresponded. clear -Hresponded. set_solver. } - rewrite size_singleton size_dom. - clear -Hsz Hsize. lia. - } - iIntros (latest) "[Hqreadm #Hqr]". - wp_loadField. - wp_apply (wp_MapInsert with "Hvaluem"); first done. - iIntros "Hvaluem". - - (*@ // The thread that determines the final value for @key also clears the @*) - (*@ // versions collected for @key. @*) - (*@ grd.clearVersions(key) @*) - (*@ } @*) - wp_apply (wp_GroupReader__clearVersions with "Hqreadm"). - iIntros "Hqreadm". - wp_pures. - iApply "HΦ". - iFrame "∗ # %". - iModIntro. - iApply (big_sepM_insert_2 with "[] Hfinal"). - by iRight. - Qed. - -End program. diff --git a/src/program_proof/tulip/program/prelude.v b/src/program_proof/tulip/program/prelude.v index 2824862e6..7820e458c 100644 --- a/src/program_proof/tulip/program/prelude.v +++ b/src/program_proof/tulip/program/prelude.v @@ -159,6 +159,12 @@ Section def. Definition own_dbmap_in_slice s (l : list dbmod) (m : dbmap) : iProp Σ := own_slice s (struct.t WriteEntry) (DfracOwn 1) l ∗ ⌜map_to_list m ≡ₚ l⌝. + Definition own_pwrs_slice (pwrsS : Slice.t) (c : ccommand) : iProp Σ := + match c with + | CmdCommit _ pwrs => (∃ pwrsL : list dbmod, own_dbmap_in_slice pwrsS pwrsL pwrs) + | _ => True + end. + Definition validate_outcome γ gid rid ts res : iProp Σ := match res with | ReplicaOK => is_replica_validated_ts γ gid rid ts diff --git a/src/program_proof/tulip/program/replica/replica.v b/src/program_proof/tulip/program/replica/replica.v deleted file mode 100644 index 3a2029842..000000000 --- a/src/program_proof/tulip/program/replica/replica.v +++ /dev/null @@ -1,1693 +0,0 @@ -From Perennial.program_proof.tulip.invariance Require Import - validate execute accept learn local_read read. -From Perennial.program_proof Require Import std_proof. -From Perennial.program_proof.tulip.program Require Import prelude. -From Perennial.program_proof.tulip.program.replica Require Import - replica_repr replica_accept replica_acquire replica_bump_key replica_finalized - replica_last_proposal replica_lowest_rank replica_readable_key replica_release_key - replica_writable_key. -From Perennial.program_proof.tulip.program.tuple Require Import tuple. -From Perennial.program_proof.tulip.program.txnlog Require Import txnlog. -From Perennial.program_proof.tulip.program.index Require Import index. - -Section replica. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - Definition own_replica_histm (rp : loc) (histm : gmap dbkey dbhist) α : iProp Σ := - ([∗ map] k ↦ h ∈ histm, own_phys_hist_half α k h). - - Definition own_replica_with_cloga_no_lsna - (rp : loc) (cloga : dblog) (gid rid : u64) γ α : iProp Σ := - ∃ (cm : gmap nat bool) (histm : gmap dbkey dbhist) - (cpm : gmap nat dbmap) (ptgsm : gmap nat (gset u64)) - (sptsm ptsm : gmap dbkey nat) (psm : gmap nat (nat * bool)) (rkm : gmap nat nat) - (clog : dblog) (ilog : list (nat * icommand)), - let log := merge_clog_ilog cloga ilog in - "Hcm" ∷ own_replica_cm rp cm ∗ - "Hhistm" ∷ own_replica_histm rp histm α ∗ - "Hcpm" ∷ own_replica_cpm rp cpm ∗ - "Hptsmsptsm" ∷ own_replica_ptsm_sptsm rp ptsm sptsm ∗ - "Hpsmrkm" ∷ own_replica_psm_rkm rp psm rkm ∗ - "Hclog" ∷ own_replica_clog_half γ gid rid clog ∗ - "Hilog" ∷ own_replica_ilog_half γ gid rid ilog ∗ - "#Hrpvds" ∷ ([∗ set] t ∈ dom cpm, is_replica_validated_ts γ gid rid t) ∗ - "#Hfpw" ∷ ([∗ map] t ↦ ps ∈ psm, fast_proposal_witness γ gid rid t ps) ∗ - "#Hclogalb" ∷ is_txn_log_lb γ gid cloga ∗ - "%Hdompsmrkm" ∷ ⌜dom psm = dom rkm⌝ ∗ - "%Hcloga" ∷ ⌜prefix clog cloga⌝ ∗ - "%Hvcpm" ∷ ⌜map_Forall (λ _ m, valid_wrs m) cpm⌝ ∗ - "%Hvicmds" ∷ ⌜Forall (λ nc, (nc.1 <= length cloga)%nat) ilog⌝ ∗ - "%Hexec" ∷ ⌜execute_cmds log = LocalState cm histm cpm ptgsm sptsm ptsm psm rkm⌝. - - Definition own_replica (rp : loc) (gid rid : u64) γ α : iProp Σ := - ∃ (cloga : dblog) (lsna : u64), - "Hrp" ∷ own_replica_with_cloga_no_lsna rp cloga gid rid γ α ∗ - "Hlsna" ∷ rp ↦[Replica :: "lsna"] #lsna ∗ - "%Hlencloga" ∷ ⌜length cloga = uint.nat lsna⌝. - - Definition is_replica_txnlog (rp : loc) gid γ : iProp Σ := - ∃ (txnlog : loc), - "#HtxnlogP" ∷ readonly (rp ↦[Replica :: "txnlog"] #txnlog) ∗ - "#Htxnlog" ∷ is_txnlog txnlog gid γ. - - Definition is_replica_idx (rp : loc) γ α : iProp Σ := - ∃ (idx : loc), - "#HidxP" ∷ readonly (rp ↦[Replica :: "idx"] #idx) ∗ - "#Hidx" ∷ is_index idx γ α. - - Definition is_replica (rp : loc) gid rid γ : iProp Σ := - ∃ (mu : loc) α, - "#HmuP" ∷ readonly (rp ↦[Replica :: "mu"] #mu) ∗ - "#Hlock" ∷ is_lock tulipNS #mu (own_replica rp gid rid γ α) ∗ - "#Htxnlog" ∷ is_replica_txnlog rp gid γ ∗ - "#Hidx" ∷ is_replica_idx rp γ α ∗ - "#Hinv" ∷ know_tulip_inv γ ∗ - "%Hgid" ∷ ⌜gid ∈ gids_all⌝ ∗ - "%Hrid" ∷ ⌜rid ∈ rids_all⌝. - - Theorem wp_Replica__logRead (rp : loc) (ts : u64) (key : string) : - {{{ True }}} - Replica__logRead #rp #ts #(LitString key) - {{{ RET #(); True }}}. - Proof. - (*@ func (rp *Replica) logRead(ts uint64, key string) { @*) - (*@ // TODO: Create an inconsistent log entry for reading @key at @ts. @*) - (*@ } @*) - Admitted. - - Theorem wp_Replica__Read (rp : loc) (tsW : u64) (key : string) gid rid γ : - let ts := uint.nat tsW in - ts ≠ O -> - key ∈ keys_all -> - key_to_group key = gid -> - is_replica rp gid rid γ -∗ - {{{ True }}} - Replica__Read #rp #tsW #(LitString key) - {{{ (t : u64) (v : dbval) (ok : bool), RET (#t, dbval_to_val v, #ok); - if ok - then fast_or_slow_read γ rid key (uint.nat t) ts v - else True - }}}. - Proof. - iIntros (ts Htsnz Hkey Hkg) "#Hrp". - iIntros (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (rp *Replica) Read(ts uint64, key string) (uint64, tulip.Value, bool) { @*) - (*@ tpl := rp.idx.GetTuple(key) @*) - (*@ @*) - iNamed "Hrp". iNamed "Hidx". - wp_loadField. - wp_apply (wp_Index__GetTuple with "Hidx"); first apply Hkey. - iIntros (tpl) "#Htpl". - - (*@ t1, v1 := tpl.ReadVersion(ts) @*) - (*@ @*) - wp_apply (wp_Tuple__ReadVersion_xphys with "Htpl"). - iIntros (t1 v1) "Hread1". - wp_pures. - - (*@ if t1 == 0 { @*) - (*@ // Fast-path read. @*) - (*@ return 0, v1, true @*) - (*@ } @*) - (*@ @*) - case_bool_decide as Ht1; wp_pures. - { iApply "HΦ". by case_decide; last inv Ht1. } - - (*@ rp.mu.Lock() @*) - (*@ @*) - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hrp]". - - (*@ ok := rp.readableKey(ts, key) @*) - (*@ @*) - do 2 iNamed "Hrp". - wp_apply (wp_Replica__readableKey with "Hptsmsptsm"); first apply Hkey. - iIntros (ok) "[Hptsmsptsm %Hreadable]". - wp_pures. - - (*@ if !ok { @*) - (*@ // Trying to read a tuple that is locked by a lower-timestamp @*) - (*@ // transaction. This read has to fail because the value to be read is @*) - (*@ // undetermined---the prepared transaction might or might not commit. @*) - (*@ rp.mu.Unlock() @*) - (*@ return 0, tulip.Value{}, false @*) - (*@ } @*) - (*@ @*) - destruct ok; wp_pures; last first. - { wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { by iFrame "Hlock Hlocked ∗ # %". } - wp_pures. - by iApply ("HΦ" $! _ None). - } - - (*@ t2, v2 := tpl.ReadVersion(ts) @*) - (*@ @*) - assert (is_Some (histm !! key)) as [hist Hhist]. - { unshelve epose proof (execute_cmds_apply_cmds cloga ilog cm histm _) as Happly. - { by eauto 10. } - pose proof (apply_cmds_dom _ _ _ Happly) as Hdomhistm. - by rewrite -elem_of_dom Hdomhistm. - } - iDestruct (big_sepM_lookup_acc with "Hhistm") as "[Hhist HhistmC]"; first apply Hhist. - wp_apply (wp_Tuple__ReadVersion with "Htpl Hhist"). - iIntros (t2 v2) "[Hhist #Hlb]". - iDestruct ("HhistmC" with "Hhist") as "Hhistm". - wp_pures. - - (*@ if t2 == 0 { @*) - (*@ // Fast-path read. @*) - (*@ rp.mu.Unlock() @*) - (*@ return 0, v2, true @*) - (*@ } @*) - (*@ @*) - case_bool_decide as Ht2; wp_pures. - { wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { by iFrame "Hlock Hlocked ∗ # %". } - wp_pures. - iApply "HΦ". - by case_decide; last inv Ht2. - } - - (*@ // Slow-path read. @*) - (*@ rp.bumpKey(ts, key) @*) - (*@ @*) - wp_apply (wp_Replica__bumpKey with "Hptsmsptsm"). - { clear -Htsnz. word. } - { apply Hkey. } - iIntros (spts) "[Hptsmsptsm %Hspts]". - - (*@ // TODO: An optimization is to create a log entry iff the smallest @*) - (*@ // preparable timestamp is actually bumped, which can be checked with the @*) - (*@ // return value of @rp.bumpKey. @*) - (*@ @*) - (*@ // Logical actions: Execute() and then LocalRead(@ts, @key) @*) - (*@ rp.logRead(ts, key) @*) - (*@ @*) - wp_pures. - wp_apply wp_Replica__logRead. - iApply fupd_wp. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. - (* First catching up the consistent log. *) - destruct Hcloga as [cmdsa ->]. - iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") - as "(Hclog & Hilog & Hgroup & Hrp)". - iMod (replica_inv_local_read key ts with "Hclog Hilog Hgroup Hrp") - as "(Hclog & Hilog & Hgroup & Hrp & #Hpromise & #Hrepllb)". - { apply Hkey. } - { apply Hkg. } - { apply Hexec. } - { simpl. - rewrite /key_readable in Hreadable. - destruct (ptsm !! key) as [pts |] eqn:Hpts; rewrite Hpts in Hreadable; last done. - exists spts, pts. - do 3 (split; first done). - clear -Hreadable. word. - } - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iDestruct ("HrgC" with "Hrp") as "Hrg". - iDestruct ("HrgsC" with "Hrg") as "Hrgs". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iModIntro. - - (*@ rp.mu.Unlock() @*) - (*@ return t2, v2, true @*) - (*@ } @*) - wp_loadField. - wp_apply (wp_Mutex__Unlock with "[-HΦ]"). - { iFrame "Hlock Hlocked ∗ # %". - iPureIntro. simpl. - exists ptgsm. - split; first done. - split. - { rewrite Forall_forall. - intros [n c] Hilog. simpl. - apply elem_of_app in Hilog as [Hilog | Hnewc]. - { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } - rewrite elem_of_list_singleton in Hnewc. - by inv Hnewc. - } - { rewrite merge_clog_ilog_snoc_ilog; last done. - rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. - erewrite lookup_alter_Some; last apply Hspts. - f_equal. - } - } - wp_pures. - iApply "HΦ". - rewrite /fast_or_slow_read. - case_decide as Hnz; first done. - iDestruct "Hlb" as "[Hlb' %Hv2]". - clear Ht2. - destruct Hv2 as (Hv2 & Ht2 & Hlenhist). - rewrite Ht2. - iFrame "Hrepllb". - rewrite Hkg. - iFrame "Hpromise". - iPureIntro. - split. - { by rewrite -last_lookup. } - { clear -Ht2 Hnz Hlenhist. word. } - Qed. - - Theorem wp_Replica__multiwrite rp (tsW : u64) pwrsS pwrsL pwrs histm gid γ α : - let ts := uint.nat tsW in - let histm' := multiwrite ts pwrs histm in - valid_pwrs gid pwrs -> - dom histm = keys_all -> - safe_extension ts pwrs histm -> - ([∗ map] k ↦ h ∈ filter_group gid histm', is_repl_hist_lb γ k h) -∗ - is_replica_idx rp γ α -∗ - {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica_histm rp histm α }}} - Replica__multiwrite #rp #tsW (to_val pwrsS) - {{{ RET #(); - own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica_histm rp histm' α - }}}. - Proof. - iIntros (ts histm' Hvw Hdomhistm Hlenhistm) "#Hrlbs #Hidx". - iIntros (Φ) "!> [[HpwrsS %Hpwrs] Hhistm] HΦ". - wp_rec. - - (*@ func (rp *Replica) multiwrite(ts uint64, pwrs []tulip.WriteEntry) { @*) - (*@ for _, ent := range pwrs { @*) - (*@ key := ent.Key @*) - (*@ value := ent.Value @*) - (*@ tpl := rp.idx.GetTuple(key) @*) - (*@ if value.Present { @*) - (*@ tpl.AppendVersion(ts, value.Content) @*) - (*@ } else { @*) - (*@ tpl.KillVersion(ts) @*) - (*@ } @*) - (*@ } @*) - (*@ } @*) - iDestruct (own_slice_sz with "HpwrsS") as %Hlenpwrs. - iDestruct (own_slice_small_acc with "HpwrsS") as "[HpwrsS HpwrsC]". - set P := (λ (i : u64), - let pwrs' := list_to_map (take (uint.nat i) pwrsL) in - own_replica_histm rp (multiwrite ts pwrs' histm) α)%I. - wp_apply (wp_forSlice P with "[] [$HpwrsS Hhistm]"); last first; first 1 last. - { (* Loop entry. *) - subst P. simpl. - rewrite uint_nat_W64_0 take_0 list_to_map_nil. - by rewrite multiwrite_empty. - } - { (* Loop body. *) - clear Φ. - iIntros (i [k v]) "!>". - iIntros (Φ) "(Hhistm & %Hbound & %Hi) HΦ". - subst P. simpl. - iNamed "Hidx". - wp_loadField. - (* Prove [k] in the domain of [pwrs] and in [keys_all]. *) - apply elem_of_list_lookup_2 in Hi as Hpwrsv. - rewrite -Hpwrs elem_of_map_to_list in Hpwrsv. - apply elem_of_dom_2 in Hpwrsv as Hdompwrs. - assert (Hvk : k ∈ keys_all). - { clear -Hvw Hdompwrs. set_solver. } - wp_apply (wp_Index__GetTuple with "Hidx"); first apply Hvk. - iIntros (tpl) "#Htpl". - (* Obtain proof that the current key [k] has not been written. *) - pose proof (NoDup_fst_map_to_list pwrs) as Hnd. - rewrite Hpwrs in Hnd. - pose proof (list_lookup_fmap fst pwrsL (uint.nat i)) as Hk. - rewrite Hi /= in Hk. - pose proof (not_elem_of_take _ _ _ Hnd Hk) as Htake. - rewrite -fmap_take in Htake. - apply not_elem_of_list_to_map_1 in Htake as Hnone. - (* Adjust the goal. *) - rewrite uint_nat_word_add_S; last by word. - rewrite (take_S_r _ _ _ Hi) list_to_map_snoc; last done. - set pwrs' := (list_to_map _) in Hnone *. - assert (is_Some (histm !! k)) as [h Hh]. - { by rewrite -elem_of_dom Hdomhistm. } - (* Obtain the length constraint. *) - rewrite /safe_extension in Hlenhistm. - set histmwr := filter _ _ in Hlenhistm. - assert (Hhistmwrk : histmwr !! k = Some h). - { by apply map_lookup_filter_Some_2. } - specialize (Hlenhistm _ _ Hhistmwrk). simpl in Hlenhistm. - (* Obtain the replicated history lb. *) - assert (Hh' : histm' !! k = Some (last_extend ts h ++ [v])). - { by rewrite (multiwrite_modified Hpwrsv Hh). } - iDestruct (big_sepM_lookup _ _ k with "Hrlbs") as "Hrlb". - { apply map_lookup_filter_Some_2; first apply Hh'. simpl. - clear -Hdompwrs Hvw. set_solver. - } - (* Take the physical history out. *) - iDestruct (big_sepM_delete with "Hhistm") as "[Hh Hhistm]". - { rewrite multiwrite_unmodified; [apply Hh | apply Hnone]. } - destruct v as [s |]; wp_pures. - { (* Case: [@AppendVersion]. *) - wp_apply (wp_Tuple__AppendVersion with "Hrlb Htpl Hh"). - { apply Hlenhistm. } - iIntros "Hh". - iDestruct (big_sepM_insert_2 with "Hh Hhistm") as "Hhistm". - rewrite insert_delete_insert /multiwrite. - erewrite insert_merge_l; last first. - { by rewrite Hh. } - iApply "HΦ". - iFrame "∗ #". - } - { (* Case: [@KillVersion]. *) - wp_apply (wp_Tuple__KillVersion with "Hrlb Htpl Hh"). - { apply Hlenhistm. } - iIntros "Hh". - iDestruct (big_sepM_insert_2 with "Hh Hhistm") as "Hhistm". - rewrite insert_delete_insert /multiwrite. - erewrite insert_merge_l; last first. - { by rewrite Hh. } - iApply "HΦ". - iFrame "∗ #". - } - } - iIntros "[Hhistm HpwrsS]". subst P. simpl. - iDestruct ("HpwrsC" with "HpwrsS") as "HpwrsS". - wp_pures. - iApply "HΦ". - pose proof (list_to_map_flip _ _ Hpwrs) as Hltm. - rewrite -Hlenpwrs firstn_all -Hltm. - by iFrame. - Qed. - - Theorem wp_Replica__terminated rp (tsW : u64) cm : - let ts := uint.nat tsW in - {{{ own_replica_cm rp cm }}} - Replica__terminated #rp #tsW - {{{ RET #(bool_decide (ts ∈ dom cm)); own_replica_cm rp cm }}}. - Proof. - iIntros (ts Φ) "Hcm HΦ". - wp_rec. - - (*@ func (rp *Replica) terminated(ts uint64) bool { @*) - (*@ _, terminated := rp.txntbl[ts] @*) - (*@ return terminated @*) - (*@ } @*) - iNamed "Hcm". - wp_loadField. - wp_apply (wp_MapGet with "Htxntbl"). - iIntros (v ok) "[%Hok Htxntbl]". - wp_pures. - case_bool_decide as Hts. - { destruct ok; last first. - { exfalso. - apply map_get_false in Hok as [Hnone _]. - apply elem_of_dom in Hts as [b Hb]. - symmetry in Hcmabs. - pose proof (lookup_kmap_eq_None _ _ _ _ _ Hcmabs Hnone) as Hcontra. - specialize (Hcontra ts). - unshelve epose proof (Hcontra _) as Hcmts; first word. - by rewrite Hb in Hcmts. - } - iApply "HΦ". by iFrame "∗ %". - } - { destruct ok. - { exfalso. - apply map_get_true in Hok. - apply not_elem_of_dom in Hts. - pose proof (lookup_kmap_eq_None _ _ _ _ _ Hcmabs Hts) as Hcontra. - specialize (Hcontra tsW). - unshelve epose proof (Hcontra _) as Hcmts; first word. - by rewrite Hok in Hcmts. - } - iApply "HΦ". by iFrame "∗ %". - } - Qed. - - Theorem wp_Replica__release rp pwrsS pwrsL pwrs ptsm sptsm : - valid_wrs pwrs -> - {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica_ptsm_sptsm rp ptsm sptsm }}} - Replica__release #rp (to_val pwrsS) - {{{ RET #(); - own_dbmap_in_slice pwrsS pwrsL pwrs ∗ - own_replica_ptsm_sptsm rp (release pwrs ptsm) sptsm - }}}. - Proof. - iIntros (Hvw Φ) "[[HpwrsS %Hpwrs] Hrp] HΦ". - wp_rec. - iDestruct (own_replica_ptsm_sptsm_dom with "Hrp") as %[Hdomptsm Hdomsptsm]. - - (*@ func (rp *Replica) release(pwrs []tulip.WriteEntry) { @*) - (*@ for _, ent := range pwrs { @*) - (*@ key := ent.Key @*) - (*@ rp.releaseKey(key) @*) - (*@ } @*) - (*@ } @*) - iDestruct (own_slice_sz with "HpwrsS") as %Hlenpwrs. - iDestruct (own_slice_small_acc with "HpwrsS") as "[HpwrsS HpwrsC]". - set P := (λ (i : u64), - let pwrs' := list_to_map (take (uint.nat i) pwrsL) in - own_replica_ptsm_sptsm rp (release pwrs' ptsm) sptsm)%I. - wp_apply (wp_forSlice P with "[] [$HpwrsS Hrp]"); last first; first 1 last. - { (* Loop entry. *) - subst P. simpl. - rewrite uint_nat_W64_0 take_0 list_to_map_nil. - by rewrite release_empty. - } - { (* Loop body. *) - clear Φ. - iIntros (i [k v]) "!>". - iIntros (Φ) "(Hrp & %Hbound & %Hi) HΦ". - subst P. simpl. - wp_pures. - wp_apply (wp_Replica__releaseKey with "Hrp"). - iIntros "Hrp". - iApply "HΦ". - (* Obtain proof that the current key [k] has not been written. *) - pose proof (map_to_list_not_elem_of_take_key _ _ _ _ Hpwrs Hi) as Htake. - (* Adjust the goal. *) - rewrite uint_nat_word_add_S; last by word. - rewrite (take_S_r _ _ _ Hi) list_to_map_snoc; last apply Htake. - set pwrs' := list_to_map _. - rewrite /release setts_insert; last first. - { apply elem_of_list_lookup_2 in Hi. - rewrite -Hpwrs in Hi. - apply elem_of_map_to_list, elem_of_dom_2 in Hi. - clear -Hvw Hi Hdomptsm. set_solver. - } - done. - } - iIntros "[Hrp HpwrsS]". - subst P. simpl. - pose proof (list_to_map_flip _ _ Hpwrs) as Hltm. - rewrite -Hlenpwrs firstn_all Hltm. - iDestruct ("HpwrsC" with "HpwrsS") as "HpwrsS". - wp_pures. - iApply "HΦ". - iFrame. - by rewrite -Hltm. - Qed. - - Theorem wp_Replica__applyCommit - rp (tsW : u64) pwrsS pwrsL pwrs cloga gid rid γ α : - let ts := uint.nat tsW in - let cloga' := cloga ++ [CmdCommit ts pwrs] in - valid_pwrs gid pwrs -> - group_histm_lbs_from_log γ gid cloga' -∗ - is_txn_log_lb γ gid cloga' -∗ - is_replica_idx rp γ α -∗ - {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ - own_replica_with_cloga_no_lsna rp cloga gid rid γ α - }}} - Replica__applyCommit #rp #tsW (to_val pwrsS) - {{{ RET #(); - own_dbmap_in_slice pwrsS pwrsL pwrs ∗ - own_replica_with_cloga_no_lsna rp cloga' gid rid γ α - }}}. - Proof. - iIntros (ts cloga' Hvpwrs) "#Hhistmlb #Hlb' #Hidx". - iIntros (Φ) "!> [Hpwrs Hrp] HΦ". - wp_rec. - (* First establish that applying this commit results does not get stuck. *) - rewrite /group_histm_lbs_from_log. - destruct (apply_cmds cloga') as [cm' histm' |] eqn:Happly'; last done. - (* Also establish connection between executing entire log vs. consistent log. *) - iNamed "Hrp". - unshelve epose proof (execute_cmds_apply_cmds cloga ilog cm histm _) as Happly. - { by eauto 10. } - - (*@ func (rp *Replica) applyCommit(ts uint64, pwrs []tulip.WriteEntry) { @*) - (*@ // Query the transaction table. Note that if there's an entry for @ts in @*) - (*@ // @txntbl, then transaction @ts can only be committed. That's why we're not @*) - (*@ // even reading the value of entry. @*) - (*@ committed := rp.terminated(ts) @*) - (*@ if committed { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_Replica__terminated with "Hcm"). - iIntros "Hcm". - case_bool_decide as Hterm; wp_pures. - { iApply "HΦ". - apply elem_of_dom in Hterm as [b Hb]. - iFrame "∗ # %". - iPureIntro. simpl. - exists ptgsm. - split. - { by apply prefix_app_r. } - rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. - split. - { eapply Forall_impl; first apply Hvicmds. simpl. - intros nc Hnc. - rewrite length_app /=. - clear -Hnc. lia. - } - rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hb. - destruct b; first done. - by rewrite /apply_cmds foldl_snoc /= apply_cmds_unfold /apply_commit Happly Hb in Happly'. - } - apply not_elem_of_dom in Hterm. - rewrite /apply_cmds foldl_snoc /= apply_cmds_unfold Happly /= Hterm in Happly'. - case_decide as Hsafeext; last done. - symmetry in Happly'. inv Happly'. - - (*@ rp.multiwrite(ts, pwrs) @*) - (*@ @*) - wp_apply (wp_Replica__multiwrite with "Hhistmlb Hidx [$Hpwrs $Hhistm]"). - { apply Hvpwrs. } - { by eapply apply_cmds_dom. } - { apply Hsafeext. } - iIntros "[Hpwrs Hhistm]". - - (*@ rp.txntbl[ts] = true @*) - (*@ @*) - iNamed "Hcm". - wp_loadField. - wp_apply (wp_MapInsert with "Htxntbl"); first done. - iIntros "Htxntbl". - - (*@ // With PCR, a replica might receive a commit even if it is not prepared on @*) - (*@ // this replica. @*) - (*@ _, prepared := rp.prepm[ts] @*) - (*@ @*) - iNamed "Hcpm". - wp_loadField. - wp_apply (wp_MapGet with "HprepmS"). - iIntros (prepS prepared) "[%Hprepared HprepmS]". - wp_pures. - - (*@ if prepared { @*) - (*@ rp.release(pwrs) @*) - (*@ delete(rp.prepm, ts) @*) - (*@ } @*) - (*@ } @*) - destruct prepared; wp_pures. - { wp_apply (wp_Replica__release with "[$Hpwrs $Hptsmsptsm]"). - { clear -Hvpwrs. set_solver. } - iIntros "[Hpwrs Hptsmsptsm]". - wp_loadField. - wp_apply (wp_MapDelete with "HprepmS"). - iIntros "HprepmS". - wp_pures. - iApply "HΦ". - apply map_get_true in Hprepared. - iDestruct (big_sepM2_delete_l with "Hprepm") as (m) "(%Hm & _ & Hprepm)". - { apply Hprepared. } - iAssert ([∗ set] t ∈ dom (delete ts cpm), is_replica_validated_ts γ gid rid t)%I - as "#Hrpvds'". - { rewrite dom_delete_L. - iDestruct (big_sepS_delete _ _ ts with "Hrpvds") as "[_ ?]"; last done. - symmetry in Hcpmabs. - pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hm) as (ts' & Hts' & Hcpmts). - assert (ts' = ts) as -> by word. - by apply elem_of_dom. - } - iClear "Hrpvds". - iFrame "∗ # %". - iPureIntro. simpl. - exists (<[ts := true]> cm), (delete ts ptgsm). - split. - { rewrite 2!kmap_insert. f_equal; [word | done]. } - split. - { rewrite 2!kmap_delete. f_equal; [word | done]. } - split. - { by apply prefix_app_r. } - { rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. - split. - { by apply map_Forall_delete. } - split. - { eapply Forall_impl; first apply Hvicmds. simpl. - intros nc Hnc. - rewrite length_app /=. - clear -Hnc. lia. - } - symmetry in Hcpmabs. - pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hm) as (ts' & Hts' & Hcpmts). - assert (ts' = ts) as -> by word. - by rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hterm Hcpmts. - } - } - iDestruct (big_sepM2_dom with "Hprepm") as %Hdomprepm. - iApply "HΦ". - iFrame "∗ # %". - iPureIntro. simpl. - exists (<[ts := true]> cm), ptgsm. - split. - { rewrite 2!kmap_insert. f_equal; [word | done]. } - split. - { by apply prefix_app_r. } - { rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. - split. - { eapply Forall_impl; first apply Hvicmds. simpl. - intros nc Hnc. - rewrite length_app /=. - clear -Hnc. lia. - } - apply map_get_false in Hprepared as [Hnone _]. - rewrite -not_elem_of_dom Hdomprepm not_elem_of_dom in Hnone. - symmetry in Hcpmabs. - pose proof (lookup_kmap_eq_None _ _ _ _ _ Hcpmabs Hnone) as Hcpmnone. - specialize (Hcpmnone ts). - unshelve epose proof (Hcpmnone _) as Hcpmts; first word. - by rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hterm Hcpmts. - } - Qed. - - Theorem wp_Replica__applyAbort rp (tsW : u64) cloga gid rid γ α : - let ts := uint.nat tsW in - let cloga' := cloga ++ [CmdAbort ts] in - not_stuck (apply_cmds cloga') -> - is_txn_log_lb γ gid cloga' -∗ - {{{ own_replica_with_cloga_no_lsna rp cloga gid rid γ α }}} - Replica__applyAbort #rp #tsW - {{{ RET #(); own_replica_with_cloga_no_lsna rp cloga' gid rid γ α }}}. - Proof. - iIntros (ts cloga' Hns) "#Hlb'". - iIntros (Φ) "!> Hrp HΦ". - wp_rec. - (* First establish that applying this commit results does not get stuck. *) - destruct (apply_cmds cloga') as [cm' histm' |] eqn:Happly'; last done. - (* Also establish connection between executing entire log vs. consistent log. *) - iNamed "Hrp". - unshelve epose proof (execute_cmds_apply_cmds cloga ilog cm histm _) as Happly. - { by eauto 10. } - - (*@ func (rp *Replica) applyAbort(ts uint64) { @*) - (*@ // Query the transaction table. Note that if there's an entry for @ts in @*) - (*@ // @txntbl, then transaction @ts can only be aborted. That's why we're not @*) - (*@ // even reading the value of entry. @*) - (*@ aborted := rp.terminated(ts) @*) - (*@ if aborted { @*) - (*@ return @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_Replica__terminated with "Hcm"). - iIntros "Hcm". - case_bool_decide as Hterm; wp_pures. - { iApply "HΦ". - apply elem_of_dom in Hterm as [b Hb]. - iFrame "∗ # %". - iPureIntro. simpl. - exists ptgsm. - split. - { by apply prefix_app_r. } - rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. - split. - { eapply Forall_impl; first apply Hvicmds. simpl. - intros nc Hnc. - rewrite length_app /=. - clear -Hnc. lia. - } - rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hb. - destruct b; last done. - by rewrite /apply_cmds foldl_snoc /= apply_cmds_unfold /apply_abort Happly Hb in Happly'. - } - apply not_elem_of_dom in Hterm. - (* rewrite /apply_cmds foldl_snoc /= apply_cmds_unfold Happly /= Hterm in Happly'. *) - (* symmetry in Happly'. inv Happly'. *) - - (*@ rp.txntbl[ts] = false @*) - (*@ @*) - iNamed "Hcm". - wp_loadField. - wp_apply (wp_MapInsert with "Htxntbl"); first done. - iIntros "Htxntbl". - - (*@ // Tuples lock are held iff @prepm[ts] contains something (and so we should @*) - (*@ // release them by calling @abort). @*) - (*@ pwrs, prepared := rp.prepm[ts] @*) - (*@ @*) - iNamed "Hcpm". - wp_loadField. - wp_apply (wp_MapGet with "HprepmS"). - iIntros (prepS prepared) "[%Hprepared HprepmS]". - wp_pures. - - (*@ if prepared { @*) - (*@ rp.release(pwrs) @*) - (*@ delete(rp.prepm, ts) @*) - (*@ } @*) - (*@ } @*) - iDestruct (big_sepM2_dom with "Hprepm") as %Hdomprepm. - destruct prepared; wp_pures. - { apply map_get_true in Hprepared. - assert (is_Some (prepm !! tsW)) as [pwrs Hpwrs]. - { by rewrite -elem_of_dom -Hdomprepm elem_of_dom. } - iDestruct (big_sepM2_delete with "Hprepm") as "[Hpwrs Hprepm]". - { apply Hprepared. } - { apply Hpwrs. } - iDestruct "Hpwrs" as (pwrsL) "Hpwrs". - wp_apply (wp_Replica__release with "[$Hpwrs $Hptsmsptsm]"). - { symmetry in Hcpmabs. - pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hpwrs) as (ts' & Hts' & Hcpmts). - assert (ts' = ts) as -> by word. - by specialize (Hvcpm _ _ Hcpmts). - } - iIntros "[Hpwrs Hptsmsptsm]". - wp_loadField. - wp_apply (wp_MapDelete with "HprepmS"). - iIntros "HprepmS". - wp_pures. - iApply "HΦ". - iAssert ([∗ set] t ∈ dom (delete ts cpm), is_replica_validated_ts γ gid rid t)%I - as "#Hrpvds'". - { rewrite dom_delete_L. - iDestruct (big_sepS_delete _ _ ts with "Hrpvds") as "[_ ?]"; last done. - symmetry in Hcpmabs. - pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hpwrs) as (ts' & Hts' & Hcpmts). - assert (ts' = ts) as -> by word. - by apply elem_of_dom. - } - iClear "Hrpvds". - iFrame "∗ # %". - iPureIntro. simpl. - exists (<[ts := false]> cm), (delete ts ptgsm). - split. - { rewrite 2!kmap_insert. f_equal; [word | done]. } - split. - { rewrite 2!kmap_delete. f_equal; [word | done]. } - split. - { by apply prefix_app_r. } - { rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. - split. - { by apply map_Forall_delete. } - split. - { eapply Forall_impl; first apply Hvicmds. simpl. - intros nc Hnc. - rewrite length_app /=. - clear -Hnc. lia. - } - symmetry in Hcpmabs. - pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hpwrs) as (ts' & Hts' & Hcpmts). - assert (ts' = ts) as -> by word. - by rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hterm Hcpmts. - } - } - iApply "HΦ". - iFrame "∗ # %". - iPureIntro. simpl. - exists (<[ts := false]> cm), ptgsm. - split. - { rewrite 2!kmap_insert. f_equal; [word | done]. } - split. - { by apply prefix_app_r. } - { rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. - split. - { eapply Forall_impl; first apply Hvicmds. simpl. - intros nc Hnc. - rewrite length_app /=. - clear -Hnc. lia. - } - apply map_get_false in Hprepared as [Hnone _]. - rewrite -not_elem_of_dom Hdomprepm not_elem_of_dom in Hnone. - symmetry in Hcpmabs. - pose proof (lookup_kmap_eq_None _ _ _ _ _ Hcpmabs Hnone) as Hcpmnone. - specialize (Hcpmnone ts). - unshelve epose proof (Hcpmnone _) as Hcpmts; first word. - by rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hterm Hcpmts. - } - Qed. - - Theorem wp_Replica__apply - rp cmd pwrsS cloga gid rid γ α : - let cloga' := cloga ++ [cmd] in - valid_ccommand gid cmd -> - group_histm_lbs_from_log γ gid cloga' -∗ - is_txn_log_lb γ gid cloga' -∗ - is_replica_idx rp γ α -∗ - {{{ own_pwrs_slice pwrsS cmd ∗ - own_replica_with_cloga_no_lsna rp cloga gid rid γ α - }}} - Replica__apply #rp (ccommand_to_val pwrsS cmd) - {{{ RET #(); - own_pwrs_slice pwrsS cmd ∗ - own_replica_with_cloga_no_lsna rp cloga' gid rid γ α - }}}. - Proof. - iIntros (cloga' Hvcmd) "#Hsafe #Hlb' #Hidx". - iIntros (Φ) "!> [Hpwrs Hrp] HΦ". - wp_rec. - - (*@ func (rp *Replica) apply(cmd txnlog.Cmd) { @*) - (*@ if cmd.Kind == 1 { @*) - (*@ rp.applyCommit(cmd.Timestamp, cmd.PartialWrites) @*) - (*@ } else if cmd.Kind == 2 { @*) - (*@ rp.applyAbort(cmd.Timestamp) @*) - (*@ } @*) - (*@ } @*) - wp_pures. - destruct cmd eqn:Hcmd; wp_pures. - { (* Case: CmdCommit. *) - destruct Hvcmd as [Hvts Hvpwrs]. - iDestruct "Hpwrs" as (pwrsL) "Hpwrs". - wp_apply (wp_Replica__applyCommit with "[Hsafe] [Hlb'] Hidx [$Hpwrs $Hrp]"). - { apply Hvpwrs. } - { rewrite uint_nat_W64_of_nat; first done. rewrite /valid_ts in Hvts. word. } - { rewrite uint_nat_W64_of_nat; first done. rewrite /valid_ts in Hvts. word. } - iIntros "[Hpwrs Hrp]". - wp_pures. - iApply "HΦ". - rewrite uint_nat_W64_of_nat; last first. - { rewrite /valid_ts in Hvts. word. } - by iFrame. - } - { (* Case: CmdAbort. *) - simpl in Hvcmd. - rewrite /group_histm_lbs_from_log. - destruct (apply_cmds cloga') as [cpm histm |] eqn:Happly; last done. - wp_apply (wp_Replica__applyAbort with "[Hlb'] Hrp"). - { rewrite uint_nat_W64_of_nat; first by rewrite Happly. rewrite /valid_ts in Hvcmd. word. } - { rewrite uint_nat_W64_of_nat; first done. rewrite /valid_ts in Hvcmd. word. } - iIntros "Hrp". - wp_pures. - iApply "HΦ". - rewrite uint_nat_W64_of_nat; last first. - { rewrite /valid_ts in Hvcmd. word. } - by iFrame. - } - Qed. - - Theorem wp_Replica__Start rp gid rid γ : - is_replica rp gid rid γ -∗ - {{{ True }}} - Replica__Start #rp - {{{ RET #(); True }}}. - Proof. - iIntros "#Hrp" (Φ) "!> _ HΦ". - wp_rec. - - (*@ func (rp *Replica) Start() { @*) - (*@ rp.mu.Lock() @*) - (*@ @*) - iNamed "Hrp". - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hrp]". - wp_pures. - - (*@ for { @*) - (*@ // TODO: a more efficient interface would return multiple safe commands @*) - (*@ // at once (so as to reduce the frequency of acquiring Paxos mutex). @*) - (*@ // Ghost action: Learn a list of new commands. @*) - (*@ cmd, ok := rp.txnlog.Lookup(rp.lsna) @*) - (*@ @*) - set P := (λ b : bool, own_replica rp gid rid γ α ∗ locked #mu)%I. - wp_apply (wp_forBreak P with "[] [$Hrp $Hlocked]"); last first. - { (* Get out of an infinite loop. *) - iIntros "Hrp". wp_pures. by iApply "HΦ". - } - clear Φ. iIntros "!>" (Φ) "[Hrp Hlocked] HΦ". - wp_rec. - do 2 iNamed "Hrp". - wp_loadField. - - (*@ cmd, ok := rp.txnlog.Lookup(lsn) @*) - (*@ @*) - iNamed "Htxnlog". - wp_loadField. - wp_apply (wp_TxnLog__Lookup with "Htxnlog"). - iInv "Hinv" as "> HinvO" "HinvC". - iApply ncfupd_mask_intro; first set_solver. - iIntros "Hmask". - iNamed "HinvO". - (* Take the required group invariant. *) - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. - (* Separate out the ownership of the Paxos log from others. *) - iDestruct (group_inv_extract_log_expose_cpool with "Hgroup") as (paxos cpool) "[Hpaxos Hgroup]". - (* Obtain validity of command input on cpool. *) - iDestruct (group_inv_impl_valid_ccommand_cpool with "[Hgroup Hpaxos]") as %Hvcmds. - { iNamed "Hgroup". iFrame. } - (* Obtain a lower bound before passing it to Paxos. *) - iDestruct (txn_log_witness with "Hpaxos") as "#Hlb". - iExists paxos. iFrame. - iIntros (paxos') "Hpaxos". - (* Obtain prefix between the old and new logs. *) - iDestruct (txn_log_prefix with "Hpaxos Hlb") as %Hpaxos. - destruct Hpaxos as [cmds Hpaxos]. - (* Obtain inclusion between the command pool and the log. *) - iAssert (⌜cpool_subsume_log cpool paxos'⌝)%I as %Hincl. - { iNamed "Hgroup". - by iDestruct (txn_log_cpool_incl with "Hpaxos Hcpool") as %?. - } - (* Transfer validity of command input on cpool to log; used when executing @apply. *) - pose proof (set_Forall_Forall_subsume _ _ _ Hvcmds Hincl) as Hvc. - (* Obtain prefix between the applied log and the new log; needed later. *) - iDestruct (txn_log_prefix with "Hpaxos Hclogalb") as %Hloga. - (* Obtain a witness of the new log; needed later. *) - iDestruct (txn_log_witness with "Hpaxos") as "#Hlbnew". - subst paxos'. - - (*@ // Ghost action: Learn a list of new commands. @*) - (*@ @*) - iMod (group_inv_learn with "Htxnsys Hkeys Hgroup") as "(Htxnsys & Hkeys & Hgroup)". - { apply Hincl. } - iDestruct (group_inv_merge_log_hide_cpool with "Hpaxos Hgroup") as "Hgroup". - (* Put back the group invariant. *) - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - (* Close the entire invariant. *) - iMod "Hmask" as "_". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iIntros "!>" (cmd ok pwrsS) "[HpwrsS %Hcmd]". - wp_pures. - - (*@ if !ok { @*) - (*@ // Sleep for 1 ms. @*) - (*@ rp.mu.Unlock() @*) - (*@ primitive.Sleep(1 * 1000000) @*) - (*@ rp.mu.Lock() @*) - (*@ continue @*) - (*@ } @*) - (*@ @*) - destruct ok; wp_pures; last first. - { (* Have applied all the commands known to be committed. *) - wp_loadField. - iClear "Hlb Hlbnew". - wp_apply (wp_Mutex__Unlock with "[-HΦ $Hlock $Hlocked]"); first by iFrame "∗ # %". - wp_apply wp_Sleep. - wp_loadField. - wp_apply (wp_Mutex__Lock with "Hlock"). - iIntros "[Hlocked Hrp]". - wp_pures. - iApply "HΦ". - by iFrame. - } - (* Obtain a witness for the newly applied log. *) - iClear "Hlb". - (* Prove the newly applied log is a prefix of the new log. *) - assert (Hprefix : prefix (cloga ++ [cmd]) (paxos ++ cmds)). - { clear -Hloga Hcmd Hlencloga. - destruct Hloga as [l Hl]. - rewrite Hl. - apply prefix_app, prefix_singleton. - rewrite Hl lookup_app_r in Hcmd; last lia. - by rewrite Hlencloga /= Nat.sub_diag in Hcmd. - } - iDestruct (txn_log_lb_weaken (cloga ++ [cmd]) with "Hlbnew") as "#Hlb"; first apply Hprefix. - (* Obtain lbs of replicated history over the new history map. *) - iApply fupd_wp. - iInv "Hinv" as "> HinvO" "HinvC". - (* Take the required group invariant. *) - iNamed "HinvO". - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. - iDestruct (group_inv_witness_group_histm_lbs_from_log with "Hlb Hgroup") as "#Hhistmlb". - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iModIntro. - - (*@ rp.apply(cmd) @*) - (*@ @*) - iAssert (own_replica_with_cloga_no_lsna rp cloga gid rid γ α)%I - with "[Hcm Hhistm Hcpm Hptsmsptsm Hpsmrkm Hclog Hilog]" as "Hrp". - { iFrame "∗ # %". } - wp_apply (wp_Replica__apply with "Hhistmlb Hlb Hidx [$HpwrsS $Hrp]"). - { rewrite Forall_forall in Hvc. - apply Hvc. - by apply elem_of_list_lookup_2 in Hcmd. - } - iIntros "[HpwrsS Hrp]". - - - (*@ rp.lsna = std.SumAssumeNoOverflow(rp.lsna, 1) @*) - (*@ @*) - wp_loadField. - wp_apply wp_SumAssumeNoOverflow. - iIntros (Hnoof). - wp_storeField. - - (*@ } @*) - (*@ } @*) - iApply "HΦ". - iFrame. - iPureIntro. - rewrite uint_nat_word_add_S; last word. - rewrite length_app /= Hlencloga. - lia. - Qed. - - Definition finalized_outcome γ ts res : iProp Σ := - match res with - | ReplicaOK => False - | ReplicaCommittedTxn => (∃ wrs, is_txn_committed γ ts wrs) - | ReplicaAbortedTxn => is_txn_aborted γ ts - | ReplicaStaleCoordinator => False - | ReplicaFailedValidation => False - | ReplicaInvalidRank => False - | ReplicaWrongLeader => False - end. - - Theorem wp_Replica__finalized rp (tsW : u64) gid rid γ α : - let ts := uint.nat tsW in - gid ∈ gids_all -> - know_tulip_inv γ -∗ - {{{ own_replica rp gid rid γ α }}} - Replica__finalized #rp #tsW - {{{ (res : rpres) (ok : bool), RET (#(rpres_to_u64 res), #ok); - own_replica rp gid rid γ α ∗ - if ok then finalized_outcome γ ts res else True - }}}. - Proof. - iIntros (ts Hgid) "#Hinv". - iIntros (Φ) "!> Hrp HΦ". - wp_rec. - - (*@ func (rp *Replica) finalized(ts uint64) (uint64, bool) { @*) - (*@ cmted, done := rp.txntbl[ts] @*) - (*@ if done { @*) - (*@ if cmted { @*) - (*@ return tulip.REPLICA_COMMITTED_TXN, true @*) - (*@ } else { @*) - (*@ return tulip.REPLICA_ABORTED_TXN, true @*) - (*@ } @*) - (*@ } @*) - (*@ @*) - do 2 iNamed "Hrp". iNamed "Hcm". - wp_loadField. - wp_apply (wp_MapGet with "Htxntbl"). - iIntros (cmted bdone) "[%Hcmted Htxntbl]". - wp_pures. - destruct bdone; wp_pures. - { destruct cmted; wp_pures. - { iApply ("HΦ" $! ReplicaCommittedTxn). - (* Open atomic invariant to obtain [is_txn_committed]. *) - iInv "Hinv" as "> HinvO" "HinvC". - iAssert (∃ wrs, is_txn_committed γ ts wrs)%I as "#Hcmted". - { (* First show that [ts] is committed on the replica. *) - rename cm into cmrp. - apply map_get_true in Hcmted. symmetry in Hcmabs. - pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcmabs Hcmted) as (ts' & Hts' & Hcmrpts). - assert (ts' = ts) as ->. - { subst ts. rewrite Hts'. lia. } - (* Next open the group invariant to obtain [is_txn_committed]. *) - iNamed "HinvO". - unshelve epose proof (execute_cmds_apply_cmds cloga ilog cmrp histm _) as Happly. - { by eauto 10. } - iDestruct (big_sepS_elem_of with "Hgroups") as "Hgroup"; first apply Hgid. - do 2 iNamed "Hgroup". - iDestruct (txn_log_prefix with "Hlog Hclogalb") as %Hprefix. - pose proof (apply_cmds_mono_cm Hprefix Hrsm Happly) as Hcmrp. - pose proof (lookup_weaken _ _ _ _ Hcmrpts Hcmrp) as Hcmts. - rewrite Hcm lookup_omap_Some in Hcmts. - destruct Hcmts as (status & Hstcmted & Hstatus). - destruct status; [done | | done]. - by iDestruct (big_sepM_lookup with "Hsafestm") as "Hcmted"; first apply Hstatus. - } - iMod ("HinvC" with "HinvO") as "_". - by iFrame "∗ # %". - } - { iApply ("HΦ" $! ReplicaAbortedTxn). - (* Open atomic invariant to obtain [is_txn_aborted]. *) - iInv "Hinv" as "> HinvO" "HinvC". - iAssert (is_txn_aborted γ ts)%I as "#Habted". - { (* First show that [ts] is aborted on the replica. *) - rename cm into cmrp. - apply map_get_true in Hcmted. symmetry in Hcmabs. - pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcmabs Hcmted) as (ts' & Hts' & Hcmrpts). - assert (ts' = ts) as ->. - { subst ts. rewrite Hts'. lia. } - (* Next open the group invariant to obtain [is_txn_aborted]. *) - iNamed "HinvO". - unshelve epose proof (execute_cmds_apply_cmds cloga ilog cmrp histm _) as Happly. - { by eauto 10. } - iDestruct (big_sepS_elem_of with "Hgroups") as "Hgroup"; first apply Hgid. - do 2 iNamed "Hgroup". - iDestruct (txn_log_prefix with "Hlog Hclogalb") as %Hprefix. - pose proof (apply_cmds_mono_cm Hprefix Hrsm Happly) as Hcmrp. - pose proof (lookup_weaken _ _ _ _ Hcmrpts Hcmrp) as Hcmts. - rewrite Hcm lookup_omap_Some in Hcmts. - destruct Hcmts as (status & Hstabted & Hstatus). - destruct status; [done | done |]. - by iDestruct (big_sepM_lookup with "Hsafestm") as "Habted"; first apply Hstatus. - } - iMod ("HinvC" with "HinvO") as "_". - by iFrame "∗ # %". - } - } - - (*@ // @tulip.REPLICA_OK is a placeholder. @*) - (*@ return tulip.REPLICA_OK, false @*) - (*@ } @*) - iApply ("HΦ" $! ReplicaOK). - by iFrame "∗ # %". - Qed. - - Theorem wp_Replica__logValidate rp (ts : u64) (pwrsS : Slice.t) (ptgsS : Slice.t) : - {{{ True }}} - Replica__logValidate #rp #ts (to_val pwrsS) (to_val ptgsS) - {{{ RET #(); True }}}. - Proof. - (*@ func (rp *Replica) logValidate(ts uint64, pwrs []tulip.WriteEntry, ptgs []uint64) { @*) - (*@ // TODO: Create an inconsistent log entry for validating @ts with @pwrs and @ptgs. @*) - (*@ } @*) - Admitted. - - Theorem wp_Replica__validate - rp (tsW : u64) pwrsS pwrsL pwrs (ptgsS : Slice.t) gid rid γ α : - let ts := uint.nat tsW in - gid ∈ gids_all -> - rid ∈ rids_all -> - safe_txn_pwrs γ gid ts pwrs -∗ - know_tulip_inv γ -∗ - {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica rp gid rid γ α }}} - Replica__validate #rp #tsW (to_val pwrsS) (to_val ptgsS) - {{{ (res : rpres), RET #(rpres_to_u64 res); - own_replica rp gid rid γ α ∗ validate_outcome γ gid rid ts res - }}}. - Proof. - iIntros (ts Hgid Hrid) "#Hsafepwrs #Hinv". - iIntros (Φ) "!> [Hpwrs Hrp] HΦ". - wp_rec. - - (*@ func (rp *Replica) validate(ts uint64, pwrs []tulip.WriteEntry, ptgs []uint64) uint64 { @*) - (*@ // Check if the transaction has aborted or committed. If so, returns the @*) - (*@ // status immediately. @*) - (*@ res, final := rp.finalized(ts) @*) - (*@ if final { @*) - (*@ return res @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_Replica__finalized with "Hinv Hrp"). - { apply Hgid. } - iIntros (res final) "[Hrp Hfinal]". - wp_pures. - destruct final; wp_pures. - { iApply ("HΦ" $! res). iFrame "Hrp". by destruct res. } - - (*@ // Check if the replica has already validated this transaction. @*) - (*@ _, validated := rp.prepm[ts] @*) - (*@ if validated { @*) - (*@ return tulip.REPLICA_OK @*) - (*@ } @*) - (*@ @*) - do 2 iNamed "Hrp". iNamed "Hcpm". - iDestruct (big_sepM2_dom with "Hprepm") as %Hdomprepm. - wp_loadField. - wp_apply (wp_MapGet with "HprepmS"). - iIntros (prepS validated) "[%Hvalidated HprepmS]". - wp_pures. - destruct validated; wp_pures. - { apply map_get_true in Hvalidated. - iApply ("HΦ" $! ReplicaOK). - assert (Hin : ts ∈ dom cpm). - { apply elem_of_dom_2 in Hvalidated. - rewrite Hdomprepm elem_of_dom in Hvalidated. - destruct Hvalidated as [b Hb]. - symmetry in Hcpmabs. - pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hb) as (ts' & Hts' & Hin). - assert (ts' = ts) as ->. - { subst ts. rewrite Hts'. lia. } - by apply elem_of_dom_2 in Hin. - } - iDestruct (big_sepS_elem_of with "Hrpvds") as "#Hrpvd"; first apply Hin. - by iFrame "∗ # %". - } - - (*@ // Validate timestamps. @*) - (*@ acquired := rp.acquire(ts, pwrs) @*) - (*@ if !acquired { @*) - (*@ return tulip.REPLICA_FAILED_VALIDATION @*) - (*@ } @*) - (*@ @*) - iDestruct (safe_txn_pwrs_dom_pwrs with "Hsafepwrs") as %Hdompwrs. - wp_apply (wp_Replica__acquire with "[$Hpwrs $Hptsmsptsm]"). - { apply Hdompwrs. } - iIntros (acquired) "[Hpwrs Hptsmsptsm]". - wp_pures. - destruct acquired; wp_pures; last first. - { iApply ("HΦ" $! ReplicaFailedValidation). by iFrame "∗ # %". } - iDestruct "Hptsmsptsm" as "(Hptsmsptsm & %Hvptsm & %Hvsptsm)". - - (*@ // Record the write set and the participant groups. @*) - (*@ rp.prepm[ts] = pwrs @*) - (*@ // rp.ptgsm[ts] = ptgs @*) - (*@ @*) - wp_loadField. - wp_apply (wp_MapInsert with "HprepmS"); first done. - iIntros "HprepmS". - - (*@ // Logical action: Validate(@ts, @pwrs, @ptgs). @*) - (*@ rp.logValidate(ts, pwrs, ptgs) @*) - (*@ @*) - wp_apply (wp_Replica__logValidate). - wp_pures. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. - (* First catching up the consistent log. *) - destruct Hcloga as [cmdsa ->]. - iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") - as "(Hclog & Hilog & Hgroup & Hrp)". - (* Then apply the validate transition. *) - (* ∅ is a placeholder for participant groups. *) - iMod (replica_inv_validate _ _ ∅ with "Hsafepwrs Hclog Hilog Hrp") - as "(Hclog & Hilog & Hrp & #Hvd)". - { apply Hexec. } - { do 2 (split; first done). - apply map_get_false in Hvalidated as [Hnone _]. - symmetry in Hcpmabs. - rewrite -not_elem_of_dom Hdomprepm not_elem_of_dom in Hnone. - unshelve epose proof (lookup_kmap_eq_None _ _ _ _ _ Hcpmabs Hnone) as Hcpm. - apply Hcpm. - word. - } - iDestruct ("HrgC" with "Hrp") as "Hrg". - iDestruct ("HrgsC" with "Hrg") as "Hrgs". - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - - (*@ return tulip.REPLICA_OK @*) - (*@ } @*) - iApply ("HΦ" $! ReplicaOK). - iDestruct (big_sepM2_insert_2 _ _ _ tsW with "[Hpwrs] Hprepm") as "Hprepm". - { iFrame "Hpwrs". } - iAssert ([∗ set] t ∈ dom (<[ts := pwrs]> cpm), is_replica_validated_ts γ gid rid t)%I - as "Hrpvds'". - { rewrite dom_insert_L. - iApply (big_sepS_insert_2 ts with "Hvd Hrpvds"). - } - iClear "Hrpvds". - iDestruct (safe_txn_pwrs_impl_valid_wrs with "Hsafepwrs") as %Hvw. - iFrame "∗ # %". - iModIntro. - iPureIntro. simpl. - exists (<[ts := ∅]> ptgsm). - split. - { rewrite 2!kmap_insert. f_equal; [word | done]. } - split; first done. - rewrite merge_clog_ilog_snoc_ilog; last done. - split. - { by apply map_Forall_insert_2. } - split. - { rewrite Forall_forall. - intros [n c] Hilog. simpl. - apply elem_of_app in Hilog as [Hilog | Hnewc]. - { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } - rewrite elem_of_list_singleton in Hnewc. - by inv Hnewc. - } - { by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. } - Qed. - - Theorem wp_Replica__logAccept (rp : loc) (ts : u64) (rank : u64) (dec : bool) : - {{{ True }}} - Replica__logAccept #rp #ts #rank #dec - {{{ RET #(); True }}}. - Proof. - (*@ func (rp *Replica) logAccept(ts uint64, rank uint64, dec bool) { @*) - (*@ // TODO: Create an inconsistent log entry for accepting prepare decision @*) - (*@ // @dec for @ts in @rank. @*) - (*@ } @*) - Admitted. - - Theorem wp_Replica__tryAccept rp (tsW : u64) (rankW : u64) (dec : bool) gid rid γ α : - let ts := uint.nat tsW in - let rank := uint.nat rankW in - gid ∈ gids_all -> - rid ∈ rids_all -> - rank ≠ O -> - is_group_prepare_proposal γ gid ts rank dec -∗ - know_tulip_inv γ -∗ - {{{ own_replica rp gid rid γ α }}} - Replica__tryAccept #rp #tsW #rankW #dec - {{{ (res : rpres), RET #(rpres_to_u64 res); - own_replica rp gid rid γ α ∗ accept_outcome γ gid rid ts rank dec res - }}}. - Proof. - iIntros (ts rank Hgid Hrid Hranknz) "#Hgpsl #Hinv". - iIntros (Φ) "!> Hrp HΦ". - wp_rec. - - (*@ func (rp *Replica) tryAccept(ts uint64, rank uint64, dec bool) uint64 { @*) - (*@ // Check if the transaction has aborted or committed. If so, returns the @*) - (*@ // status immediately. @*) - (*@ res, final := rp.finalized(ts) @*) - (*@ if final { @*) - (*@ return res @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_Replica__finalized with "Hinv Hrp"). - { apply Hgid. } - iIntros (res final) "[Hrp Hfinal]". - wp_pures. - destruct final; wp_pures. - { iApply ("HΦ" $! res). iFrame "Hrp". by destruct res. } - - (*@ // Check if the coordinator is the most recent one. If not, report the @*) - (*@ // existence of a more recent coordinator. @*) - (*@ rankl, ok := rp.lowestRank(ts) @*) - (*@ if ok && rank < rankl { @*) - (*@ return tulip.REPLICA_STALE_COORDINATOR @*) - (*@ } @*) - (*@ @*) - do 2 iNamed "Hrp". - wp_apply (wp_Replica__lowestRank with "Hpsmrkm"). - iIntros (rankl ok) "[Hpsmrkm %Hok]". - wp_pures. - unshelve wp_apply (wp_and_pure (ok = true)). - { shelve. } - { apply _. } - { shelve. } - { wp_pures. case_bool_decide as Hcase; last apply not_true_is_false in Hcase; by subst ok. } - { iIntros (_). by wp_pures. } - case_bool_decide as Hcase; wp_pures. - { iApply ("HΦ" $! ReplicaStaleCoordinator). by iFrame "∗ # %". } - - (*@ // Update prepare status table to record that @ts is prepared at @rank. @*) - (*@ rp.accept(ts, rank, dec) @*) - (*@ @*) - wp_apply (wp_Replica__accept with "Hpsmrkm"). - iIntros "Hpsmrkm". - wp_pures. - - (*@ // Logical actions: Execute() and then Accept(@ts, @rank, @dec). @*) - (*@ rp.logAccept(ts, rank, dec) @*) - (*@ @*) - wp_apply wp_Replica__logAccept. - wp_pures. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. - (* First catching up the consistent log. *) - destruct Hcloga as [cmdsa ->]. - iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") - as "(Hclog & Hilog & Hgroup & Hrp)". - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod (replica_inv_accept ts rank dec with "[Hgpsl] Hclog Hilog Hrp") - as "(Hclog & Hilog & Hrp & #Hacc)". - { apply Hexec. } - { rewrite /accept_requirement. - destruct ok; rewrite Hok; last done. - apply Classical_Prop.not_and_or in Hcase. - destruct Hcase as [? | Hge]; first done. - clear -Hge. lia. - } - { case_decide as Hrank; [word | done]. } - iDestruct ("HrgC" with "Hrp") as "Hrg". - iDestruct ("HrgsC" with "Hrg") as "Hrgs". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - - (*@ return tulip.REPLICA_OK @*) - (*@ } @*) - iApply ("HΦ" $! ReplicaOK). - iAssert ([∗ map] t ↦ ps ∈ <[ts := (rank, dec)]> psm, fast_proposal_witness γ gid rid t ps)%I - as "Hfpw'". - { iApply (big_sepM_insert_2 with "[] Hfpw"). - rewrite /fast_proposal_witness /=. - case_decide; [word | done]. - } - iClear "Hfpw". - iFrame "∗ # %". - iPureIntro. simpl. - exists ptgsm. - split. - { by rewrite 2!dom_insert_L Hdompsmrkm. } - split; first done. - rewrite merge_clog_ilog_snoc_ilog; last done. - split. - { rewrite Forall_forall. - intros [n c] Hilog. simpl. - apply elem_of_app in Hilog as [Hilog | Hnewc]. - { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } - rewrite elem_of_list_singleton in Hnewc. - by inv Hnewc. - } - { by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. } - Qed. - - Theorem wp_Replica__logFastPrepare (rp : loc) (ts : u64) (pwrs : Slice.t) (ptgs : Slice.t) : - {{{ True }}} - Replica__logFastPrepare #rp #ts (to_val pwrs) (to_val ptgs) - {{{ RET #(); True }}}. - Proof. - (*@ func (rp *Replica) logFastPrepare(ts uint64, pwrs []tulip.WriteEntry, ptgs []uint64) { @*) - (*@ // TODO: Create an inconsistent log entry for fast preparing @ts. @*) - (*@ } @*) - Admitted. - - Theorem wp_Replica__fastPrepare - rp (tsW : u64) pwrsS pwrsL pwrs (ptgsS : Slice.t) gid rid γ α : - let ts := uint.nat tsW in - gid ∈ gids_all -> - rid ∈ rids_all -> - safe_txn_pwrs γ gid ts pwrs -∗ - know_tulip_inv γ -∗ - {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica rp gid rid γ α }}} - Replica__fastPrepare #rp #tsW (to_val pwrsS) (to_val ptgsS) - {{{ (res : rpres), RET #(rpres_to_u64 res); - own_replica rp gid rid γ α ∗ fast_prepare_outcome γ gid rid ts res - }}}. - Proof. - iIntros (ts Hgid Hrid) "#Hsafepwrs #Hinv". - iIntros (Φ) "!> [Hpwrs Hrp] HΦ". - wp_rec. - - (*@ func (rp *Replica) fastPrepare(ts uint64, pwrs []tulip.WriteEntry, ptgs []uint64) uint64 { @*) - (*@ // Check if the transaction has aborted or committed. If so, returns the @*) - (*@ // status immediately. @*) - (*@ res, final := rp.finalized(ts) @*) - (*@ if final { @*) - (*@ return res @*) - (*@ } @*) - (*@ @*) - wp_apply (wp_Replica__finalized with "Hinv Hrp"). - { apply Hgid. } - iIntros (res final) "[Hrp Hfinal]". - wp_pures. - destruct final; wp_pures. - { iApply ("HΦ" $! res). iFrame "Hrp". by destruct res. } - - (*@ // Check if the coordinator is the most recent one. If not, report the @*) - (*@ // existence of a more recent coordinator. @*) - (*@ rank, dec, ok := rp.lastProposal(ts) @*) - (*@ if ok { @*) - (*@ if 0 < rank { @*) - (*@ // TODO: This would be a performance problem if @pp.rank = 1 (i.e., @*) - (*@ // txn client's slow-path prepare) since the client would stops its @*) - (*@ // 2PC on receiving such response. For now the ad-hoc fix is to not @*) - (*@ // respond to the client in this case, but should figure out a more @*) - (*@ // efficient design. @*) - (*@ return tulip.REPLICA_STALE_COORDINATOR @*) - (*@ } @*) - (*@ if !dec { @*) - (*@ return tulip.REPLICA_FAILED_VALIDATION @*) - (*@ } @*) - (*@ return tulip.REPLICA_OK @*) - (*@ } @*) - (*@ @*) - do 2 iNamed "Hrp". - wp_apply (wp_Replica__lastProposal with "Hpsmrkm"). - iIntros (rank dec ok) "[Hpsmrkm %Hok]". - wp_pures. - destruct ok; wp_pures. - { case_bool_decide as Hrank; wp_pures. - { iApply ("HΦ" $! ReplicaStaleCoordinator). by iFrame "∗ # %". } - destruct dec; wp_pures; last first. - { iApply ("HΦ" $! ReplicaFailedValidation). - iDestruct (big_sepM_lookup with "Hfpw") as "#Hnp". - { apply Hok. } - rewrite /fast_proposal_witness. - assert (Hz : uint.nat rank = O) by word. - case_decide as Hfast; simpl in Hfast; last word. - iDestruct "Hnp" as "[Hnp _]". - by iFrame "∗ # %". - } - { iApply ("HΦ" $! ReplicaOK). - iDestruct (big_sepM_lookup with "Hfpw") as "#Hpv". - { apply Hok. } - rewrite /fast_proposal_witness. - assert (Hz : uint.nat rank = O) by word. - case_decide as Hfast; simpl in Hfast; last word. - simpl. - iDestruct "Hpv" as "[Hprepared Hvalidated]". - by iFrame "∗ # %". - } - } - - (*@ // If the replica has validated this transaction, but no corresponding @*) - (*@ // prepare proposal entry (as is the case after passing the conditional @*) - (*@ // above), this means the client has already proceeded to the slow path, and @*) - (*@ // hence there's nothing more to be done with this fast-prepare. @*) - (*@ _, validated := rp.prepm[ts] @*) - (*@ if validated { @*) - (*@ return tulip.REPLICA_STALE_COORDINATOR @*) - (*@ } @*) - (*@ @*) - iNamed "Hcpm". wp_loadField. - wp_apply (wp_MapGet with "HprepmS"). - iIntros (prepS validated) "[%Hvalidated HprepmS]". - wp_pures. - destruct validated; wp_pures. - { iApply ("HΦ" $! ReplicaStaleCoordinator). by iFrame "∗ # %". } - - (*@ // Validate timestamps. @*) - (*@ acquired := rp.acquire(ts, pwrs) @*) - (*@ @*) - iDestruct (safe_txn_pwrs_dom_pwrs with "Hsafepwrs") as %Hdompwrs. - wp_apply (wp_Replica__acquire with "[$Hpwrs $Hptsmsptsm]"). - { apply Hdompwrs. } - iIntros (acquired) "[Hpwrs Hptsmsptsm]". - - (*@ // Update prepare status table to record that @ts is prepared or unprepared @*) - (*@ // at rank 0. @*) - (*@ rp.accept(ts, 0, acquired) @*) - (*@ @*) - wp_apply (wp_Replica__accept with "Hpsmrkm"). - iIntros "Hpsmrkm". - - (*@ if !acquired { @*) - (*@ // Logical actions: Execute() and then Accept(@ts, @0, @false). @*) - (*@ rp.logAccept(ts, 0, false) @*) - (*@ return tulip.REPLICA_FAILED_VALIDATION @*) - (*@ } @*) - (*@ @*) - wp_pures. - destruct acquired; wp_pures; last first. - { wp_apply wp_Replica__logAccept. - wp_pures. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. - (* First catching up the consistent log. *) - destruct Hcloga as [cmdsa ->]. - iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") - as "(Hclog & Hilog & Hgroup & Hrp)". - iMod (replica_inv_accept ts O false with "[] Hclog Hilog Hrp") - as "(Hclog & Hilog & Hrp & #Hacc)". - { apply Hexec. } - { rewrite /accept_requirement. - destruct (rkm !! ts) as [r |] eqn:Hr; last done. - apply elem_of_dom_2 in Hr. - by rewrite -not_elem_of_dom Hdompsmrkm in Hok. - } - { done. } - iDestruct ("HrgC" with "Hrp") as "Hrg". - iDestruct ("HrgsC" with "Hrg") as "Hrgs". - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iApply ("HΦ" $! ReplicaFailedValidation). - iFrame "∗ # %". - iModIntro. - iExists ptgsm. - iSplit. - { iApply (big_sepM_insert_2 with "[] Hfpw"). - rewrite /fast_proposal_witness /=. - case_decide; last done. - iFrame "Hacc". - } - iPureIntro. - split. - { by rewrite 2!dom_insert_L Hdompsmrkm. } - split; first done. - rewrite merge_clog_ilog_snoc_ilog; last done. - split. - { rewrite Forall_forall. - intros [n c] Hilog. simpl. - apply elem_of_app in Hilog as [Hilog | Hnewc]. - { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } - rewrite elem_of_list_singleton in Hnewc. - by inv Hnewc. - } - { by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. } - } - iDestruct "Hptsmsptsm" as "(Hptsmsptsm & %Hvptsm & %Hvsptsm)". - - (*@ // Record the write set and the participant groups. @*) - (*@ rp.prepm[ts] = pwrs @*) - (*@ // rp.ptgsm[ts] = ptgs @*) - (*@ @*) - wp_loadField. - wp_apply (wp_MapInsert with "HprepmS"); first done. - iIntros "HprepmS". - - (*@ // Logical actions: Execute() and then Validate(@ts, @pwrs, @ptgs) and @*) - (*@ // Accept(@ts, @0, @true). @*) - (*@ rp.logFastPrepare(ts, pwrs, ptgs) @*) - (*@ @*) - wp_apply wp_Replica__logFastPrepare. - wp_pures. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. - iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. - (* First catching up the consistent log. *) - destruct Hcloga as [cmdsa ->]. - iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") - as "(Hclog & Hilog & Hgroup & Hrp)". - iDestruct (big_sepM2_dom with "Hprepm") as %Hdomprepm. - iMod (replica_inv_validate _ _ ∅ with "Hsafepwrs Hclog Hilog Hrp") - as "(Hclog & Hilog & Hrp & #Hvd)". - { apply Hexec. } - { do 2 (split; first done). - apply map_get_false in Hvalidated as [Hnone _]. - symmetry in Hcpmabs. - rewrite -not_elem_of_dom Hdomprepm not_elem_of_dom in Hnone. - unshelve epose proof (lookup_kmap_eq_None _ _ _ _ _ Hcpmabs Hnone) as Hcpm. - apply Hcpm. - word. - } - iMod (replica_inv_accept ts O true with "[] Hclog Hilog Hrp") - as "(Hclog & Hilog & Hrp & #Hacc)". - { rewrite merge_clog_ilog_snoc_ilog; last done. - by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. - } - { rewrite /accept_requirement. - destruct (rkm !! ts) as [r |] eqn:Hr; last done. - apply elem_of_dom_2 in Hr. - by rewrite -not_elem_of_dom Hdompsmrkm in Hok. - } - { iFrame "Hvd". } - iDestruct ("HrgC" with "Hrp") as "Hrg". - iDestruct ("HrgsC" with "Hrg") as "Hrgs". - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - - (*@ return tulip.REPLICA_OK @*) - (*@ } @*) - iApply ("HΦ" $! ReplicaOK). - iDestruct (big_sepM2_insert_2 _ _ _ tsW with "[Hpwrs] Hprepm") as "Hprepm". - { iFrame "Hpwrs". } - iAssert ([∗ set] t ∈ dom (<[ts := pwrs]> cpm), is_replica_validated_ts γ gid rid t)%I - as "Hrpvds'". - { rewrite dom_insert_L. - iApply (big_sepS_insert_2 ts with "Hvd Hrpvds"). - } - iClear "Hrpvds". - iAssert ([∗ map] t ↦ ps ∈ <[ts := (O, true)]> psm, fast_proposal_witness γ gid rid t ps)%I - as "Hfpw'". - { iApply (big_sepM_insert_2 with "[] Hfpw"). - rewrite /fast_proposal_witness /=. - iFrame "Hvd Hacc". - } - iClear "Hfpw". - iDestruct (safe_txn_pwrs_impl_valid_wrs with "Hsafepwrs") as %Hvw. - iFrame "∗ # %". - iPureIntro. simpl. - exists (<[ts := ∅]> ptgsm). - split. - { rewrite 2!kmap_insert. f_equal; [word | done]. } - split. - { by rewrite 2!dom_insert_L Hdompsmrkm. } - split; first done. - do 2 (rewrite merge_clog_ilog_snoc_ilog; last done). - rewrite /execute_cmds foldl_snoc execute_cmds_unfold. - split. - { by apply map_Forall_insert_2. } - split. - { rewrite Forall_forall. - intros [n c] Hilog. simpl. - apply elem_of_app in Hilog as [Hilog | Hnewc]. - { apply elem_of_app in Hilog as [Hilog | Hnewc]. - { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } - rewrite elem_of_list_singleton in Hnewc. - by inv Hnewc. - } - rewrite elem_of_list_singleton in Hnewc. - by inv Hnewc. - } - { by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. } - Qed. - -End replica. diff --git a/src/program_proof/tulip/program/replica/replica_apply.v b/src/program_proof/tulip/program/replica/replica_apply.v new file mode 100644 index 000000000..bab2fa6df --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_apply.v @@ -0,0 +1,67 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import + replica_repr replica_apply_commit replica_apply_abort. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__apply + rp cmd pwrsS cloga gid rid γ α : + let cloga' := cloga ++ [cmd] in + valid_ccommand gid cmd -> + group_histm_lbs_from_log γ gid cloga' -∗ + is_txn_log_lb γ gid cloga' -∗ + is_replica_idx rp γ α -∗ + {{{ own_pwrs_slice pwrsS cmd ∗ + own_replica_with_cloga_no_lsna rp cloga gid rid γ α + }}} + Replica__apply #rp (ccommand_to_val pwrsS cmd) + {{{ RET #(); + own_pwrs_slice pwrsS cmd ∗ + own_replica_with_cloga_no_lsna rp cloga' gid rid γ α + }}}. + Proof. + iIntros (cloga' Hvcmd) "#Hsafe #Hlb' #Hidx". + iIntros (Φ) "!> [Hpwrs Hrp] HΦ". + wp_rec. + + (*@ func (rp *Replica) apply(cmd txnlog.Cmd) { @*) + (*@ if cmd.Kind == 1 { @*) + (*@ rp.applyCommit(cmd.Timestamp, cmd.PartialWrites) @*) + (*@ } else if cmd.Kind == 2 { @*) + (*@ rp.applyAbort(cmd.Timestamp) @*) + (*@ } @*) + (*@ } @*) + wp_pures. + destruct cmd eqn:Hcmd; wp_pures. + { (* Case: CmdCommit. *) + destruct Hvcmd as [Hvts Hvpwrs]. + iDestruct "Hpwrs" as (pwrsL) "Hpwrs". + wp_apply (wp_Replica__applyCommit with "[Hsafe] [Hlb'] Hidx [$Hpwrs $Hrp]"). + { apply Hvpwrs. } + { rewrite uint_nat_W64_of_nat; first done. rewrite /valid_ts in Hvts. word. } + { rewrite uint_nat_W64_of_nat; first done. rewrite /valid_ts in Hvts. word. } + iIntros "[Hpwrs Hrp]". + wp_pures. + iApply "HΦ". + rewrite uint_nat_W64_of_nat; last first. + { rewrite /valid_ts in Hvts. word. } + by iFrame. + } + { (* Case: CmdAbort. *) + simpl in Hvcmd. + rewrite /group_histm_lbs_from_log. + destruct (apply_cmds cloga') as [cpm histm |] eqn:Happly; last done. + wp_apply (wp_Replica__applyAbort with "[Hlb'] Hrp"). + { rewrite uint_nat_W64_of_nat; first by rewrite Happly. rewrite /valid_ts in Hvcmd. word. } + { rewrite uint_nat_W64_of_nat; first done. rewrite /valid_ts in Hvcmd. word. } + iIntros "Hrp". + wp_pures. + iApply "HΦ". + rewrite uint_nat_W64_of_nat; last first. + { rewrite /valid_ts in Hvcmd. word. } + by iFrame. + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_apply_abort.v b/src/program_proof/tulip/program/replica/replica_apply_abort.v new file mode 100644 index 000000000..dedac9c04 --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_apply_abort.v @@ -0,0 +1,163 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import + replica_repr replica_terminated replica_release. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__applyAbort rp (tsW : u64) cloga gid rid γ α : + let ts := uint.nat tsW in + let cloga' := cloga ++ [CmdAbort ts] in + not_stuck (apply_cmds cloga') -> + is_txn_log_lb γ gid cloga' -∗ + {{{ own_replica_with_cloga_no_lsna rp cloga gid rid γ α }}} + Replica__applyAbort #rp #tsW + {{{ RET #(); own_replica_with_cloga_no_lsna rp cloga' gid rid γ α }}}. + Proof. + iIntros (ts cloga' Hns) "#Hlb'". + iIntros (Φ) "!> Hrp HΦ". + wp_rec. + (* First establish that applying this commit results does not get stuck. *) + destruct (apply_cmds cloga') as [cm' histm' |] eqn:Happly'; last done. + (* Also establish connection between executing entire log vs. consistent log. *) + iNamed "Hrp". + unshelve epose proof (execute_cmds_apply_cmds cloga ilog cm histm _) as Happly. + { by eauto 10. } + + (*@ func (rp *Replica) applyAbort(ts uint64) { @*) + (*@ // Query the transaction table. Note that if there's an entry for @ts in @*) + (*@ // @txntbl, then transaction @ts can only be aborted. That's why we're not @*) + (*@ // even reading the value of entry. @*) + (*@ aborted := rp.terminated(ts) @*) + (*@ if aborted { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_Replica__terminated with "Hcm"). + iIntros "Hcm". + case_bool_decide as Hterm; wp_pures. + { iApply "HΦ". + apply elem_of_dom in Hterm as [b Hb]. + iFrame "∗ # %". + iPureIntro. simpl. + exists ptgsm. + split. + { by apply prefix_app_r. } + rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. + split. + { eapply Forall_impl; first apply Hvicmds. simpl. + intros nc Hnc. + rewrite length_app /=. + clear -Hnc. lia. + } + rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hb. + destruct b; last done. + by rewrite /apply_cmds foldl_snoc /= apply_cmds_unfold /apply_abort Happly Hb in Happly'. + } + apply not_elem_of_dom in Hterm. + (* rewrite /apply_cmds foldl_snoc /= apply_cmds_unfold Happly /= Hterm in Happly'. *) + (* symmetry in Happly'. inv Happly'. *) + + (*@ rp.txntbl[ts] = false @*) + (*@ @*) + iNamed "Hcm". + wp_loadField. + wp_apply (wp_MapInsert with "Htxntbl"); first done. + iIntros "Htxntbl". + + (*@ // Tuples lock are held iff @prepm[ts] contains something (and so we should @*) + (*@ // release them by calling @abort). @*) + (*@ pwrs, prepared := rp.prepm[ts] @*) + (*@ @*) + iNamed "Hcpm". + wp_loadField. + wp_apply (wp_MapGet with "HprepmS"). + iIntros (prepS prepared) "[%Hprepared HprepmS]". + wp_pures. + + (*@ if prepared { @*) + (*@ rp.release(pwrs) @*) + (*@ delete(rp.prepm, ts) @*) + (*@ } @*) + (*@ } @*) + iDestruct (big_sepM2_dom with "Hprepm") as %Hdomprepm. + destruct prepared; wp_pures. + { apply map_get_true in Hprepared. + assert (is_Some (prepm !! tsW)) as [pwrs Hpwrs]. + { by rewrite -elem_of_dom -Hdomprepm elem_of_dom. } + iDestruct (big_sepM2_delete with "Hprepm") as "[Hpwrs Hprepm]". + { apply Hprepared. } + { apply Hpwrs. } + iDestruct "Hpwrs" as (pwrsL) "Hpwrs". + wp_apply (wp_Replica__release with "[$Hpwrs $Hptsmsptsm]"). + { symmetry in Hcpmabs. + pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hpwrs) as (ts' & Hts' & Hcpmts). + assert (ts' = ts) as -> by word. + by specialize (Hvcpm _ _ Hcpmts). + } + iIntros "[Hpwrs Hptsmsptsm]". + wp_loadField. + wp_apply (wp_MapDelete with "HprepmS"). + iIntros "HprepmS". + wp_pures. + iApply "HΦ". + iAssert ([∗ set] t ∈ dom (delete ts cpm), is_replica_validated_ts γ gid rid t)%I + as "#Hrpvds'". + { rewrite dom_delete_L. + iDestruct (big_sepS_delete _ _ ts with "Hrpvds") as "[_ ?]"; last done. + symmetry in Hcpmabs. + pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hpwrs) as (ts' & Hts' & Hcpmts). + assert (ts' = ts) as -> by word. + by apply elem_of_dom. + } + iClear "Hrpvds". + iFrame "∗ # %". + iPureIntro. simpl. + exists (<[ts := false]> cm), (delete ts ptgsm). + split. + { rewrite 2!kmap_insert. f_equal; [word | done]. } + split. + { rewrite 2!kmap_delete. f_equal; [word | done]. } + split. + { by apply prefix_app_r. } + { rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. + split. + { by apply map_Forall_delete. } + split. + { eapply Forall_impl; first apply Hvicmds. simpl. + intros nc Hnc. + rewrite length_app /=. + clear -Hnc. lia. + } + symmetry in Hcpmabs. + pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hpwrs) as (ts' & Hts' & Hcpmts). + assert (ts' = ts) as -> by word. + by rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hterm Hcpmts. + } + } + iApply "HΦ". + iFrame "∗ # %". + iPureIntro. simpl. + exists (<[ts := false]> cm), ptgsm. + split. + { rewrite 2!kmap_insert. f_equal; [word | done]. } + split. + { by apply prefix_app_r. } + { rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. + split. + { eapply Forall_impl; first apply Hvicmds. simpl. + intros nc Hnc. + rewrite length_app /=. + clear -Hnc. lia. + } + apply map_get_false in Hprepared as [Hnone _]. + rewrite -not_elem_of_dom Hdomprepm not_elem_of_dom in Hnone. + symmetry in Hcpmabs. + pose proof (lookup_kmap_eq_None _ _ _ _ _ Hcpmabs Hnone) as Hcpmnone. + specialize (Hcpmnone ts). + unshelve epose proof (Hcpmnone _) as Hcpmts; first word. + by rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hterm Hcpmts. + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_apply_commit.v b/src/program_proof/tulip/program/replica/replica_apply_commit.v new file mode 100644 index 000000000..2f6d1d590 --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_apply_commit.v @@ -0,0 +1,173 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import + replica_repr replica_terminated replica_multiwrite replica_release. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__applyCommit + rp (tsW : u64) pwrsS pwrsL pwrs cloga gid rid γ α : + let ts := uint.nat tsW in + let cloga' := cloga ++ [CmdCommit ts pwrs] in + valid_pwrs gid pwrs -> + group_histm_lbs_from_log γ gid cloga' -∗ + is_txn_log_lb γ gid cloga' -∗ + is_replica_idx rp γ α -∗ + {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ + own_replica_with_cloga_no_lsna rp cloga gid rid γ α + }}} + Replica__applyCommit #rp #tsW (to_val pwrsS) + {{{ RET #(); + own_dbmap_in_slice pwrsS pwrsL pwrs ∗ + own_replica_with_cloga_no_lsna rp cloga' gid rid γ α + }}}. + Proof. + iIntros (ts cloga' Hvpwrs) "#Hhistmlb #Hlb' #Hidx". + iIntros (Φ) "!> [Hpwrs Hrp] HΦ". + wp_rec. + (* First establish that applying this commit results does not get stuck. *) + rewrite /group_histm_lbs_from_log. + destruct (apply_cmds cloga') as [cm' histm' |] eqn:Happly'; last done. + (* Also establish connection between executing entire log vs. consistent log. *) + iNamed "Hrp". + unshelve epose proof (execute_cmds_apply_cmds cloga ilog cm histm _) as Happly. + { by eauto 10. } + + (*@ func (rp *Replica) applyCommit(ts uint64, pwrs []tulip.WriteEntry) { @*) + (*@ // Query the transaction table. Note that if there's an entry for @ts in @*) + (*@ // @txntbl, then transaction @ts can only be committed. That's why we're not @*) + (*@ // even reading the value of entry. @*) + (*@ committed := rp.terminated(ts) @*) + (*@ if committed { @*) + (*@ return @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_Replica__terminated with "Hcm"). + iIntros "Hcm". + case_bool_decide as Hterm; wp_pures. + { iApply "HΦ". + apply elem_of_dom in Hterm as [b Hb]. + iFrame "∗ # %". + iPureIntro. simpl. + exists ptgsm. + split. + { by apply prefix_app_r. } + rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. + split. + { eapply Forall_impl; first apply Hvicmds. simpl. + intros nc Hnc. + rewrite length_app /=. + clear -Hnc. lia. + } + rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hb. + destruct b; first done. + by rewrite /apply_cmds foldl_snoc /= apply_cmds_unfold /apply_commit Happly Hb in Happly'. + } + apply not_elem_of_dom in Hterm. + rewrite /apply_cmds foldl_snoc /= apply_cmds_unfold Happly /= Hterm in Happly'. + case_decide as Hsafeext; last done. + symmetry in Happly'. inv Happly'. + + (*@ rp.multiwrite(ts, pwrs) @*) + (*@ @*) + wp_apply (wp_Replica__multiwrite with "Hhistmlb Hidx [$Hpwrs $Hhistm]"). + { apply Hvpwrs. } + { by eapply apply_cmds_dom. } + { apply Hsafeext. } + iIntros "[Hpwrs Hhistm]". + + (*@ rp.txntbl[ts] = true @*) + (*@ @*) + iNamed "Hcm". + wp_loadField. + wp_apply (wp_MapInsert with "Htxntbl"); first done. + iIntros "Htxntbl". + + (*@ // With PCR, a replica might receive a commit even if it is not prepared on @*) + (*@ // this replica. @*) + (*@ _, prepared := rp.prepm[ts] @*) + (*@ @*) + iNamed "Hcpm". + wp_loadField. + wp_apply (wp_MapGet with "HprepmS"). + iIntros (prepS prepared) "[%Hprepared HprepmS]". + wp_pures. + + (*@ if prepared { @*) + (*@ rp.release(pwrs) @*) + (*@ delete(rp.prepm, ts) @*) + (*@ } @*) + (*@ } @*) + destruct prepared; wp_pures. + { wp_apply (wp_Replica__release with "[$Hpwrs $Hptsmsptsm]"). + { clear -Hvpwrs. set_solver. } + iIntros "[Hpwrs Hptsmsptsm]". + wp_loadField. + wp_apply (wp_MapDelete with "HprepmS"). + iIntros "HprepmS". + wp_pures. + iApply "HΦ". + apply map_get_true in Hprepared. + iDestruct (big_sepM2_delete_l with "Hprepm") as (m) "(%Hm & _ & Hprepm)". + { apply Hprepared. } + iAssert ([∗ set] t ∈ dom (delete ts cpm), is_replica_validated_ts γ gid rid t)%I + as "#Hrpvds'". + { rewrite dom_delete_L. + iDestruct (big_sepS_delete _ _ ts with "Hrpvds") as "[_ ?]"; last done. + symmetry in Hcpmabs. + pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hm) as (ts' & Hts' & Hcpmts). + assert (ts' = ts) as -> by word. + by apply elem_of_dom. + } + iClear "Hrpvds". + iFrame "∗ # %". + iPureIntro. simpl. + exists (<[ts := true]> cm), (delete ts ptgsm). + split. + { rewrite 2!kmap_insert. f_equal; [word | done]. } + split. + { rewrite 2!kmap_delete. f_equal; [word | done]. } + split. + { by apply prefix_app_r. } + { rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. + split. + { by apply map_Forall_delete. } + split. + { eapply Forall_impl; first apply Hvicmds. simpl. + intros nc Hnc. + rewrite length_app /=. + clear -Hnc. lia. + } + symmetry in Hcpmabs. + pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hm) as (ts' & Hts' & Hcpmts). + assert (ts' = ts) as -> by word. + by rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hterm Hcpmts. + } + } + iDestruct (big_sepM2_dom with "Hprepm") as %Hdomprepm. + iApply "HΦ". + iFrame "∗ # %". + iPureIntro. simpl. + exists (<[ts := true]> cm), ptgsm. + split. + { rewrite 2!kmap_insert. f_equal; [word | done]. } + split. + { by apply prefix_app_r. } + { rewrite merge_clog_ilog_snoc_clog; last apply Hvicmds. + split. + { eapply Forall_impl; first apply Hvicmds. simpl. + intros nc Hnc. + rewrite length_app /=. + clear -Hnc. lia. + } + apply map_get_false in Hprepared as [Hnone _]. + rewrite -not_elem_of_dom Hdomprepm not_elem_of_dom in Hnone. + symmetry in Hcpmabs. + pose proof (lookup_kmap_eq_None _ _ _ _ _ Hcpmabs Hnone) as Hcpmnone. + specialize (Hcpmnone ts). + unshelve epose proof (Hcpmnone _) as Hcpmts; first word. + by rewrite /execute_cmds foldl_snoc /= execute_cmds_unfold Hexec /= Hterm Hcpmts. + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_fast_prepare.v b/src/program_proof/tulip/program/replica/replica_fast_prepare.v new file mode 100644 index 000000000..002a49e27 --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_fast_prepare.v @@ -0,0 +1,276 @@ +From Perennial.program_proof.tulip.invariance Require Import execute validate accept. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import + replica_repr replica_finalized replica_last_proposal replica_acquire + replica_accept replica_log. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__fastPrepare + rp (tsW : u64) pwrsS pwrsL pwrs (ptgsS : Slice.t) gid rid γ α : + let ts := uint.nat tsW in + gid ∈ gids_all -> + rid ∈ rids_all -> + safe_txn_pwrs γ gid ts pwrs -∗ + know_tulip_inv γ -∗ + {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica rp gid rid γ α }}} + Replica__fastPrepare #rp #tsW (to_val pwrsS) (to_val ptgsS) + {{{ (res : rpres), RET #(rpres_to_u64 res); + own_replica rp gid rid γ α ∗ fast_prepare_outcome γ gid rid ts res + }}}. + Proof. + iIntros (ts Hgid Hrid) "#Hsafepwrs #Hinv". + iIntros (Φ) "!> [Hpwrs Hrp] HΦ". + wp_rec. + + (*@ func (rp *Replica) fastPrepare(ts uint64, pwrs []tulip.WriteEntry, ptgs []uint64) uint64 { @*) + (*@ // Check if the transaction has aborted or committed. If so, returns the @*) + (*@ // status immediately. @*) + (*@ res, final := rp.finalized(ts) @*) + (*@ if final { @*) + (*@ return res @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_Replica__finalized with "Hinv Hrp"). + { apply Hgid. } + iIntros (res final) "[Hrp Hfinal]". + wp_pures. + destruct final; wp_pures. + { iApply ("HΦ" $! res). iFrame "Hrp". by destruct res. } + + (*@ // Check if the coordinator is the most recent one. If not, report the @*) + (*@ // existence of a more recent coordinator. @*) + (*@ rank, dec, ok := rp.lastProposal(ts) @*) + (*@ if ok { @*) + (*@ if 0 < rank { @*) + (*@ // TODO: This would be a performance problem if @pp.rank = 1 (i.e., @*) + (*@ // txn client's slow-path prepare) since the client would stops its @*) + (*@ // 2PC on receiving such response. For now the ad-hoc fix is to not @*) + (*@ // respond to the client in this case, but should figure out a more @*) + (*@ // efficient design. @*) + (*@ return tulip.REPLICA_STALE_COORDINATOR @*) + (*@ } @*) + (*@ if !dec { @*) + (*@ return tulip.REPLICA_FAILED_VALIDATION @*) + (*@ } @*) + (*@ return tulip.REPLICA_OK @*) + (*@ } @*) + (*@ @*) + do 2 iNamed "Hrp". + wp_apply (wp_Replica__lastProposal with "Hpsmrkm"). + iIntros (rank dec ok) "[Hpsmrkm %Hok]". + wp_pures. + destruct ok; wp_pures. + { case_bool_decide as Hrank; wp_pures. + { iApply ("HΦ" $! ReplicaStaleCoordinator). by iFrame "∗ # %". } + destruct dec; wp_pures; last first. + { iApply ("HΦ" $! ReplicaFailedValidation). + iDestruct (big_sepM_lookup with "Hfpw") as "#Hnp". + { apply Hok. } + rewrite /fast_proposal_witness. + assert (Hz : uint.nat rank = O) by word. + case_decide as Hfast; simpl in Hfast; last word. + iDestruct "Hnp" as "[Hnp _]". + by iFrame "∗ # %". + } + { iApply ("HΦ" $! ReplicaOK). + iDestruct (big_sepM_lookup with "Hfpw") as "#Hpv". + { apply Hok. } + rewrite /fast_proposal_witness. + assert (Hz : uint.nat rank = O) by word. + case_decide as Hfast; simpl in Hfast; last word. + simpl. + iDestruct "Hpv" as "[Hprepared Hvalidated]". + by iFrame "∗ # %". + } + } + + (*@ // If the replica has validated this transaction, but no corresponding @*) + (*@ // prepare proposal entry (as is the case after passing the conditional @*) + (*@ // above), this means the client has already proceeded to the slow path, and @*) + (*@ // hence there's nothing more to be done with this fast-prepare. @*) + (*@ _, validated := rp.prepm[ts] @*) + (*@ if validated { @*) + (*@ return tulip.REPLICA_STALE_COORDINATOR @*) + (*@ } @*) + (*@ @*) + iNamed "Hcpm". wp_loadField. + wp_apply (wp_MapGet with "HprepmS"). + iIntros (prepS validated) "[%Hvalidated HprepmS]". + wp_pures. + destruct validated; wp_pures. + { iApply ("HΦ" $! ReplicaStaleCoordinator). by iFrame "∗ # %". } + + (*@ // Validate timestamps. @*) + (*@ acquired := rp.acquire(ts, pwrs) @*) + (*@ @*) + iDestruct (safe_txn_pwrs_dom_pwrs with "Hsafepwrs") as %Hdompwrs. + wp_apply (wp_Replica__acquire with "[$Hpwrs $Hptsmsptsm]"). + { apply Hdompwrs. } + iIntros (acquired) "[Hpwrs Hptsmsptsm]". + + (*@ // Update prepare status table to record that @ts is prepared or unprepared @*) + (*@ // at rank 0. @*) + (*@ rp.accept(ts, 0, acquired) @*) + (*@ @*) + wp_apply (wp_Replica__accept with "Hpsmrkm"). + iIntros "Hpsmrkm". + + (*@ if !acquired { @*) + (*@ // Logical actions: Execute() and then Accept(@ts, @0, @false). @*) + (*@ rp.logAccept(ts, 0, false) @*) + (*@ return tulip.REPLICA_FAILED_VALIDATION @*) + (*@ } @*) + (*@ @*) + wp_pures. + destruct acquired; wp_pures; last first. + { wp_apply wp_Replica__logAccept. + wp_pures. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. + (* First catching up the consistent log. *) + destruct Hcloga as [cmdsa ->]. + iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") + as "(Hclog & Hilog & Hgroup & Hrp)". + iMod (replica_inv_accept ts O false with "[] Hclog Hilog Hrp") + as "(Hclog & Hilog & Hrp & #Hacc)". + { apply Hexec. } + { rewrite /accept_requirement. + destruct (rkm !! ts) as [r |] eqn:Hr; last done. + apply elem_of_dom_2 in Hr. + by rewrite -not_elem_of_dom Hdompsmrkm in Hok. + } + { done. } + iDestruct ("HrgC" with "Hrp") as "Hrg". + iDestruct ("HrgsC" with "Hrg") as "Hrgs". + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iApply ("HΦ" $! ReplicaFailedValidation). + iFrame "∗ # %". + iModIntro. + iExists ptgsm. + iSplit. + { iApply (big_sepM_insert_2 with "[] Hfpw"). + rewrite /fast_proposal_witness /=. + case_decide; last done. + iFrame "Hacc". + } + iPureIntro. + split. + { by rewrite 2!dom_insert_L Hdompsmrkm. } + split; first done. + rewrite merge_clog_ilog_snoc_ilog; last done. + split. + { rewrite Forall_forall. + intros [n c] Hilog. simpl. + apply elem_of_app in Hilog as [Hilog | Hnewc]. + { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } + rewrite elem_of_list_singleton in Hnewc. + by inv Hnewc. + } + { by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. } + } + iDestruct "Hptsmsptsm" as "(Hptsmsptsm & %Hvptsm & %Hvsptsm)". + + (*@ // Record the write set and the participant groups. @*) + (*@ rp.prepm[ts] = pwrs @*) + (*@ // rp.ptgsm[ts] = ptgs @*) + (*@ @*) + wp_loadField. + wp_apply (wp_MapInsert with "HprepmS"); first done. + iIntros "HprepmS". + + (*@ // Logical actions: Execute() and then Validate(@ts, @pwrs, @ptgs) and @*) + (*@ // Accept(@ts, @0, @true). @*) + (*@ rp.logFastPrepare(ts, pwrs, ptgs) @*) + (*@ @*) + wp_apply wp_Replica__logFastPrepare. + wp_pures. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. + (* First catching up the consistent log. *) + destruct Hcloga as [cmdsa ->]. + iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") + as "(Hclog & Hilog & Hgroup & Hrp)". + iDestruct (big_sepM2_dom with "Hprepm") as %Hdomprepm. + iMod (replica_inv_validate _ _ ∅ with "Hsafepwrs Hclog Hilog Hrp") + as "(Hclog & Hilog & Hrp & #Hvd)". + { apply Hexec. } + { do 2 (split; first done). + apply map_get_false in Hvalidated as [Hnone _]. + symmetry in Hcpmabs. + rewrite -not_elem_of_dom Hdomprepm not_elem_of_dom in Hnone. + unshelve epose proof (lookup_kmap_eq_None _ _ _ _ _ Hcpmabs Hnone) as Hcpm. + apply Hcpm. + word. + } + iMod (replica_inv_accept ts O true with "[] Hclog Hilog Hrp") + as "(Hclog & Hilog & Hrp & #Hacc)". + { rewrite merge_clog_ilog_snoc_ilog; last done. + by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. + } + { rewrite /accept_requirement. + destruct (rkm !! ts) as [r |] eqn:Hr; last done. + apply elem_of_dom_2 in Hr. + by rewrite -not_elem_of_dom Hdompsmrkm in Hok. + } + { iFrame "Hvd". } + iDestruct ("HrgC" with "Hrp") as "Hrg". + iDestruct ("HrgsC" with "Hrg") as "Hrgs". + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + + (*@ return tulip.REPLICA_OK @*) + (*@ } @*) + iApply ("HΦ" $! ReplicaOK). + iDestruct (big_sepM2_insert_2 _ _ _ tsW with "[Hpwrs] Hprepm") as "Hprepm". + { iFrame "Hpwrs". } + iAssert ([∗ set] t ∈ dom (<[ts := pwrs]> cpm), is_replica_validated_ts γ gid rid t)%I + as "Hrpvds'". + { rewrite dom_insert_L. + iApply (big_sepS_insert_2 ts with "Hvd Hrpvds"). + } + iClear "Hrpvds". + iAssert ([∗ map] t ↦ ps ∈ <[ts := (O, true)]> psm, fast_proposal_witness γ gid rid t ps)%I + as "Hfpw'". + { iApply (big_sepM_insert_2 with "[] Hfpw"). + rewrite /fast_proposal_witness /=. + iFrame "Hvd Hacc". + } + iClear "Hfpw". + iDestruct (safe_txn_pwrs_impl_valid_wrs with "Hsafepwrs") as %Hvw. + iFrame "∗ # %". + iPureIntro. simpl. + exists (<[ts := ∅]> ptgsm). + split. + { rewrite 2!kmap_insert. f_equal; [word | done]. } + split. + { by rewrite 2!dom_insert_L Hdompsmrkm. } + split; first done. + do 2 (rewrite merge_clog_ilog_snoc_ilog; last done). + rewrite /execute_cmds foldl_snoc execute_cmds_unfold. + split. + { by apply map_Forall_insert_2. } + split. + { rewrite Forall_forall. + intros [n c] Hilog. simpl. + apply elem_of_app in Hilog as [Hilog | Hnewc]. + { apply elem_of_app in Hilog as [Hilog | Hnewc]. + { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } + rewrite elem_of_list_singleton in Hnewc. + by inv Hnewc. + } + rewrite elem_of_list_singleton in Hnewc. + by inv Hnewc. + } + { by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_finalized.v b/src/program_proof/tulip/program/replica/replica_finalized.v index e69de29bb..e058017db 100644 --- a/src/program_proof/tulip/program/replica/replica_finalized.v +++ b/src/program_proof/tulip/program/replica/replica_finalized.v @@ -0,0 +1,113 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import replica_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Definition finalized_outcome γ ts res : iProp Σ := + match res with + | ReplicaOK => False + | ReplicaCommittedTxn => (∃ wrs, is_txn_committed γ ts wrs) + | ReplicaAbortedTxn => is_txn_aborted γ ts + | ReplicaStaleCoordinator => False + | ReplicaFailedValidation => False + | ReplicaInvalidRank => False + | ReplicaWrongLeader => False + end. + + Theorem wp_Replica__finalized rp (tsW : u64) gid rid γ α : + let ts := uint.nat tsW in + gid ∈ gids_all -> + know_tulip_inv γ -∗ + {{{ own_replica rp gid rid γ α }}} + Replica__finalized #rp #tsW + {{{ (res : rpres) (ok : bool), RET (#(rpres_to_u64 res), #ok); + own_replica rp gid rid γ α ∗ + if ok then finalized_outcome γ ts res else True + }}}. + Proof. + iIntros (ts Hgid) "#Hinv". + iIntros (Φ) "!> Hrp HΦ". + wp_rec. + + (*@ func (rp *Replica) finalized(ts uint64) (uint64, bool) { @*) + (*@ cmted, done := rp.txntbl[ts] @*) + (*@ if done { @*) + (*@ if cmted { @*) + (*@ return tulip.REPLICA_COMMITTED_TXN, true @*) + (*@ } else { @*) + (*@ return tulip.REPLICA_ABORTED_TXN, true @*) + (*@ } @*) + (*@ } @*) + (*@ @*) + do 2 iNamed "Hrp". iNamed "Hcm". + wp_loadField. + wp_apply (wp_MapGet with "Htxntbl"). + iIntros (cmted bdone) "[%Hcmted Htxntbl]". + wp_pures. + destruct bdone; wp_pures. + { destruct cmted; wp_pures. + { iApply ("HΦ" $! ReplicaCommittedTxn). + (* Open atomic invariant to obtain [is_txn_committed]. *) + iInv "Hinv" as "> HinvO" "HinvC". + iAssert (∃ wrs, is_txn_committed γ ts wrs)%I as "#Hcmted". + { (* First show that [ts] is committed on the replica. *) + rename cm into cmrp. + apply map_get_true in Hcmted. symmetry in Hcmabs. + pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcmabs Hcmted) as (ts' & Hts' & Hcmrpts). + assert (ts' = ts) as ->. + { subst ts. rewrite Hts'. lia. } + (* Next open the group invariant to obtain [is_txn_committed]. *) + iNamed "HinvO". + unshelve epose proof (execute_cmds_apply_cmds cloga ilog cmrp histm _) as Happly. + { by eauto 10. } + iDestruct (big_sepS_elem_of with "Hgroups") as "Hgroup"; first apply Hgid. + do 2 iNamed "Hgroup". + iDestruct (txn_log_prefix with "Hlog Hclogalb") as %Hprefix. + pose proof (apply_cmds_mono_cm Hprefix Hrsm Happly) as Hcmrp. + pose proof (lookup_weaken _ _ _ _ Hcmrpts Hcmrp) as Hcmts. + rewrite Hcm lookup_omap_Some in Hcmts. + destruct Hcmts as (status & Hstcmted & Hstatus). + destruct status; [done | | done]. + by iDestruct (big_sepM_lookup with "Hsafestm") as "Hcmted"; first apply Hstatus. + } + iMod ("HinvC" with "HinvO") as "_". + by iFrame "∗ # %". + } + { iApply ("HΦ" $! ReplicaAbortedTxn). + (* Open atomic invariant to obtain [is_txn_aborted]. *) + iInv "Hinv" as "> HinvO" "HinvC". + iAssert (is_txn_aborted γ ts)%I as "#Habted". + { (* First show that [ts] is aborted on the replica. *) + rename cm into cmrp. + apply map_get_true in Hcmted. symmetry in Hcmabs. + pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcmabs Hcmted) as (ts' & Hts' & Hcmrpts). + assert (ts' = ts) as ->. + { subst ts. rewrite Hts'. lia. } + (* Next open the group invariant to obtain [is_txn_aborted]. *) + iNamed "HinvO". + unshelve epose proof (execute_cmds_apply_cmds cloga ilog cmrp histm _) as Happly. + { by eauto 10. } + iDestruct (big_sepS_elem_of with "Hgroups") as "Hgroup"; first apply Hgid. + do 2 iNamed "Hgroup". + iDestruct (txn_log_prefix with "Hlog Hclogalb") as %Hprefix. + pose proof (apply_cmds_mono_cm Hprefix Hrsm Happly) as Hcmrp. + pose proof (lookup_weaken _ _ _ _ Hcmrpts Hcmrp) as Hcmts. + rewrite Hcm lookup_omap_Some in Hcmts. + destruct Hcmts as (status & Hstabted & Hstatus). + destruct status; [done | done |]. + by iDestruct (big_sepM_lookup with "Hsafestm") as "Habted"; first apply Hstatus. + } + iMod ("HinvC" with "HinvO") as "_". + by iFrame "∗ # %". + } + } + + (*@ // @tulip.REPLICA_OK is a placeholder. @*) + (*@ return tulip.REPLICA_OK, false @*) + (*@ } @*) + iApply ("HΦ" $! ReplicaOK). + by iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_log.v b/src/program_proof/tulip/program/replica/replica_log.v new file mode 100644 index 000000000..2179e42f6 --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_log.v @@ -0,0 +1,47 @@ +From Perennial.program_proof.tulip.program Require Import prelude. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__logRead (rp : loc) (ts : u64) (key : string) : + {{{ True }}} + Replica__logRead #rp #ts #(LitString key) + {{{ RET #(); True }}}. + Proof. + (*@ func (rp *Replica) logRead(ts uint64, key string) { @*) + (*@ // TODO: Create an inconsistent log entry for reading @key at @ts. @*) + (*@ } @*) + Admitted. + + Theorem wp_Replica__logValidate rp (ts : u64) (pwrsS : Slice.t) (ptgsS : Slice.t) : + {{{ True }}} + Replica__logValidate #rp #ts (to_val pwrsS) (to_val ptgsS) + {{{ RET #(); True }}}. + Proof. + (*@ func (rp *Replica) logValidate(ts uint64, pwrs []tulip.WriteEntry, ptgs []uint64) { @*) + (*@ // TODO: Create an inconsistent log entry for validating @ts with @pwrs and @ptgs. @*) + (*@ } @*) + Admitted. + + Theorem wp_Replica__logFastPrepare (rp : loc) (ts : u64) (pwrs : Slice.t) (ptgs : Slice.t) : + {{{ True }}} + Replica__logFastPrepare #rp #ts (to_val pwrs) (to_val ptgs) + {{{ RET #(); True }}}. + Proof. + (*@ func (rp *Replica) logFastPrepare(ts uint64, pwrs []tulip.WriteEntry, ptgs []uint64) { @*) + (*@ // TODO: Create an inconsistent log entry for fast preparing @ts. @*) + (*@ } @*) + Admitted. + + Theorem wp_Replica__logAccept (rp : loc) (ts : u64) (rank : u64) (dec : bool) : + {{{ True }}} + Replica__logAccept #rp #ts #rank #dec + {{{ RET #(); True }}}. + Proof. + (*@ func (rp *Replica) logAccept(ts uint64, rank uint64, dec bool) { @*) + (*@ // TODO: Create an inconsistent log entry for accepting prepare decision @*) + (*@ // @dec for @ts in @rank. @*) + (*@ } @*) + Admitted. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_multiwrite.v b/src/program_proof/tulip/program/replica/replica_multiwrite.v new file mode 100644 index 000000000..91e61cd05 --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_multiwrite.v @@ -0,0 +1,128 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import replica_repr. +From Perennial.program_proof.tulip.program.tuple Require Import tuple. +From Perennial.program_proof.tulip.program.index Require Import index. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__multiwrite rp (tsW : u64) pwrsS pwrsL pwrs histm gid γ α : + let ts := uint.nat tsW in + let histm' := multiwrite ts pwrs histm in + valid_pwrs gid pwrs -> + dom histm = keys_all -> + safe_extension ts pwrs histm -> + ([∗ map] k ↦ h ∈ filter_group gid histm', is_repl_hist_lb γ k h) -∗ + is_replica_idx rp γ α -∗ + {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica_histm rp histm α }}} + Replica__multiwrite #rp #tsW (to_val pwrsS) + {{{ RET #(); + own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica_histm rp histm' α + }}}. + Proof. + iIntros (ts histm' Hvw Hdomhistm Hlenhistm) "#Hrlbs #Hidx". + iIntros (Φ) "!> [[HpwrsS %Hpwrs] Hhistm] HΦ". + wp_rec. + + (*@ func (rp *Replica) multiwrite(ts uint64, pwrs []tulip.WriteEntry) { @*) + (*@ for _, ent := range pwrs { @*) + (*@ key := ent.Key @*) + (*@ value := ent.Value @*) + (*@ tpl := rp.idx.GetTuple(key) @*) + (*@ if value.Present { @*) + (*@ tpl.AppendVersion(ts, value.Content) @*) + (*@ } else { @*) + (*@ tpl.KillVersion(ts) @*) + (*@ } @*) + (*@ } @*) + (*@ } @*) + iDestruct (own_slice_sz with "HpwrsS") as %Hlenpwrs. + iDestruct (own_slice_small_acc with "HpwrsS") as "[HpwrsS HpwrsC]". + set P := (λ (i : u64), + let pwrs' := list_to_map (take (uint.nat i) pwrsL) in + own_replica_histm rp (multiwrite ts pwrs' histm) α)%I. + wp_apply (wp_forSlice P with "[] [$HpwrsS Hhistm]"); last first; first 1 last. + { (* Loop entry. *) + subst P. simpl. + rewrite uint_nat_W64_0 take_0 list_to_map_nil. + by rewrite multiwrite_empty. + } + { (* Loop body. *) + clear Φ. + iIntros (i [k v]) "!>". + iIntros (Φ) "(Hhistm & %Hbound & %Hi) HΦ". + subst P. simpl. + iNamed "Hidx". + wp_loadField. + (* Prove [k] in the domain of [pwrs] and in [keys_all]. *) + apply elem_of_list_lookup_2 in Hi as Hpwrsv. + rewrite -Hpwrs elem_of_map_to_list in Hpwrsv. + apply elem_of_dom_2 in Hpwrsv as Hdompwrs. + assert (Hvk : k ∈ keys_all). + { clear -Hvw Hdompwrs. set_solver. } + wp_apply (wp_Index__GetTuple with "Hidx"); first apply Hvk. + iIntros (tpl) "#Htpl". + (* Obtain proof that the current key [k] has not been written. *) + pose proof (NoDup_fst_map_to_list pwrs) as Hnd. + rewrite Hpwrs in Hnd. + pose proof (list_lookup_fmap fst pwrsL (uint.nat i)) as Hk. + rewrite Hi /= in Hk. + pose proof (not_elem_of_take _ _ _ Hnd Hk) as Htake. + rewrite -fmap_take in Htake. + apply not_elem_of_list_to_map_1 in Htake as Hnone. + (* Adjust the goal. *) + rewrite uint_nat_word_add_S; last by word. + rewrite (take_S_r _ _ _ Hi) list_to_map_snoc; last done. + set pwrs' := (list_to_map _) in Hnone *. + assert (is_Some (histm !! k)) as [h Hh]. + { by rewrite -elem_of_dom Hdomhistm. } + (* Obtain the length constraint. *) + rewrite /safe_extension in Hlenhistm. + set histmwr := filter _ _ in Hlenhistm. + assert (Hhistmwrk : histmwr !! k = Some h). + { by apply map_lookup_filter_Some_2. } + specialize (Hlenhistm _ _ Hhistmwrk). simpl in Hlenhistm. + (* Obtain the replicated history lb. *) + assert (Hh' : histm' !! k = Some (last_extend ts h ++ [v])). + { by rewrite (multiwrite_modified Hpwrsv Hh). } + iDestruct (big_sepM_lookup _ _ k with "Hrlbs") as "Hrlb". + { apply map_lookup_filter_Some_2; first apply Hh'. simpl. + clear -Hdompwrs Hvw. set_solver. + } + (* Take the physical history out. *) + iDestruct (big_sepM_delete with "Hhistm") as "[Hh Hhistm]". + { rewrite multiwrite_unmodified; [apply Hh | apply Hnone]. } + destruct v as [s |]; wp_pures. + { (* Case: [@AppendVersion]. *) + wp_apply (wp_Tuple__AppendVersion with "Hrlb Htpl Hh"). + { apply Hlenhistm. } + iIntros "Hh". + iDestruct (big_sepM_insert_2 with "Hh Hhistm") as "Hhistm". + rewrite insert_delete_insert /multiwrite. + erewrite insert_merge_l; last first. + { by rewrite Hh. } + iApply "HΦ". + iFrame "∗ #". + } + { (* Case: [@KillVersion]. *) + wp_apply (wp_Tuple__KillVersion with "Hrlb Htpl Hh"). + { apply Hlenhistm. } + iIntros "Hh". + iDestruct (big_sepM_insert_2 with "Hh Hhistm") as "Hhistm". + rewrite insert_delete_insert /multiwrite. + erewrite insert_merge_l; last first. + { by rewrite Hh. } + iApply "HΦ". + iFrame "∗ #". + } + } + iIntros "[Hhistm HpwrsS]". subst P. simpl. + iDestruct ("HpwrsC" with "HpwrsS") as "HpwrsS". + wp_pures. + iApply "HΦ". + pose proof (list_to_map_flip _ _ Hpwrs) as Hltm. + rewrite -Hlenpwrs firstn_all -Hltm. + by iFrame. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_read.v b/src/program_proof/tulip/program/replica/replica_read.v new file mode 100644 index 000000000..f6a136513 --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_read.v @@ -0,0 +1,195 @@ +From Perennial.program_proof.tulip.invariance Require Import execute read local_read. +From Perennial.program_proof Require Import std_proof. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import + replica_repr replica_readable_key replica_bump_key replica_log. +From Perennial.program_proof.tulip.program.tuple Require Import tuple. +From Perennial.program_proof.tulip.program.index Require Import index. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__Read (rp : loc) (tsW : u64) (key : string) gid rid γ : + let ts := uint.nat tsW in + ts ≠ O -> + key ∈ keys_all -> + key_to_group key = gid -> + is_replica rp gid rid γ -∗ + {{{ True }}} + Replica__Read #rp #tsW #(LitString key) + {{{ (t : u64) (v : dbval) (ok : bool), RET (#t, dbval_to_val v, #ok); + if ok + then fast_or_slow_read γ rid key (uint.nat t) ts v + else True + }}}. + Proof. + iIntros (ts Htsnz Hkey Hkg) "#Hrp". + iIntros (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (rp *Replica) Read(ts uint64, key string) (uint64, tulip.Value, bool) { @*) + (*@ tpl := rp.idx.GetTuple(key) @*) + (*@ @*) + iNamed "Hrp". iNamed "Hidx". + wp_loadField. + wp_apply (wp_Index__GetTuple with "Hidx"); first apply Hkey. + iIntros (tpl) "#Htpl". + + (*@ t1, v1 := tpl.ReadVersion(ts) @*) + (*@ @*) + wp_apply (wp_Tuple__ReadVersion_xphys with "Htpl"). + iIntros (t1 v1) "Hread1". + wp_pures. + + (*@ if t1 == 0 { @*) + (*@ // Fast-path read. @*) + (*@ return 0, v1, true @*) + (*@ } @*) + (*@ @*) + case_bool_decide as Ht1; wp_pures. + { iApply "HΦ". by case_decide; last inv Ht1. } + + (*@ rp.mu.Lock() @*) + (*@ @*) + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hrp]". + + (*@ ok := rp.readableKey(ts, key) @*) + (*@ @*) + do 2 iNamed "Hrp". + wp_apply (wp_Replica__readableKey with "Hptsmsptsm"); first apply Hkey. + iIntros (ok) "[Hptsmsptsm %Hreadable]". + wp_pures. + + (*@ if !ok { @*) + (*@ // Trying to read a tuple that is locked by a lower-timestamp @*) + (*@ // transaction. This read has to fail because the value to be read is @*) + (*@ // undetermined---the prepared transaction might or might not commit. @*) + (*@ rp.mu.Unlock() @*) + (*@ return 0, tulip.Value{}, false @*) + (*@ } @*) + (*@ @*) + destruct ok; wp_pures; last first. + { wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { by iFrame "Hlock Hlocked ∗ # %". } + wp_pures. + by iApply ("HΦ" $! _ None). + } + + (*@ t2, v2 := tpl.ReadVersion(ts) @*) + (*@ @*) + assert (is_Some (histm !! key)) as [hist Hhist]. + { unshelve epose proof (execute_cmds_apply_cmds cloga ilog cm histm _) as Happly. + { by eauto 10. } + pose proof (apply_cmds_dom _ _ _ Happly) as Hdomhistm. + by rewrite -elem_of_dom Hdomhistm. + } + iDestruct (big_sepM_lookup_acc with "Hhistm") as "[Hhist HhistmC]"; first apply Hhist. + wp_apply (wp_Tuple__ReadVersion with "Htpl Hhist"). + iIntros (t2 v2) "[Hhist #Hlb]". + iDestruct ("HhistmC" with "Hhist") as "Hhistm". + wp_pures. + + (*@ if t2 == 0 { @*) + (*@ // Fast-path read. @*) + (*@ rp.mu.Unlock() @*) + (*@ return 0, v2, true @*) + (*@ } @*) + (*@ @*) + case_bool_decide as Ht2; wp_pures. + { wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { by iFrame "Hlock Hlocked ∗ # %". } + wp_pures. + iApply "HΦ". + by case_decide; last inv Ht2. + } + + (*@ // Slow-path read. @*) + (*@ rp.bumpKey(ts, key) @*) + (*@ @*) + wp_apply (wp_Replica__bumpKey with "Hptsmsptsm"). + { clear -Htsnz. word. } + { apply Hkey. } + iIntros (spts) "[Hptsmsptsm %Hspts]". + + (*@ // TODO: An optimization is to create a log entry iff the smallest @*) + (*@ // preparable timestamp is actually bumped, which can be checked with the @*) + (*@ // return value of @rp.bumpKey. @*) + (*@ @*) + (*@ // Logical actions: Execute() and then LocalRead(@ts, @key) @*) + (*@ rp.logRead(ts, key) @*) + (*@ @*) + wp_pures. + wp_apply wp_Replica__logRead. + iApply fupd_wp. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. + (* First catching up the consistent log. *) + destruct Hcloga as [cmdsa ->]. + iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") + as "(Hclog & Hilog & Hgroup & Hrp)". + iMod (replica_inv_local_read key ts with "Hclog Hilog Hgroup Hrp") + as "(Hclog & Hilog & Hgroup & Hrp & #Hpromise & #Hrepllb)". + { apply Hkey. } + { apply Hkg. } + { apply Hexec. } + { simpl. + rewrite /key_readable in Hreadable. + destruct (ptsm !! key) as [pts |] eqn:Hpts; rewrite Hpts in Hreadable; last done. + exists spts, pts. + do 3 (split; first done). + clear -Hreadable. word. + } + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iDestruct ("HrgC" with "Hrp") as "Hrg". + iDestruct ("HrgsC" with "Hrg") as "Hrgs". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iModIntro. + + (*@ rp.mu.Unlock() @*) + (*@ return t2, v2, true @*) + (*@ } @*) + wp_loadField. + wp_apply (wp_Mutex__Unlock with "[-HΦ]"). + { iFrame "Hlock Hlocked ∗ # %". + iPureIntro. simpl. + exists ptgsm. + split; first done. + split. + { rewrite Forall_forall. + intros [n c] Hilog. simpl. + apply elem_of_app in Hilog as [Hilog | Hnewc]. + { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } + rewrite elem_of_list_singleton in Hnewc. + by inv Hnewc. + } + { rewrite merge_clog_ilog_snoc_ilog; last done. + rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. + erewrite lookup_alter_Some; last apply Hspts. + f_equal. + } + } + wp_pures. + iApply "HΦ". + rewrite /fast_or_slow_read. + case_decide as Hnz; first done. + iDestruct "Hlb" as "[Hlb' %Hv2]". + clear Ht2. + destruct Hv2 as (Hv2 & Ht2 & Hlenhist). + rewrite Ht2. + iFrame "Hrepllb". + rewrite Hkg. + iFrame "Hpromise". + iPureIntro. + split. + { by rewrite -last_lookup. } + { clear -Ht2 Hnz Hlenhist. word. } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_release.v b/src/program_proof/tulip/program/replica/replica_release.v new file mode 100644 index 000000000..8c242d390 --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_release.v @@ -0,0 +1,72 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import + replica_repr replica_release_key. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__release rp pwrsS pwrsL pwrs ptsm sptsm : + valid_wrs pwrs -> + {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica_ptsm_sptsm rp ptsm sptsm }}} + Replica__release #rp (to_val pwrsS) + {{{ RET #(); + own_dbmap_in_slice pwrsS pwrsL pwrs ∗ + own_replica_ptsm_sptsm rp (release pwrs ptsm) sptsm + }}}. + Proof. + iIntros (Hvw Φ) "[[HpwrsS %Hpwrs] Hrp] HΦ". + wp_rec. + iDestruct (own_replica_ptsm_sptsm_dom with "Hrp") as %[Hdomptsm Hdomsptsm]. + + (*@ func (rp *Replica) release(pwrs []tulip.WriteEntry) { @*) + (*@ for _, ent := range pwrs { @*) + (*@ key := ent.Key @*) + (*@ rp.releaseKey(key) @*) + (*@ } @*) + (*@ } @*) + iDestruct (own_slice_sz with "HpwrsS") as %Hlenpwrs. + iDestruct (own_slice_small_acc with "HpwrsS") as "[HpwrsS HpwrsC]". + set P := (λ (i : u64), + let pwrs' := list_to_map (take (uint.nat i) pwrsL) in + own_replica_ptsm_sptsm rp (release pwrs' ptsm) sptsm)%I. + wp_apply (wp_forSlice P with "[] [$HpwrsS Hrp]"); last first; first 1 last. + { (* Loop entry. *) + subst P. simpl. + rewrite uint_nat_W64_0 take_0 list_to_map_nil. + by rewrite release_empty. + } + { (* Loop body. *) + clear Φ. + iIntros (i [k v]) "!>". + iIntros (Φ) "(Hrp & %Hbound & %Hi) HΦ". + subst P. simpl. + wp_pures. + wp_apply (wp_Replica__releaseKey with "Hrp"). + iIntros "Hrp". + iApply "HΦ". + (* Obtain proof that the current key [k] has not been written. *) + pose proof (map_to_list_not_elem_of_take_key _ _ _ _ Hpwrs Hi) as Htake. + (* Adjust the goal. *) + rewrite uint_nat_word_add_S; last by word. + rewrite (take_S_r _ _ _ Hi) list_to_map_snoc; last apply Htake. + set pwrs' := list_to_map _. + rewrite /release setts_insert; last first. + { apply elem_of_list_lookup_2 in Hi. + rewrite -Hpwrs in Hi. + apply elem_of_map_to_list, elem_of_dom_2 in Hi. + clear -Hvw Hi Hdomptsm. set_solver. + } + done. + } + iIntros "[Hrp HpwrsS]". + subst P. simpl. + pose proof (list_to_map_flip _ _ Hpwrs) as Hltm. + rewrite -Hlenpwrs firstn_all Hltm. + iDestruct ("HpwrsC" with "HpwrsS") as "HpwrsS". + wp_pures. + iApply "HΦ". + iFrame. + by rewrite -Hltm. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_repr.v b/src/program_proof/tulip/program/replica/replica_repr.v index a23ae24bb..cedb3685b 100644 --- a/src/program_proof/tulip/program/replica/replica_repr.v +++ b/src/program_proof/tulip/program/replica/replica_repr.v @@ -1,4 +1,7 @@ From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.tuple Require Import res. +From Perennial.program_proof.tulip.program.txnlog Require Import txnlog. +From Perennial.program_proof.tulip.program.index Require Import index. Section repr. Context `{!heapGS Σ, !tulip_ghostG Σ}. @@ -95,4 +98,56 @@ Section repr. "%Hpsmabs" ∷ ⌜(kmap Z.of_nat psm : gmap Z (nat * bool)) = kmap uint.Z (fmap ppsl_to_nat_bool pstbl)⌝ ∗ "%Hrkmabs" ∷ ⌜(kmap Z.of_nat rkm : gmap Z nat) = kmap uint.Z (fmap (λ x, uint.nat x) rktbl)⌝. + Definition own_replica_histm (rp : loc) (histm : gmap dbkey dbhist) α : iProp Σ := + ([∗ map] k ↦ h ∈ histm, own_phys_hist_half α k h). + + Definition own_replica_with_cloga_no_lsna + (rp : loc) (cloga : dblog) (gid rid : u64) γ α : iProp Σ := + ∃ (cm : gmap nat bool) (histm : gmap dbkey dbhist) + (cpm : gmap nat dbmap) (ptgsm : gmap nat (gset u64)) + (sptsm ptsm : gmap dbkey nat) (psm : gmap nat (nat * bool)) (rkm : gmap nat nat) + (clog : dblog) (ilog : list (nat * icommand)), + let log := merge_clog_ilog cloga ilog in + "Hcm" ∷ own_replica_cm rp cm ∗ + "Hhistm" ∷ own_replica_histm rp histm α ∗ + "Hcpm" ∷ own_replica_cpm rp cpm ∗ + "Hptsmsptsm" ∷ own_replica_ptsm_sptsm rp ptsm sptsm ∗ + "Hpsmrkm" ∷ own_replica_psm_rkm rp psm rkm ∗ + "Hclog" ∷ own_replica_clog_half γ gid rid clog ∗ + "Hilog" ∷ own_replica_ilog_half γ gid rid ilog ∗ + "#Hrpvds" ∷ ([∗ set] t ∈ dom cpm, is_replica_validated_ts γ gid rid t) ∗ + "#Hfpw" ∷ ([∗ map] t ↦ ps ∈ psm, fast_proposal_witness γ gid rid t ps) ∗ + "#Hclogalb" ∷ is_txn_log_lb γ gid cloga ∗ + "%Hdompsmrkm" ∷ ⌜dom psm = dom rkm⌝ ∗ + "%Hcloga" ∷ ⌜prefix clog cloga⌝ ∗ + "%Hvcpm" ∷ ⌜map_Forall (λ _ m, valid_wrs m) cpm⌝ ∗ + "%Hvicmds" ∷ ⌜Forall (λ nc, (nc.1 <= length cloga)%nat) ilog⌝ ∗ + "%Hexec" ∷ ⌜execute_cmds log = LocalState cm histm cpm ptgsm sptsm ptsm psm rkm⌝. + + Definition own_replica (rp : loc) (gid rid : u64) γ α : iProp Σ := + ∃ (cloga : dblog) (lsna : u64), + "Hrp" ∷ own_replica_with_cloga_no_lsna rp cloga gid rid γ α ∗ + "Hlsna" ∷ rp ↦[Replica :: "lsna"] #lsna ∗ + "%Hlencloga" ∷ ⌜length cloga = uint.nat lsna⌝. + + Definition is_replica_txnlog (rp : loc) gid γ : iProp Σ := + ∃ (txnlog : loc), + "#HtxnlogP" ∷ readonly (rp ↦[Replica :: "txnlog"] #txnlog) ∗ + "#Htxnlog" ∷ is_txnlog txnlog gid γ. + + Definition is_replica_idx (rp : loc) γ α : iProp Σ := + ∃ (idx : loc), + "#HidxP" ∷ readonly (rp ↦[Replica :: "idx"] #idx) ∗ + "#Hidx" ∷ is_index idx γ α. + + Definition is_replica (rp : loc) gid rid γ : iProp Σ := + ∃ (mu : loc) α, + "#HmuP" ∷ readonly (rp ↦[Replica :: "mu"] #mu) ∗ + "#Hlock" ∷ is_lock tulipNS #mu (own_replica rp gid rid γ α) ∗ + "#Htxnlog" ∷ is_replica_txnlog rp gid γ ∗ + "#Hidx" ∷ is_replica_idx rp γ α ∗ + "#Hinv" ∷ know_tulip_inv γ ∗ + "%Hgid" ∷ ⌜gid ∈ gids_all⌝ ∗ + "%Hrid" ∷ ⌜rid ∈ rids_all⌝. + End repr. diff --git a/src/program_proof/tulip/program/replica/replica_start.v b/src/program_proof/tulip/program/replica/replica_start.v new file mode 100644 index 000000000..39855770f --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_start.v @@ -0,0 +1,166 @@ +From Perennial.program_proof.tulip.invariance Require Import learn. +From Perennial.program_proof Require Import std_proof. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import replica_repr replica_apply. +From Perennial.program_proof.tulip.program.txnlog Require Import txnlog. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__Start rp gid rid γ : + is_replica rp gid rid γ -∗ + {{{ True }}} + Replica__Start #rp + {{{ RET #(); True }}}. + Proof. + iIntros "#Hrp" (Φ) "!> _ HΦ". + wp_rec. + + (*@ func (rp *Replica) Start() { @*) + (*@ rp.mu.Lock() @*) + (*@ @*) + iNamed "Hrp". + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hrp]". + wp_pures. + + (*@ for { @*) + (*@ // TODO: a more efficient interface would return multiple safe commands @*) + (*@ // at once (so as to reduce the frequency of acquiring Paxos mutex). @*) + (*@ // Ghost action: Learn a list of new commands. @*) + (*@ @*) + set P := (λ b : bool, own_replica rp gid rid γ α ∗ locked #mu)%I. + wp_apply (wp_forBreak P with "[] [$Hrp $Hlocked]"); last first. + { (* Get out of an infinite loop. *) + iIntros "Hrp". wp_pures. by iApply "HΦ". + } + clear Φ. iIntros "!>" (Φ) "[Hrp Hlocked] HΦ". + wp_rec. + do 2 iNamed "Hrp". + wp_loadField. + + (*@ cmd, ok := rp.txnlog.Lookup(rp.lsna) @*) + (*@ @*) + iNamed "Htxnlog". + wp_loadField. + wp_apply (wp_TxnLog__Lookup with "Htxnlog"). + iInv "Hinv" as "> HinvO" "HinvC". + iApply ncfupd_mask_intro; first set_solver. + iIntros "Hmask". + iNamed "HinvO". + (* Take the required group invariant. *) + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. + (* Separate out the ownership of the Paxos log from others. *) + iDestruct (group_inv_extract_log_expose_cpool with "Hgroup") as (paxos cpool) "[Hpaxos Hgroup]". + (* Obtain validity of command input on cpool. *) + iDestruct (group_inv_impl_valid_ccommand_cpool with "[Hgroup Hpaxos]") as %Hvcmds. + { iNamed "Hgroup". iFrame. } + (* Obtain a lower bound before passing it to Paxos. *) + iDestruct (txn_log_witness with "Hpaxos") as "#Hlb". + iExists paxos. iFrame. + iIntros (paxos') "Hpaxos". + (* Obtain prefix between the old and new logs. *) + iDestruct (txn_log_prefix with "Hpaxos Hlb") as %Hpaxos. + destruct Hpaxos as [cmds Hpaxos]. + (* Obtain inclusion between the command pool and the log. *) + iAssert (⌜cpool_subsume_log cpool paxos'⌝)%I as %Hincl. + { iNamed "Hgroup". + by iDestruct (txn_log_cpool_incl with "Hpaxos Hcpool") as %?. + } + (* Transfer validity of command input on cpool to log; used when executing @apply. *) + pose proof (set_Forall_Forall_subsume _ _ _ Hvcmds Hincl) as Hvc. + (* Obtain prefix between the applied log and the new log; needed later. *) + iDestruct (txn_log_prefix with "Hpaxos Hclogalb") as %Hloga. + (* Obtain a witness of the new log; needed later. *) + iDestruct (txn_log_witness with "Hpaxos") as "#Hlbnew". + subst paxos'. + + (*@ // Ghost action: Learn a list of new commands. @*) + (*@ @*) + iMod (group_inv_learn with "Htxnsys Hkeys Hgroup") as "(Htxnsys & Hkeys & Hgroup)". + { apply Hincl. } + iDestruct (group_inv_merge_log_hide_cpool with "Hpaxos Hgroup") as "Hgroup". + (* Put back the group invariant. *) + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + (* Close the entire invariant. *) + iMod "Hmask" as "_". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iIntros "!>" (cmd ok pwrsS) "[HpwrsS %Hcmd]". + wp_pures. + + (*@ if !ok { @*) + (*@ // Sleep for 1 ms. @*) + (*@ rp.mu.Unlock() @*) + (*@ primitive.Sleep(1 * 1000000) @*) + (*@ rp.mu.Lock() @*) + (*@ continue @*) + (*@ } @*) + (*@ @*) + destruct ok; wp_pures; last first. + { (* Have applied all the commands known to be committed. *) + wp_loadField. + iClear "Hlb Hlbnew". + wp_apply (wp_Mutex__Unlock with "[-HΦ $Hlock $Hlocked]"); first by iFrame "∗ # %". + wp_apply wp_Sleep. + wp_loadField. + wp_apply (wp_Mutex__Lock with "Hlock"). + iIntros "[Hlocked Hrp]". + wp_pures. + iApply "HΦ". + by iFrame. + } + (* Obtain a witness for the newly applied log. *) + iClear "Hlb". + (* Prove the newly applied log is a prefix of the new log. *) + assert (Hprefix : prefix (cloga ++ [cmd]) (paxos ++ cmds)). + { clear -Hloga Hcmd Hlencloga. + destruct Hloga as [l Hl]. + rewrite Hl. + apply prefix_app, prefix_singleton. + rewrite Hl lookup_app_r in Hcmd; last lia. + by rewrite Hlencloga /= Nat.sub_diag in Hcmd. + } + iDestruct (txn_log_lb_weaken (cloga ++ [cmd]) with "Hlbnew") as "#Hlb"; first apply Hprefix. + (* Obtain lbs of replicated history over the new history map. *) + iApply fupd_wp. + iInv "Hinv" as "> HinvO" "HinvC". + (* Take the required group invariant. *) + iNamed "HinvO". + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. + iDestruct (group_inv_witness_group_histm_lbs_from_log with "Hlb Hgroup") as "#Hhistmlb". + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iModIntro. + + (*@ rp.apply(cmd) @*) + (*@ @*) + iAssert (own_replica_with_cloga_no_lsna rp cloga gid rid γ α)%I + with "[Hcm Hhistm Hcpm Hptsmsptsm Hpsmrkm Hclog Hilog]" as "Hrp". + { iFrame "∗ # %". } + wp_apply (wp_Replica__apply with "Hhistmlb Hlb Hidx [$HpwrsS $Hrp]"). + { rewrite Forall_forall in Hvc. + apply Hvc. + by apply elem_of_list_lookup_2 in Hcmd. + } + iIntros "[HpwrsS Hrp]". + + + (*@ rp.lsna = std.SumAssumeNoOverflow(rp.lsna, 1) @*) + (*@ @*) + wp_loadField. + wp_apply wp_SumAssumeNoOverflow. + iIntros (Hnoof). + wp_storeField. + + (*@ } @*) + (*@ } @*) + iApply "HΦ". + iFrame. + iPureIntro. + rewrite uint_nat_word_add_S; last word. + rewrite length_app /= Hlencloga. + lia. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_terminated.v b/src/program_proof/tulip/program/replica/replica_terminated.v new file mode 100644 index 000000000..a2403b1bb --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_terminated.v @@ -0,0 +1,51 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import replica_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__terminated rp (tsW : u64) cm : + let ts := uint.nat tsW in + {{{ own_replica_cm rp cm }}} + Replica__terminated #rp #tsW + {{{ RET #(bool_decide (ts ∈ dom cm)); own_replica_cm rp cm }}}. + Proof. + iIntros (ts Φ) "Hcm HΦ". + wp_rec. + + (*@ func (rp *Replica) terminated(ts uint64) bool { @*) + (*@ _, terminated := rp.txntbl[ts] @*) + (*@ return terminated @*) + (*@ } @*) + iNamed "Hcm". + wp_loadField. + wp_apply (wp_MapGet with "Htxntbl"). + iIntros (v ok) "[%Hok Htxntbl]". + wp_pures. + case_bool_decide as Hts. + { destruct ok; last first. + { exfalso. + apply map_get_false in Hok as [Hnone _]. + apply elem_of_dom in Hts as [b Hb]. + symmetry in Hcmabs. + pose proof (lookup_kmap_eq_None _ _ _ _ _ Hcmabs Hnone) as Hcontra. + specialize (Hcontra ts). + unshelve epose proof (Hcontra _) as Hcmts; first word. + by rewrite Hb in Hcmts. + } + iApply "HΦ". by iFrame "∗ %". + } + { destruct ok. + { exfalso. + apply map_get_true in Hok. + apply not_elem_of_dom in Hts. + pose proof (lookup_kmap_eq_None _ _ _ _ _ Hcmabs Hts) as Hcontra. + specialize (Hcontra tsW). + unshelve epose proof (Hcontra _) as Hcmts; first word. + by rewrite Hok in Hcmts. + } + iApply "HΦ". by iFrame "∗ %". + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_try_accept.v b/src/program_proof/tulip/program/replica/replica_try_accept.v new file mode 100644 index 000000000..7cdd0a47a --- /dev/null +++ b/src/program_proof/tulip/program/replica/replica_try_accept.v @@ -0,0 +1,126 @@ +From Perennial.program_proof.tulip.invariance Require Import execute accept. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import + replica_repr replica_finalized replica_lowest_rank replica_accept replica_log. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__tryAccept rp (tsW : u64) (rankW : u64) (dec : bool) gid rid γ α : + let ts := uint.nat tsW in + let rank := uint.nat rankW in + gid ∈ gids_all -> + rid ∈ rids_all -> + rank ≠ O -> + is_group_prepare_proposal γ gid ts rank dec -∗ + know_tulip_inv γ -∗ + {{{ own_replica rp gid rid γ α }}} + Replica__tryAccept #rp #tsW #rankW #dec + {{{ (res : rpres), RET #(rpres_to_u64 res); + own_replica rp gid rid γ α ∗ accept_outcome γ gid rid ts rank dec res + }}}. + Proof. + iIntros (ts rank Hgid Hrid Hranknz) "#Hgpsl #Hinv". + iIntros (Φ) "!> Hrp HΦ". + wp_rec. + + (*@ func (rp *Replica) tryAccept(ts uint64, rank uint64, dec bool) uint64 { @*) + (*@ // Check if the transaction has aborted or committed. If so, returns the @*) + (*@ // status immediately. @*) + (*@ res, final := rp.finalized(ts) @*) + (*@ if final { @*) + (*@ return res @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_Replica__finalized with "Hinv Hrp"). + { apply Hgid. } + iIntros (res final) "[Hrp Hfinal]". + wp_pures. + destruct final; wp_pures. + { iApply ("HΦ" $! res). iFrame "Hrp". by destruct res. } + + (*@ // Check if the coordinator is the most recent one. If not, report the @*) + (*@ // existence of a more recent coordinator. @*) + (*@ rankl, ok := rp.lowestRank(ts) @*) + (*@ if ok && rank < rankl { @*) + (*@ return tulip.REPLICA_STALE_COORDINATOR @*) + (*@ } @*) + (*@ @*) + do 2 iNamed "Hrp". + wp_apply (wp_Replica__lowestRank with "Hpsmrkm"). + iIntros (rankl ok) "[Hpsmrkm %Hok]". + wp_pures. + unshelve wp_apply (wp_and_pure (ok = true)). + { shelve. } + { apply _. } + { shelve. } + { wp_pures. case_bool_decide as Hcase; last apply not_true_is_false in Hcase; by subst ok. } + { iIntros (_). by wp_pures. } + case_bool_decide as Hcase; wp_pures. + { iApply ("HΦ" $! ReplicaStaleCoordinator). by iFrame "∗ # %". } + + (*@ // Update prepare status table to record that @ts is prepared at @rank. @*) + (*@ rp.accept(ts, rank, dec) @*) + (*@ @*) + wp_apply (wp_Replica__accept with "Hpsmrkm"). + iIntros "Hpsmrkm". + wp_pures. + + (*@ // Logical actions: Execute() and then Accept(@ts, @rank, @dec). @*) + (*@ rp.logAccept(ts, rank, dec) @*) + (*@ @*) + wp_apply wp_Replica__logAccept. + wp_pures. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. + (* First catching up the consistent log. *) + destruct Hcloga as [cmdsa ->]. + iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") + as "(Hclog & Hilog & Hgroup & Hrp)". + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod (replica_inv_accept ts rank dec with "[Hgpsl] Hclog Hilog Hrp") + as "(Hclog & Hilog & Hrp & #Hacc)". + { apply Hexec. } + { rewrite /accept_requirement. + destruct ok; rewrite Hok; last done. + apply Classical_Prop.not_and_or in Hcase. + destruct Hcase as [? | Hge]; first done. + clear -Hge. lia. + } + { case_decide as Hrank; [word | done]. } + iDestruct ("HrgC" with "Hrp") as "Hrg". + iDestruct ("HrgsC" with "Hrg") as "Hrgs". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + + (*@ return tulip.REPLICA_OK @*) + (*@ } @*) + iApply ("HΦ" $! ReplicaOK). + iAssert ([∗ map] t ↦ ps ∈ <[ts := (rank, dec)]> psm, fast_proposal_witness γ gid rid t ps)%I + as "Hfpw'". + { iApply (big_sepM_insert_2 with "[] Hfpw"). + rewrite /fast_proposal_witness /=. + case_decide; [word | done]. + } + iClear "Hfpw". + iFrame "∗ # %". + iPureIntro. simpl. + exists ptgsm. + split. + { by rewrite 2!dom_insert_L Hdompsmrkm. } + split; first done. + rewrite merge_clog_ilog_snoc_ilog; last done. + split. + { rewrite Forall_forall. + intros [n c] Hilog. simpl. + apply elem_of_app in Hilog as [Hilog | Hnewc]. + { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } + rewrite elem_of_list_singleton in Hnewc. + by inv Hnewc. + } + { by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/replica/replica_validate.v b/src/program_proof/tulip/program/replica/replica_validate.v index e69de29bb..3047938ce 100644 --- a/src/program_proof/tulip/program/replica/replica_validate.v +++ b/src/program_proof/tulip/program/replica/replica_validate.v @@ -0,0 +1,158 @@ +From Perennial.program_proof.tulip.invariance Require Import execute validate. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.replica Require Import + replica_repr replica_finalized replica_acquire replica_log. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Replica__validate + rp (tsW : u64) pwrsS pwrsL pwrs (ptgsS : Slice.t) gid rid γ α : + let ts := uint.nat tsW in + gid ∈ gids_all -> + rid ∈ rids_all -> + safe_txn_pwrs γ gid ts pwrs -∗ + know_tulip_inv γ -∗ + {{{ own_dbmap_in_slice pwrsS pwrsL pwrs ∗ own_replica rp gid rid γ α }}} + Replica__validate #rp #tsW (to_val pwrsS) (to_val ptgsS) + {{{ (res : rpres), RET #(rpres_to_u64 res); + own_replica rp gid rid γ α ∗ validate_outcome γ gid rid ts res + }}}. + Proof. + iIntros (ts Hgid Hrid) "#Hsafepwrs #Hinv". + iIntros (Φ) "!> [Hpwrs Hrp] HΦ". + wp_rec. + + (*@ func (rp *Replica) validate(ts uint64, pwrs []tulip.WriteEntry, ptgs []uint64) uint64 { @*) + (*@ // Check if the transaction has aborted or committed. If so, returns the @*) + (*@ // status immediately. @*) + (*@ res, final := rp.finalized(ts) @*) + (*@ if final { @*) + (*@ return res @*) + (*@ } @*) + (*@ @*) + wp_apply (wp_Replica__finalized with "Hinv Hrp"). + { apply Hgid. } + iIntros (res final) "[Hrp Hfinal]". + wp_pures. + destruct final; wp_pures. + { iApply ("HΦ" $! res). iFrame "Hrp". by destruct res. } + + (*@ // Check if the replica has already validated this transaction. @*) + (*@ _, validated := rp.prepm[ts] @*) + (*@ if validated { @*) + (*@ return tulip.REPLICA_OK @*) + (*@ } @*) + (*@ @*) + do 2 iNamed "Hrp". iNamed "Hcpm". + iDestruct (big_sepM2_dom with "Hprepm") as %Hdomprepm. + wp_loadField. + wp_apply (wp_MapGet with "HprepmS"). + iIntros (prepS validated) "[%Hvalidated HprepmS]". + wp_pures. + destruct validated; wp_pures. + { apply map_get_true in Hvalidated. + iApply ("HΦ" $! ReplicaOK). + assert (Hin : ts ∈ dom cpm). + { apply elem_of_dom_2 in Hvalidated. + rewrite Hdomprepm elem_of_dom in Hvalidated. + destruct Hvalidated as [b Hb]. + symmetry in Hcpmabs. + pose proof (lookup_kmap_eq_Some _ _ _ _ _ _ Hcpmabs Hb) as (ts' & Hts' & Hin). + assert (ts' = ts) as ->. + { subst ts. rewrite Hts'. lia. } + by apply elem_of_dom_2 in Hin. + } + iDestruct (big_sepS_elem_of with "Hrpvds") as "#Hrpvd"; first apply Hin. + by iFrame "∗ # %". + } + + (*@ // Validate timestamps. @*) + (*@ acquired := rp.acquire(ts, pwrs) @*) + (*@ if !acquired { @*) + (*@ return tulip.REPLICA_FAILED_VALIDATION @*) + (*@ } @*) + (*@ @*) + iDestruct (safe_txn_pwrs_dom_pwrs with "Hsafepwrs") as %Hdompwrs. + wp_apply (wp_Replica__acquire with "[$Hpwrs $Hptsmsptsm]"). + { apply Hdompwrs. } + iIntros (acquired) "[Hpwrs Hptsmsptsm]". + wp_pures. + destruct acquired; wp_pures; last first. + { iApply ("HΦ" $! ReplicaFailedValidation). by iFrame "∗ # %". } + iDestruct "Hptsmsptsm" as "(Hptsmsptsm & %Hvptsm & %Hvsptsm)". + + (*@ // Record the write set and the participant groups. @*) + (*@ rp.prepm[ts] = pwrs @*) + (*@ // rp.ptgsm[ts] = ptgs @*) + (*@ @*) + wp_loadField. + wp_apply (wp_MapInsert with "HprepmS"); first done. + iIntros "HprepmS". + + (*@ // Logical action: Validate(@ts, @pwrs, @ptgs). @*) + (*@ rp.logValidate(ts, pwrs, ptgs) @*) + (*@ @*) + wp_apply (wp_Replica__logValidate). + wp_pures. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]"; first apply Hgid. + iDestruct (big_sepS_elem_of_acc with "Hrg") as "[Hrp HrgC]"; first apply Hrid. + (* First catching up the consistent log. *) + destruct Hcloga as [cmdsa ->]. + iMod (replica_inv_execute with "Hclogalb Hclog Hilog Hgroup Hrp") + as "(Hclog & Hilog & Hgroup & Hrp)". + (* Then apply the validate transition. *) + (* ∅ is a placeholder for participant groups. *) + iMod (replica_inv_validate _ _ ∅ with "Hsafepwrs Hclog Hilog Hrp") + as "(Hclog & Hilog & Hrp & #Hvd)". + { apply Hexec. } + { do 2 (split; first done). + apply map_get_false in Hvalidated as [Hnone _]. + symmetry in Hcpmabs. + rewrite -not_elem_of_dom Hdomprepm not_elem_of_dom in Hnone. + unshelve epose proof (lookup_kmap_eq_None _ _ _ _ _ Hcpmabs Hnone) as Hcpm. + apply Hcpm. + word. + } + iDestruct ("HrgC" with "Hrp") as "Hrg". + iDestruct ("HrgsC" with "Hrg") as "Hrgs". + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + + (*@ return tulip.REPLICA_OK @*) + (*@ } @*) + iApply ("HΦ" $! ReplicaOK). + iDestruct (big_sepM2_insert_2 _ _ _ tsW with "[Hpwrs] Hprepm") as "Hprepm". + { iFrame "Hpwrs". } + iAssert ([∗ set] t ∈ dom (<[ts := pwrs]> cpm), is_replica_validated_ts γ gid rid t)%I + as "Hrpvds'". + { rewrite dom_insert_L. + iApply (big_sepS_insert_2 ts with "Hvd Hrpvds"). + } + iClear "Hrpvds". + iDestruct (safe_txn_pwrs_impl_valid_wrs with "Hsafepwrs") as %Hvw. + iFrame "∗ # %". + iModIntro. + iPureIntro. simpl. + exists (<[ts := ∅]> ptgsm). + split. + { rewrite 2!kmap_insert. f_equal; [word | done]. } + split; first done. + rewrite merge_clog_ilog_snoc_ilog; last done. + split. + { by apply map_Forall_insert_2. } + split. + { rewrite Forall_forall. + intros [n c] Hilog. simpl. + apply elem_of_app in Hilog as [Hilog | Hnewc]. + { rewrite Forall_forall in Hvicmds. by specialize (Hvicmds _ Hilog). } + rewrite elem_of_list_singleton in Hnewc. + by inv Hnewc. + } + { by rewrite /execute_cmds foldl_snoc execute_cmds_unfold Hexec /=. } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/tuple/res.v b/src/program_proof/tulip/program/tuple/res.v new file mode 100644 index 000000000..4e5d2b878 --- /dev/null +++ b/src/program_proof/tulip/program/tuple/res.v @@ -0,0 +1,9 @@ +From Perennial.program_proof.tulip.program Require Import prelude. + +Section res. + Context `{!tulip_ghostG Σ}. + Implicit Type (α : replica_names). + + Definition own_phys_hist_half α (key : string) (hist : dbhist) : iProp Σ. + Admitted. +End res. diff --git a/src/program_proof/tulip/program/tuple/tuple.v b/src/program_proof/tulip/program/tuple/tuple.v index 1369a8ce3..24aee605d 100644 --- a/src/program_proof/tulip/program/tuple/tuple.v +++ b/src/program_proof/tulip/program/tuple/tuple.v @@ -1,12 +1,5 @@ From Perennial.program_proof.tulip.program Require Import prelude. - -Section res. - Context `{!tulip_ghostG Σ}. - Implicit Type (α : replica_names). - - Definition own_phys_hist_half α (key : string) (hist : dbhist) : iProp Σ. - Admitted. -End res. +From Perennial.program_proof.tulip.program.tuple Require Import res. Section program. Context `{!heapGS Σ, !tulip_ghostG Σ}. diff --git a/src/program_proof/tulip/program/txn/key_to_group.v b/src/program_proof/tulip/program/txn/key_to_group.v new file mode 100644 index 000000000..89285c638 --- /dev/null +++ b/src/program_proof/tulip/program/txn/key_to_group.v @@ -0,0 +1,17 @@ +From Perennial.program_proof.tulip.program Require Import prelude. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_KeyToGroup (key : string) : + {{{ True }}} + KeyToGroup #(LitString key) + {{{ (gid : u64), RET #gid; ⌜key_to_group key = gid⌝ }}}. + Proof. + (*@ func KeyToGroup(key string) uint64 { @*) + (*@ // TODO @*) + (*@ return 0 @*) + (*@ } @*) + Admitted. + +End program. diff --git a/src/program_proof/tulip/program/txn/proph.v b/src/program_proof/tulip/program/txn/proph.v new file mode 100644 index 000000000..f38897940 --- /dev/null +++ b/src/program_proof/tulip/program/txn/proph.v @@ -0,0 +1,35 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.goose_lang.trusted.github_com.mit_pdos.tulip Require Import trusted_proph. + +Section proph. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Lemma wp_ResolveRead p (tid : u64) (key : string) (ts : nat) : + ⊢ + {{{ ⌜uint.nat tid = ts⌝ }}} + <<< ∀∀ acs, own_txn_proph p acs >>> + ResolveRead #p #tid #(LitString key) @ ∅ + <<< ∃ acs', ⌜acs = ActRead ts key :: acs'⌝ ∗ own_txn_proph p acs' >>> + {{{ RET #(); True }}}. + Admitted. + + Lemma wp_ResolveAbort p (tid : u64) (ts : nat) : + ⊢ + {{{ ⌜uint.nat tid = ts⌝ }}} + <<< ∀∀ acs, own_txn_proph p acs >>> + ResolveAbort #p #tid @ ∅ + <<< ∃ acs', ⌜acs = ActAbort ts :: acs'⌝ ∗ own_txn_proph p acs' >>> + {{{ RET #(); True }}}. + Admitted. + + Lemma wp_ResolveCommit + p (tid : u64) (ts : nat) (wrsP : loc) q (wrs : dbmap) : + ⊢ + {{{ ⌜uint.nat tid = ts⌝ ∗ own_map wrsP q wrs }}} + <<< ∀∀ acs, own_txn_proph p acs >>> + ResolveCommit #p #tid #wrsP @ ∅ + <<< ∃ acs', ⌜acs = ActCommit ts wrs :: acs'⌝ ∗ own_txn_proph p acs' >>> + {{{ RET #(); own_map wrsP q wrs }}}. + Admitted. + +End proph. diff --git a/src/program_proof/tulip/program/txn/res.v b/src/program_proof/tulip/program/txn/res.v new file mode 100644 index 000000000..c23e2ca49 --- /dev/null +++ b/src/program_proof/tulip/program/txn/res.v @@ -0,0 +1,50 @@ +From Perennial.program_proof.tulip.program Require Import prelude. + +Section res. + Context `{!heapGS Σ}. + + Definition txnmap_auth (τ : gname) (m : dbmap) : iProp Σ. + Admitted. + + Definition txnmap_ptsto (τ : gname) (k : dbkey) (v : dbval) : iProp Σ. + Admitted. + + Definition txnmap_ptstos (τ : gname) (m : dbmap) : iProp Σ := + [∗ map] k ↦ v ∈ m, txnmap_ptsto τ k v. + + Lemma txnmap_alloc m : + ⊢ |==> ∃ τ, txnmap_auth τ m ∗ ([∗ map] k ↦ v ∈ m, txnmap_ptsto τ k v). + Admitted. + + Lemma txnmap_lookup τ m k v : + txnmap_auth τ m -∗ + txnmap_ptsto τ k v -∗ + ⌜m !! k = Some v⌝. + Admitted. + + Lemma txnmap_update {τ m k v1} v2 : + txnmap_auth τ m -∗ + txnmap_ptsto τ k v1 ==∗ + txnmap_auth τ (<[k := v2]> m) ∗ txnmap_ptsto τ k v2. + Admitted. + + Lemma txnmap_subseteq τ m1 m2 : + txnmap_auth τ m1 -∗ + txnmap_ptstos τ m2 -∗ + ⌜m2 ⊆ m1⌝. + Admitted. + + Definition local_gid_token (α : gname) (gid : u64) : iProp Σ. + Admitted. + + Lemma local_gid_tokens_alloc (gids : gset u64) : + ⊢ |==> ∃ α, [∗ set] gid ∈ gids, local_gid_token α gid. + Admitted. + + Lemma local_gid_token_ne (α : gname) (gid1 gid2 : u64) : + local_gid_token α gid1 -∗ + local_gid_token α gid2 -∗ + ⌜gid2 ≠ gid1⌝. + Admitted. + +End res. diff --git a/src/program_proof/tulip/program/txn/txn.v b/src/program_proof/tulip/program/txn/txn.v deleted file mode 100644 index 627d4b105..000000000 --- a/src/program_proof/tulip/program/txn/txn.v +++ /dev/null @@ -1,1917 +0,0 @@ -From Perennial.program_proof.tulip.invariance Require Import - read commit abort cancel linearize preprepare unprepare prepare. -From Perennial.program_proof.tulip.program Require Import prelude. -From Perennial.program_proof.tulip.program Require Import prelude group_coordinator. -From Perennial.goose_lang.trusted.github_com.mit_pdos.tulip Require Import trusted_proph. - -Section res. - Context `{!heapGS Σ}. - - Definition txnmap_auth (τ : gname) (m : dbmap) : iProp Σ. - Admitted. - - Definition txnmap_ptsto (τ : gname) (k : dbkey) (v : dbval) : iProp Σ. - Admitted. - - Definition txnmap_ptstos (τ : gname) (m : dbmap) : iProp Σ := - [∗ map] k ↦ v ∈ m, txnmap_ptsto τ k v. - - Lemma txnmap_alloc m : - ⊢ |==> ∃ τ, txnmap_auth τ m ∗ ([∗ map] k ↦ v ∈ m, txnmap_ptsto τ k v). - Admitted. - - Lemma txnmap_lookup τ m k v : - txnmap_auth τ m -∗ - txnmap_ptsto τ k v -∗ - ⌜m !! k = Some v⌝. - Admitted. - - Lemma txnmap_update {τ m k v1} v2 : - txnmap_auth τ m -∗ - txnmap_ptsto τ k v1 ==∗ - txnmap_auth τ (<[k := v2]> m) ∗ txnmap_ptsto τ k v2. - Admitted. - - Lemma txnmap_subseteq τ m1 m2 : - txnmap_auth τ m1 -∗ - txnmap_ptstos τ m2 -∗ - ⌜m2 ⊆ m1⌝. - Admitted. - - Definition local_gid_token (α : gname) (gid : u64) : iProp Σ. - Admitted. - - Lemma local_gid_tokens_alloc (gids : gset u64) : - ⊢ |==> ∃ α, [∗ set] gid ∈ gids, local_gid_token α gid. - Admitted. - - Lemma local_gid_token_ne (α : gname) (gid1 gid2 : u64) : - local_gid_token α gid1 -∗ - local_gid_token α gid2 -∗ - ⌜gid2 ≠ gid1⌝. - Admitted. - -End res. - -Section repr. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - (*@ type Txn struct { @*) - (*@ // Timestamp of this transaction. @*) - (*@ ts uint64 @*) - (*@ // Buffered write set. @*) - (*@ wrs map[uint64]map[string]tulip.Value @*) - (*@ // Participant group of this transaction. Initialized in prepare time. @*) - (*@ ptgs []uint64 @*) - (*@ // Group coordinators for performing reads, prepare, abort, and commit. @*) - (*@ gcoords map[uint64]*gcoord.GroupCoordinator @*) - (*@ // Global prophecy variable (for verification purpose). @*) - (*@ proph primitive.ProphId @*) - (*@ } @*) - Definition txn_wrs (wrsP : loc) q (wrs : dbmap) : iProp Σ := - ∃ (pwrsmP : gmap u64 loc) (pwrsm : gmap u64 dbmap), - "HpwrsmP" ∷ own_map wrsP (DfracOwn 1) pwrsmP ∗ - "Hpwrsm" ∷ ([∗ map] p; m ∈ pwrsmP; pwrsm, own_map p q m) ∗ - "%Hwrsg" ∷ ⌜map_Forall (λ g m, m = wrs_group g wrs) pwrsm⌝ ∗ - "%Hdomwrs" ∷ ⌜dom pwrsmP = gids_all⌝. - - Definition own_txn_wrs txn q (wrs : dbmap) : iProp Σ := - ∃ (wrsP : loc) (wrspP : loc), - "HwrsP" ∷ txn ↦[Txn :: "wrs"] #wrsP ∗ - "Hwrs" ∷ txn_wrs wrsP q wrs ∗ - "HwrspP" ∷ txn ↦[Txn :: "wrsp"] #wrspP ∗ - "Hwrsp" ∷ own_map wrspP (DfracOwn 1) wrs. - - Definition own_txn_ptgs txn (ptgs : list u64) : iProp Σ := - ∃ (ptgsS : Slice.t), - "HptgsS" ∷ txn ↦[Txn :: "ptgs"] (to_val ptgsS) ∗ - "Hptgs" ∷ own_slice ptgsS uint64T (DfracOwn 1) ptgs ∗ - "%Hnd" ∷ ⌜NoDup ptgs⌝. - - Definition own_txn_ts txn (tid : nat) : iProp Σ := - ∃ (tsW : u64), - "HtsW" ∷ txn ↦[Txn :: "ts"] #tsW ∗ - "%Htsword" ∷ ⌜uint.nat tsW = tid⌝. - - Definition own_txn_gcoords txn γ : iProp Σ := - ∃ (gcoordsP : loc) (gcoords : gmap u64 loc), - "HgcoordsP" ∷ txn ↦[Txn :: "gcoords"] #gcoordsP ∗ - "Hgcoords" ∷ own_map gcoordsP (DfracOwn 1) gcoords ∗ - "#Hgcoordsabs" ∷ ([∗ map] gid ↦ gcoord ∈ gcoords, is_gcoord gcoord gid γ) ∗ - "%Hdomgcoords" ∷ ⌜dom gcoords = gids_all⌝. - - Definition own_txn_internal txn tid γ : iProp Σ := - ∃ (proph : proph_id), - "Hts" ∷ own_txn_ts txn tid ∗ - "Hwrs" ∷ own_txn_wrs txn (DfracOwn 1) ∅ ∗ - "Hgcoords" ∷ own_txn_gcoords txn γ ∗ - "Hptgs" ∷ own_txn_ptgs txn [] ∗ - "HprophP" ∷ txn ↦[Txn :: "proph"] #proph ∗ - "#Hinv" ∷ know_tulip_inv_with_proph γ proph. - - Definition own_txn_uninit txn γ : iProp Σ := - ∃ tid, "Htxn" ∷ own_txn_internal txn tid γ. - - Definition own_txn_init txn tid γ : iProp Σ := - "Htxn" ∷ own_txn_internal txn tid γ ∗ - "%Hvts" ∷ ⌜valid_ts tid⌝. - - Definition own_txn txn tid rds γ τ : iProp Σ := - ∃ (proph : proph_id) wrs, - "Htxn" ∷ own_txn_ts txn tid ∗ - "Hwrs" ∷ own_txn_wrs txn (DfracOwn 1) wrs ∗ - "Hgcoords" ∷ own_txn_gcoords txn γ ∗ - "Hptgs" ∷ own_txn_ptgs txn [] ∗ - (* diff from [own_txn_init] *) - "Htxnmap" ∷ txnmap_auth τ (wrs ∪ rds) ∗ - "HprophP" ∷ txn ↦[Txn :: "proph"] #proph ∗ - "#Hinv" ∷ know_tulip_inv_with_proph γ proph ∗ - (* diff from [own_txn_init] *) - "#Hlnrz" ∷ ([∗ map] key ↦ value ∈ rds, is_lnrz_hist_at γ key (pred tid) value) ∗ - "%Hdomr" ∷ ⌜dom rds ⊆ keys_all⌝ ∗ - (* diff from [own_txn_init] *) - "%Hincl" ∷ ⌜dom wrs ⊆ dom rds⌝ ∗ - "%Hvts" ∷ ⌜valid_ts tid⌝ ∗ - (* diff from [own_txn_init] *) - "%Hvwrs" ∷ ⌜valid_wrs wrs⌝. - - Definition own_txn_stable txn tid rds wrs γ τ : iProp Σ := - ∃ (proph : proph_id), - "Htxn" ∷ own_txn_ts txn tid ∗ - (* diff from [own_txn] *) - "Hwrs" ∷ own_txn_wrs txn DfracDiscarded wrs ∗ - "Hgcoords" ∷ own_txn_gcoords txn γ ∗ - "Hptgs" ∷ own_txn_ptgs txn [] ∗ - "Htxnmap" ∷ txnmap_auth τ (wrs ∪ rds) ∗ - "HprophP" ∷ txn ↦[Txn :: "proph"] #proph ∗ - "#Hinv" ∷ know_tulip_inv_with_proph γ proph ∗ - "#Hlnrz" ∷ ([∗ map] key ↦ value ∈ rds, is_lnrz_hist_at γ key (pred tid) value) ∗ - "%Hdomr" ∷ ⌜dom rds ⊆ keys_all⌝ ∗ - (* diff from [own_txn] and [wrs] is exposed *) - "#Htxnwrs" ∷ is_txn_wrs γ tid wrs ∗ - "%Hincl" ∷ ⌜dom wrs ⊆ dom rds⌝ ∗ - "%Hvts" ∷ ⌜valid_ts tid⌝ ∗ - "%Hvwrs" ∷ ⌜valid_wrs wrs⌝. - - Definition own_txn_prepared txn tid rds wrs γ τ : iProp Σ := - ∃ (proph : proph_id) ptgs, - "Htxn" ∷ own_txn_ts txn tid ∗ - "Hwrs" ∷ own_txn_wrs txn DfracDiscarded wrs ∗ - "Hgcoords" ∷ own_txn_gcoords txn γ ∗ - (* diff from [own_txn_stable] *) - "Hptgs" ∷ own_txn_ptgs txn ptgs ∗ - "Htxnmap" ∷ txnmap_auth τ (wrs ∪ rds) ∗ - "HprophP" ∷ txn ↦[Txn :: "proph"] #proph ∗ - "#Hinv" ∷ know_tulip_inv_with_proph γ proph ∗ - "#Hlnrz" ∷ ([∗ map] key ↦ value ∈ rds, is_lnrz_hist_at γ key (pred tid) value) ∗ - "#Htxnwrs" ∷ is_txn_wrs γ tid wrs ∗ - "%Hdomr" ∷ ⌜dom rds ⊆ keys_all⌝ ∗ - "%Hincl" ∷ ⌜dom wrs ⊆ dom rds⌝ ∗ - "%Hvts" ∷ ⌜valid_ts tid⌝ ∗ - "%Hvwrs" ∷ ⌜valid_wrs wrs⌝ ∗ - (* diff from [own_txn_stable] *) - "%Hptgs" ∷ ⌜list_to_set ptgs = ptgroups (dom wrs)⌝. - -End repr. - -Section proph. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - Lemma wp_ResolveRead p (tid : u64) (key : string) (ts : nat) : - ⊢ - {{{ ⌜uint.nat tid = ts⌝ }}} - <<< ∀∀ acs, own_txn_proph p acs >>> - ResolveRead #p #tid #(LitString key) @ ∅ - <<< ∃ acs', ⌜acs = ActRead ts key :: acs'⌝ ∗ own_txn_proph p acs' >>> - {{{ RET #(); True }}}. - Admitted. - - Lemma wp_ResolveAbort p (tid : u64) (ts : nat) : - ⊢ - {{{ ⌜uint.nat tid = ts⌝ }}} - <<< ∀∀ acs, own_txn_proph p acs >>> - ResolveAbort #p #tid @ ∅ - <<< ∃ acs', ⌜acs = ActAbort ts :: acs'⌝ ∗ own_txn_proph p acs' >>> - {{{ RET #(); True }}}. - Admitted. - - Lemma wp_ResolveCommit - p (tid : u64) (ts : nat) (wrsP : loc) q (wrs : dbmap) : - ⊢ - {{{ ⌜uint.nat tid = ts⌝ ∗ own_map wrsP q wrs }}} - <<< ∀∀ acs, own_txn_proph p acs >>> - ResolveCommit #p #tid #wrsP @ ∅ - <<< ∃ acs', ⌜acs = ActCommit ts wrs :: acs'⌝ ∗ own_txn_proph p acs' >>> - {{{ RET #(); own_map wrsP q wrs }}}. - Admitted. - -End proph. - -Section program. - Context `{!heapGS Σ, !tulip_ghostG Σ}. - - Theorem wp_KeyToGroup (key : string) : - {{{ True }}} - KeyToGroup #(LitString key) - {{{ (gid : u64), RET #gid; ⌜key_to_group key = gid⌝ }}}. - Proof. - (*@ func KeyToGroup(key string) uint64 { @*) - (*@ // TODO @*) - (*@ return 0 @*) - (*@ } @*) - Admitted. - - Theorem wp_Txn__getwrs (txn : loc) (key : string) q wrs : - {{{ own_txn_wrs txn q wrs }}} - Txn__getwrs #txn #(LitString key) - {{{ (v : dbval) (ok : bool), RET (dbval_to_val v, #ok); - own_txn_wrs txn q wrs ∗ ⌜wrs !! key = if ok then Some v else None⌝ - }}}. - Proof. - iIntros (Φ) "Hwrs HΦ". - wp_rec. - - (*@ func (txn *Txn) getwrs(key string) (Value, bool) { @*) - (*@ gid := KeyToGroup(key) @*) - (*@ pwrs := txn.wrs[gid] @*) - (*@ @*) - wp_apply wp_KeyToGroup. - iIntros (gid Hgid). - do 2 iNamed "Hwrs". - wp_loadField. - wp_apply (wp_MapGet with "HpwrsmP"). - iIntros (pwrsP ok) "[%Hget HpwrsmP]". - destruct ok; last first. - { apply map_get_false in Hget as [Hget _]. - rewrite -not_elem_of_dom Hdomwrs -Hgid in Hget. - by pose proof (elem_of_key_to_group key). - } - apply map_get_true in Hget. - iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. - { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. - iPureIntro. - by rewrite -elem_of_dom -Hdom elem_of_dom. - } - iDestruct (big_sepM2_lookup_acc with "Hpwrsm") as "[Hpwrs HpwrsmC]"; [done | done |]. - - (*@ v, ok := pwrs[key] @*) - (*@ return v, ok @*) - (*@ } @*) - wp_apply (wp_MapGet with "Hpwrs"). - iIntros (v ok) "[%Hv Hpwrs]". - wp_pures. - iApply "HΦ". - iDestruct ("HpwrsmC" with "Hpwrs") as "Hpwrsm". - iFrame "∗ # %". - iPureIntro. - specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. - rewrite Hwrsg in Hv. - destruct ok. - - apply map_get_true in Hv. - rewrite lookup_wrs_group_Some in Hv. - by destruct Hv as [Hv _]. - - apply map_get_false in Hv as [Hv _]. - rewrite lookup_wrs_group_None in Hv. - by destruct Hv. - Qed. - - Theorem wp_Txn__setwrs (txn : loc) (key : string) (value : dbval) wrs : - {{{ own_txn_wrs txn (DfracOwn 1) wrs }}} - Txn__setwrs #txn #(LitString key) (dbval_to_val value) - {{{ RET #(); own_txn_wrs txn (DfracOwn 1) (<[key := value]> wrs) }}}. - Proof. - iIntros (Φ) "Hwrs HΦ". - wp_rec. - - (*@ func (txn *Txn) setwrs(key string, value Value) { @*) - (*@ gid := KeyToGroup(key) @*) - (*@ pwrs := txn.wrs[gid] @*) - (*@ @*) - wp_apply wp_KeyToGroup. - iIntros (gid Hgid). - do 2 iNamed "Hwrs". - wp_loadField. - wp_apply (wp_MapGet with "HpwrsmP"). - iIntros (pwrsP ok) "[%Hget HpwrsmP]". - destruct ok; last first. - { apply map_get_false in Hget as [Hget _]. - rewrite -not_elem_of_dom Hdomwrs -Hgid in Hget. - by pose proof (elem_of_key_to_group key). - } - apply map_get_true in Hget. - iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. - { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. - iPureIntro. - by rewrite -elem_of_dom -Hdom elem_of_dom. - } - iDestruct (big_sepM2_delete with "Hpwrsm") as "[Hpwrs Hpwrsm]"; [done | done |]. - - (*@ pwrs[key] = value @*) - (*@ } @*) - wp_apply (wp_MapInsert with "Hpwrs"); first done. - iIntros "Hpwrs". - wp_loadField. - wp_apply (wp_MapInsert with "Hwrsp"); first done. - iIntros "Hwrsp". - wp_pures. - iApply "HΦ". - set pwrs' := <[key := value]> pwrs. - iAssert ([∗ map] p; m ∈ pwrsmP; <[gid := pwrs']> pwrsm, own_map p (DfracOwn 1) m)%I - with "[Hpwrsm Hpwrs]" as "Hpwrsm". - { iDestruct (big_sepM2_insert_2 (λ k p m, own_map p (DfracOwn 1) m) _ _ gid with "Hpwrs Hpwrsm") - as "Hpwrsm". - rewrite insert_delete; last apply Hget. - rewrite insert_delete_insert. - done. - } - iFrame "∗ %". - iPureIntro. - intros g m Hgm. - destruct (decide (gid = g)) as [-> | Hne]. - - rewrite lookup_insert in Hgm. inv Hgm. - specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. - by rewrite Hwrsg wrs_group_insert. - - rewrite lookup_insert_ne in Hgm; last done. - specialize (Hwrsg _ _ Hgm). simpl in Hwrsg. - subst m. - by rewrite wrs_group_insert_ne; last rewrite Hgid. - Qed. - - Theorem wp_Txn__resetwrs (txn : loc) q wrs : - {{{ own_txn_wrs txn q wrs }}} - Txn__resetwrs #txn - {{{ RET #(); own_txn_wrs txn (DfracOwn 1) ∅ }}}. - Proof. - iIntros (Φ) "Hwrs HΦ". - wp_rec. - - (*@ func (txn *Txn) resetwrs() { @*) - (*@ // Creating a new @wrs is not really necessary, but currently it seems like @*) - (*@ // there's no easy way to reason modifying a map while iterating over it @*) - (*@ // (which is a defined behavior in Go). @*) - (*@ wrs := make(map[uint64]map[string]tulip.Value) @*) - (*@ for gid := range(txn.wrs) { @*) - (*@ wrs[gid] = make(map[string]tulip.Value) @*) - (*@ } @*) - (*@ txn.wrs = wrs @*) - (*@ txn.wrsp = make(map[string]tulip.Value) @*) - (*@ } @*) - wp_apply wp_NewMap. - iIntros (wrsP') "HpwrsmP'". - do 2 iNamed "Hwrs". - (* iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. *) - wp_loadField. - set P := (λ (mx : gmap u64 loc), - let em := gset_to_gmap (∅ : dbmap) (dom mx) in - ∃ (pwrsmP' : gmap u64 loc), - "HpwrsmP'" ∷ own_map wrsP' (DfracOwn 1) pwrsmP' ∗ - "Hpwrsm'" ∷ ([∗ map] p;m ∈ pwrsmP';em, own_map p (DfracOwn 1) m))%I. - wp_apply (wp_MapIter_fold _ _ _ P with "HpwrsmP [HpwrsmP']"). - { subst P. simpl. - rewrite dom_empty_L gset_to_gmap_empty. - iFrame. - by iApply big_sepM2_empty. - } - { clear Φ. - iIntros (m gid pwrsP Φ) "!> [HP [%Hnone %Hsome]] HΦ". - iNamed "HP". - wp_pures. - wp_apply wp_NewMap. - iIntros (empP) "HempP". - wp_apply (wp_MapInsert with "HpwrsmP'"); first by auto. - iIntros "HpwrsmP'". - iApply "HΦ". - subst P. simpl. - iFrame. - rewrite dom_insert_L gset_to_gmap_union_singleton. - iApply (big_sepM2_insert_2 with "[HempP] Hpwrsm'"); first iFrame. - } - iIntros "[HpwrsmP HP]". - subst P. simpl. - iNamed "HP". - wp_storeField. - wp_apply wp_NewMap. - iIntros (wrspP') "HwrspP'". - wp_storeField. - iApply "HΦ". - iDestruct (big_sepM2_dom with "Hpwrsm'") as %Hdom'. - iFrame "∗ %". - iPureIntro. - split; last first. - { by rewrite Hdom' dom_gset_to_gmap Hdomwrs. } - intros g m Hgm. - rewrite lookup_gset_to_gmap_Some in Hgm. - destruct Hgm as [_ Hm]. - by rewrite /wrs_group map_filter_empty. - Qed. - - Theorem wp_Txn__setptgs txn q wrs : - {{{ own_txn_wrs txn q wrs ∗ own_txn_ptgs txn [] }}} - Txn__setptgs #txn - {{{ RET #(); ∃ ptgs, own_txn_wrs txn q wrs ∗ own_txn_ptgs txn ptgs ∗ - ⌜list_to_set ptgs = ptgroups (dom wrs)⌝ - }}}. - Proof using heapGS0 tulip_ghostG0 Σ. - iIntros (Φ) "[Hwrs Hptgs] HΦ". - wp_rec. - - (*@ func (txn *Txn) setptgs() { @*) - (*@ var ptgs = txn.ptgs @*) - (*@ @*) - iNamed "Hptgs". - clear Hnd. - wp_loadField. - wp_apply wp_ref_to; first apply slice_val_ty. - iIntros (ptgsP) "HptgsP". - - (*@ for gid, pwrs := range(txn.wrs) { @*) - (*@ if uint64(len(pwrs)) != 0 { @*) - (*@ ptgs = append(ptgs, gid) @*) - (*@ } @*) - (*@ } @*) - (*@ txn.ptgs = ptgs @*) - (*@ } @*) - do 2 iNamed "Hwrs". - wp_loadField. - set P := (λ (mx : gmap u64 loc), - ∃ (s : Slice.t) (ptgs : list u64), - "HptgsP" ∷ ptgsP ↦[slice.T uint64T] (to_val s) ∗ - "Hptgs" ∷ own_slice s uint64T (DfracOwn 1) ptgs ∗ - "Hpwrsm" ∷ ([∗ map] p;m ∈ pwrsmP;pwrsm, own_map p q m) ∗ - "%Hnd" ∷ ⌜NoDup ptgs⌝ ∗ - "%Hincl" ∷ ⌜Forall (λ g, g ∈ dom mx) ptgs⌝ ∗ - (* non-empty ↔ in ptgs *) - "%Hspec" ∷ ⌜set_Forall (λ g, keys_group g (dom wrs) ≠ ∅ ↔ g ∈ ptgs) (dom mx)⌝)%I. - wp_apply (wp_MapIter_fold _ _ _ P with "HpwrsmP [$HptgsP $Hptgs $Hpwrsm]"). - { iPureIntro. by split; first apply NoDup_nil. } - { clear Φ. - iIntros (m gid pwrsP Φ) "!> [HP [%Hnone %Hsome]] HΦ". - iNamed "HP". - iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. - { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. - iPureIntro. - by rewrite -elem_of_dom -Hdom elem_of_dom. - } - iDestruct (big_sepM2_lookup_acc with "Hpwrsm") as "[Hpwrs HpwrsmC]"; [done | done |]. - wp_apply (wp_MapLen with "Hpwrs"). - iIntros "[%Hsize Hpwrs]". - iDestruct ("HpwrsmC" with "Hpwrs") as "Hpwrsm". - wp_if_destruct. - { wp_load. - (* NB: need to provide [own_slice] to properly resolve the right typeclass. *) - wp_apply (wp_SliceAppend with "Hptgs"). - iIntros (s') "Hptgs". - wp_store. - iApply "HΦ". - iFrame. - iPureIntro. - split. - { apply NoDup_snoc; last apply Hnd. - intros Hgid. - rewrite Forall_forall in Hincl. - specialize (Hincl _ Hgid). - by apply not_elem_of_dom in Hnone. - } - split. - { rewrite Forall_app Forall_singleton dom_insert_L. - split; last set_solver. - apply (Forall_impl _ _ _ Hincl). - set_solver. - } - intros g Hg. - rewrite dom_insert_L elem_of_union in Hg. - split. - { intros Hne. - destruct Hg as [? | Hg]; first set_solver. - specialize (Hspec _ Hg). simpl in Hspec. - set_solver. - } - { intros Hsnoc. - destruct Hg as [Hgid | Hg]; last first. - { specialize (Hspec _ Hg). simpl in Hspec. - apply Hspec. - rewrite -not_elem_of_dom in Hnone. - set_solver. - } - rewrite elem_of_singleton in Hgid. - subst g. - (* FIXME: not sure if word is supposed to solve this immediately *) - assert (Hnz : size pwrs ≠ O). - { intros Hz. rewrite Hz in Heqb. word. } - clear Heqb. - specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. - intros Hempty. - rewrite -wrs_group_keys_group_dom -Hwrsg in Hempty. - apply dom_empty_inv_L in Hempty. - by rewrite map_size_non_empty_iff in Hnz. - } - } - iApply "HΦ". - iFrame. - iPureIntro. - rewrite dom_insert_L. - split; first apply Hnd. - split. - { apply (Forall_impl _ _ _ Hincl). set_solver. } - apply set_Forall_union; last apply Hspec. - rewrite set_Forall_singleton. - assert (Hsizez : size pwrs = O). - { rewrite Heqb in Hsize. done. } - split. - { intros Hne. - specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. - rewrite -wrs_group_keys_group_dom -Hwrsg in Hne. - apply map_size_empty_inv in Hsizez. - by rewrite Hsizez in Hne. - } - { intros Hinptgs. - rewrite Forall_forall in Hincl. - specialize (Hincl _ Hinptgs). - by rewrite -not_elem_of_dom in Hnone. - } - } - iIntros "[HpwrsmP HP]". - iNamed "HP". - wp_load. wp_storeField. - iApply "HΦ". - iFrame "∗ # %". - iPureIntro. - apply set_eq. - intros gid. - rewrite elem_of_ptgroups elem_of_list_to_set. - split. - { intros Hgid. - rewrite Forall_forall in Hincl. - specialize (Hincl _ Hgid). - specialize (Hspec _ Hincl). simpl in Hspec. - by apply Hspec. - } - { intros Hne. - destruct (decide (gid ∈ gids_all)) as [Hin | Hnotin]; last first. - { rewrite /keys_group in Hne. - apply set_choose_L in Hne as [k Hk]. - pose proof (elem_of_key_to_group k) as Hin. - set_solver. - } - rewrite Hdomwrs in Hspec. - specialize (Hspec _ Hin). simpl in Hspec. - by apply Hspec. - } - Qed. - - Theorem wp_Txn__resetptgs (txn : loc) ptgs : - {{{ own_txn_ptgs txn ptgs }}} - Txn__resetptgs #txn - {{{ RET #(); own_txn_ptgs txn [] }}}. - Proof. - iIntros (Φ) "Hptgs HΦ". - wp_rec. - - (*@ func (txn *Txn) resetptgs() { @*) - (*@ txn.ptgs = txn.ptgs[:0] @*) - (*@ } @*) - iNamed "Hptgs". - wp_loadField. - wp_apply wp_SliceTake; first word. - wp_storeField. - iApply "HΦ". - iDestruct (own_slice_take_cap _ _ _ (W64 0) with "Hptgs") as "Hptgs"; first word. - iFrame. - iPureIntro. - by apply NoDup_nil. - Qed. - - Theorem wp_Txn__reset (txn : loc) wrs q ptgs : - {{{ own_txn_wrs txn q wrs ∗ own_txn_ptgs txn ptgs }}} - Txn__reset #txn - {{{ RET #(); own_txn_wrs txn (DfracOwn 1) ∅ ∗ own_txn_ptgs txn [] }}}. - Proof. - iIntros (Φ) "[Hwrs Hptgs] HΦ". - wp_rec. - - (*@ func (txn *Txn) reset() { @*) - (*@ txn.resetwrs() @*) - (*@ txn.resetptgs() @*) - (*@ } @*) - wp_apply (wp_Txn__resetwrs with "Hwrs"). - iIntros "Hwrs". - wp_apply (wp_Txn__resetptgs with "Hptgs"). - iIntros "Hptgs". - wp_pures. - iApply "HΦ". - by iFrame. - Qed. - - Theorem wp_Txn__commit txn tid rds wrsphys wrsproph γ τ : - is_lnrz_tid γ tid -∗ - all_prepared γ tid wrsphys -∗ - {{{ own_txn_prepared txn tid rds wrsphys γ τ ∗ own_cmt_tmod γ tid wrsproph }}} - Txn__commit #txn - {{{ RET #(); own_txn_uninit txn γ ∗ ⌜wrsphys = wrsproph⌝ }}}. - Proof. - iIntros "#Hlnrzed #Hprep" (Φ) "!> [Htxn Htidc] HΦ". - wp_rec. - - (*@ func (txn *Txn) commit() { @*) - (*@ ResolveCommit(txn.proph, txn.ts, txn.wrs) @*) - (*@ @*) - do 2 iNamed "Htxn". iNamed "Hwrs". - do 3 wp_loadField. - wp_apply (wp_ResolveCommit with "[$Hwrsp]"); first done. - iInv "Hinv" as "> HinvO" "HinvC". - iApply ncfupd_mask_intro; first set_solver. - iIntros "Hmask". - iNamed "HinvO". - iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". - iFrame "Hproph". - iIntros "(%future' & %Hfuture & Hproph)". - iMod (txnsys_inv_commit with "Hlnrzed Hprep Htxnsys Hgroups Hrgs Hkeys") - as "(Htxnsys & Hgroups & Hrgs & Hkeys & #Hcmt)". - { by rewrite Hfuture. } - iAssert (⌜wrsphys = wrsproph⌝)%I as %Heq. - { do 2 iNamed "Htxnsys". - iDestruct (txn_res_lookup with "Hresm Hcmt") as %Hwrsc. - iDestruct (elem_of_committed_partitioned_tids with "Hpart") as %[Hnotinwc Hnotinwa]. - { by eauto. } - iDestruct (cmt_tmod_lookup with "Htidcs Htidc") as %Htidc. - specialize (Htidcs _ _ Htidc). simpl in Htidcs. - (* Prove [resm !! tid = Some (ResCommitted wrs)]. *) - destruct Htidcs as [Htmodcs | Hresm]. - { by rewrite not_elem_of_dom Htmodcs in Hnotinwc. } - rewrite Hresm in Hwrsc. symmetry in Hwrsc. inv Hwrsc. - done. - } - (* Close the invariant. *) - rewrite Hfuture /=. - iDestruct (txnsys_inv_merge_future with "Hproph Htxnsys") as "Htxnsys". - iMod "Hmask" as "_". - iMod ("HinvC" with "[Htxnsys Hkeys Hgroups Hrgs]") as "_"; first by iFrame. - iIntros "!> Hwrsp". - wp_pures. - do 2 wp_loadField. - - (*@ ts := txn.ts @*) - (*@ for _, gid := range(txn.ptgs) { @*) - (*@ @*) - iNamed "Hptgs". iNamed "Hwrs". - iDestruct "Hpwrsm" as "#Hpwrsm". - wp_loadField. - set P := (λ (_ : u64), - "HpwrsmP" ∷ own_map wrsP (DfracOwn 1) pwrsmP ∗ - "Hgcoords" ∷ own_txn_gcoords txn γ)%I. - iDestruct (own_slice_small_acc with "Hptgs") as "[Hptgs HptgsC]". - wp_apply (wp_forSlice P with "[] [$Hptgs $HpwrsmP $Hgcoords]"). - { (* Loop body. *) - clear Φ. - - (*@ gcoord := txn.gcoords[gid] @*) - (*@ pwrs := txn.wrs[gid] @*) - (*@ @*) - iIntros (i gid Φ) "!> (HP & %Hinbound & %Hgid) HΦ". - iNamed "HP". iNamed "Hgcoords". - wp_loadField. - assert (Hin : gid ∈ gids_all). - { pose proof (subseteq_ptgroups (dom wrsphys)) as Hdom. - apply elem_of_list_lookup_2 in Hgid. - clear -Hdom Hgid Hptgs. - set_solver. - } - wp_apply (wp_MapGet with "Hgcoords"). - iIntros (gcoordP ok) "[%Hgetgcoords Hgcoords]". - destruct ok; last first. - { apply map_get_false in Hgetgcoords as [Hnone _]. - by rewrite -not_elem_of_dom Hdomgcoords in Hnone. - } - apply map_get_true in Hgetgcoords. - wp_apply (wp_MapGet with "HpwrsmP"). - iIntros (pwrsP ok) "[%Hgetwrs HpwrsmP]". - destruct ok; last first. - { apply map_get_false in Hgetwrs as [Hnotin _]. - by rewrite -not_elem_of_dom Hdomwrs in Hnotin. - } - apply map_get_true in Hgetwrs. - iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. - { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. - iPureIntro. - by rewrite -elem_of_dom -Hdom elem_of_dom. - } - iDestruct (big_sepM2_lookup_acc with "Hpwrsm") as "[Hpwrs HpwrsmC]"; [done | done |]. - - (*@ go func() { @*) - (*@ gcoord.Commit(ts, pwrs) @*) - (*@ }() @*) - (*@ } @*) - (*@ @*) - wp_pures. - iDestruct (big_sepM_lookup with "Hgcoordsabs") as "Hgcoordabs"; first apply Hgetgcoords. - wp_apply wp_fork. - { wp_apply (wp_GroupCoordinator__Commit with "[] Hgcoordabs Hpwrs"). - { rewrite Htsword. - iFrame "Hcmt Htxnwrs". - iPureIntro. - assert (Hinptgs : gid ∈ ptgroups (dom wrsphys)). - { rewrite -Hptgs elem_of_list_to_set elem_of_list_lookup. by eauto. } - specialize (Hwrsg _ _ Hpwrs). - done. - } - by iIntros "_". - } - iApply "HΦ". - iFrame "∗ # %". - } - iIntros "[HP Hptgs]". - iNamed "HP". clear P. - iDestruct ("HptgsC" with "Hptgs") as "Hptgs". - iAssert (own_txn_ptgs txn ptgs)%I with "[$HptgsS $Hptgs]" as "Hptgs"; first done. - - (*@ txn.reset() @*) - (*@ } @*) - iAssert (own_txn_wrs txn DfracDiscarded wrsphys)%I - with "[$HwrsP $HwrspP $Hwrsp $HpwrsmP]" as "Hwrs". - { iFrame "# %". } - wp_apply (wp_Txn__reset with "[$Hwrs $Hptgs]"). - iIntros "[Hwrs Hptgs]". - wp_pures. - iApply "HΦ". - by iFrame "∗ # %". - Qed. - - Theorem wp_Txn__commit_in_abort_future txn tid rds wrs γ τ : - is_lnrz_tid γ tid -∗ - all_prepared γ tid wrs -∗ - {{{ own_txn_prepared txn tid rds wrs γ τ ∗ own_wabt_tid γ tid }}} - Txn__commit #txn - {{{ RET #(); False }}}. - Proof. - iIntros "#Hlnrzed #Hprep" (Φ) "!> [Htxn Hwabt] HΦ". - wp_rec. - - (*@ func (txn *Txn) commit() { @*) - (*@ trusted_proph.ResolveCommit(txn.proph, txn.ts, txn.wrsp) @*) - (*@ @*) - do 2 iNamed "Htxn". iNamed "Hwrs". - do 3 wp_loadField. - wp_apply (wp_ResolveCommit with "[$Hwrsp]"); first done. - iInv "Hinv" as "> HinvO" "HinvC". - iApply ncfupd_mask_intro; first set_solver. - iIntros "Hmask". - iNamed "HinvO". - iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". - iFrame "Hproph". - iIntros "(%future' & %Hfuture & Hproph)". - iMod (txnsys_inv_commit with "Hlnrzed Hprep Htxnsys Hgroups Hrgs Hkeys") - as "(Htxnsys & Hgroups & Hrgs & Hkeys & Hcmt)". - { by rewrite Hfuture. } - (* Obtain contradiction. *) - do 2 iNamed "Htxnsys". - iDestruct (txn_res_lookup with "Hresm Hcmt") as %Hcmt. - iDestruct (wabt_tid_elem_of with "Htidas Hwabt") as %Hwabt. - rewrite -Htidas in Hwabt. - iDestruct (elem_of_tmodas_partitioned_tids with "Hpart") as %[_ Hnotin]. - { apply Hwabt. } - by specialize (Hnotin _ Hcmt). - - (*@ ts := txn.ts @*) - (*@ wrs := txn.wrs @*) - (*@ for _, gid := range(txn.ptgs) { @*) - (*@ gcoord := txn.gcoords[gid] @*) - (*@ pwrs := wrs[gid] @*) - (*@ @*) - (*@ go func() { @*) - (*@ gcoord.Commit(ts, pwrs) @*) - (*@ }() @*) - (*@ } @*) - (*@ @*) - (*@ txn.reset() @*) - (*@ } @*) - Qed. - - Theorem wp_Txn__abort txn tid rds wrs γ τ : - is_txn_aborted γ tid -∗ - {{{ own_txn_prepared txn tid rds wrs γ τ ∗ own_wabt_tid γ tid }}} - Txn__abort #txn - {{{ RET #(); own_txn_uninit txn γ }}}. - Proof. - iIntros "#Habt" (Φ) "!> [Htxn Hwabt] HΦ". - wp_rec. - - (*@ func (txn *Txn) abort() { @*) - (*@ trusted_proph.ResolveAbort(txn.proph, txn.ts) @*) - (*@ @*) - do 2 iNamed "Htxn". - do 2 wp_loadField. - wp_apply (wp_ResolveAbort); first done. - iInv "Hinv" as "> HinvO" "HinvC". - iApply ncfupd_mask_intro; first set_solver. - iIntros "Hmask". - iNamed "HinvO". - iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". - iFrame "Hproph". - iIntros "(%future' & %Hfuture & Hproph)". - iMod (txnsys_inv_abort with "Habt Hwabt Htxnsys") as "Htxnsys". - { by rewrite Hfuture. } - rewrite Hfuture /=. - iDestruct (txnsys_inv_merge_future with "Hproph Htxnsys") as "Htxnsys". - iMod "Hmask" as "_". - iMod ("HinvC" with "[Htxnsys Hkeys Hgroups Hrgs]") as "_"; first by iFrame. - iIntros "!> _". - wp_pures. - - (*@ ts := txn.ts @*) - (*@ for _, gid := range(txn.ptgs) { @*) - (*@ @*) - (*@ txn.reset() @*) - (*@ } @*) - - - (*@ for _, gid := range(txn.ptgs) { @*) - (*@ rg := txn.rgs[gid] @*) - (*@ rg.Abort(txn.ts) @*) - (*@ } @*) - (*@ @*) - iNamed "Hptgs". - do 2 wp_loadField. - set P := (λ (_ : u64), own_txn_gcoords txn γ)%I. - iDestruct (own_slice_small_acc with "Hptgs") as "[Hptgs HptgsC]". - wp_apply (wp_forSlice P with "[] [$Hptgs $Hgcoords]"). - { (* Loop body. *) - clear Φ. - - (*@ gcoord := txn.gcoords[gid] @*) - (*@ @*) - iIntros (i gid Φ) "!> (Hgcoords & %Hinbound & %Hgid) HΦ". - iNamed "Hgcoords". - wp_loadField. - assert (Hin : gid ∈ gids_all). - { pose proof (subseteq_ptgroups (dom wrs)) as Hdom. - apply elem_of_list_lookup_2 in Hgid. - clear -Hdom Hgid Hptgs. - set_solver. - } - wp_apply (wp_MapGet with "Hgcoords"). - iIntros (gcoordP ok) "[%Hgetgcoords Hgcoords]". - destruct ok; last first. - { apply map_get_false in Hgetgcoords as [Hnone _]. - by rewrite -not_elem_of_dom Hdomgcoords in Hnone. - } - apply map_get_true in Hgetgcoords. - (*@ go func() { @*) - (*@ gcoord.Abort(ts) @*) - (*@ }() @*) - (*@ } @*) - (*@ @*) - wp_pures. - iDestruct (big_sepM_lookup with "Hgcoordsabs") as "Hgcoordabs"; first apply Hgetgcoords. - wp_apply wp_fork. - { wp_apply (wp_GroupCoordinator__Abort with "[] Hgcoordabs"). - { rewrite Htsword. by iFrame "Habt". } - done. - } - iApply "HΦ". - iFrame "∗ # %". - } - iIntros "[Hgcoods Hptgs]". subst P. simpl. - iDestruct ("HptgsC" with "Hptgs") as "Hptgs". - iAssert (own_txn_ptgs txn ptgs)%I with "[$HptgsS $Hptgs]" as "Hptgs"; first done. - - (*@ txn.reset() @*) - (*@ } @*) - wp_apply (wp_Txn__reset with "[$Hwrs $Hptgs]"). - iIntros "[Hwrs Hptgs]". - wp_pures. - iApply "HΦ". - by iFrame "∗ # %". - Qed. - - Theorem wp_Txn__abort_in_commit_future txn tid rds wrsphys wrsproph γ τ : - is_txn_aborted γ tid -∗ - {{{ own_txn_prepared txn tid rds wrsphys γ τ ∗ own_cmt_tmod γ tid wrsproph }}} - Txn__abort #txn - {{{ RET #(); False }}}. - Proof. - iIntros "#Habt" (Φ) "!> [Htxn Htidc] HΦ". - wp_rec. - - (*@ func (txn *Txn) abort() { @*) - (*@ trusted_proph.ResolveAbort(txn.proph, txn.ts) @*) - (*@ @*) - do 2 iNamed "Htxn". - do 2 wp_loadField. - wp_apply (wp_ResolveAbort); first done. - iInv "Hinv" as "> HinvO" "HinvC". - iApply ncfupd_mask_intro; first set_solver. - iIntros "Hmask". - iNamed "HinvO". do 2 iNamed "Htxnsys". - iFrame "Hproph". - iIntros "(%future' & %Hfuture & Hproph)". - (* Prove [tid] must not have committed. *) - iDestruct (txn_res_lookup with "Hresm Habt") as %Habt. - iDestruct (cmt_tmod_lookup with "Htidcs Htidc") as %Htidc. - specialize (Htidcs _ _ Htidc). simpl in Htidcs. - destruct Htidcs as [Hwc | Hcmt]; last first. - { by rewrite Hcmt in Habt. } - specialize (Hcf _ _ Hwc). simpl in Hcf. - destruct Hcf as (lp & ls & Hfc & _). - assert (Hhead : head_abort future tid). - { by rewrite Hfuture. } - destruct (first_commit_head_abort _ _ _ _ _ Hfc Hhead) as []. - - (*@ ts := txn.ts @*) - (*@ for _, gid := range(txn.ptgs) { @*) - (*@ gcoord := txn.gcoords[gid] @*) - (*@ @*) - (*@ go func() { @*) - (*@ gcoord.Abort(ts) @*) - (*@ }() @*) - (*@ } @*) - (*@ @*) - (*@ txn.reset() @*) - (*@ } @*) - Qed. - - Theorem wp_Txn__cancel txn tid rds γ τ : - {{{ own_txn txn tid rds γ τ ∗ own_wabt_tid γ tid ∗ own_txn_reserved_wrs γ tid }}} - Txn__cancel #txn - {{{ RET #(); own_txn_uninit txn γ }}}. - Proof. - iIntros (Φ) "(Htxn & Habt & Hwrsexcl) HΦ". - wp_rec. - - (*@ func (txn *Txn) cancel() { @*) - (*@ trusted_proph.ResolveAbort(txn.proph, txn.ts) @*) - (*@ @*) - do 2 iNamed "Htxn". - do 2 wp_loadField. - wp_apply (wp_ResolveAbort); first done. - iInv "Hinv" as "> HinvO" "HinvC". - iApply ncfupd_mask_intro; first set_solver. - iIntros "Hmask". - iNamed "HinvO". - iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". - iFrame "Hproph". - iIntros "(%future' & %Hfuture & Hproph)". - iMod (txnsys_inv_cancel with "Habt Hwrsexcl Htxnsys") as "Htxnsys". - { by rewrite Hfuture. } - rewrite Hfuture /=. - iDestruct (txnsys_inv_merge_future with "Hproph Htxnsys") as "Htxnsys". - iMod "Hmask" as "_". - iMod ("HinvC" with "[Htxnsys Hkeys Hgroups Hrgs]") as "_"; first by iFrame. - iIntros "!> _". - - (*@ txn.reset() @*) - (*@ } @*) - wp_apply (wp_Txn__reset with "[$Hwrs $Hptgs]"). - iIntros "[Hwrs Hptgs]". - wp_pures. - iApply "HΦ". - by iFrame "∗ # %". - Qed. - - Theorem wp_Txn__cancel_in_commit_future txn tid rds γ τ : - {{{ own_txn txn tid rds γ τ ∗ (∃ m, own_cmt_tmod γ tid m) ∗ own_txn_reserved_wrs γ tid }}} - Txn__cancel #txn - {{{ RET #(); False }}}. - Proof. - iIntros (Φ) "(Htxn & [%m Htidc] & Hwrsexcl) HΦ". - wp_rec. - - (*@ func (txn *Txn) cancel() { @*) - (*@ trusted_proph.ResolveAbort(txn.proph, txn.ts) @*) - (*@ @*) - do 2 iNamed "Htxn". - do 2 wp_loadField. - wp_apply (wp_ResolveAbort); first done. - iInv "Hinv" as "> HinvO" "HinvC". - iApply ncfupd_mask_intro; first set_solver. - iIntros "Hmask". - iNamed "HinvO". do 2 iNamed "Htxnsys". - iFrame "Hproph". - iIntros "(%future' & %Hfuture & Hproph)". - (* Obtain [tmods !! tid = Some m]. *) - iDestruct (cmt_tmod_lookup with "Htidcs Htidc") as %Htidc. - specialize (Htidcs _ _ Htidc). simpl in Htidcs. - (* Prove [resm !! tid = Some (ResCommitted m)] impossible, i.e., [tid] not committed yet. *) - destruct Htidcs as [Htmodcs | Hcmt]; last first. - { iDestruct (big_sepM_lookup with "Hvr") as "Hvc"; first apply Hcmt. - iDestruct "Hvc" as "[Hwrsrcpt _]". - (* Contradicting facts: - * 1. Txn still owns exclusively the write-set (which is true before prepare). - * Represented as [Hwrsexcl] from the precondition. - * 2. Txn has set the write-set and given up the ability to change - * (which is true after prepare). Represented as [Hwrsrcpt]. - *) - by iDestruct (txn_oneshot_wrs_agree with "Hwrsexcl Hwrsrcpt") as %Hcontra. - } - (* Obtain [first_commit]. *) - specialize (Hcf _ _ Htmodcs). simpl in Hcf. - destruct Hcf as (lp & ls & Hfc & _). - (* Obtain contradiction from [first_commit] and [head_abort]. *) - assert (Hha : head_abort future tid). - { by rewrite Hfuture /head_abort /=. } - destruct (first_commit_head_abort _ _ _ _ _ Hfc Hha). - - (*@ txn.reset() @*) - (*@ } @*) - Qed. - - Theorem wp_Txn__begin (txn : loc) γ : - ⊢ {{{ own_txn_uninit txn γ }}} - <<< ∀∀ (ts : nat), own_largest_ts γ ts >>> - Txn__begin #txn @ ↑tsNS - <<< ∃∃ (ts' : nat), own_largest_ts γ ts' ∗ ⌜(ts < ts')%nat⌝ >>> - {{{ RET #(); own_txn_init txn ts' γ }}}. - Proof. - (*@ func (txn *Txn) begin() { @*) - (*@ // TODO @*) - (*@ // Ghost action: Linearize. @*) - (*@ txn.ts = GetTS() @*) - (*@ } @*) - Admitted. - - Theorem wp_Txn__prepare txn tid rds wrs γ τ : - {{{ own_txn_stable txn tid rds wrs γ τ }}} - Txn__prepare #txn - {{{ (status : txnphase), RET #(txnphase_to_u64 status); - own_txn_prepared txn tid rds wrs γ τ ∗ safe_txnphase γ tid status - }}}. - Proof. - iIntros (Φ) "Htxn HΦ". - wp_rec. - - (*@ func (txn *Txn) prepare() uint64 { @*) - (*@ // Compute the participant groups. @*) - (*@ txn.setptgs() @*) - (*@ @*) - iNamed "Htxn". - wp_apply (wp_Txn__setptgs with "[$Hwrs $Hptgs]"). - iIntros "Hptgs". - iDestruct "Hptgs" as (ptgs) "(Hwrs & Hptgs & %Hptgs)". - - (*@ // TODO: init the group coordinator @*) - (*@ @*) - (*@ ts := txn.ts @*) - (*@ ptgs := txn.ptgs @*) - (*@ @*) - iNamed "Htxn". iNamed "Hptgs". - do 2 wp_loadField. - - (*@ // An alternative (and more elegant) design would be using a wait-groups, but @*) - (*@ // the CV approach has the advantage of early abort: If the transaction @*) - (*@ // fails to prepare on one of the participant groups (e.g., due to conflict @*) - (*@ // with another transaction), then the CV approach can "short-circuiting" to @*) - (*@ // aborting the entire transaction, whereas the WaitGroup approach would @*) - (*@ // have to wait until all groups reach their own prepare decisions. @*) - (*@ mu := new(sync.Mutex) @*) - (*@ cv := sync.NewCond(mu) @*) - (*@ var np uint64 = 0 @*) - (*@ var st uint64 = tulip.TXN_PREPARED @*) - (*@ @*) - wp_apply wp_new_free_lock. - iIntros (muP) "Hfree". - wp_apply (wp_newCond' with "Hfree"). - iIntros (cvP) "[Hfree #Hcv]". - wp_apply wp_ref_to; first by auto. - iIntros (npP) "HnpP". - wp_apply wp_ref_to; first by auto. - iIntros (stP) "HstP". - wp_pures. - (* Allocate exclusive tokens to prove freshness of response. *) - iApply fupd_wp. - iMod (local_gid_tokens_alloc (ptgroups (dom wrs))) as (α) "Htks". - iModIntro. - (* Establish the lock invariant. *) - set I := (∃ (np : u64) (st : txnphase) (gids : gset u64), - "HnpP" ∷ npP ↦[uint64T] #np ∗ - "HstP" ∷ stP ↦[uint64T] #(txnphase_to_u64 st) ∗ - "Htks" ∷ ([∗ set] gid ∈ gids, local_gid_token α gid) ∗ - "#Hst" ∷ (match st with - | TxnPrepared => [∗ set] gid ∈ gids, is_group_prepared γ gid tid - | TxnCommitted => (∃ wrs, is_txn_committed γ tid wrs) - | TxnAborted => is_txn_aborted γ tid - end) ∗ - "%Hgidsincl" ∷ ⌜gids ⊆ ptgroups (dom wrs)⌝ ∗ - "%Hsizegids" ∷ ⌜size gids = uint.nat np⌝)%I. - iApply fupd_wp. - iMod (alloc_lock tulipNS _ _ I with "Hfree [HnpP HstP]") as "#Hmu". - { iModIntro. - iExists (W64 0), TxnPrepared, ∅. - iFrame. - iSplit; first by iApply big_sepS_empty. - iSplit; first by iApply big_sepS_empty. - done. - } - iModIntro. - - (*@ // Some notes about the concurrency reasoning here: @*) - (*@ // @*) - (*@ // 1. Even though at any point the group coordinators are assigned @*) - (*@ // exclusively to @txn.ts, the fact that it is reused (for performance @*) - (*@ // reason: connection can be established only once for each @Txn object) @*) - (*@ // means that the associated timestamp is not exposed in the representation @*) - (*@ // predicate. Hence, we'll need a fractional RA to remember that the group @*) - (*@ // coordinators are assigned to @txn.ts during the course of @txn.prepare. @*) - (*@ // @*) - (*@ // 2. To establish sufficient proof that @txn.ts can finalize, we need to @*) - (*@ // maintain the following the lock invariant: @*) - (*@ // There exists a set G of group IDs: @*) - (*@ // (a) @st associated with the right txn tokens; for @st = TXN_PREPARED, in @*) - (*@ // particular, all groups in G must have prepared; @*) - (*@ // (b) size(G) = @np; @*) - (*@ // (c) exclusive tokens over G, allowing a coordinator to prove uniqueness @*) - (*@ // when adding its result, and thereby re-esbalish property (b). @*) - (*@ @*) - (*@ // Try to prepare transaction @tcoord.ts on each group. @*) - (*@ for _, gid := range(ptgs) { @*) - (*@ @*) - do 2 iNamed "Hwrs". - iDestruct "Hpwrsm" as "#Hpwrsm". - wp_loadField. - set P := (λ (i : u64), - "HpwrsmP" ∷ own_map wrsP (DfracOwn 1) pwrsmP ∗ - "Hgcoords" ∷ own_txn_gcoords txn γ ∗ - "Htks" ∷ [∗ set] gid ∈ list_to_set (drop (uint.nat i) ptgs), local_gid_token α gid)%I. - iDestruct (own_slice_small_acc with "Hptgs") as "[Hptgs HptgsC]". - iDestruct (own_slice_small_sz with "Hptgs") as %Hlenptgs. - wp_apply (wp_forSlice P with "[] [$Hptgs $HpwrsmP $Hgcoords Htks]"); last first; first 1 last. - { by rewrite uint_nat_W64_0 drop_0 Hptgs. } - { clear Φ. - - (*@ gcoord := txn.gcoords[gid] @*) - (*@ pwrs := txn.wrs[gid] @*) - (*@ @*) - iIntros (i gid Φ) "!> (HP & %Hinbound & %Hgid) HΦ". - iNamed "HP". iNamed "Hgcoords". - wp_loadField. - assert (Hin : gid ∈ gids_all). - { pose proof (subseteq_ptgroups (dom wrs)) as Hdom. - apply elem_of_list_lookup_2 in Hgid. - clear -Hdom Hgid Hptgs. - set_solver. - } - wp_apply (wp_MapGet with "Hgcoords"). - iIntros (gcoordP ok) "[%Hgetgcoords Hgcoords]". - destruct ok; last first. - { apply map_get_false in Hgetgcoords as [Hnone _]. - by rewrite -not_elem_of_dom Hdomgcoords in Hnone. - } - apply map_get_true in Hgetgcoords. - wp_apply (wp_MapGet with "HpwrsmP"). - iIntros (pwrsP ok) "[%Hgetwrs HpwrsmP]". - destruct ok; last first. - { apply map_get_false in Hgetwrs as [Hnotin _]. - by rewrite -not_elem_of_dom Hdomwrs in Hnotin. - } - apply map_get_true in Hgetwrs. - iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. - { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. - iPureIntro. - by rewrite -elem_of_dom -Hdom elem_of_dom. - } - iDestruct (big_sepM2_lookup_acc with "Hpwrsm") as "[Hpwrs HpwrsmC]"; [done | done |]. - wp_pures. - assert (Hvg : gid ∈ ptgroups (dom wrs)). - { rewrite -Hptgs elem_of_list_to_set. by apply elem_of_list_lookup_2 in Hgid. } - - (*@ go func() { @*) - (*@ @*) - iDestruct (big_sepM_lookup with "Hgcoordsabs") as "Hgcoordabs"; first apply Hgetgcoords. - rewrite (drop_S _ _ _ Hgid) list_to_set_cons big_sepS_insert; last first. - { rewrite not_elem_of_list_to_set. intros Hgidin. - clear -Hgid Hgidin Hnd. - rewrite -(take_drop_middle _ _ _ Hgid) in Hnd. - apply NoDup_app in Hnd as (_ & _ & Hnd). - by apply NoDup_cons in Hnd as [? _]. - } - iDestruct "Htks" as "[Htk Htks]". - wp_apply (wp_fork with "[Htk]"). - { (* Forked thread. *) - - (*@ stg, ok := gcoord.Prepare(ts, ptgs, pwrs) @*) - (*@ @*) - iModIntro. - wp_apply (wp_GroupCoordinator__Prepare with "Hgcoordabs"). - iIntros (stg ok) "#Hsafe". - wp_pures. - - (*@ if ok { @*) - (*@ mu.Lock() @*) - (*@ if stg == tulip.TXN_PREPARED { @*) - (*@ np += 1 @*) - (*@ } else { @*) - (*@ st = stg @*) - (*@ } @*) - (*@ mu.Unlock() @*) - (*@ cv.Signal() @*) - (*@ } @*) - (*@ @*) - destruct ok; wp_pures. - { wp_apply (wp_Mutex__Lock with "Hmu"). - iIntros "[Hlocked HI]". - iNamed "HI". - assert (Hszgids : (size gids ≤ size gids_all)%nat). - { apply subseteq_size. etrans; [apply Hgidsincl | apply subseteq_ptgroups]. } - pose proof size_gids_all as Hszgidsall. - wp_pures. - (* Prove [safe_txn_pwrs] used in invariance of PREPARE and UNPREPARE. *) - iAssert (safe_txn_pwrs γ gid tid pwrs)%I as "#Hsafepwrs". - { iFrame "Htxnwrs". - iPureIntro. - specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. - pose proof (elem_of_ptgroups_non_empty _ _ Hvg) as Hne. - rewrite -Hwrsg in Hne. - done. - } - case_bool_decide as Hstg; wp_pures. - { (* Case [TxnPrepared]. *) - wp_load. wp_store. - destruct stg; [| done | done]. - rewrite Htsword /=. - iAssert (|={⊤}=> is_group_prepared γ gid tid)%I as "Hprepared". - { iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". - { apply Hin. } - iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]". - { apply Hin. } - iDestruct "Hsafe" as "[Hqp Hqv]". - iMod (group_inv_prepare with "Hqv Hqp Hsafepwrs Htxnsys Hkeys Hrg Hgroup") - as "(Htxnsys & Hkeys & Hrg & Hgroup & #Hprepared)". - iDestruct ("HrgsC" with "Hrg") as "Hrgs". - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - done. - } - iMod "Hprepared" as "#Hprepared". - wp_apply (wp_Mutex__Unlock with "[-]"). - { iFrame "Hmu Hlocked HnpP HstP". - iModIntro. - iExists ({[gid]} ∪ gids). - iAssert (⌜gid ∉ gids⌝)%I as %Hnotin. - { iIntros (Hgidin). - iDestruct (big_sepS_elem_of with "Htks") as "Htk'"; first apply Hgidin. - by iDestruct (local_gid_token_ne with "Htk Htk'") as %?. - } - iSplitL "Htk Htks". - { iApply (big_sepS_insert_2 with "Htk Htks"). } - iSplit. - { destruct st; [| done | done]. - by iApply big_sepS_insert_2. - } - iPureIntro. - { split. - { clear -Hgidsincl Hvg. set_solver. } - { rewrite size_union; last set_solver. - rewrite size_singleton Hsizegids. - clear -Hszgids Hszgidsall Hsizegids. word. - } - } - } - by wp_apply (wp_Cond__Signal with "Hcv"). - } - { wp_store. - destruct stg eqn:Hstgeq; first done. - { (* Case [TxnCommitted]. *) - wp_apply (wp_Mutex__Unlock with "[-]"). - { iFrame "Hmu Hlocked ∗ # %". by rewrite Htsword. } - by wp_apply (wp_Cond__Signal with "Hcv"). - } - { (* Case [TxnAborted]. *) - rewrite Htsword. - iAssert (|={⊤}=> is_txn_aborted γ tid)%I as "Habted". - { iDestruct "Hsafe" as "[? | Hsafe]"; first done. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". - { apply Hin. } - iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]". - { apply Hin. } - iMod (txnsys_group_inv_unprepare with "Hsafe Hsafepwrs Hrg Hgroup Htxnsys") - as "(Hrg & Hgroup & Htxnsys & #Habted)". - iDestruct ("HrgsC" with "Hrg") as "Hrgs". - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - done. - } - iMod "Habted" as "#Habted". - wp_apply (wp_Mutex__Unlock with "[-]"). - { iFrame "Hmu Hlocked ∗ # %". } - by wp_apply (wp_Cond__Signal with "Hcv"). - } - } - } - - (*@ // @ok = false means that the group coordinator has already been @*) - (*@ // assigned to a different transaction, implying nothing is waiting @*) - (*@ // on the CV. @*) - (*@ }() @*) - (*@ } @*) - (*@ @*) - done. - } - - iApply "HΦ". - iFrame "∗ # %". - rewrite uint_nat_word_add_S; last first. - { clear -Hinbound. word. } - done. - } - - (*@ mu.Lock() @*) - (*@ // Wait until either status is no longer TXN_PREPARED or all participant @*) - (*@ // groups have responded. @*) - (*@ for st == tulip.TXN_PREPARED && np != uint64(len(ptgs)) { @*) - (*@ cv.Wait() @*) - (*@ } @*) - (*@ @*) - iIntros "[HP Hptgs]". - subst P. iNamed "HP". - wp_apply (wp_Mutex__Lock with "Hmu"). - iIntros "[Hlocked HI]". - wp_pures. - set P := (λ cont : bool, - ∃ (np : u64) (st : txnphase) (gids : gset u64), - "HnpP" ∷ npP ↦[uint64T] #np ∗ - "HstP" ∷ stP ↦[uint64T] #(txnphase_to_u64 st) ∗ - "Htks" ∷ ([∗ set] gid ∈ gids, local_gid_token α gid) ∗ - "Hlocked" ∷ locked #muP ∗ - "#Hst" ∷ (match st with - | TxnPrepared => [∗ set] gid ∈ gids, is_group_prepared γ gid tid - | TxnCommitted => (∃ wrs, is_txn_committed γ tid wrs) - | TxnAborted => is_txn_aborted γ tid - end) ∗ - "%Hgidsincl" ∷ ⌜gids ⊆ ptgroups (dom wrs)⌝ ∗ - "%Hsizegids" ∷ ⌜size gids = uint.nat np⌝ ∗ - "%Hcond" ∷ ⌜(if cont - then True - else match st with - | TxnPrepared => uint.nat np = length ptgs - | _ => True - end)⌝)%I. - wp_apply (wp_forBreak_cond P with "[] [Hlocked HI]"); last first; first 1 last. - { iNamed "HI". iFrame "∗ # %". } - { clear Φ. - iIntros (Φ) "!> HP HΦ". - iNamed "HP". - wp_load. - wp_pures. - case_bool_decide as Hprepared; wp_pures. - { wp_load. - wp_apply wp_slice_len. - wp_pures. - case_bool_decide as Hsize; wp_pures. - { iApply "HΦ". - iFrame "∗ # %". - iPureIntro. - destruct st; try done. - inv Hsize. - clear -Hlenptgs. done. - } - wp_apply (wp_Cond__Wait with "[-HΦ]"). - { by iFrame "Hcv Hmu Hlocked ∗ # %". } - iIntros "[Hlocked HI]". - wp_pures. - iApply "HΦ". - iClear "Hst". - iNamed "HI". - by iFrame "∗ # %". - } - iApply "HΦ". - iFrame "∗ # %". - iPureIntro. - by destruct st. - } - iClear "Htks". - iNamed 1. - - (*@ status := st @*) - (*@ mu.Unlock() @*) - (*@ @*) - wp_load. wp_pures. - wp_apply (wp_Mutex__Unlock with "[Hlocked HnpP HstP Htks]"). - { by iFrame "Hmu Hlocked ∗ # %". } - - (*@ return status @*) - (*@ } @*) - wp_pures. - iApply "HΦ". - iAssert (safe_txnphase γ tid st)%I as "#Hsafe". - { destruct st; [| done | done]. - simpl. - iFrame "Htxnwrs". - assert (gids = ptgroups (dom wrs)) as ->; last done. - apply set_subseteq_size_eq; first apply Hgidsincl. - rewrite -Hptgs size_list_to_set; last apply Hnd. - clear -Hsizegids Hcond. lia. - } - iDestruct ("HptgsC" with "Hptgs") as "Hptgs". - by iFrame "Hsafe ∗ # %". - Qed. - - Definition body_spec - (body : val) (txn : loc) tid r - (P : dbmap -> Prop) (Q : dbmap -> dbmap -> Prop) - (Rc : dbmap -> dbmap -> iProp Σ) (Ra : dbmap -> iProp Σ) - γ τ : iProp Σ := - ∀ Φ, - own_txn txn tid r γ τ ∗ ⌜P r⌝ ∗ txnmap_ptstos τ r -∗ - (∀ ok : bool, - (own_txn txn tid r γ τ ∗ - if ok - then ∃ w, ⌜Q r w ∧ dom r = dom w⌝ ∗ (Rc r w ∧ Ra r) ∗ txnmap_ptstos τ w - else Ra r) -∗ Φ #ok) -∗ - WP body #txn {{ v, Φ v }}. - - Theorem wp_Txn__Run - txn (body : val) - (P : dbmap -> Prop) (Q : dbmap -> dbmap -> Prop) - (Rc : dbmap -> dbmap -> iProp Σ) (Ra : dbmap -> iProp Σ) γ : - (∀ r w, (Decision (Q r w))) -> - ⊢ {{{ own_txn_uninit txn γ ∗ (∀ tid r τ, body_spec body txn tid r P Q Rc Ra γ τ) }}} - <<< ∀∀ (r : dbmap), ⌜P r ∧ dom r ⊆ keys_all⌝ ∗ own_db_ptstos γ r >>> - Txn__Run #txn body @ ↑sysNS - <<< ∃∃ (ok : bool) (w : dbmap), if ok then ⌜Q r w⌝ ∗ own_db_ptstos γ w else own_db_ptstos γ r >>> - {{{ RET #ok; own_txn_uninit txn γ ∗ if ok then Rc r w else Ra r }}}. - Proof. - iIntros (Hdec) "!>". - iIntros (Φ) "[Htxn Hbody] HAU". - wp_rec. wp_pures. - - (*@ func (txn *Txn) Run(body func(txn *Txn) bool) bool { @*) - (*@ txn.begin() @*) - (*@ @*) - iAssert (∃ p, know_tulip_inv_with_proph γ p)%I as (p) "#Hinv". - { do 2 iNamed "Htxn". iFrame "Hinv". } - wp_apply (wp_Txn__begin with "[-Hbody HAU]"). - { iFrame "∗ # %". } - iInv "Hinv" as "> HinvO" "HinvC". - iMod (ncfupd_mask_subseteq (⊤ ∖ ↑sysNS)) as "Hclose"; first solve_ndisj. - iMod "HAU" as (rds) "[[[%HP %Hdomr] Hdbpts] HAUC]". - iModIntro. - iNamed "HinvO". - iDestruct (txnsys_inv_expose_future_extract_ts with "Htxnsys") - as (future ts) "[Htxnsys Hts]". - (* Prove [key_inv] are linearizable after [ts]. *) - iDestruct (keys_inv_before_linearize with "Hkeys Hts") as "[Hkeys Hts]". - iExists ts. - (* Pass [ts_auth γ ts] to the underlying layer. *) - iFrame "Hts". - iIntros (tid) "[Hts %Htidgt]". - iDestruct (largest_ts_witness with "Hts") as "#Htidlb". - - pose proof (peek_spec future tid) as Hpeek. - set form := peek _ _ in Hpeek. - set Qr := λ m, Q rds (m ∪ rds) ∧ dom m ⊆ dom rds. - destruct (decide (incorrect_fcc Qr form)) as [Hifcc | HQ]. - { (* Case: Abort branch. *) - iMod (txnsys_inv_linearize_abort form Q with "Htidlb Hdbpts Htxnsys Hkeys") - as "(Hdbpts & Htxnsys & Hkeys & Htida & Hwrsexcl & Hclients & #HQ & #Hlnrzs & #Hlnrzed)". - { apply Hdomr. } - { apply Htidgt. } - { apply Hpeek. } - { done. } - (* Choose the will-abort branch. Use [∅] as placeholder. *) - iMod ("HAUC" $! false ∅ with "Hdbpts") as "HΦ". - iMod "Hclose" as "_". - iMod ("HinvC" with "[Hts Htxnsys Hkeys Hgroups Hrgs]") as "_". - { iNamed "Htxnsys". iFrame "∗ # %". } - (* Allocate transaction local view [txnmap_ptstos τ r]. *) - iMod (txnmap_alloc rds) as (τ) "[Htxnmap Htxnpts]". - iIntros "!> Htxn". - iAssert (own_txn txn tid rds γ τ)%I with "[Htxn Htxnmap]" as "Htxn". - { iClear "Hinv". do 2 iNamed "Htxn". - iExists _, ∅. - rewrite map_empty_union. - by iFrame "∗ # %". - } - - (*@ cmt := body(txn) @*) - (*@ @*) - wp_apply ("Hbody" with "[$Htxn $Htxnpts]"); first done. - iIntros (cmt) "[Htxn Hpts]". - - (*@ if !cmt { @*) - (*@ // This transaction has not really requested to prepare yet, so no @*) - (*@ // cleanup tasks are required. @*) - (*@ txn.cancel() @*) - (*@ return false @*) - (*@ } @*) - (*@ @*) - wp_if_destruct. - { wp_apply (wp_Txn__cancel with "[$Htxn $Htida $Hwrsexcl]"). - iIntros "Htxn". - wp_pures. - iApply "HΦ". - by iFrame. - } - - (*@ status := txn.prepare() @*) - (*@ @*) - iDestruct "Hpts" as (w) "([%HQ %Hdomw] & [_ HRa] & Hpts)". - iAssert (|={⊤}=> ∃ wrst, own_txn_stable txn tid rds wrst γ τ)%I - with "[Htxn Hwrsexcl Hpts]" as "Htxn". - { iClear "Hinv". iNamed "Htxn". - iDestruct (txnmap_subseteq with "Htxnmap Hpts") as %Hsubseteq. - unshelve epose proof (subseteq_dom_eq _ _ Hsubseteq _) as Heq. - { clear -Hincl Hdomw. set_solver. } - subst w. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iMod (txnsys_inv_preprepare with "HQ Hwrsexcl Htxnsys") as "[Htxnsys Hwrsrcpt]". - { apply Hvts. } - { apply Hvwrs. } - { done. } - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iFrame "∗ # %". - do 2 iNamed "Hwrs". - iFrame "∗ %". - rewrite -big_sepM2_fupd. - iApply (big_sepM2_mono with "Hpwrsm"). - iIntros (g r m Hr Hm) "Hm". - by iMod (own_map_persist with "Hm") as "Hm". - } - iMod "Htxn" as (wrst) "Htxn". - wp_apply (wp_Txn__prepare with "Htxn"). - iIntros (status) "[Htxn Hstatus]". - - (*@ if status == TXN_COMMITTED { @*) - (*@ // A backup coordinator must have committed this transaction, so simply @*) - (*@ // reset the write-set here. @*) - (*@ txn.reset() @*) - (*@ return true @*) - (*@ } @*) - (*@ @*) - wp_if_destruct. - { destruct status eqn:Hstatus; [done | | done]. clear Heqb. - subst status. - iDestruct "Hstatus" as (wrs) "Hcmt". - (* Obtain a contradiction from [Hcmt] and [Htida]. *) - iApply fupd_wp. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". do 2 iNamed "Htxnsys". - iDestruct (txn_res_lookup with "Hresm Hcmt") as %Hcmt. - iDestruct (wabt_tid_elem_of with "Htidas Htida") as %Hwabt. - rewrite -Htidas in Hwabt. - iDestruct (elem_of_tmodas_partitioned_tids with "Hpart") as %[_ Hnotin]. - { apply Hwabt. } - by specialize (Hnotin _ Hcmt). - } - rename Heqb into Hstatusnc. - - (*@ if status == TXN_ABORTED { @*) - (*@ // Ghost action: Abort this transaction. @*) - (*@ txn.abort() @*) - (*@ return false @*) - (*@ } @*) - (*@ @*) - wp_if_destruct. - { destruct status eqn:Hstatus; [done | done |]. clear Heqb. - subst status. - wp_apply (wp_Txn__abort with "Hstatus [$Htxn $Htida]"). - iIntros "Htxn". - wp_pures. - iApply "HΦ". - by iFrame. - } - rename Heqb into Hstatusna. - - (*@ // Ghost action: Commit this transaction. @*) - (*@ txn.commit() @*) - (*@ return true @*) - (*@ } @*) - destruct status; [| done | done]. simpl. clear Hstatusnc Hstatusna. - iDestruct "Hstatus" as (wrs) "#Hprep". - iAssert (⌜wrst = wrs⌝)%I as %->. - { iClear "Hinv". iNamed "Htxn". - iDestruct "Hprep" as "[#Hwrsrcpt _]". - by iDestruct (txn_wrs_agree with "Hwrsrcpt Htxnwrs") as %?. - } - wp_apply (wp_Txn__commit_in_abort_future with "Hlnrzed Hprep [$Htxn $Htida]"). - iIntros ([]). - } - { (* Case: Commit branch. *) - destruct form as [| | wrs | wrs]; [done | done | done |]. - apply dec_stable in HQ. simpl in Hpeek. - subst Qr. - destruct HQ as [HQ Hdomwrs]. - iMod (txnsys_inv_linearize_commit wrs Q with "Htidlb Hdbpts Htxnsys Hkeys") - as "(Hdbpts & Htxnsys & Hkeys & Htidc & Hwrsexcl & Hclients & #HQ & #Hlnrzs & #Hlnrzed)". - { apply Hdomwrs. } - { apply Hdomr. } - { apply Htidgt. } - { apply Hpeek. } - (* Choose the will-commit branch. *) - iMod ("HAUC" $! true (wrs ∪ rds) with "[$Hdbpts]") as "HΦ"; first done. - iMod "Hclose" as "_". - iMod ("HinvC" with "[Hts Htxnsys Hkeys Hgroups Hrgs]") as "_". - { iNamed "Htxnsys". iFrame "∗ # %". } - iClear "Hinv". - (* Allocate transaction local view [txnmap_ptstos τ r]. *) - iMod (txnmap_alloc rds) as (τ) "[Htxnmap Htxnpts]". - iIntros "!> Htxn". - iAssert (own_txn txn tid rds γ τ)%I with "[Htxn Htxnmap]" as "Htxn". - { do 2 iNamed "Htxn". - iExists _, ∅. - rewrite map_empty_union. - by iFrame "∗ # %". - } - - (*@ cmt := body(txn) @*) - (*@ @*) - wp_apply ("Hbody" with "[$Htxn $Htxnpts]"); first done. - iIntros (cmt) "[Htxn Hpts]". - - (*@ if !cmt { @*) - (*@ // This transaction has not really requested to prepare yet, so no @*) - (*@ // cleanup tasks are required. @*) - (*@ txn.cancel() @*) - (*@ return false @*) - (*@ } @*) - (*@ @*) - wp_if_destruct. - { wp_apply (wp_Txn__cancel_in_commit_future with "[$Htxn $Htidc $Hwrsexcl]"). - iIntros ([]). - } - - (*@ status := txn.prepare() @*) - (*@ @*) - clear HQ. - iDestruct "Hpts" as (w) "([%HQ %Hdomw] & [HRc _] & Hpts)". - iAssert (|={⊤}=> ∃ wrst, own_txn_stable txn tid rds wrst γ τ ∗ ⌜w = wrst ∪ rds⌝)%I - with "[Htxn Hwrsexcl Hpts]" as "Htxn". - { clear p. - iDestruct "Htxn" as (p wrst) "Htxn". iNamed "Htxn". - iDestruct (txnmap_subseteq with "Htxnmap Hpts") as %Hsubseteq. - unshelve epose proof (subseteq_dom_eq _ _ Hsubseteq _) as Heq. - { clear -Hincl Hdomw. set_solver. } - subst w. - iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". - iMod (txnsys_inv_preprepare with "HQ Hwrsexcl Htxnsys") as "[Htxnsys Hwrsrcpt]". - { apply Hvts. } - { apply Hvwrs. } - { done. } - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iFrame "∗ # %". - do 2 iNamed "Hwrs". - iFrame "∗ %". - iApply fupd_sep. - iSplitL; last done. - rewrite -big_sepM2_fupd. - iApply (big_sepM2_mono with "Hpwrsm"). - iIntros (g r m Hr Hm) "Hm". - by iMod (own_map_persist with "Hm") as "Hm". - } - iMod "Htxn" as (wrst) "[Htxn %Heq]". subst w. - wp_apply (wp_Txn__prepare with "Htxn"). - iIntros (status) "[Htxn Hstatus]". - - (*@ if status == TXN_COMMITTED { @*) - (*@ // A backup coordinator must have committed this transaction, so simply @*) - (*@ // reset the write-set here. @*) - (*@ txn.reset() @*) - (*@ return true @*) - (*@ } @*) - (*@ @*) - wp_if_destruct. - { destruct status eqn:Hstatus; [done | | done]. clear Heqb. - subst status. - iDestruct "Hstatus" as (wrsc) "#Hwrsc". - iNamed "Htxn". - (* Obtain [wrsc = wrs ∧ wrst = wrs]. *) - iAssert (|={⊤}=> own_cmt_tmod γ tid wrs ∗ ⌜wrsc = wrs ∧ wrst = wrs⌝)%I - with "[Htidc]" as "Htidc". - { iInv "Hinv" as "> HinvO" "HinvC". - iNamed "HinvO". do 2 iNamed "Htxnsys". - iDestruct (txn_res_lookup with "Hresm Hwrsc") as %Hwrsc. - iDestruct (elem_of_committed_partitioned_tids with "Hpart") as %[Hnotinwc Hnotinwa]. - { by eauto. } - iDestruct (cmt_tmod_lookup with "Htidcs Htidc") as %Htidc. - apply Htidcs in Htidc. - (* Prove [resm !! tid = Some (ResCommitted wrs)]. *) - destruct Htidc as [Htmodcs | Hresm]. - { by rewrite not_elem_of_dom Htmodcs in Hnotinwc. } - rewrite Hresm in Hwrsc. symmetry in Hwrsc. inv Hwrsc. - iDestruct (big_sepM_lookup with "Hvr") as "Hr"; first apply Hresm. - iDestruct "Hr" as "[Hrcp _]". - iDestruct (txn_wrs_agree with "Hrcp Htxnwrs") as %->. - iMod ("HinvC" with "[-Htidc]") as "_". - { by iFrame "∗ # %". } - by iFrame "∗ %". - } - iMod "Htidc" as "[Htidc %Heq]". - destruct Heq as [-> ->]. - iNamed "Htxn". - wp_apply (wp_Txn__reset with "[$Hwrs $Hptgs]"). - iIntros "[Hwrs Hptgs]". - wp_pures. - iApply "HΦ". - by iFrame "∗ # %". - } - rename Heqb into Hstatusnc. - - (*@ if status == TXN_ABORTED { @*) - (*@ // Ghost action: Abort this transaction. @*) - (*@ txn.abort() @*) - (*@ return false @*) - (*@ } @*) - (*@ @*) - wp_if_destruct. - { destruct status eqn:Hstatus; [done | done |]. clear Heqb. - subst status. simpl. - wp_apply (wp_Txn__abort_in_commit_future with "Hstatus [$Htxn $Htidc]"). - iIntros ([]). - } - rename Heqb into Hstatusna. - - (*@ // Ghost action: Commit this transaction. @*) - (*@ txn.commit() @*) - (*@ return true @*) - (*@ } @*) - destruct status as [| |] eqn:Hstatus; [| done | done]. - simpl. clear Hstatus Hstatusnc Hstatusna. - iDestruct "Hstatus" as (wrsc) "#Hprep". - iAssert (⌜wrsc = wrst⌝)%I as %->. - { iNamed "Htxn". - iDestruct "Hprep" as "[Hwrsrcpt _]". - by iDestruct (txn_wrs_agree with "Htxnwrs Hwrsrcpt") as %?. - } - wp_apply (wp_Txn__commit with "Hlnrzed Hprep [Htxn Htidc]"). - { iFrame "∗ #". } - iIntros "[Htxn %Heq]". subst wrst. - wp_pures. - iApply "HΦ". - by iFrame. - } - Qed. - - Theorem wp_Txn__Write txn tid key value rds γ τ : - {{{ own_txn txn tid rds γ τ ∗ (∃ vprev, txnmap_ptsto τ key vprev) }}} - Txn__Write #txn #(LitString key) #(LitString value) - {{{ RET #(); own_txn txn tid rds γ τ ∗ txnmap_ptsto τ key (Some value) }}}. - Proof. - iIntros (Φ) "[Htxn [%v Hpt]] HΦ". - wp_rec. - - (*@ func (txn *Txn) Write(key string, value string) { @*) - (*@ v := tulip.Value{ @*) - (*@ Present : true, @*) - (*@ Content : value, @*) - (*@ } @*) - (*@ txn.setwrs(key, v) @*) - (*@ } @*) - iNamed "Htxn". - wp_pures. - wp_apply (wp_Txn__setwrs _ _ (Some value) with "Hwrs"). - iIntros "Hwrs". - wp_pures. - iApply "HΦ". - iDestruct (txnmap_lookup with "Htxnmap Hpt") as %Hlookup. - apply elem_of_dom_2 in Hlookup. - iMod (txnmap_update (Some value) with "Htxnmap Hpt") as "[Htxnmap Hpt]". - rewrite insert_union_l. - iFrame "∗ # %". - iPureIntro. - rewrite /valid_wrs dom_insert_L. - set_solver. - Qed. - - Theorem wp_Txn__Delete txn tid key rds γ τ : - {{{ own_txn txn tid rds γ τ ∗ (∃ vprev, txnmap_ptsto τ key vprev) }}} - Txn__Delete #txn #(LitString key) - {{{ RET #(); own_txn txn tid rds γ τ ∗ txnmap_ptsto τ key None }}}. - Proof. - iIntros (Φ) "[Htxn [%v Hpt]] HΦ". - wp_rec. - - (*@ func (txn *Txn) Delete(key string) { @*) - (*@ v := tulip.Value{ @*) - (*@ Present : false, @*) - (*@ } @*) - (*@ txn.setwrs(key, v) @*) - (*@ } @*) - iNamed "Htxn". - wp_pures. - wp_apply (wp_Txn__setwrs _ _ None with "Hwrs"). - iIntros "Hwrs". - wp_pures. - iApply "HΦ". - iDestruct (txnmap_lookup with "Htxnmap Hpt") as %Hlookup. - apply elem_of_dom_2 in Hlookup. - iMod (txnmap_update None with "Htxnmap Hpt") as "[Htxnmap Hpt]". - rewrite insert_union_l. - iFrame "∗ # %". - iPureIntro. - rewrite /valid_wrs dom_insert_L. - set_solver. - Qed. - - Theorem wp_Txn__Read txn tid key value rds γ τ : - {{{ own_txn txn tid rds γ τ ∗ txnmap_ptsto τ key value }}} - Txn__Read #txn #(LitString key) - {{{ (ok : bool), RET (dbval_to_val (if ok then value else None), #ok); - own_txn txn tid rds γ τ ∗ txnmap_ptsto τ key value - }}}. - Proof. - iIntros (Φ) "[Htxn Hpt] HΦ". - wp_rec. - - (*@ func (txn *Txn) Read(key string) (tulip.Value, bool) { @*) - (*@ vlocal, hit := txn.getwrs(key) @*) - (*@ if hit { @*) - (*@ return vlocal, true @*) - (*@ } @*) - (*@ @*) - iNamed "Htxn". - wp_apply (wp_Txn__getwrs with "Hwrs"). - iIntros (vlocal ok) "[Hwrs %Hv]". - iDestruct (txnmap_lookup with "Htxnmap Hpt") as %Hvalue. - wp_if_destruct. - { (* Prove [vlocal = value]. *) - apply (lookup_union_Some_l _ rds) in Hv. - rewrite Hv in Hvalue. - inv Hvalue. - wp_pures. - iApply ("HΦ" $! true). - by iFrame "∗ # %". - } - clear Heqb ok. - - (*@ gid := KeyToGroup(key) @*) - (*@ gcoord := txn.gcoords[gid] @*) - (*@ v, ok := gcoord.Read(txn.ts, key) @*) - (*@ @*) - wp_apply wp_KeyToGroup. - iIntros (gid Hgid). - iNamed "Hgcoords". - wp_loadField. - wp_apply (wp_MapGet with "Hgcoords"). - iIntros (gcoord ok) "[%Hget Hgcoords]". - destruct ok; last first. - { apply map_get_false in Hget as [Hget _]. - rewrite -not_elem_of_dom Hdomgcoords -Hgid in Hget. - by pose proof (elem_of_key_to_group key). - } - apply map_get_true in Hget. - iDestruct (big_sepM_lookup with "Hgcoordsabs") as "Hgcoordabs"; first apply Hget. - iNamed "Htxn". - wp_loadField. - wp_apply (wp_GroupCoordinator__Read with "Hgcoordabs"). - iIntros (v ok) "#Hread". - wp_pures. - - (*@ if !ok { @*) - (*@ return tulip.Value{}, false @*) - (*@ } @*) - (*@ @*) - destruct ok; wp_pures; last first. - { iApply ("HΦ" $! false). - iAssert (own_txn_gcoords txn γ)%I with "[$HgcoordsP $Hgcoords]" as "Hgcoords". - { by iFrame "# %". } - by iFrame "∗ # %". - } - rewrite Htsword. - - (*@ trusted_proph.ResolveRead(txn.proph, txn.ts, key) @*) - (*@ @*) - rewrite lookup_union_r in Hvalue; last apply Hv. - iDestruct (big_sepM_lookup with "Hlnrz") as "Hhistl"; first apply Hvalue. - do 2 wp_loadField. - wp_apply wp_ResolveRead; first done. - iInv "Hinv" as "> HinvO" "HinvC". - iApply ncfupd_mask_intro; first set_solver. - iIntros "Hmask". - iNamed "HinvO". - iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". - iFrame "Hproph". - iIntros "(%future' & %Hfuture & Hproph)". - pose proof (elem_of_key_to_group key) as Hin. - iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". - { apply Hin. } - iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]". - { apply Hin. } - iDestruct (big_sepS_elem_of_acc _ _ key with "Hkeys") as "[Hkey HkeysC]". - { apply elem_of_dom_2 in Hvalue. set_solver. } - iMod (txnsys_inv_read with "Hread Hhistl Htxnsys Hgroup Hrg Hkey") - as "(Htxnsys & Hgroup & Hrg & Hkey & %Heq)". - { rewrite /valid_ts in Hvts. lia. } - { by rewrite Hfuture. } - iDestruct ("HrgsC" with "Hrg") as "Hrgs". - iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". - iDestruct ("HkeysC" with "Hkey") as "Hkeys". - rewrite Hfuture /=. - iDestruct (txnsys_inv_merge_future with "Hproph Htxnsys") as "Htxnsys". - iMod "Hmask" as "_". - iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". - iIntros "!> _". - wp_pures. - subst value. - - (*@ return v, true @*) - (*@ } @*) - iApply ("HΦ" $! true). - iAssert (own_txn_gcoords txn γ)%I with "[$HgcoordsP $Hgcoords]" as "Hgcoords". - { by iFrame "# %". } - by iFrame "∗ # %". - Qed. - -End program. diff --git a/src/program_proof/tulip/program/txn/txn_abort.v b/src/program_proof/tulip/program/txn/txn_abort.v new file mode 100644 index 000000000..72c2eaf69 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_abort.v @@ -0,0 +1,144 @@ +From Perennial.program_proof.tulip.invariance Require Import abort. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr proph txn_reset. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_abort. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__abort txn tid rds wrs γ τ : + is_txn_aborted γ tid -∗ + {{{ own_txn_prepared txn tid rds wrs γ τ ∗ own_wabt_tid γ tid }}} + Txn__abort #txn + {{{ RET #(); own_txn_uninit txn γ }}}. + Proof. + iIntros "#Habt" (Φ) "!> [Htxn Hwabt] HΦ". + wp_rec. + + (*@ func (txn *Txn) abort() { @*) + (*@ trusted_proph.ResolveAbort(txn.proph, txn.ts) @*) + (*@ @*) + do 2 iNamed "Htxn". + do 2 wp_loadField. + wp_apply (wp_ResolveAbort); first done. + iInv "Hinv" as "> HinvO" "HinvC". + iApply ncfupd_mask_intro; first set_solver. + iIntros "Hmask". + iNamed "HinvO". + iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". + iFrame "Hproph". + iIntros "(%future' & %Hfuture & Hproph)". + iMod (txnsys_inv_abort with "Habt Hwabt Htxnsys") as "Htxnsys". + { by rewrite Hfuture. } + rewrite Hfuture /=. + iDestruct (txnsys_inv_merge_future with "Hproph Htxnsys") as "Htxnsys". + iMod "Hmask" as "_". + iMod ("HinvC" with "[Htxnsys Hkeys Hgroups Hrgs]") as "_"; first by iFrame. + iIntros "!> _". + wp_pures. + + (*@ ts := txn.ts @*) + (*@ for _, gid := range(txn.ptgs) { @*) + (*@ @*) + iNamed "Hptgs". + do 2 wp_loadField. + set P := (λ (_ : u64), own_txn_gcoords txn γ)%I. + iDestruct (own_slice_small_acc with "Hptgs") as "[Hptgs HptgsC]". + wp_apply (wp_forSlice P with "[] [$Hptgs $Hgcoords]"). + { (* Loop body. *) + clear Φ. + + (*@ gcoord := txn.gcoords[gid] @*) + (*@ @*) + iIntros (i gid Φ) "!> (Hgcoords & %Hinbound & %Hgid) HΦ". + iNamed "Hgcoords". + wp_loadField. + assert (Hin : gid ∈ gids_all). + { pose proof (subseteq_ptgroups (dom wrs)) as Hdom. + apply elem_of_list_lookup_2 in Hgid. + clear -Hdom Hgid Hptgs. + set_solver. + } + wp_apply (wp_MapGet with "Hgcoords"). + iIntros (gcoordP ok) "[%Hgetgcoords Hgcoords]". + destruct ok; last first. + { apply map_get_false in Hgetgcoords as [Hnone _]. + by rewrite -not_elem_of_dom Hdomgcoords in Hnone. + } + apply map_get_true in Hgetgcoords. + + (*@ go func() { @*) + (*@ gcoord.Abort(ts) @*) + (*@ }() @*) + (*@ } @*) + (*@ @*) + wp_pures. + iDestruct (big_sepM_lookup with "Hgcoordsabs") as "Hgcoordabs"; first apply Hgetgcoords. + wp_apply wp_fork. + { wp_apply (wp_GroupCoordinator__Abort with "[] Hgcoordabs"). + { rewrite Htsword. by iFrame "Habt". } + done. + } + iApply "HΦ". + iFrame "∗ # %". + } + iIntros "[Hgcoods Hptgs]". subst P. simpl. + iDestruct ("HptgsC" with "Hptgs") as "Hptgs". + iAssert (own_txn_ptgs txn ptgs)%I with "[$HptgsS $Hptgs]" as "Hptgs"; first done. + + (*@ txn.reset() @*) + (*@ } @*) + wp_apply (wp_Txn__reset with "[$Hwrs $Hptgs]"). + iIntros "[Hwrs Hptgs]". + wp_pures. + iApply "HΦ". + by iFrame "∗ # %". + Qed. + + Theorem wp_Txn__abort_in_commit_future txn tid rds wrsphys wrsproph γ τ : + is_txn_aborted γ tid -∗ + {{{ own_txn_prepared txn tid rds wrsphys γ τ ∗ own_cmt_tmod γ tid wrsproph }}} + Txn__abort #txn + {{{ RET #(); False }}}. + Proof. + iIntros "#Habt" (Φ) "!> [Htxn Htidc] HΦ". + wp_rec. + + (*@ func (txn *Txn) abort() { @*) + (*@ trusted_proph.ResolveAbort(txn.proph, txn.ts) @*) + (*@ @*) + do 2 iNamed "Htxn". + do 2 wp_loadField. + wp_apply (wp_ResolveAbort); first done. + iInv "Hinv" as "> HinvO" "HinvC". + iApply ncfupd_mask_intro; first set_solver. + iIntros "Hmask". + iNamed "HinvO". do 2 iNamed "Htxnsys". + iFrame "Hproph". + iIntros "(%future' & %Hfuture & Hproph)". + (* Prove [tid] must not have committed. *) + iDestruct (txn_res_lookup with "Hresm Habt") as %Habt. + iDestruct (cmt_tmod_lookup with "Htidcs Htidc") as %Htidc. + specialize (Htidcs _ _ Htidc). simpl in Htidcs. + destruct Htidcs as [Hwc | Hcmt]; last first. + { by rewrite Hcmt in Habt. } + specialize (Hcf _ _ Hwc). simpl in Hcf. + destruct Hcf as (lp & ls & Hfc & _). + assert (Hhead : head_abort future tid). + { by rewrite Hfuture. } + destruct (first_commit_head_abort _ _ _ _ _ Hfc Hhead) as []. + + (*@ ts := txn.ts @*) + (*@ for _, gid := range(txn.ptgs) { @*) + (*@ gcoord := txn.gcoords[gid] @*) + (*@ @*) + (*@ go func() { @*) + (*@ gcoord.Abort(ts) @*) + (*@ }() @*) + (*@ } @*) + (*@ @*) + (*@ txn.reset() @*) + (*@ } @*) + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_begin.v b/src/program_proof/tulip/program/txn/txn_begin.v new file mode 100644 index 000000000..412d41227 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_begin.v @@ -0,0 +1,21 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__begin (txn : loc) γ : + ⊢ {{{ own_txn_uninit txn γ }}} + <<< ∀∀ (ts : nat), own_largest_ts γ ts >>> + Txn__begin #txn @ ↑tsNS + <<< ∃∃ (ts' : nat), own_largest_ts γ ts' ∗ ⌜(ts < ts')%nat⌝ >>> + {{{ RET #(); own_txn_init txn ts' γ }}}. + Proof. + (*@ func (txn *Txn) begin() { @*) + (*@ // TODO @*) + (*@ // Ghost action: Linearize. @*) + (*@ txn.ts = GetTS() @*) + (*@ } @*) + Admitted. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_cancel.v b/src/program_proof/tulip/program/txn/txn_cancel.v new file mode 100644 index 000000000..cc070014f --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_cancel.v @@ -0,0 +1,93 @@ +From Perennial.program_proof.tulip.invariance Require Import cancel. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr proph txn_reset. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__cancel txn tid rds γ τ : + {{{ own_txn txn tid rds γ τ ∗ own_wabt_tid γ tid ∗ own_txn_reserved_wrs γ tid }}} + Txn__cancel #txn + {{{ RET #(); own_txn_uninit txn γ }}}. + Proof. + iIntros (Φ) "(Htxn & Habt & Hwrsexcl) HΦ". + wp_rec. + + (*@ func (txn *Txn) cancel() { @*) + (*@ trusted_proph.ResolveAbort(txn.proph, txn.ts) @*) + (*@ @*) + do 2 iNamed "Htxn". + do 2 wp_loadField. + wp_apply (wp_ResolveAbort); first done. + iInv "Hinv" as "> HinvO" "HinvC". + iApply ncfupd_mask_intro; first set_solver. + iIntros "Hmask". + iNamed "HinvO". + iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". + iFrame "Hproph". + iIntros "(%future' & %Hfuture & Hproph)". + iMod (txnsys_inv_cancel with "Habt Hwrsexcl Htxnsys") as "Htxnsys". + { by rewrite Hfuture. } + rewrite Hfuture /=. + iDestruct (txnsys_inv_merge_future with "Hproph Htxnsys") as "Htxnsys". + iMod "Hmask" as "_". + iMod ("HinvC" with "[Htxnsys Hkeys Hgroups Hrgs]") as "_"; first by iFrame. + iIntros "!> _". + + (*@ txn.reset() @*) + (*@ } @*) + wp_apply (wp_Txn__reset with "[$Hwrs $Hptgs]"). + iIntros "[Hwrs Hptgs]". + wp_pures. + iApply "HΦ". + by iFrame "∗ # %". + Qed. + + Theorem wp_Txn__cancel_in_commit_future txn tid rds γ τ : + {{{ own_txn txn tid rds γ τ ∗ (∃ m, own_cmt_tmod γ tid m) ∗ own_txn_reserved_wrs γ tid }}} + Txn__cancel #txn + {{{ RET #(); False }}}. + Proof. + iIntros (Φ) "(Htxn & [%m Htidc] & Hwrsexcl) HΦ". + wp_rec. + + (*@ func (txn *Txn) cancel() { @*) + (*@ trusted_proph.ResolveAbort(txn.proph, txn.ts) @*) + (*@ @*) + do 2 iNamed "Htxn". + do 2 wp_loadField. + wp_apply (wp_ResolveAbort); first done. + iInv "Hinv" as "> HinvO" "HinvC". + iApply ncfupd_mask_intro; first set_solver. + iIntros "Hmask". + iNamed "HinvO". do 2 iNamed "Htxnsys". + iFrame "Hproph". + iIntros "(%future' & %Hfuture & Hproph)". + (* Obtain [tmods !! tid = Some m]. *) + iDestruct (cmt_tmod_lookup with "Htidcs Htidc") as %Htidc. + specialize (Htidcs _ _ Htidc). simpl in Htidcs. + (* Prove [resm !! tid = Some (ResCommitted m)] impossible, i.e., [tid] not committed yet. *) + destruct Htidcs as [Htmodcs | Hcmt]; last first. + { iDestruct (big_sepM_lookup with "Hvr") as "Hvc"; first apply Hcmt. + iDestruct "Hvc" as "[Hwrsrcpt _]". + (* Contradicting facts: + * 1. Txn still owns exclusively the write-set (which is true before prepare). + * Represented as [Hwrsexcl] from the precondition. + * 2. Txn has set the write-set and given up the ability to change + * (which is true after prepare). Represented as [Hwrsrcpt]. + *) + by iDestruct (txn_oneshot_wrs_agree with "Hwrsexcl Hwrsrcpt") as %Hcontra. + } + (* Obtain [first_commit]. *) + specialize (Hcf _ _ Htmodcs). simpl in Hcf. + destruct Hcf as (lp & ls & Hfc & _). + (* Obtain contradiction from [first_commit] and [head_abort]. *) + assert (Hha : head_abort future tid). + { by rewrite Hfuture /head_abort /=. } + destruct (first_commit_head_abort _ _ _ _ _ Hfc Hha). + + (*@ txn.reset() @*) + (*@ } @*) + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_commit.v b/src/program_proof/tulip/program/txn/txn_commit.v new file mode 100644 index 000000000..6ea0d2bbd --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_commit.v @@ -0,0 +1,193 @@ +From Perennial.program_proof.tulip.invariance Require Import commit. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr proph txn_reset. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_commit. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__commit txn tid rds wrsphys wrsproph γ τ : + is_lnrz_tid γ tid -∗ + all_prepared γ tid wrsphys -∗ + {{{ own_txn_prepared txn tid rds wrsphys γ τ ∗ own_cmt_tmod γ tid wrsproph }}} + Txn__commit #txn + {{{ RET #(); own_txn_uninit txn γ ∗ ⌜wrsphys = wrsproph⌝ }}}. + Proof. + iIntros "#Hlnrzed #Hprep" (Φ) "!> [Htxn Htidc] HΦ". + wp_rec. + + (*@ func (txn *Txn) commit() { @*) + (*@ ResolveCommit(txn.proph, txn.ts, txn.wrs) @*) + (*@ @*) + do 2 iNamed "Htxn". iNamed "Hwrs". + do 3 wp_loadField. + wp_apply (wp_ResolveCommit with "[$Hwrsp]"); first done. + iInv "Hinv" as "> HinvO" "HinvC". + iApply ncfupd_mask_intro; first set_solver. + iIntros "Hmask". + iNamed "HinvO". + iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". + iFrame "Hproph". + iIntros "(%future' & %Hfuture & Hproph)". + iMod (txnsys_inv_commit with "Hlnrzed Hprep Htxnsys Hgroups Hrgs Hkeys") + as "(Htxnsys & Hgroups & Hrgs & Hkeys & #Hcmt)". + { by rewrite Hfuture. } + iAssert (⌜wrsphys = wrsproph⌝)%I as %Heq. + { do 2 iNamed "Htxnsys". + iDestruct (txn_res_lookup with "Hresm Hcmt") as %Hwrsc. + iDestruct (elem_of_committed_partitioned_tids with "Hpart") as %[Hnotinwc Hnotinwa]. + { by eauto. } + iDestruct (cmt_tmod_lookup with "Htidcs Htidc") as %Htidc. + specialize (Htidcs _ _ Htidc). simpl in Htidcs. + (* Prove [resm !! tid = Some (ResCommitted wrs)]. *) + destruct Htidcs as [Htmodcs | Hresm]. + { by rewrite not_elem_of_dom Htmodcs in Hnotinwc. } + rewrite Hresm in Hwrsc. symmetry in Hwrsc. inv Hwrsc. + done. + } + (* Close the invariant. *) + rewrite Hfuture /=. + iDestruct (txnsys_inv_merge_future with "Hproph Htxnsys") as "Htxnsys". + iMod "Hmask" as "_". + iMod ("HinvC" with "[Htxnsys Hkeys Hgroups Hrgs]") as "_"; first by iFrame. + iIntros "!> Hwrsp". + wp_pures. + do 2 wp_loadField. + + (*@ ts := txn.ts @*) + (*@ for _, gid := range(txn.ptgs) { @*) + (*@ @*) + iNamed "Hptgs". iNamed "Hwrs". + iDestruct "Hpwrsm" as "#Hpwrsm". + wp_loadField. + set P := (λ (_ : u64), + "HpwrsmP" ∷ own_map wrsP (DfracOwn 1) pwrsmP ∗ + "Hgcoords" ∷ own_txn_gcoords txn γ)%I. + iDestruct (own_slice_small_acc with "Hptgs") as "[Hptgs HptgsC]". + wp_apply (wp_forSlice P with "[] [$Hptgs $HpwrsmP $Hgcoords]"). + { (* Loop body. *) + clear Φ. + + (*@ gcoord := txn.gcoords[gid] @*) + (*@ pwrs := txn.wrs[gid] @*) + (*@ @*) + iIntros (i gid Φ) "!> (HP & %Hinbound & %Hgid) HΦ". + iNamed "HP". iNamed "Hgcoords". + wp_loadField. + assert (Hin : gid ∈ gids_all). + { pose proof (subseteq_ptgroups (dom wrsphys)) as Hdom. + apply elem_of_list_lookup_2 in Hgid. + clear -Hdom Hgid Hptgs. + set_solver. + } + wp_apply (wp_MapGet with "Hgcoords"). + iIntros (gcoordP ok) "[%Hgetgcoords Hgcoords]". + destruct ok; last first. + { apply map_get_false in Hgetgcoords as [Hnone _]. + by rewrite -not_elem_of_dom Hdomgcoords in Hnone. + } + apply map_get_true in Hgetgcoords. + wp_apply (wp_MapGet with "HpwrsmP"). + iIntros (pwrsP ok) "[%Hgetwrs HpwrsmP]". + destruct ok; last first. + { apply map_get_false in Hgetwrs as [Hnotin _]. + by rewrite -not_elem_of_dom Hdomwrs in Hnotin. + } + apply map_get_true in Hgetwrs. + iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. + { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. + iPureIntro. + by rewrite -elem_of_dom -Hdom elem_of_dom. + } + iDestruct (big_sepM2_lookup_acc with "Hpwrsm") as "[Hpwrs HpwrsmC]"; [done | done |]. + + (*@ go func() { @*) + (*@ gcoord.Commit(ts, pwrs) @*) + (*@ }() @*) + (*@ } @*) + (*@ @*) + wp_pures. + iDestruct (big_sepM_lookup with "Hgcoordsabs") as "Hgcoordabs"; first apply Hgetgcoords. + wp_apply wp_fork. + { wp_apply (wp_GroupCoordinator__Commit with "[] Hgcoordabs Hpwrs"). + { rewrite Htsword. + iFrame "Hcmt Htxnwrs". + iPureIntro. + assert (Hinptgs : gid ∈ ptgroups (dom wrsphys)). + { rewrite -Hptgs elem_of_list_to_set elem_of_list_lookup. by eauto. } + specialize (Hwrsg _ _ Hpwrs). + done. + } + by iIntros "_". + } + iApply "HΦ". + iFrame "∗ # %". + } + iIntros "[HP Hptgs]". + iNamed "HP". clear P. + iDestruct ("HptgsC" with "Hptgs") as "Hptgs". + iAssert (own_txn_ptgs txn ptgs)%I with "[$HptgsS $Hptgs]" as "Hptgs"; first done. + + (*@ txn.reset() @*) + (*@ } @*) + iAssert (own_txn_wrs txn DfracDiscarded wrsphys)%I + with "[$HwrsP $HwrspP $Hwrsp $HpwrsmP]" as "Hwrs". + { iFrame "# %". } + wp_apply (wp_Txn__reset with "[$Hwrs $Hptgs]"). + iIntros "[Hwrs Hptgs]". + wp_pures. + iApply "HΦ". + by iFrame "∗ # %". + Qed. + + Theorem wp_Txn__commit_in_abort_future txn tid rds wrs γ τ : + is_lnrz_tid γ tid -∗ + all_prepared γ tid wrs -∗ + {{{ own_txn_prepared txn tid rds wrs γ τ ∗ own_wabt_tid γ tid }}} + Txn__commit #txn + {{{ RET #(); False }}}. + Proof. + iIntros "#Hlnrzed #Hprep" (Φ) "!> [Htxn Hwabt] HΦ". + wp_rec. + + (*@ func (txn *Txn) commit() { @*) + (*@ trusted_proph.ResolveCommit(txn.proph, txn.ts, txn.wrsp) @*) + (*@ @*) + do 2 iNamed "Htxn". iNamed "Hwrs". + do 3 wp_loadField. + wp_apply (wp_ResolveCommit with "[$Hwrsp]"); first done. + iInv "Hinv" as "> HinvO" "HinvC". + iApply ncfupd_mask_intro; first set_solver. + iIntros "Hmask". + iNamed "HinvO". + iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". + iFrame "Hproph". + iIntros "(%future' & %Hfuture & Hproph)". + iMod (txnsys_inv_commit with "Hlnrzed Hprep Htxnsys Hgroups Hrgs Hkeys") + as "(Htxnsys & Hgroups & Hrgs & Hkeys & Hcmt)". + { by rewrite Hfuture. } + (* Obtain contradiction. *) + do 2 iNamed "Htxnsys". + iDestruct (txn_res_lookup with "Hresm Hcmt") as %Hcmt. + iDestruct (wabt_tid_elem_of with "Htidas Hwabt") as %Hwabt. + rewrite -Htidas in Hwabt. + iDestruct (elem_of_tmodas_partitioned_tids with "Hpart") as %[_ Hnotin]. + { apply Hwabt. } + by specialize (Hnotin _ Hcmt). + + (*@ ts := txn.ts @*) + (*@ wrs := txn.wrs @*) + (*@ for _, gid := range(txn.ptgs) { @*) + (*@ gcoord := txn.gcoords[gid] @*) + (*@ pwrs := wrs[gid] @*) + (*@ @*) + (*@ go func() { @*) + (*@ gcoord.Commit(ts, pwrs) @*) + (*@ }() @*) + (*@ } @*) + (*@ @*) + (*@ txn.reset() @*) + (*@ } @*) + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_delete.v b/src/program_proof/tulip/program/txn/txn_delete.v new file mode 100644 index 000000000..fd79dd91c --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_delete.v @@ -0,0 +1,37 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import res txn_repr txn_setwrs. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__Delete txn tid key rds γ τ : + {{{ own_txn txn tid rds γ τ ∗ (∃ vprev, txnmap_ptsto τ key vprev) }}} + Txn__Delete #txn #(LitString key) + {{{ RET #(); own_txn txn tid rds γ τ ∗ txnmap_ptsto τ key None }}}. + Proof. + iIntros (Φ) "[Htxn [%v Hpt]] HΦ". + wp_rec. + + (*@ func (txn *Txn) Delete(key string) { @*) + (*@ v := tulip.Value{ @*) + (*@ Present : false, @*) + (*@ } @*) + (*@ txn.setwrs(key, v) @*) + (*@ } @*) + iNamed "Htxn". + wp_pures. + wp_apply (wp_Txn__setwrs _ _ None with "Hwrs"). + iIntros "Hwrs". + wp_pures. + iApply "HΦ". + iDestruct (txnmap_lookup with "Htxnmap Hpt") as %Hlookup. + apply elem_of_dom_2 in Hlookup. + iMod (txnmap_update None with "Htxnmap Hpt") as "[Htxnmap Hpt]". + rewrite insert_union_l. + iFrame "∗ # %". + iPureIntro. + rewrite /valid_wrs dom_insert_L. + set_solver. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_getwrs.v b/src/program_proof/tulip/program/txn/txn_getwrs.v new file mode 100644 index 000000000..38d08a8f3 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_getwrs.v @@ -0,0 +1,61 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr key_to_group. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__getwrs (txn : loc) (key : string) q wrs : + {{{ own_txn_wrs txn q wrs }}} + Txn__getwrs #txn #(LitString key) + {{{ (v : dbval) (ok : bool), RET (dbval_to_val v, #ok); + own_txn_wrs txn q wrs ∗ ⌜wrs !! key = if ok then Some v else None⌝ + }}}. + Proof. + iIntros (Φ) "Hwrs HΦ". + wp_rec. + + (*@ func (txn *Txn) getwrs(key string) (Value, bool) { @*) + (*@ gid := KeyToGroup(key) @*) + (*@ pwrs := txn.wrs[gid] @*) + (*@ @*) + wp_apply wp_KeyToGroup. + iIntros (gid Hgid). + do 2 iNamed "Hwrs". + wp_loadField. + wp_apply (wp_MapGet with "HpwrsmP"). + iIntros (pwrsP ok) "[%Hget HpwrsmP]". + destruct ok; last first. + { apply map_get_false in Hget as [Hget _]. + rewrite -not_elem_of_dom Hdomwrs -Hgid in Hget. + by pose proof (elem_of_key_to_group key). + } + apply map_get_true in Hget. + iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. + { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. + iPureIntro. + by rewrite -elem_of_dom -Hdom elem_of_dom. + } + iDestruct (big_sepM2_lookup_acc with "Hpwrsm") as "[Hpwrs HpwrsmC]"; [done | done |]. + + (*@ v, ok := pwrs[key] @*) + (*@ return v, ok @*) + (*@ } @*) + wp_apply (wp_MapGet with "Hpwrs"). + iIntros (v ok) "[%Hv Hpwrs]". + wp_pures. + iApply "HΦ". + iDestruct ("HpwrsmC" with "Hpwrs") as "Hpwrsm". + iFrame "∗ # %". + iPureIntro. + specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. + rewrite Hwrsg in Hv. + destruct ok. + - apply map_get_true in Hv. + rewrite lookup_wrs_group_Some in Hv. + by destruct Hv as [Hv _]. + - apply map_get_false in Hv as [Hv _]. + rewrite lookup_wrs_group_None in Hv. + by destruct Hv. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_prepare.v b/src/program_proof/tulip/program/txn/txn_prepare.v new file mode 100644 index 000000000..440c877e2 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_prepare.v @@ -0,0 +1,388 @@ +From Perennial.program_proof.tulip.invariance Require Import prepare unprepare. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import res txn_repr txn_setptgs. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_prepare. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__prepare txn tid rds wrs γ τ : + {{{ own_txn_stable txn tid rds wrs γ τ }}} + Txn__prepare #txn + {{{ (status : txnphase), RET #(txnphase_to_u64 status); + own_txn_prepared txn tid rds wrs γ τ ∗ safe_txnphase γ tid status + }}}. + Proof. + iIntros (Φ) "Htxn HΦ". + wp_rec. + + (*@ func (txn *Txn) prepare() uint64 { @*) + (*@ // Compute the participant groups. @*) + (*@ txn.setptgs() @*) + (*@ @*) + iNamed "Htxn". + wp_apply (wp_Txn__setptgs with "[$Hwrs $Hptgs]"). + iIntros "Hptgs". + iDestruct "Hptgs" as (ptgs) "(Hwrs & Hptgs & %Hptgs)". + + (*@ // TODO: init the group coordinator @*) + (*@ @*) + (*@ ts := txn.ts @*) + (*@ ptgs := txn.ptgs @*) + (*@ @*) + iNamed "Htxn". iNamed "Hptgs". + do 2 wp_loadField. + + (*@ // An alternative (and more elegant) design would be using a wait-groups, but @*) + (*@ // the CV approach has the advantage of early abort: If the transaction @*) + (*@ // fails to prepare on one of the participant groups (e.g., due to conflict @*) + (*@ // with another transaction), then the CV approach can "short-circuiting" to @*) + (*@ // aborting the entire transaction, whereas the WaitGroup approach would @*) + (*@ // have to wait until all groups reach their own prepare decisions. @*) + (*@ mu := new(sync.Mutex) @*) + (*@ cv := sync.NewCond(mu) @*) + (*@ var np uint64 = 0 @*) + (*@ var st uint64 = tulip.TXN_PREPARED @*) + (*@ @*) + wp_apply wp_new_free_lock. + iIntros (muP) "Hfree". + wp_apply (wp_newCond' with "Hfree"). + iIntros (cvP) "[Hfree #Hcv]". + wp_apply wp_ref_to; first by auto. + iIntros (npP) "HnpP". + wp_apply wp_ref_to; first by auto. + iIntros (stP) "HstP". + wp_pures. + (* Allocate exclusive tokens to prove freshness of response. *) + iApply fupd_wp. + iMod (local_gid_tokens_alloc (ptgroups (dom wrs))) as (α) "Htks". + iModIntro. + (* Establish the lock invariant. *) + set I := (∃ (np : u64) (st : txnphase) (gids : gset u64), + "HnpP" ∷ npP ↦[uint64T] #np ∗ + "HstP" ∷ stP ↦[uint64T] #(txnphase_to_u64 st) ∗ + "Htks" ∷ ([∗ set] gid ∈ gids, local_gid_token α gid) ∗ + "#Hst" ∷ (match st with + | TxnPrepared => [∗ set] gid ∈ gids, is_group_prepared γ gid tid + | TxnCommitted => (∃ wrs, is_txn_committed γ tid wrs) + | TxnAborted => is_txn_aborted γ tid + end) ∗ + "%Hgidsincl" ∷ ⌜gids ⊆ ptgroups (dom wrs)⌝ ∗ + "%Hsizegids" ∷ ⌜size gids = uint.nat np⌝)%I. + iApply fupd_wp. + iMod (alloc_lock tulipNS _ _ I with "Hfree [HnpP HstP]") as "#Hmu". + { iModIntro. + iExists (W64 0), TxnPrepared, ∅. + iFrame. + iSplit; first by iApply big_sepS_empty. + iSplit; first by iApply big_sepS_empty. + done. + } + iModIntro. + + (*@ // Some notes about the concurrency reasoning here: @*) + (*@ // @*) + (*@ // 1. Even though at any point the group coordinators are assigned @*) + (*@ // exclusively to @txn.ts, the fact that it is reused (for performance @*) + (*@ // reason: connection can be established only once for each @Txn object) @*) + (*@ // means that the associated timestamp is not exposed in the representation @*) + (*@ // predicate. Hence, we'll need a fractional RA to remember that the group @*) + (*@ // coordinators are assigned to @txn.ts during the course of @txn.prepare. @*) + (*@ // @*) + (*@ // 2. To establish sufficient proof that @txn.ts can finalize, we need to @*) + (*@ // maintain the following the lock invariant: @*) + (*@ // There exists a set G of group IDs: @*) + (*@ // (a) @st associated with the right txn tokens; for @st = TXN_PREPARED, in @*) + (*@ // particular, all groups in G must have prepared; @*) + (*@ // (b) size(G) = @np; @*) + (*@ // (c) exclusive tokens over G, allowing a coordinator to prove uniqueness @*) + (*@ // when adding its result, and thereby re-esbalish property (b). @*) + (*@ @*) + (*@ // Try to prepare transaction @tcoord.ts on each group. @*) + (*@ for _, gid := range(ptgs) { @*) + (*@ @*) + do 2 iNamed "Hwrs". + iDestruct "Hpwrsm" as "#Hpwrsm". + wp_loadField. + set P := (λ (i : u64), + "HpwrsmP" ∷ own_map wrsP (DfracOwn 1) pwrsmP ∗ + "Hgcoords" ∷ own_txn_gcoords txn γ ∗ + "Htks" ∷ [∗ set] gid ∈ list_to_set (drop (uint.nat i) ptgs), local_gid_token α gid)%I. + iDestruct (own_slice_small_acc with "Hptgs") as "[Hptgs HptgsC]". + iDestruct (own_slice_small_sz with "Hptgs") as %Hlenptgs. + wp_apply (wp_forSlice P with "[] [$Hptgs $HpwrsmP $Hgcoords Htks]"); last first; first 1 last. + { by rewrite uint_nat_W64_0 drop_0 Hptgs. } + { clear Φ. + + (*@ gcoord := txn.gcoords[gid] @*) + (*@ pwrs := txn.wrs[gid] @*) + (*@ @*) + iIntros (i gid Φ) "!> (HP & %Hinbound & %Hgid) HΦ". + iNamed "HP". iNamed "Hgcoords". + wp_loadField. + assert (Hin : gid ∈ gids_all). + { pose proof (subseteq_ptgroups (dom wrs)) as Hdom. + apply elem_of_list_lookup_2 in Hgid. + clear -Hdom Hgid Hptgs. + set_solver. + } + wp_apply (wp_MapGet with "Hgcoords"). + iIntros (gcoordP ok) "[%Hgetgcoords Hgcoords]". + destruct ok; last first. + { apply map_get_false in Hgetgcoords as [Hnone _]. + by rewrite -not_elem_of_dom Hdomgcoords in Hnone. + } + apply map_get_true in Hgetgcoords. + wp_apply (wp_MapGet with "HpwrsmP"). + iIntros (pwrsP ok) "[%Hgetwrs HpwrsmP]". + destruct ok; last first. + { apply map_get_false in Hgetwrs as [Hnotin _]. + by rewrite -not_elem_of_dom Hdomwrs in Hnotin. + } + apply map_get_true in Hgetwrs. + iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. + { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. + iPureIntro. + by rewrite -elem_of_dom -Hdom elem_of_dom. + } + iDestruct (big_sepM2_lookup_acc with "Hpwrsm") as "[Hpwrs HpwrsmC]"; [done | done |]. + wp_pures. + assert (Hvg : gid ∈ ptgroups (dom wrs)). + { rewrite -Hptgs elem_of_list_to_set. by apply elem_of_list_lookup_2 in Hgid. } + + (*@ go func() { @*) + (*@ @*) + iDestruct (big_sepM_lookup with "Hgcoordsabs") as "Hgcoordabs"; first apply Hgetgcoords. + rewrite (drop_S _ _ _ Hgid) list_to_set_cons big_sepS_insert; last first. + { rewrite not_elem_of_list_to_set. intros Hgidin. + clear -Hgid Hgidin Hnd. + rewrite -(take_drop_middle _ _ _ Hgid) in Hnd. + apply NoDup_app in Hnd as (_ & _ & Hnd). + by apply NoDup_cons in Hnd as [? _]. + } + iDestruct "Htks" as "[Htk Htks]". + wp_apply (wp_fork with "[Htk]"). + { (* Forked thread. *) + + (*@ stg, ok := gcoord.Prepare(ts, ptgs, pwrs) @*) + (*@ @*) + iModIntro. + wp_apply (wp_GroupCoordinator__Prepare with "Hgcoordabs"). + iIntros (stg ok) "#Hsafe". + wp_pures. + + (*@ if ok { @*) + (*@ mu.Lock() @*) + (*@ if stg == tulip.TXN_PREPARED { @*) + (*@ np += 1 @*) + (*@ } else { @*) + (*@ st = stg @*) + (*@ } @*) + (*@ mu.Unlock() @*) + (*@ cv.Signal() @*) + (*@ } @*) + (*@ @*) + destruct ok; wp_pures. + { wp_apply (wp_Mutex__Lock with "Hmu"). + iIntros "[Hlocked HI]". + iNamed "HI". + assert (Hszgids : (size gids ≤ size gids_all)%nat). + { apply subseteq_size. etrans; [apply Hgidsincl | apply subseteq_ptgroups]. } + pose proof size_gids_all as Hszgidsall. + wp_pures. + (* Prove [safe_txn_pwrs] used in invariance of PREPARE and UNPREPARE. *) + iAssert (safe_txn_pwrs γ gid tid pwrs)%I as "#Hsafepwrs". + { iFrame "Htxnwrs". + iPureIntro. + specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. + pose proof (elem_of_ptgroups_non_empty _ _ Hvg) as Hne. + rewrite -Hwrsg in Hne. + done. + } + case_bool_decide as Hstg; wp_pures. + { (* Case [TxnPrepared]. *) + wp_load. wp_store. + destruct stg; [| done | done]. + rewrite Htsword /=. + iAssert (|={⊤}=> is_group_prepared γ gid tid)%I as "Hprepared". + { iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". + { apply Hin. } + iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]". + { apply Hin. } + iDestruct "Hsafe" as "[Hqp Hqv]". + iMod (group_inv_prepare with "Hqv Hqp Hsafepwrs Htxnsys Hkeys Hrg Hgroup") + as "(Htxnsys & Hkeys & Hrg & Hgroup & #Hprepared)". + iDestruct ("HrgsC" with "Hrg") as "Hrgs". + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + done. + } + iMod "Hprepared" as "#Hprepared". + wp_apply (wp_Mutex__Unlock with "[-]"). + { iFrame "Hmu Hlocked HnpP HstP". + iModIntro. + iExists ({[gid]} ∪ gids). + iAssert (⌜gid ∉ gids⌝)%I as %Hnotin. + { iIntros (Hgidin). + iDestruct (big_sepS_elem_of with "Htks") as "Htk'"; first apply Hgidin. + by iDestruct (local_gid_token_ne with "Htk Htk'") as %?. + } + iSplitL "Htk Htks". + { iApply (big_sepS_insert_2 with "Htk Htks"). } + iSplit. + { destruct st; [| done | done]. + by iApply big_sepS_insert_2. + } + iPureIntro. + { split. + { clear -Hgidsincl Hvg. set_solver. } + { rewrite size_union; last set_solver. + rewrite size_singleton Hsizegids. + clear -Hszgids Hszgidsall Hsizegids. word. + } + } + } + by wp_apply (wp_Cond__Signal with "Hcv"). + } + { wp_store. + destruct stg eqn:Hstgeq; first done. + { (* Case [TxnCommitted]. *) + wp_apply (wp_Mutex__Unlock with "[-]"). + { iFrame "Hmu Hlocked ∗ # %". by rewrite Htsword. } + by wp_apply (wp_Cond__Signal with "Hcv"). + } + { (* Case [TxnAborted]. *) + rewrite Htsword. + iAssert (|={⊤}=> is_txn_aborted γ tid)%I as "Habted". + { iDestruct "Hsafe" as "[? | Hsafe]"; first done. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". + { apply Hin. } + iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]". + { apply Hin. } + iMod (txnsys_group_inv_unprepare with "Hsafe Hsafepwrs Hrg Hgroup Htxnsys") + as "(Hrg & Hgroup & Htxnsys & #Habted)". + iDestruct ("HrgsC" with "Hrg") as "Hrgs". + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + done. + } + iMod "Habted" as "#Habted". + wp_apply (wp_Mutex__Unlock with "[-]"). + { iFrame "Hmu Hlocked ∗ # %". } + by wp_apply (wp_Cond__Signal with "Hcv"). + } + } + } + + (*@ // @ok = false means that the group coordinator has already been @*) + (*@ // assigned to a different transaction, implying nothing is waiting @*) + (*@ // on the CV. @*) + (*@ }() @*) + (*@ } @*) + (*@ @*) + done. + } + + iApply "HΦ". + iFrame "∗ # %". + rewrite uint_nat_word_add_S; last first. + { clear -Hinbound. word. } + done. + } + + (*@ mu.Lock() @*) + (*@ // Wait until either status is no longer TXN_PREPARED or all participant @*) + (*@ // groups have responded. @*) + (*@ for st == tulip.TXN_PREPARED && np != uint64(len(ptgs)) { @*) + (*@ cv.Wait() @*) + (*@ } @*) + (*@ @*) + iIntros "[HP Hptgs]". + subst P. iNamed "HP". + wp_apply (wp_Mutex__Lock with "Hmu"). + iIntros "[Hlocked HI]". + wp_pures. + set P := (λ cont : bool, + ∃ (np : u64) (st : txnphase) (gids : gset u64), + "HnpP" ∷ npP ↦[uint64T] #np ∗ + "HstP" ∷ stP ↦[uint64T] #(txnphase_to_u64 st) ∗ + "Htks" ∷ ([∗ set] gid ∈ gids, local_gid_token α gid) ∗ + "Hlocked" ∷ locked #muP ∗ + "#Hst" ∷ (match st with + | TxnPrepared => [∗ set] gid ∈ gids, is_group_prepared γ gid tid + | TxnCommitted => (∃ wrs, is_txn_committed γ tid wrs) + | TxnAborted => is_txn_aborted γ tid + end) ∗ + "%Hgidsincl" ∷ ⌜gids ⊆ ptgroups (dom wrs)⌝ ∗ + "%Hsizegids" ∷ ⌜size gids = uint.nat np⌝ ∗ + "%Hcond" ∷ ⌜(if cont + then True + else match st with + | TxnPrepared => uint.nat np = length ptgs + | _ => True + end)⌝)%I. + wp_apply (wp_forBreak_cond P with "[] [Hlocked HI]"); last first; first 1 last. + { iNamed "HI". iFrame "∗ # %". } + { clear Φ. + iIntros (Φ) "!> HP HΦ". + iNamed "HP". + wp_load. + wp_pures. + case_bool_decide as Hprepared; wp_pures. + { wp_load. + wp_apply wp_slice_len. + wp_pures. + case_bool_decide as Hsize; wp_pures. + { iApply "HΦ". + iFrame "∗ # %". + iPureIntro. + destruct st; try done. + inv Hsize. + clear -Hlenptgs. done. + } + wp_apply (wp_Cond__Wait with "[-HΦ]"). + { by iFrame "Hcv Hmu Hlocked ∗ # %". } + iIntros "[Hlocked HI]". + wp_pures. + iApply "HΦ". + iClear "Hst". + iNamed "HI". + by iFrame "∗ # %". + } + iApply "HΦ". + iFrame "∗ # %". + iPureIntro. + by destruct st. + } + iClear "Htks". + iNamed 1. + + (*@ status := st @*) + (*@ mu.Unlock() @*) + (*@ @*) + wp_load. wp_pures. + wp_apply (wp_Mutex__Unlock with "[Hlocked HnpP HstP Htks]"). + { by iFrame "Hmu Hlocked ∗ # %". } + + (*@ return status @*) + (*@ } @*) + wp_pures. + iApply "HΦ". + iAssert (safe_txnphase γ tid st)%I as "#Hsafe". + { destruct st; [| done | done]. + simpl. + iFrame "Htxnwrs". + assert (gids = ptgroups (dom wrs)) as ->; last done. + apply set_subseteq_size_eq; first apply Hgidsincl. + rewrite -Hptgs size_list_to_set; last apply Hnd. + clear -Hsizegids Hcond. lia. + } + iDestruct ("HptgsC" with "Hptgs") as "Hptgs". + by iFrame "Hsafe ∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_read.v b/src/program_proof/tulip/program/txn/txn_read.v new file mode 100644 index 000000000..657bea1aa --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_read.v @@ -0,0 +1,119 @@ +From Perennial.program_proof.tulip.invariance Require Import read. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import + res txn_repr txn_getwrs proph key_to_group. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_read. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__Read txn tid key value rds γ τ : + {{{ own_txn txn tid rds γ τ ∗ txnmap_ptsto τ key value }}} + Txn__Read #txn #(LitString key) + {{{ (ok : bool), RET (dbval_to_val (if ok then value else None), #ok); + own_txn txn tid rds γ τ ∗ txnmap_ptsto τ key value + }}}. + Proof. + iIntros (Φ) "[Htxn Hpt] HΦ". + wp_rec. + + (*@ func (txn *Txn) Read(key string) (tulip.Value, bool) { @*) + (*@ vlocal, hit := txn.getwrs(key) @*) + (*@ if hit { @*) + (*@ return vlocal, true @*) + (*@ } @*) + (*@ @*) + iNamed "Htxn". + wp_apply (wp_Txn__getwrs with "Hwrs"). + iIntros (vlocal ok) "[Hwrs %Hv]". + iDestruct (txnmap_lookup with "Htxnmap Hpt") as %Hvalue. + wp_if_destruct. + { (* Prove [vlocal = value]. *) + apply (lookup_union_Some_l _ rds) in Hv. + rewrite Hv in Hvalue. + inv Hvalue. + wp_pures. + iApply ("HΦ" $! true). + by iFrame "∗ # %". + } + clear Heqb ok. + + (*@ gid := KeyToGroup(key) @*) + (*@ gcoord := txn.gcoords[gid] @*) + (*@ v, ok := gcoord.Read(txn.ts, key) @*) + (*@ @*) + wp_apply wp_KeyToGroup. + iIntros (gid Hgid). + iNamed "Hgcoords". + wp_loadField. + wp_apply (wp_MapGet with "Hgcoords"). + iIntros (gcoord ok) "[%Hget Hgcoords]". + destruct ok; last first. + { apply map_get_false in Hget as [Hget _]. + rewrite -not_elem_of_dom Hdomgcoords -Hgid in Hget. + by pose proof (elem_of_key_to_group key). + } + apply map_get_true in Hget. + iDestruct (big_sepM_lookup with "Hgcoordsabs") as "Hgcoordabs"; first apply Hget. + iNamed "Htxn". + wp_loadField. + wp_apply (wp_GroupCoordinator__Read with "Hgcoordabs"). + iIntros (v ok) "#Hread". + wp_pures. + + (*@ if !ok { @*) + (*@ return tulip.Value{}, false @*) + (*@ } @*) + (*@ @*) + destruct ok; wp_pures; last first. + { iApply ("HΦ" $! false). + iAssert (own_txn_gcoords txn γ)%I with "[$HgcoordsP $Hgcoords]" as "Hgcoords". + { by iFrame "# %". } + by iFrame "∗ # %". + } + rewrite Htsword. + + (*@ trusted_proph.ResolveRead(txn.proph, txn.ts, key) @*) + (*@ @*) + rewrite lookup_union_r in Hvalue; last apply Hv. + iDestruct (big_sepM_lookup with "Hlnrz") as "Hhistl"; first apply Hvalue. + do 2 wp_loadField. + wp_apply wp_ResolveRead; first done. + iInv "Hinv" as "> HinvO" "HinvC". + iApply ncfupd_mask_intro; first set_solver. + iIntros "Hmask". + iNamed "HinvO". + iDestruct (txnsys_inv_extract_future with "Htxnsys") as (future) "[Hproph Htxnsys]". + iFrame "Hproph". + iIntros "(%future' & %Hfuture & Hproph)". + pose proof (elem_of_key_to_group key) as Hin. + iDestruct (big_sepS_elem_of_acc with "Hgroups") as "[Hgroup HgroupsC]". + { apply Hin. } + iDestruct (big_sepS_elem_of_acc with "Hrgs") as "[Hrg HrgsC]". + { apply Hin. } + iDestruct (big_sepS_elem_of_acc _ _ key with "Hkeys") as "[Hkey HkeysC]". + { apply elem_of_dom_2 in Hvalue. set_solver. } + iMod (txnsys_inv_read with "Hread Hhistl Htxnsys Hgroup Hrg Hkey") + as "(Htxnsys & Hgroup & Hrg & Hkey & %Heq)". + { rewrite /valid_ts in Hvts. lia. } + { by rewrite Hfuture. } + iDestruct ("HrgsC" with "Hrg") as "Hrgs". + iDestruct ("HgroupsC" with "Hgroup") as "Hgroups". + iDestruct ("HkeysC" with "Hkey") as "Hkeys". + rewrite Hfuture /=. + iDestruct (txnsys_inv_merge_future with "Hproph Htxnsys") as "Htxnsys". + iMod "Hmask" as "_". + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iIntros "!> _". + wp_pures. + subst value. + + (*@ return v, true @*) + (*@ } @*) + iApply ("HΦ" $! true). + iAssert (own_txn_gcoords txn γ)%I with "[$HgcoordsP $Hgcoords]" as "Hgcoords". + { by iFrame "# %". } + by iFrame "∗ # %". + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_repr.v b/src/program_proof/tulip/program/txn/txn_repr.v new file mode 100644 index 000000000..fde071de1 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_repr.v @@ -0,0 +1,124 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import res. +From Perennial.program_proof.tulip.program.gcoord Require Import gcoord_repr. + +Section repr. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + (*@ type Txn struct { @*) + (*@ // Timestamp of this transaction. @*) + (*@ ts uint64 @*) + (*@ // Buffered write set. @*) + (*@ wrs map[uint64]map[string]tulip.Value @*) + (*@ // Participant group of this transaction. Initialized in prepare time. @*) + (*@ ptgs []uint64 @*) + (*@ // Group coordinators for performing reads, prepare, abort, and commit. @*) + (*@ gcoords map[uint64]*gcoord.GroupCoordinator @*) + (*@ // Global prophecy variable (for verification purpose). @*) + (*@ proph primitive.ProphId @*) + (*@ } @*) + Definition txn_wrs (wrsP : loc) q (wrs : dbmap) : iProp Σ := + ∃ (pwrsmP : gmap u64 loc) (pwrsm : gmap u64 dbmap), + "HpwrsmP" ∷ own_map wrsP (DfracOwn 1) pwrsmP ∗ + "Hpwrsm" ∷ ([∗ map] p; m ∈ pwrsmP; pwrsm, own_map p q m) ∗ + "%Hwrsg" ∷ ⌜map_Forall (λ g m, m = wrs_group g wrs) pwrsm⌝ ∗ + "%Hdomwrs" ∷ ⌜dom pwrsmP = gids_all⌝. + + Definition own_txn_wrs txn q (wrs : dbmap) : iProp Σ := + ∃ (wrsP : loc) (wrspP : loc), + "HwrsP" ∷ txn ↦[Txn :: "wrs"] #wrsP ∗ + "Hwrs" ∷ txn_wrs wrsP q wrs ∗ + "HwrspP" ∷ txn ↦[Txn :: "wrsp"] #wrspP ∗ + "Hwrsp" ∷ own_map wrspP (DfracOwn 1) wrs. + + Definition own_txn_ptgs txn (ptgs : list u64) : iProp Σ := + ∃ (ptgsS : Slice.t), + "HptgsS" ∷ txn ↦[Txn :: "ptgs"] (to_val ptgsS) ∗ + "Hptgs" ∷ own_slice ptgsS uint64T (DfracOwn 1) ptgs ∗ + "%Hnd" ∷ ⌜NoDup ptgs⌝. + + Definition own_txn_ts txn (tid : nat) : iProp Σ := + ∃ (tsW : u64), + "HtsW" ∷ txn ↦[Txn :: "ts"] #tsW ∗ + "%Htsword" ∷ ⌜uint.nat tsW = tid⌝. + + Definition own_txn_gcoords txn γ : iProp Σ := + ∃ (gcoordsP : loc) (gcoords : gmap u64 loc), + "HgcoordsP" ∷ txn ↦[Txn :: "gcoords"] #gcoordsP ∗ + "Hgcoords" ∷ own_map gcoordsP (DfracOwn 1) gcoords ∗ + "#Hgcoordsabs" ∷ ([∗ map] gid ↦ gcoord ∈ gcoords, is_gcoord gcoord gid γ) ∗ + "%Hdomgcoords" ∷ ⌜dom gcoords = gids_all⌝. + + Definition own_txn_internal txn tid γ : iProp Σ := + ∃ (proph : proph_id), + "Hts" ∷ own_txn_ts txn tid ∗ + "Hwrs" ∷ own_txn_wrs txn (DfracOwn 1) ∅ ∗ + "Hgcoords" ∷ own_txn_gcoords txn γ ∗ + "Hptgs" ∷ own_txn_ptgs txn [] ∗ + "HprophP" ∷ txn ↦[Txn :: "proph"] #proph ∗ + "#Hinv" ∷ know_tulip_inv_with_proph γ proph. + + Definition own_txn_uninit txn γ : iProp Σ := + ∃ tid, "Htxn" ∷ own_txn_internal txn tid γ. + + Definition own_txn_init txn tid γ : iProp Σ := + "Htxn" ∷ own_txn_internal txn tid γ ∗ + "%Hvts" ∷ ⌜valid_ts tid⌝. + + Definition own_txn txn tid rds γ τ : iProp Σ := + ∃ (proph : proph_id) wrs, + "Htxn" ∷ own_txn_ts txn tid ∗ + "Hwrs" ∷ own_txn_wrs txn (DfracOwn 1) wrs ∗ + "Hgcoords" ∷ own_txn_gcoords txn γ ∗ + "Hptgs" ∷ own_txn_ptgs txn [] ∗ + (* diff from [own_txn_init] *) + "Htxnmap" ∷ txnmap_auth τ (wrs ∪ rds) ∗ + "HprophP" ∷ txn ↦[Txn :: "proph"] #proph ∗ + "#Hinv" ∷ know_tulip_inv_with_proph γ proph ∗ + (* diff from [own_txn_init] *) + "#Hlnrz" ∷ ([∗ map] key ↦ value ∈ rds, is_lnrz_hist_at γ key (pred tid) value) ∗ + "%Hdomr" ∷ ⌜dom rds ⊆ keys_all⌝ ∗ + (* diff from [own_txn_init] *) + "%Hincl" ∷ ⌜dom wrs ⊆ dom rds⌝ ∗ + "%Hvts" ∷ ⌜valid_ts tid⌝ ∗ + (* diff from [own_txn_init] *) + "%Hvwrs" ∷ ⌜valid_wrs wrs⌝. + + Definition own_txn_stable txn tid rds wrs γ τ : iProp Σ := + ∃ (proph : proph_id), + "Htxn" ∷ own_txn_ts txn tid ∗ + (* diff from [own_txn] *) + "Hwrs" ∷ own_txn_wrs txn DfracDiscarded wrs ∗ + "Hgcoords" ∷ own_txn_gcoords txn γ ∗ + "Hptgs" ∷ own_txn_ptgs txn [] ∗ + "Htxnmap" ∷ txnmap_auth τ (wrs ∪ rds) ∗ + "HprophP" ∷ txn ↦[Txn :: "proph"] #proph ∗ + "#Hinv" ∷ know_tulip_inv_with_proph γ proph ∗ + "#Hlnrz" ∷ ([∗ map] key ↦ value ∈ rds, is_lnrz_hist_at γ key (pred tid) value) ∗ + "%Hdomr" ∷ ⌜dom rds ⊆ keys_all⌝ ∗ + (* diff from [own_txn] and [wrs] is exposed *) + "#Htxnwrs" ∷ is_txn_wrs γ tid wrs ∗ + "%Hincl" ∷ ⌜dom wrs ⊆ dom rds⌝ ∗ + "%Hvts" ∷ ⌜valid_ts tid⌝ ∗ + "%Hvwrs" ∷ ⌜valid_wrs wrs⌝. + + Definition own_txn_prepared txn tid rds wrs γ τ : iProp Σ := + ∃ (proph : proph_id) ptgs, + "Htxn" ∷ own_txn_ts txn tid ∗ + "Hwrs" ∷ own_txn_wrs txn DfracDiscarded wrs ∗ + "Hgcoords" ∷ own_txn_gcoords txn γ ∗ + (* diff from [own_txn_stable] *) + "Hptgs" ∷ own_txn_ptgs txn ptgs ∗ + "Htxnmap" ∷ txnmap_auth τ (wrs ∪ rds) ∗ + "HprophP" ∷ txn ↦[Txn :: "proph"] #proph ∗ + "#Hinv" ∷ know_tulip_inv_with_proph γ proph ∗ + "#Hlnrz" ∷ ([∗ map] key ↦ value ∈ rds, is_lnrz_hist_at γ key (pred tid) value) ∗ + "#Htxnwrs" ∷ is_txn_wrs γ tid wrs ∗ + "%Hdomr" ∷ ⌜dom rds ⊆ keys_all⌝ ∗ + "%Hincl" ∷ ⌜dom wrs ⊆ dom rds⌝ ∗ + "%Hvts" ∷ ⌜valid_ts tid⌝ ∗ + "%Hvwrs" ∷ ⌜valid_wrs wrs⌝ ∗ + (* diff from [own_txn_stable] *) + "%Hptgs" ∷ ⌜list_to_set ptgs = ptgroups (dom wrs)⌝. + +End repr. diff --git a/src/program_proof/tulip/program/txn/txn_reset.v b/src/program_proof/tulip/program/txn/txn_reset.v new file mode 100644 index 000000000..1c19c1742 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_reset.v @@ -0,0 +1,29 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import + txn_repr txn_resetwrs txn_resetptgs. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__reset (txn : loc) wrs q ptgs : + {{{ own_txn_wrs txn q wrs ∗ own_txn_ptgs txn ptgs }}} + Txn__reset #txn + {{{ RET #(); own_txn_wrs txn (DfracOwn 1) ∅ ∗ own_txn_ptgs txn [] }}}. + Proof. + iIntros (Φ) "[Hwrs Hptgs] HΦ". + wp_rec. + + (*@ func (txn *Txn) reset() { @*) + (*@ txn.resetwrs() @*) + (*@ txn.resetptgs() @*) + (*@ } @*) + wp_apply (wp_Txn__resetwrs with "Hwrs"). + iIntros "Hwrs". + wp_apply (wp_Txn__resetptgs with "Hptgs"). + iIntros "Hptgs". + wp_pures. + iApply "HΦ". + by iFrame. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_resetptgs.v b/src/program_proof/tulip/program/txn/txn_resetptgs.v new file mode 100644 index 000000000..5b6b237ef --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_resetptgs.v @@ -0,0 +1,29 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__resetptgs (txn : loc) ptgs : + {{{ own_txn_ptgs txn ptgs }}} + Txn__resetptgs #txn + {{{ RET #(); own_txn_ptgs txn [] }}}. + Proof. + iIntros (Φ) "Hptgs HΦ". + wp_rec. + + (*@ func (txn *Txn) resetptgs() { @*) + (*@ txn.ptgs = txn.ptgs[:0] @*) + (*@ } @*) + iNamed "Hptgs". + wp_loadField. + wp_apply wp_SliceTake; first word. + wp_storeField. + iApply "HΦ". + iDestruct (own_slice_take_cap _ _ _ (W64 0) with "Hptgs") as "Hptgs"; first word. + iFrame. + iPureIntro. + by apply NoDup_nil. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_resetwrs.v b/src/program_proof/tulip/program/txn/txn_resetwrs.v new file mode 100644 index 000000000..6c9c4afd1 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_resetwrs.v @@ -0,0 +1,75 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__resetwrs (txn : loc) q wrs : + {{{ own_txn_wrs txn q wrs }}} + Txn__resetwrs #txn + {{{ RET #(); own_txn_wrs txn (DfracOwn 1) ∅ }}}. + Proof. + iIntros (Φ) "Hwrs HΦ". + wp_rec. + + (*@ func (txn *Txn) resetwrs() { @*) + (*@ // Creating a new @wrs is not really necessary, but currently it seems like @*) + (*@ // there's no easy way to reason modifying a map while iterating over it @*) + (*@ // (which is a defined behavior in Go). @*) + (*@ wrs := make(map[uint64]map[string]tulip.Value) @*) + (*@ for gid := range(txn.wrs) { @*) + (*@ wrs[gid] = make(map[string]tulip.Value) @*) + (*@ } @*) + (*@ txn.wrs = wrs @*) + (*@ txn.wrsp = make(map[string]tulip.Value) @*) + (*@ } @*) + wp_apply wp_NewMap. + iIntros (wrsP') "HpwrsmP'". + do 2 iNamed "Hwrs". + (* iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. *) + wp_loadField. + set P := (λ (mx : gmap u64 loc), + let em := gset_to_gmap (∅ : dbmap) (dom mx) in + ∃ (pwrsmP' : gmap u64 loc), + "HpwrsmP'" ∷ own_map wrsP' (DfracOwn 1) pwrsmP' ∗ + "Hpwrsm'" ∷ ([∗ map] p;m ∈ pwrsmP';em, own_map p (DfracOwn 1) m))%I. + wp_apply (wp_MapIter_fold _ _ _ P with "HpwrsmP [HpwrsmP']"). + { subst P. simpl. + rewrite dom_empty_L gset_to_gmap_empty. + iFrame. + by iApply big_sepM2_empty. + } + { clear Φ. + iIntros (m gid pwrsP Φ) "!> [HP [%Hnone %Hsome]] HΦ". + iNamed "HP". + wp_pures. + wp_apply wp_NewMap. + iIntros (empP) "HempP". + wp_apply (wp_MapInsert with "HpwrsmP'"); first by auto. + iIntros "HpwrsmP'". + iApply "HΦ". + subst P. simpl. + iFrame. + rewrite dom_insert_L gset_to_gmap_union_singleton. + iApply (big_sepM2_insert_2 with "[HempP] Hpwrsm'"); first iFrame. + } + iIntros "[HpwrsmP HP]". + subst P. simpl. + iNamed "HP". + wp_storeField. + wp_apply wp_NewMap. + iIntros (wrspP') "HwrspP'". + wp_storeField. + iApply "HΦ". + iDestruct (big_sepM2_dom with "Hpwrsm'") as %Hdom'. + iFrame "∗ %". + iPureIntro. + split; last first. + { by rewrite Hdom' dom_gset_to_gmap Hdomwrs. } + intros g m Hgm. + rewrite lookup_gset_to_gmap_Some in Hgm. + destruct Hgm as [_ Hm]. + by rewrite /wrs_group map_filter_empty. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_run.v b/src/program_proof/tulip/program/txn/txn_run.v new file mode 100644 index 000000000..cb707f67c --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_run.v @@ -0,0 +1,346 @@ +From Perennial.program_proof.tulip.invariance Require Import linearize preprepare. +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import + res txn_repr txn_begin txn_cancel txn_prepare txn_reset txn_abort txn_commit. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Definition body_spec + (body : val) (txn : loc) tid r + (P : dbmap -> Prop) (Q : dbmap -> dbmap -> Prop) + (Rc : dbmap -> dbmap -> iProp Σ) (Ra : dbmap -> iProp Σ) + γ τ : iProp Σ := + ∀ Φ, + own_txn txn tid r γ τ ∗ ⌜P r⌝ ∗ txnmap_ptstos τ r -∗ + (∀ ok : bool, + (own_txn txn tid r γ τ ∗ + if ok + then ∃ w, ⌜Q r w ∧ dom r = dom w⌝ ∗ (Rc r w ∧ Ra r) ∗ txnmap_ptstos τ w + else Ra r) -∗ Φ #ok) -∗ + WP body #txn {{ v, Φ v }}. + + Theorem wp_Txn__Run + txn (body : val) + (P : dbmap -> Prop) (Q : dbmap -> dbmap -> Prop) + (Rc : dbmap -> dbmap -> iProp Σ) (Ra : dbmap -> iProp Σ) γ : + (∀ r w, (Decision (Q r w))) -> + ⊢ {{{ own_txn_uninit txn γ ∗ (∀ tid r τ, body_spec body txn tid r P Q Rc Ra γ τ) }}} + <<< ∀∀ (r : dbmap), ⌜P r ∧ dom r ⊆ keys_all⌝ ∗ own_db_ptstos γ r >>> + Txn__Run #txn body @ ↑sysNS + <<< ∃∃ (ok : bool) (w : dbmap), if ok then ⌜Q r w⌝ ∗ own_db_ptstos γ w else own_db_ptstos γ r >>> + {{{ RET #ok; own_txn_uninit txn γ ∗ if ok then Rc r w else Ra r }}}. + Proof. + iIntros (Hdec) "!>". + iIntros (Φ) "[Htxn Hbody] HAU". + wp_rec. wp_pures. + + (*@ func (txn *Txn) Run(body func(txn *Txn) bool) bool { @*) + (*@ txn.begin() @*) + (*@ @*) + iAssert (∃ p, know_tulip_inv_with_proph γ p)%I as (p) "#Hinv". + { do 2 iNamed "Htxn". iFrame "Hinv". } + wp_apply (wp_Txn__begin with "[-Hbody HAU]"). + { iFrame "∗ # %". } + iInv "Hinv" as "> HinvO" "HinvC". + iMod (ncfupd_mask_subseteq (⊤ ∖ ↑sysNS)) as "Hclose"; first solve_ndisj. + iMod "HAU" as (rds) "[[[%HP %Hdomr] Hdbpts] HAUC]". + iModIntro. + iNamed "HinvO". + iDestruct (txnsys_inv_expose_future_extract_ts with "Htxnsys") + as (future ts) "[Htxnsys Hts]". + (* Prove [key_inv] are linearizable after [ts]. *) + iDestruct (keys_inv_before_linearize with "Hkeys Hts") as "[Hkeys Hts]". + iExists ts. + (* Pass [ts_auth γ ts] to the underlying layer. *) + iFrame "Hts". + iIntros (tid) "[Hts %Htidgt]". + iDestruct (largest_ts_witness with "Hts") as "#Htidlb". + + pose proof (peek_spec future tid) as Hpeek. + set form := peek _ _ in Hpeek. + set Qr := λ m, Q rds (m ∪ rds) ∧ dom m ⊆ dom rds. + destruct (decide (incorrect_fcc Qr form)) as [Hifcc | HQ]. + { (* Case: Abort branch. *) + iMod (txnsys_inv_linearize_abort form Q with "Htidlb Hdbpts Htxnsys Hkeys") + as "(Hdbpts & Htxnsys & Hkeys & Htida & Hwrsexcl & Hclients & #HQ & #Hlnrzs & #Hlnrzed)". + { apply Hdomr. } + { apply Htidgt. } + { apply Hpeek. } + { done. } + (* Choose the will-abort branch. Use [∅] as placeholder. *) + iMod ("HAUC" $! false ∅ with "Hdbpts") as "HΦ". + iMod "Hclose" as "_". + iMod ("HinvC" with "[Hts Htxnsys Hkeys Hgroups Hrgs]") as "_". + { iNamed "Htxnsys". iFrame "∗ # %". } + (* Allocate transaction local view [txnmap_ptstos τ r]. *) + iMod (txnmap_alloc rds) as (τ) "[Htxnmap Htxnpts]". + iIntros "!> Htxn". + iAssert (own_txn txn tid rds γ τ)%I with "[Htxn Htxnmap]" as "Htxn". + { iClear "Hinv". do 2 iNamed "Htxn". + iExists _, ∅. + rewrite map_empty_union. + by iFrame "∗ # %". + } + + (*@ cmt := body(txn) @*) + (*@ @*) + wp_apply ("Hbody" with "[$Htxn $Htxnpts]"); first done. + iIntros (cmt) "[Htxn Hpts]". + + (*@ if !cmt { @*) + (*@ // This transaction has not really requested to prepare yet, so no @*) + (*@ // cleanup tasks are required. @*) + (*@ txn.cancel() @*) + (*@ return false @*) + (*@ } @*) + (*@ @*) + wp_if_destruct. + { wp_apply (wp_Txn__cancel with "[$Htxn $Htida $Hwrsexcl]"). + iIntros "Htxn". + wp_pures. + iApply "HΦ". + by iFrame. + } + + (*@ status := txn.prepare() @*) + (*@ @*) + iDestruct "Hpts" as (w) "([%HQ %Hdomw] & [_ HRa] & Hpts)". + iAssert (|={⊤}=> ∃ wrst, own_txn_stable txn tid rds wrst γ τ)%I + with "[Htxn Hwrsexcl Hpts]" as "Htxn". + { iClear "Hinv". iNamed "Htxn". + iDestruct (txnmap_subseteq with "Htxnmap Hpts") as %Hsubseteq. + unshelve epose proof (subseteq_dom_eq _ _ Hsubseteq _) as Heq. + { clear -Hincl Hdomw. set_solver. } + subst w. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iMod (txnsys_inv_preprepare with "HQ Hwrsexcl Htxnsys") as "[Htxnsys Hwrsrcpt]". + { apply Hvts. } + { apply Hvwrs. } + { done. } + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iFrame "∗ # %". + do 2 iNamed "Hwrs". + iFrame "∗ %". + rewrite -big_sepM2_fupd. + iApply (big_sepM2_mono with "Hpwrsm"). + iIntros (g r m Hr Hm) "Hm". + by iMod (own_map_persist with "Hm") as "Hm". + } + iMod "Htxn" as (wrst) "Htxn". + wp_apply (wp_Txn__prepare with "Htxn"). + iIntros (status) "[Htxn Hstatus]". + + (*@ if status == TXN_COMMITTED { @*) + (*@ // A backup coordinator must have committed this transaction, so simply @*) + (*@ // reset the write-set here. @*) + (*@ txn.reset() @*) + (*@ return true @*) + (*@ } @*) + (*@ @*) + wp_if_destruct. + { destruct status eqn:Hstatus; [done | | done]. clear Heqb. + subst status. + iDestruct "Hstatus" as (wrs) "Hcmt". + (* Obtain a contradiction from [Hcmt] and [Htida]. *) + iApply fupd_wp. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". do 2 iNamed "Htxnsys". + iDestruct (txn_res_lookup with "Hresm Hcmt") as %Hcmt. + iDestruct (wabt_tid_elem_of with "Htidas Htida") as %Hwabt. + rewrite -Htidas in Hwabt. + iDestruct (elem_of_tmodas_partitioned_tids with "Hpart") as %[_ Hnotin]. + { apply Hwabt. } + by specialize (Hnotin _ Hcmt). + } + rename Heqb into Hstatusnc. + + (*@ if status == TXN_ABORTED { @*) + (*@ // Ghost action: Abort this transaction. @*) + (*@ txn.abort() @*) + (*@ return false @*) + (*@ } @*) + (*@ @*) + wp_if_destruct. + { destruct status eqn:Hstatus; [done | done |]. clear Heqb. + subst status. + wp_apply (wp_Txn__abort with "Hstatus [$Htxn $Htida]"). + iIntros "Htxn". + wp_pures. + iApply "HΦ". + by iFrame. + } + rename Heqb into Hstatusna. + + (*@ // Ghost action: Commit this transaction. @*) + (*@ txn.commit() @*) + (*@ return true @*) + (*@ } @*) + destruct status; [| done | done]. simpl. clear Hstatusnc Hstatusna. + iDestruct "Hstatus" as (wrs) "#Hprep". + iAssert (⌜wrst = wrs⌝)%I as %->. + { iClear "Hinv". iNamed "Htxn". + iDestruct "Hprep" as "[#Hwrsrcpt _]". + by iDestruct (txn_wrs_agree with "Hwrsrcpt Htxnwrs") as %?. + } + wp_apply (wp_Txn__commit_in_abort_future with "Hlnrzed Hprep [$Htxn $Htida]"). + iIntros ([]). + } + { (* Case: Commit branch. *) + destruct form as [| | wrs | wrs]; [done | done | done |]. + apply dec_stable in HQ. simpl in Hpeek. + subst Qr. + destruct HQ as [HQ Hdomwrs]. + iMod (txnsys_inv_linearize_commit wrs Q with "Htidlb Hdbpts Htxnsys Hkeys") + as "(Hdbpts & Htxnsys & Hkeys & Htidc & Hwrsexcl & Hclients & #HQ & #Hlnrzs & #Hlnrzed)". + { apply Hdomwrs. } + { apply Hdomr. } + { apply Htidgt. } + { apply Hpeek. } + (* Choose the will-commit branch. *) + iMod ("HAUC" $! true (wrs ∪ rds) with "[$Hdbpts]") as "HΦ"; first done. + iMod "Hclose" as "_". + iMod ("HinvC" with "[Hts Htxnsys Hkeys Hgroups Hrgs]") as "_". + { iNamed "Htxnsys". iFrame "∗ # %". } + iClear "Hinv". + (* Allocate transaction local view [txnmap_ptstos τ r]. *) + iMod (txnmap_alloc rds) as (τ) "[Htxnmap Htxnpts]". + iIntros "!> Htxn". + iAssert (own_txn txn tid rds γ τ)%I with "[Htxn Htxnmap]" as "Htxn". + { do 2 iNamed "Htxn". + iExists _, ∅. + rewrite map_empty_union. + by iFrame "∗ # %". + } + + (*@ cmt := body(txn) @*) + (*@ @*) + wp_apply ("Hbody" with "[$Htxn $Htxnpts]"); first done. + iIntros (cmt) "[Htxn Hpts]". + + (*@ if !cmt { @*) + (*@ // This transaction has not really requested to prepare yet, so no @*) + (*@ // cleanup tasks are required. @*) + (*@ txn.cancel() @*) + (*@ return false @*) + (*@ } @*) + (*@ @*) + wp_if_destruct. + { wp_apply (wp_Txn__cancel_in_commit_future with "[$Htxn $Htidc $Hwrsexcl]"). + iIntros ([]). + } + + (*@ status := txn.prepare() @*) + (*@ @*) + clear HQ. + iDestruct "Hpts" as (w) "([%HQ %Hdomw] & [HRc _] & Hpts)". + iAssert (|={⊤}=> ∃ wrst, own_txn_stable txn tid rds wrst γ τ ∗ ⌜w = wrst ∪ rds⌝)%I + with "[Htxn Hwrsexcl Hpts]" as "Htxn". + { clear p. + iDestruct "Htxn" as (p wrst) "Htxn". iNamed "Htxn". + iDestruct (txnmap_subseteq with "Htxnmap Hpts") as %Hsubseteq. + unshelve epose proof (subseteq_dom_eq _ _ Hsubseteq _) as Heq. + { clear -Hincl Hdomw. set_solver. } + subst w. + iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". + iMod (txnsys_inv_preprepare with "HQ Hwrsexcl Htxnsys") as "[Htxnsys Hwrsrcpt]". + { apply Hvts. } + { apply Hvwrs. } + { done. } + iMod ("HinvC" with "[$Htxnsys $Hkeys $Hgroups $Hrgs]") as "_". + iFrame "∗ # %". + do 2 iNamed "Hwrs". + iFrame "∗ %". + iApply fupd_sep. + iSplitL; last done. + rewrite -big_sepM2_fupd. + iApply (big_sepM2_mono with "Hpwrsm"). + iIntros (g r m Hr Hm) "Hm". + by iMod (own_map_persist with "Hm") as "Hm". + } + iMod "Htxn" as (wrst) "[Htxn %Heq]". subst w. + wp_apply (wp_Txn__prepare with "Htxn"). + iIntros (status) "[Htxn Hstatus]". + + (*@ if status == TXN_COMMITTED { @*) + (*@ // A backup coordinator must have committed this transaction, so simply @*) + (*@ // reset the write-set here. @*) + (*@ txn.reset() @*) + (*@ return true @*) + (*@ } @*) + (*@ @*) + wp_if_destruct. + { destruct status eqn:Hstatus; [done | | done]. clear Heqb. + subst status. + iDestruct "Hstatus" as (wrsc) "#Hwrsc". + iNamed "Htxn". + (* Obtain [wrsc = wrs ∧ wrst = wrs]. *) + iAssert (|={⊤}=> own_cmt_tmod γ tid wrs ∗ ⌜wrsc = wrs ∧ wrst = wrs⌝)%I + with "[Htidc]" as "Htidc". + { iInv "Hinv" as "> HinvO" "HinvC". + iNamed "HinvO". do 2 iNamed "Htxnsys". + iDestruct (txn_res_lookup with "Hresm Hwrsc") as %Hwrsc. + iDestruct (elem_of_committed_partitioned_tids with "Hpart") as %[Hnotinwc Hnotinwa]. + { by eauto. } + iDestruct (cmt_tmod_lookup with "Htidcs Htidc") as %Htidc. + apply Htidcs in Htidc. + (* Prove [resm !! tid = Some (ResCommitted wrs)]. *) + destruct Htidc as [Htmodcs | Hresm]. + { by rewrite not_elem_of_dom Htmodcs in Hnotinwc. } + rewrite Hresm in Hwrsc. symmetry in Hwrsc. inv Hwrsc. + iDestruct (big_sepM_lookup with "Hvr") as "Hr"; first apply Hresm. + iDestruct "Hr" as "[Hrcp _]". + iDestruct (txn_wrs_agree with "Hrcp Htxnwrs") as %->. + iMod ("HinvC" with "[-Htidc]") as "_". + { by iFrame "∗ # %". } + by iFrame "∗ %". + } + iMod "Htidc" as "[Htidc %Heq]". + destruct Heq as [-> ->]. + iNamed "Htxn". + wp_apply (wp_Txn__reset with "[$Hwrs $Hptgs]"). + iIntros "[Hwrs Hptgs]". + wp_pures. + iApply "HΦ". + by iFrame "∗ # %". + } + rename Heqb into Hstatusnc. + + (*@ if status == TXN_ABORTED { @*) + (*@ // Ghost action: Abort this transaction. @*) + (*@ txn.abort() @*) + (*@ return false @*) + (*@ } @*) + (*@ @*) + wp_if_destruct. + { destruct status eqn:Hstatus; [done | done |]. clear Heqb. + subst status. simpl. + wp_apply (wp_Txn__abort_in_commit_future with "Hstatus [$Htxn $Htidc]"). + iIntros ([]). + } + rename Heqb into Hstatusna. + + (*@ // Ghost action: Commit this transaction. @*) + (*@ txn.commit() @*) + (*@ return true @*) + (*@ } @*) + destruct status as [| |] eqn:Hstatus; [| done | done]. + simpl. clear Hstatus Hstatusnc Hstatusna. + iDestruct "Hstatus" as (wrsc) "#Hprep". + iAssert (⌜wrsc = wrst⌝)%I as %->. + { iNamed "Htxn". + iDestruct "Hprep" as "[Hwrsrcpt _]". + by iDestruct (txn_wrs_agree with "Htxnwrs Hwrsrcpt") as %?. + } + wp_apply (wp_Txn__commit with "Hlnrzed Hprep [Htxn Htidc]"). + { iFrame "∗ #". } + iIntros "[Htxn %Heq]". subst wrst. + wp_pures. + iApply "HΦ". + by iFrame. + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_setptgs.v b/src/program_proof/tulip/program/txn/txn_setptgs.v new file mode 100644 index 000000000..91c44d438 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_setptgs.v @@ -0,0 +1,161 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__setptgs txn q wrs : + {{{ own_txn_wrs txn q wrs ∗ own_txn_ptgs txn [] }}} + Txn__setptgs #txn + {{{ RET #(); ∃ ptgs, own_txn_wrs txn q wrs ∗ own_txn_ptgs txn ptgs ∗ + ⌜list_to_set ptgs = ptgroups (dom wrs)⌝ + }}}. + Proof using heapGS0 tulip_ghostG0 Σ. + iIntros (Φ) "[Hwrs Hptgs] HΦ". + wp_rec. + + (*@ func (txn *Txn) setptgs() { @*) + (*@ var ptgs = txn.ptgs @*) + (*@ @*) + iNamed "Hptgs". + clear Hnd. + wp_loadField. + wp_apply wp_ref_to; first apply slice_val_ty. + iIntros (ptgsP) "HptgsP". + + (*@ for gid, pwrs := range(txn.wrs) { @*) + (*@ if uint64(len(pwrs)) != 0 { @*) + (*@ ptgs = append(ptgs, gid) @*) + (*@ } @*) + (*@ } @*) + (*@ txn.ptgs = ptgs @*) + (*@ } @*) + do 2 iNamed "Hwrs". + wp_loadField. + set P := (λ (mx : gmap u64 loc), + ∃ (s : Slice.t) (ptgs : list u64), + "HptgsP" ∷ ptgsP ↦[slice.T uint64T] (to_val s) ∗ + "Hptgs" ∷ own_slice s uint64T (DfracOwn 1) ptgs ∗ + "Hpwrsm" ∷ ([∗ map] p;m ∈ pwrsmP;pwrsm, own_map p q m) ∗ + "%Hnd" ∷ ⌜NoDup ptgs⌝ ∗ + "%Hincl" ∷ ⌜Forall (λ g, g ∈ dom mx) ptgs⌝ ∗ + (* non-empty ↔ in ptgs *) + "%Hspec" ∷ ⌜set_Forall (λ g, keys_group g (dom wrs) ≠ ∅ ↔ g ∈ ptgs) (dom mx)⌝)%I. + wp_apply (wp_MapIter_fold _ _ _ P with "HpwrsmP [$HptgsP $Hptgs $Hpwrsm]"). + { iPureIntro. by split; first apply NoDup_nil. } + { clear Φ. + iIntros (m gid pwrsP Φ) "!> [HP [%Hnone %Hsome]] HΦ". + iNamed "HP". + iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. + { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. + iPureIntro. + by rewrite -elem_of_dom -Hdom elem_of_dom. + } + iDestruct (big_sepM2_lookup_acc with "Hpwrsm") as "[Hpwrs HpwrsmC]"; [done | done |]. + wp_apply (wp_MapLen with "Hpwrs"). + iIntros "[%Hsize Hpwrs]". + iDestruct ("HpwrsmC" with "Hpwrs") as "Hpwrsm". + wp_if_destruct. + { wp_load. + (* NB: need to provide [own_slice] to properly resolve the right typeclass. *) + wp_apply (wp_SliceAppend with "Hptgs"). + iIntros (s') "Hptgs". + wp_store. + iApply "HΦ". + iFrame. + iPureIntro. + split. + { apply NoDup_snoc; last apply Hnd. + intros Hgid. + rewrite Forall_forall in Hincl. + specialize (Hincl _ Hgid). + by apply not_elem_of_dom in Hnone. + } + split. + { rewrite Forall_app Forall_singleton dom_insert_L. + split; last set_solver. + apply (Forall_impl _ _ _ Hincl). + set_solver. + } + intros g Hg. + rewrite dom_insert_L elem_of_union in Hg. + split. + { intros Hne. + destruct Hg as [? | Hg]; first set_solver. + specialize (Hspec _ Hg). simpl in Hspec. + set_solver. + } + { intros Hsnoc. + destruct Hg as [Hgid | Hg]; last first. + { specialize (Hspec _ Hg). simpl in Hspec. + apply Hspec. + rewrite -not_elem_of_dom in Hnone. + set_solver. + } + rewrite elem_of_singleton in Hgid. + subst g. + (* FIXME: not sure if word is supposed to solve this immediately *) + assert (Hnz : size pwrs ≠ O). + { intros Hz. rewrite Hz in Heqb. word. } + clear Heqb. + specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. + intros Hempty. + rewrite -wrs_group_keys_group_dom -Hwrsg in Hempty. + apply dom_empty_inv_L in Hempty. + by rewrite map_size_non_empty_iff in Hnz. + } + } + iApply "HΦ". + iFrame. + iPureIntro. + rewrite dom_insert_L. + split; first apply Hnd. + split. + { apply (Forall_impl _ _ _ Hincl). set_solver. } + apply set_Forall_union; last apply Hspec. + rewrite set_Forall_singleton. + assert (Hsizez : size pwrs = O). + { rewrite Heqb in Hsize. done. } + split. + { intros Hne. + specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. + rewrite -wrs_group_keys_group_dom -Hwrsg in Hne. + apply map_size_empty_inv in Hsizez. + by rewrite Hsizez in Hne. + } + { intros Hinptgs. + rewrite Forall_forall in Hincl. + specialize (Hincl _ Hinptgs). + by rewrite -not_elem_of_dom in Hnone. + } + } + iIntros "[HpwrsmP HP]". + iNamed "HP". + wp_load. wp_storeField. + iApply "HΦ". + iFrame "∗ # %". + iPureIntro. + apply set_eq. + intros gid. + rewrite elem_of_ptgroups elem_of_list_to_set. + split. + { intros Hgid. + rewrite Forall_forall in Hincl. + specialize (Hincl _ Hgid). + specialize (Hspec _ Hincl). simpl in Hspec. + by apply Hspec. + } + { intros Hne. + destruct (decide (gid ∈ gids_all)) as [Hin | Hnotin]; last first. + { rewrite /keys_group in Hne. + apply set_choose_L in Hne as [k Hk]. + pose proof (elem_of_key_to_group k) as Hin. + set_solver. + } + rewrite Hdomwrs in Hspec. + specialize (Hspec _ Hin). simpl in Hspec. + by apply Hspec. + } + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_setwrs.v b/src/program_proof/tulip/program/txn/txn_setwrs.v new file mode 100644 index 000000000..955966625 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_setwrs.v @@ -0,0 +1,69 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import txn_repr key_to_group. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__setwrs (txn : loc) (key : string) (value : dbval) wrs : + {{{ own_txn_wrs txn (DfracOwn 1) wrs }}} + Txn__setwrs #txn #(LitString key) (dbval_to_val value) + {{{ RET #(); own_txn_wrs txn (DfracOwn 1) (<[key := value]> wrs) }}}. + Proof. + iIntros (Φ) "Hwrs HΦ". + wp_rec. + + (*@ func (txn *Txn) setwrs(key string, value Value) { @*) + (*@ gid := KeyToGroup(key) @*) + (*@ pwrs := txn.wrs[gid] @*) + (*@ @*) + wp_apply wp_KeyToGroup. + iIntros (gid Hgid). + do 2 iNamed "Hwrs". + wp_loadField. + wp_apply (wp_MapGet with "HpwrsmP"). + iIntros (pwrsP ok) "[%Hget HpwrsmP]". + destruct ok; last first. + { apply map_get_false in Hget as [Hget _]. + rewrite -not_elem_of_dom Hdomwrs -Hgid in Hget. + by pose proof (elem_of_key_to_group key). + } + apply map_get_true in Hget. + iAssert (⌜is_Some (pwrsm !! gid)⌝)%I as %[pwrs Hpwrs]. + { iDestruct (big_sepM2_dom with "Hpwrsm") as %Hdom. + iPureIntro. + by rewrite -elem_of_dom -Hdom elem_of_dom. + } + iDestruct (big_sepM2_delete with "Hpwrsm") as "[Hpwrs Hpwrsm]"; [done | done |]. + + (*@ pwrs[key] = value @*) + (*@ } @*) + wp_apply (wp_MapInsert with "Hpwrs"); first done. + iIntros "Hpwrs". + wp_loadField. + wp_apply (wp_MapInsert with "Hwrsp"); first done. + iIntros "Hwrsp". + wp_pures. + iApply "HΦ". + set pwrs' := <[key := value]> pwrs. + iAssert ([∗ map] p; m ∈ pwrsmP; <[gid := pwrs']> pwrsm, own_map p (DfracOwn 1) m)%I + with "[Hpwrsm Hpwrs]" as "Hpwrsm". + { iDestruct (big_sepM2_insert_2 (λ k p m, own_map p (DfracOwn 1) m) _ _ gid with "Hpwrs Hpwrsm") + as "Hpwrsm". + rewrite insert_delete; last apply Hget. + rewrite insert_delete_insert. + done. + } + iFrame "∗ %". + iPureIntro. + intros g m Hgm. + destruct (decide (gid = g)) as [-> | Hne]. + - rewrite lookup_insert in Hgm. inv Hgm. + specialize (Hwrsg _ _ Hpwrs). simpl in Hwrsg. + by rewrite Hwrsg wrs_group_insert. + - rewrite lookup_insert_ne in Hgm; last done. + specialize (Hwrsg _ _ Hgm). simpl in Hwrsg. + subst m. + by rewrite wrs_group_insert_ne; last rewrite Hgid. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txn/txn_write.v b/src/program_proof/tulip/program/txn/txn_write.v new file mode 100644 index 000000000..d037c55f2 --- /dev/null +++ b/src/program_proof/tulip/program/txn/txn_write.v @@ -0,0 +1,38 @@ +From Perennial.program_proof.tulip.program Require Import prelude. +From Perennial.program_proof.tulip.program.txn Require Import res txn_repr txn_setwrs. + +Section program. + Context `{!heapGS Σ, !tulip_ghostG Σ}. + + Theorem wp_Txn__Write txn tid key value rds γ τ : + {{{ own_txn txn tid rds γ τ ∗ (∃ vprev, txnmap_ptsto τ key vprev) }}} + Txn__Write #txn #(LitString key) #(LitString value) + {{{ RET #(); own_txn txn tid rds γ τ ∗ txnmap_ptsto τ key (Some value) }}}. + Proof. + iIntros (Φ) "[Htxn [%v Hpt]] HΦ". + wp_rec. + + (*@ func (txn *Txn) Write(key string, value string) { @*) + (*@ v := tulip.Value{ @*) + (*@ Present : true, @*) + (*@ Content : value, @*) + (*@ } @*) + (*@ txn.setwrs(key, v) @*) + (*@ } @*) + iNamed "Htxn". + wp_pures. + wp_apply (wp_Txn__setwrs _ _ (Some value) with "Hwrs"). + iIntros "Hwrs". + wp_pures. + iApply "HΦ". + iDestruct (txnmap_lookup with "Htxnmap Hpt") as %Hlookup. + apply elem_of_dom_2 in Hlookup. + iMod (txnmap_update (Some value) with "Htxnmap Hpt") as "[Htxnmap Hpt]". + rewrite insert_union_l. + iFrame "∗ # %". + iPureIntro. + rewrite /valid_wrs dom_insert_L. + set_solver. + Qed. + +End program. diff --git a/src/program_proof/tulip/program/txnlog/txnlog.v b/src/program_proof/tulip/program/txnlog/txnlog.v index 8dbd4db62..9567f6b45 100644 --- a/src/program_proof/tulip/program/txnlog/txnlog.v +++ b/src/program_proof/tulip/program/txnlog/txnlog.v @@ -3,12 +3,6 @@ From Perennial.program_proof.tulip.program Require Import prelude. Section program. Context `{!heapGS Σ, !tulip_ghostG Σ}. - Definition own_pwrs_slice (pwrsS : Slice.t) (c : ccommand) : iProp Σ := - match c with - | CmdCommit _ pwrs => (∃ pwrsL : list dbmod, own_dbmap_in_slice pwrsS pwrsL pwrs) - | _ => True - end. - Definition is_txnlog (txnlog : loc) (gid : u64) (γ : tulip_names) : iProp Σ. Admitted.