From b918872af0bfeb92948ce5c657d7c0f9ab97f3f8 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:06:45 +0100 Subject: [PATCH 01/35] Add Lean disaster recovery transition model Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery/.gitignore | 1 + lean/disaster-recovery/DisasterRecovery.lean | 1 + .../DisasterRecovery/Protocol/Model.lean | 290 ++++++++++++++++++ lean/disaster-recovery/lake-manifest.json | 116 +++++++ lean/disaster-recovery/lakefile.toml | 14 + lean/disaster-recovery/lean-toolchain | 1 + 6 files changed, 423 insertions(+) create mode 100644 lean/disaster-recovery/.gitignore create mode 100644 lean/disaster-recovery/DisasterRecovery.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/Model.lean create mode 100644 lean/disaster-recovery/lake-manifest.json create mode 100644 lean/disaster-recovery/lakefile.toml create mode 100644 lean/disaster-recovery/lean-toolchain diff --git a/lean/disaster-recovery/.gitignore b/lean/disaster-recovery/.gitignore new file mode 100644 index 000000000000..4080d07dfc31 --- /dev/null +++ b/lean/disaster-recovery/.gitignore @@ -0,0 +1 @@ +/.lake/ diff --git a/lean/disaster-recovery/DisasterRecovery.lean b/lean/disaster-recovery/DisasterRecovery.lean new file mode 100644 index 000000000000..18d54a2a49b0 --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery.lean @@ -0,0 +1 @@ +import DisasterRecovery.Protocol.Model diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Model.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Model.lean new file mode 100644 index 000000000000..323e79f08c10 --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Model.lean @@ -0,0 +1,290 @@ +import Std + +namespace DisasterRecovery.Protocol + +abbrev Location := String + +structure TxID where + view : Nat + seqno : Nat +deriving Repr, BEq, ReflBEq, LawfulBEq, Hashable, Inhabited, DecidableEq + +inductive Phase where + | gossiping + | voting + | opening + | joining + | open +deriving Repr, BEq, ReflBEq, LawfulBEq, Hashable, Inhabited, DecidableEq + +inductive OpenKind where + | quorum + | failover +deriving Repr, BEq, ReflBEq, LawfulBEq, Hashable, Inhabited, DecidableEq + +inductive Validation where + | accepted + | rejected +deriving Repr, BEq, Hashable, Inhabited, DecidableEq + +structure Config where + instanceId : String + expectedLocations : List Location +deriving Repr, BEq, Hashable, Inhabited + +def Config.isValid (config : Config) : Bool := + !config.instanceId.isEmpty && + !config.expectedLocations.isEmpty && + !config.expectedLocations.any String.isEmpty && + config.expectedLocations.eraseDups.length = + config.expectedLocations.length + +structure NodeState where + location : Location + phase : Phase := .gossiping + timeoutState : Phase := .gossiping + gossips : List (Prod Location TxID) := [] + votes : List Location := [] + chosen : Option Location := none + openKind : Option OpenKind := none + restartRequested : Bool := false +deriving Repr, BEq, ReflBEq, LawfulBEq, Hashable, Inhabited + +inductive Event where + | receiveGossip (source : Location) (txid : TxID) (validation : Validation) + | receiveVote (source : Location) (validation : Validation) + | receiveIAmOpen (source : Location) (validation : Validation) + | timeout + | retry +deriving Repr, BEq, Hashable + +inductive Effect where + | sendGossip (destination : Location) + | sendVote (destination : Location) + | sendIAmOpen (destination : Location) + | opening (kind : OpenKind) + | restart (chosen : Location) + | completed + | rejected (reason : String) +deriving Repr, BEq, Hashable + +structure StepOutput where + state : NodeState + effects : List Effect := [] + accepted : Bool := true +deriving Repr, BEq, Inhabited + +structure SystemState where + nodes : List (Prod Location NodeState) +deriving Repr, BEq, Hashable, Inhabited + +def phaseName : Phase -> String + | .gossiping => "GOSSIPING" + | .voting => "VOTING" + | .opening => "OPENING" + | .joining => "JOINING" + | .open => "OPEN" + +def openKindName : OpenKind -> String + | .quorum => "QUORUM" + | .failover => "FAILOVER" + +def initialNode (location : Location) : NodeState := + { location } + +def initialSystem (config : Config) : SystemState := + { nodes := config.expectedLocations.map fun location => + (location, initialNode location) } + +def voteQuorum (config : Config) : Nat := + config.expectedLocations.length / 2 + 1 + +def validTimeout (state : NodeState) (timeout : Bool) : Bool := + timeout && decide (state.phase = state.timeoutState) + +def txScoreGreater + (leftName : Location) + (left : TxID) + (rightName : Location) + (right : TxID) : Bool := + right.view < left.view || + (right.view == left.view && + (right.seqno < left.seqno || + (right.seqno == left.seqno && rightName < leftName))) + +def selectMaximum + (current candidate : Prod Location TxID) : + Prod Location TxID := + if txScoreGreater candidate.1 candidate.2 current.1 current.2 then + candidate + else + current + +def maximumGossip : List (Prod Location TxID) -> Option (Prod Location TxID) + | [] => none + | head :: tail => + some (tail.foldl selectMaximum head) + +def insertGossip + (source : Location) + (txid : TxID) + (gossips : List (Prod Location TxID)) : + List (Prod Location TxID) := + if gossips.any (fun entry => entry.1 == source) then + gossips + else + ((source, txid) :: gossips).mergeSort (fun left right => left.1 <= right.1) + +def insertVote (source : Location) (votes : List Location) : List Location := + if votes.contains source then votes + else (source :: votes).mergeSort (fun left right => left <= right) + +def advanceTimeoutState : Phase -> Phase + | .gossiping => .voting + | .voting => .opening + | state => state + +def advanceTimeoutLane (state : NodeState) (timeout : Bool) : NodeState := + if timeout then + { state with timeoutState := advanceTimeoutState state.timeoutState } + else + state + +def advance (config : Config) (state : NodeState) (timeout : Bool) : + Option StepOutput := + let aligned := validTimeout state timeout + match state.phase with + | .gossiping => + if decide (state.gossips.length >= config.expectedLocations.length) || aligned then + match maximumGossip state.gossips with + | none => none + | some (chosen, _) => + let next := { state with phase := .voting, chosen := some chosen } + some { state := advanceTimeoutLane next timeout } + else + some { state := advanceTimeoutLane state timeout } + | .voting => + let sufficient := decide (state.votes.length >= voteQuorum config) + if sufficient || aligned then + if aligned && state.votes.isEmpty then + some { state } + else + let kind := if aligned && !sufficient then .failover else .quorum + let next := { + state with + phase := .opening + openKind := some kind + } + some { + state := advanceTimeoutLane next timeout + effects := [.opening kind] + } + else + some { state := advanceTimeoutLane state timeout } + | .joining => + match state.chosen with + | none => none + | some chosen => + some { + state := advanceTimeoutLane + { state with restartRequested := true } timeout + effects := [.restart chosen] + } + | .opening => + if aligned then + some { + state := advanceTimeoutLane { state with phase := .open } timeout + effects := [.completed] + } + else + some { state := advanceTimeoutLane state timeout } + | .open => + some { state := advanceTimeoutLane state timeout } + +def rejected (state : NodeState) (reason : String) : StepOutput := + { state, effects := [.rejected reason], accepted := false } + +def step (config : Config) (state : NodeState) : Event -> StepOutput + | .receiveGossip source txid validation => + match validation with + | .rejected => rejected state "quote-or-certificate" + | .accepted => + if state.chosen != none then + rejected state "gossip-frozen" + else + let received := { state with + gossips := insertGossip source txid state.gossips } + (advance config received false).getD + (rejected state "empty-gossip-advance") + | .receiveVote source validation => + match validation with + | .rejected => rejected state "quote-or-certificate" + | .accepted => + let received := { state with votes := insertVote source state.votes } + (advance config received false).getD + (rejected state "vote-advance") + | .receiveIAmOpen source validation => + match validation with + | .rejected => rejected state "quote-or-certificate" + | .accepted => + match state.phase with + | .opening | .open => + rejected state "already-opening-or-open" + | _ => + let received := { + state with + phase := .joining + chosen := some source + } + (advance config received false).getD + (rejected state "join-without-chosen") + | .timeout => + (advance config state true).getD + (rejected state "empty-gossip-timeout-aborts") + | .retry => + let effects := + match state.phase with + | .gossiping => + config.expectedLocations.map .sendGossip + | .voting => + match state.chosen with + | none => config.expectedLocations.map .sendGossip + | some chosen => + .sendVote chosen :: config.expectedLocations.map .sendGossip + | .opening => + (config.expectedLocations.filter + (fun location => location != state.location)).map .sendIAmOpen + | .joining | .open => [] + { state, effects } + +def replaceNode + (target : Location) + (next : NodeState) + (nodes : List (Prod Location NodeState)) : + List (Prod Location NodeState) := + nodes.map fun entry => if entry.1 == target then (target, next) else entry + +def systemStep + (config : Config) + (state : SystemState) + (target : Location) + (event : Event) : + Option (Prod SystemState StepOutput) := do + let node <- (state.nodes.find? fun entry => entry.1 == target).map Prod.snd + let output := step config node event + pure ({ + nodes := replaceNode target output.state state.nodes + }, output) + +def expectedSource (config : Config) (source : Location) : Bool := + config.expectedLocations.contains source + +def stateKey (state : NodeState) : String := + let gossips := String.intercalate "," (state.gossips.map fun entry => + s!"{entry.1}@{entry.2.view}.{entry.2.seqno}") + let votes := String.intercalate "," state.votes + let chosen := state.chosen.getD "-" + let kind := state.openKind.map openKindName |>.getD "-" + s!"{state.location}|{phaseName state.phase}|{phaseName state.timeoutState}|g={gossips}|v={votes}|c={chosen}|k={kind}|r={state.restartRequested}" + +end DisasterRecovery.Protocol diff --git a/lean/disaster-recovery/lake-manifest.json b/lean/disaster-recovery/lake-manifest.json new file mode 100644 index 000000000000..4df3dace4b34 --- /dev/null +++ b/lean/disaster-recovery/lake-manifest.json @@ -0,0 +1,116 @@ +{ + "version": "1.1.0", + "packagesDir": ".lake/packages", + "packages": [ + { + "url": "https://github.com/leanprover-community/mathlib4.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", + "name": "mathlib", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": false, + "configFile": "lakefile.lean" + }, + { + "url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/LeanSearchClient", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "name": "LeanSearchClient", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/import-graph", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", + "name": "importGraph", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/ProofWidgets4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", + "name": "proofwidgets", + "manifestFile": "lake-manifest.json", + "inputRev": "v0.0.87", + "inherited": true, + "configFile": "lakefile.lean" + }, + { + "url": "https://github.com/leanprover-community/aesop", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", + "name": "aesop", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/quote4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", + "name": "Qq", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/batteries", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", + "name": "batteries", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover/lean4-cli", + "type": "git", + "subDir": null, + "scope": "leanprover", + "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.toml" + } + ], + "name": "disaster_recovery", + "lakeDir": ".lake" +} diff --git a/lean/disaster-recovery/lakefile.toml b/lean/disaster-recovery/lakefile.toml new file mode 100644 index 000000000000..df0456dcd8c3 --- /dev/null +++ b/lean/disaster-recovery/lakefile.toml @@ -0,0 +1,14 @@ +name = "disaster_recovery" +version = "0.1.0" +moreLeanArgs = ["-DwarningAsError=true"] +defaultTargets = [ + "DisasterRecovery", +] + +[[require]] +name = "mathlib" +git = "https://github.com/leanprover-community/mathlib4.git" +rev = "v4.28.0" + +[[lean_lib]] +name = "DisasterRecovery" diff --git a/lean/disaster-recovery/lean-toolchain b/lean/disaster-recovery/lean-toolchain new file mode 100644 index 000000000000..4c685fa085fa --- /dev/null +++ b/lean/disaster-recovery/lean-toolchain @@ -0,0 +1 @@ +leanprover/lean4:v4.28.0 From 497efc990afcfdfbc693d6b00858e47975626928 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:06:56 +0100 Subject: [PATCH 02/35] Prove local recovery safety and liveness Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery/DisasterRecovery.lean | 1 + .../DisasterRecovery/Protocol/Temporal.lean | 231 ++++++++++++++++++ 2 files changed, 232 insertions(+) create mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean diff --git a/lean/disaster-recovery/DisasterRecovery.lean b/lean/disaster-recovery/DisasterRecovery.lean index 18d54a2a49b0..7fc1d3ad48aa 100644 --- a/lean/disaster-recovery/DisasterRecovery.lean +++ b/lean/disaster-recovery/DisasterRecovery.lean @@ -1 +1,2 @@ import DisasterRecovery.Protocol.Model +import DisasterRecovery.Protocol.Temporal diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean new file mode 100644 index 000000000000..72db88bcbc0b --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean @@ -0,0 +1,231 @@ +import DisasterRecovery.Protocol.Model + +namespace DisasterRecovery.Protocol + +def EventuallyFrom (start : Nat) (predicate : Nat -> Prop) : Prop := + exists n, start <= n /\ predicate n + +def AlwaysFrom (start : Nat) (predicate : Nat -> Prop) : Prop := + forall n, start <= n -> predicate n + +def InfinitelyOften (predicate : Nat -> Prop) : Prop := + forall start, EventuallyFrom start predicate + +def EventuallyAlways (predicate : Nat -> Prop) : Prop := + exists start, AlwaysFrom start predicate + +structure Execution (config : Config) where + states : Nat -> NodeState + events : Nat -> Event + step_succ : forall n, + states (n + 1) = (step config (states n) (events n)).state + +def WeakFairness + {config : Config} + (execution : Execution config) + (enabled : NodeState -> Prop) + (fired : NodeState -> Event -> Prop) : Prop := + forall start, + AlwaysFrom start (fun n => enabled (execution.states n)) -> + EventuallyFrom start + (fun n => fired (execution.states n) (execution.events n)) + +def StrongFairness + {config : Config} + (execution : Execution config) + (enabled : NodeState -> Prop) + (fired : NodeState -> Event -> Prop) : Prop := + InfinitelyOften (fun n => enabled (execution.states n)) -> + InfinitelyOften + (fun n => fired (execution.states n) (execution.events n)) + +def AlignedOpening (state : NodeState) : Prop := + state.phase = .opening /\ state.timeoutState = .opening + +theorem valid_timeout_requires_alignment + (state : NodeState) + (h : validTimeout state true = true) : + state.phase = state.timeoutState := by + simpa [validTimeout] using h + +theorem gossip_freezes_after_choice + (config : Config) + (state : NodeState) + (source : Location) + (txid : TxID) + (h : state.chosen.isSome = true) : + let output := step config state (.receiveGossip source txid .accepted) + output.state = state /\ output.accepted = false := by + cases chosen : state.chosen <;> simp_all [step, rejected] + +theorem rejected_gossip_stutters + (config : Config) + (state : NodeState) + (source : Location) + (txid : TxID) : + let output := step config state (.receiveGossip source txid .rejected) + output.state = state /\ output.accepted = false := by + simp [step, rejected] + +theorem duplicate_vote_is_idempotent + (source : Location) + (votes : List Location) + (h : votes.contains source = true) : + insertVote source votes = votes := by + unfold insertVote + rw [h] + simp + +theorem opening_rejects_iamopen + (config : Config) + (state : NodeState) + (source : Location) : + let opening := { state with phase := .opening } + let output := step config opening (.receiveIAmOpen source .accepted) + output.state = opening /\ output.accepted = false := by + simp [step, rejected] + +theorem open_rejects_iamopen + (config : Config) + (state : NodeState) + (source : Location) : + let opened := { state with phase := .open } + let output := step config opened (.receiveIAmOpen source .accepted) + output.state = opened /\ output.accepted = false := by + simp [step, rejected] + +theorem aligned_voting_timeout_without_votes_stutters + (config : Config) + (state : NodeState) : + let waiting := { + state with + phase := .voting + timeoutState := .voting + votes := [] + } + step config waiting .timeout = { state := waiting } := by + simp [step, advance, validTimeout, voteQuorum] + +theorem aligned_opening_timeout_completes + (config : Config) + (state : NodeState) : + let opening := { + state with + phase := .opening + timeoutState := .opening + } + let output := step config opening .timeout + output.state.phase = .open /\ + output.state.timeoutState = .opening /\ + output.effects = [.completed] := by + simp [step, advance, validTimeout, advanceTimeoutLane, advanceTimeoutState] + +theorem quorum_advance_opens + (config : Config) + (state : NodeState) + (phase : state.phase = .voting) + (quorum : state.votes.length >= voteQuorum config) : + let output := (advance config state false).get! + output.state.phase = .opening /\ + output.state.openKind = some .quorum /\ + output.effects = [.opening .quorum] := by + simp [advance, phase, quorum, validTimeout, advanceTimeoutLane] + +theorem aligned_empty_gossip_timeout_aborts + (config : Config) + (state : NodeState) : + let waiting := { + state with + phase := .gossiping + timeoutState := .gossiping + gossips := [] + } + let output := step config waiting .timeout + output.state = waiting /\ output.accepted = false := by + simp [step, advance, validTimeout, rejected, maximumGossip] + +theorem non_timeout_step_preserves_aligned_opening + (config : Config) + (state : NodeState) + (event : Event) + (aligned : AlignedOpening state) + (notTimeout : Not (event = .timeout)) : + AlignedOpening (step config state event).state := by + have phase := aligned.1 + have timeoutState := aligned.2 + cases event with + | receiveGossip source txid validation => + cases validation <;> + simp_all [AlignedOpening, step, rejected, advance, validTimeout, + advanceTimeoutLane] + split <;> simp_all + | receiveVote source validation => + cases validation <;> + simp_all [AlignedOpening, step, rejected, advance, validTimeout, + advanceTimeoutLane] + | receiveIAmOpen source validation => + cases validation <;> + simp_all [AlignedOpening, step, rejected] + | timeout => + exact (notTimeout rfl).elim + | retry => + simp [AlignedOpening, step, phase, timeoutState] + +theorem aligned_timeout_transitions_to_open + (config : Config) + (state : NodeState) + (aligned : AlignedOpening state) : + (step config state .timeout).state.phase = .open := by + have phase := aligned.1 + have timeoutState := aligned.2 + simp [step, advance, validTimeout, phase, timeoutState, + advanceTimeoutLane, advanceTimeoutState] + +theorem fairness_supplies_firing + {config : Config} + (execution : Execution config) + (enabled : NodeState -> Prop) + (fired : NodeState -> Event -> Prop) + (fair : WeakFairness execution enabled fired) + (alwaysEnabled : forall n, enabled (execution.states n)) : + InfinitelyOften + (fun n => fired (execution.states n) (execution.events n)) := by + intro start + exact fair start (fun n _ => alwaysEnabled n) + +theorem fair_aligned_opening_progress + {config : Config} + (execution : Execution config) + (initial : AlignedOpening (execution.states 0)) + (fair : WeakFairness execution AlignedOpening + (fun _ event => event = .timeout)) : + EventuallyFrom 0 + (fun n => (execution.states n).phase = .open) := by + apply Classical.byContradiction + intro noOpen + have neverOpen : + forall n, Not ((execution.states n).phase = .open) := by + intro n opened + apply noOpen + exact Exists.intro n (And.intro (Nat.zero_le n) opened) + have alignedAlways : forall n, AlignedOpening (execution.states n) := by + intro n + induction n with + | zero => exact initial + | succ n aligned => + have notTimeout : Not (execution.events n = .timeout) := by + intro timeout + apply neverOpen (n + 1) + rw [execution.step_succ n, timeout] + exact aligned_timeout_transitions_to_open config _ aligned + rw [execution.step_succ n] + exact non_timeout_step_preserves_aligned_opening + config _ _ aligned notTimeout + have firing := fair 0 (fun n _ => alignedAlways n) + let n := firing.choose + have timeout := firing.choose_spec.2 + apply neverOpen (n + 1) + rw [execution.step_succ n, timeout] + exact aligned_timeout_transitions_to_open config _ (alignedAlways n) + +end DisasterRecovery.Protocol \ No newline at end of file From f242dd49e6e252725db28cd7a5814433b851e587 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:07:08 +0100 Subject: [PATCH 03/35] Add global recovery semantics and invariants Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery/DisasterRecovery.lean | 2 + .../DisasterRecovery/Protocol/Global.lean | 166 ++++ .../DisasterRecovery/Protocol/Invariants.lean | 899 ++++++++++++++++++ 3 files changed, 1067 insertions(+) create mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean diff --git a/lean/disaster-recovery/DisasterRecovery.lean b/lean/disaster-recovery/DisasterRecovery.lean index 7fc1d3ad48aa..c20571142be1 100644 --- a/lean/disaster-recovery/DisasterRecovery.lean +++ b/lean/disaster-recovery/DisasterRecovery.lean @@ -1,2 +1,4 @@ import DisasterRecovery.Protocol.Model import DisasterRecovery.Protocol.Temporal +import DisasterRecovery.Protocol.Global +import DisasterRecovery.Protocol.Invariants diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean new file mode 100644 index 000000000000..c29b83a1305f --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean @@ -0,0 +1,166 @@ +import DisasterRecovery.Protocol.Model + +namespace DisasterRecovery.Protocol.Global + +structure Config where + protocol : Protocol.Config + recovered : List (Prod Location TxID) +deriving Repr, BEq + +def Config.Valid (config : Config) : Prop := + config.protocol.isValid = true /\ + config.protocol.expectedLocations.Nodup /\ + config.recovered.map Prod.fst = config.protocol.expectedLocations + +def recoveredTxID (config : Config) (source : Location) : Option TxID := + (config.recovered.find? fun entry => entry.1 == source).map Prod.snd + +inductive Payload where + | gossip (txid : TxID) + | vote + | iAmOpen +deriving Repr, BEq, ReflBEq, LawfulBEq + +structure Envelope where + source : Location + target : Location + payload : Payload + sourceState : NodeState +deriving Repr, BEq, ReflBEq, LawfulBEq + +structure Opening where + node : Location + kind : OpenKind + state : NodeState +deriving Repr, BEq + +structure State where + system : SystemState + active : List Location + network : List Envelope := [] + sent : List Envelope := [] + openings : List Opening := [] + restarts : List Location := [] + completed : List Location := [] +deriving Repr, BEq + +inductive Action where + | retry (source : Location) + | deliver (envelope : Envelope) + | timeout (target : Location) +deriving Repr, BEq + +def nodeState (state : State) (node : Location) : Option NodeState := + (state.system.nodes.find? fun entry => entry.1 == node).map Prod.snd + +def messageForEffect + (config : Config) + (source : Location) + (sourceState : NodeState) : Effect -> Option Envelope + | .sendGossip target => do + let txid <- recoveredTxID config source + pure { source, target, payload := .gossip txid, sourceState } + | .sendVote target => + some { source, target, payload := .vote, sourceState } + | .sendIAmOpen target => + some { source, target, payload := .iAmOpen, sourceState } + | _ => none + +def retryMessages + (config : Config) + (source : Location) + (sourceState : NodeState) : List Envelope := + (step config.protocol sourceState .retry).effects.filterMap + (messageForEffect config source sourceState) + +def Envelope.Valid (config : Config) (envelope : Envelope) : Prop := + envelope.sourceState.location = envelope.source /\ + envelope ∈ retryMessages config envelope.source envelope.sourceState + +def eventFor (envelope : Envelope) : Event := + match envelope.payload with + | .gossip txid => .receiveGossip envelope.source txid .accepted + | .vote => .receiveVote envelope.source .accepted + | .iAmOpen => .receiveIAmOpen envelope.source .accepted + +def removeOne [BEq α] (value : α) : List α -> List α + | [] => [] + | head :: tail => + if head == value then tail else head :: removeOne value tail + +def recordEffect + (node : Location) + (nodeState : NodeState) + (state : State) : Effect -> State + | .opening kind => + { + state with + openings := { node, kind, state := nodeState } :: state.openings + } + | .restart _ => + { state with restarts := node :: state.restarts } + | .completed => + { state with completed := node :: state.completed } + | _ => state + +def recordEffects + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : State := + effects.foldl (recordEffect node nodeState) state + +def initial (config : Config) (active : List Location) : State := { + system := initialSystem config.protocol + active +} + +def next (config : Config) (state : State) : Action -> Option State + | .retry source => do + guard (state.active.contains source) + let sourceState <- nodeState state source + let messages := retryMessages config source sourceState + guard (!messages.isEmpty) + pure { + state with + network := state.network ++ messages + sent := state.sent ++ messages + } + | .deliver envelope => do + guard (state.network.contains envelope) + guard (state.active.contains envelope.target) + let (system, output) <- + systemStep config.protocol state.system envelope.target + (eventFor envelope) + let delivered := { + state with + system + network := removeOne envelope state.network + } + pure + (recordEffects envelope.target output.state output.effects delivered) + | .timeout target => do + guard (state.active.contains target) + let (system, output) <- + systemStep config.protocol state.system target .timeout + guard output.accepted + pure + (recordEffects target output.state output.effects { state with system }) + +inductive Reachable (config : Config) : State -> Prop where + | initial + (active : List Location) + (valid : config.Valid) + (nodup : active.Nodup) + (configured : + forall node, node ∈ active -> + node ∈ config.protocol.expectedLocations) : + Reachable config (Global.initial config active) + | step + {state nextState : State} + {action : Action} + (reachable : Reachable config state) + (transition : next config state action = some nextState) : + Reachable config nextState + +end DisasterRecovery.Protocol.Global diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean new file mode 100644 index 000000000000..3fa11e0bcdd1 --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean @@ -0,0 +1,899 @@ +import DisasterRecovery.Protocol.Global +import Mathlib.Tactic + +namespace DisasterRecovery.Protocol.Global + +structure HistoriesActive (state : State) : Prop where + openings : + forall opening, opening ∈ state.openings -> + opening.node ∈ state.active + restarts : + forall node, node ∈ state.restarts -> + node ∈ state.active + completed : + forall node, node ∈ state.completed -> + node ∈ state.active + +structure WellFormed (config : Config) (state : State) : Prop where + nodeKeys : + state.system.nodes.map Prod.fst = + config.protocol.expectedLocations + nodeKeysNodup : (state.system.nodes.map Prod.fst).Nodup + nodeLocations : + forall entry, entry ∈ state.system.nodes -> + entry.2.location = entry.1 + activeNodup : state.active.Nodup + activeConfigured : + forall node, node ∈ state.active -> + node ∈ config.protocol.expectedLocations + sentValid : + forall envelope, envelope ∈ state.sent -> + envelope.Valid config + sentSourceActive : + forall envelope, envelope ∈ state.sent -> + envelope.source ∈ state.active + networkSent : + forall envelope, envelope ∈ state.network -> + envelope ∈ state.sent + historiesActive : HistoriesActive state + +theorem messageForEffect_source + {config : Config} + {source : Location} + {sourceState : NodeState} + {effect : Effect} + {envelope : Envelope} + (created : + messageForEffect config source sourceState effect = some envelope) : + envelope.source = source /\ + envelope.sourceState = sourceState := by + cases effect with + | sendGossip target => + cases found : recoveredTxID config source with + | none => + simp [messageForEffect, found] at created + | some txid => + simp [messageForEffect, found] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | sendVote target => + simp [messageForEffect] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | opening kind => + simp_all [messageForEffect] + | restart chosen => + simp_all [messageForEffect] + | completed => + simp_all [messageForEffect] + | rejected reason => + simp_all [messageForEffect] + +theorem retryMessages_source + {config : Config} + {source : Location} + {sourceState : NodeState} + {envelope : Envelope} + (created : + envelope ∈ retryMessages config source sourceState) : + envelope.source = source /\ + envelope.sourceState = sourceState := by + rw [retryMessages, List.mem_filterMap] at created + rcases created with ⟨effect, _, produced⟩ + exact messageForEffect_source produced + +theorem retryMessages_valid + (config : Config) + (source : Location) + (sourceState : NodeState) + (sourceLocation : sourceState.location = source) : + forall envelope, + envelope ∈ retryMessages config source sourceState -> + envelope.Valid config := by + intro envelope created + rcases retryMessages_source created with + ⟨sourceEq, stateEq⟩ + constructor + · rw [stateEq, sourceEq] + exact sourceLocation + · rw [sourceEq, stateEq] + exact created + +theorem valid_envelope_effect + {config : Config} + {envelope : Envelope} + (valid : envelope.Valid config) : + exists effect, + effect ∈ + (step config.protocol envelope.sourceState .retry).effects /\ + messageForEffect config envelope.source + envelope.sourceState effect = some envelope := by + rcases valid with ⟨_, created⟩ + rw [retryMessages, List.mem_filterMap] at created + exact created + +theorem valid_gossip_uses_recovered_txid + {config : Config} + {envelope : Envelope} + {txid : TxID} + (valid : envelope.Valid config) + (gossip : envelope.payload = .gossip txid) : + recoveredTxID config envelope.source = some txid := by + rcases valid_envelope_effect valid with + ⟨effect, _, created⟩ + cases effect with + | sendGossip target => + cases found : recoveredTxID config envelope.source with + | none => + simp [messageForEffect, found] at created + | some recovered => + simp [messageForEffect, found] at created + rw [←created] at gossip + injection gossip with same + subst recovered + rfl + | sendVote target => + simp [messageForEffect] at created + rw [←created] at gossip + contradiction + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] at gossip + contradiction + | opening kind => + simp [messageForEffect] at created + | restart chosen => + simp [messageForEffect] at created + | completed => + simp [messageForEffect] at created + | rejected reason => + simp [messageForEffect] at created + +theorem step_preserves_location + (config : Protocol.Config) + (state : NodeState) + (event : Event) : + (step config state event).state.location = state.location := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] + all_goals repeat first | split | simp_all + +theorem nodeState_location + {state : State} + {node : Location} + {foundState : NodeState} + (locations : + forall entry, entry ∈ state.system.nodes -> + entry.2.location = entry.1) + (found : nodeState state node = some foundState) : + foundState.location = node := by + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have membership : entry ∈ state.system.nodes := + List.mem_of_find?_eq_some findEq + have condition : (entry.1 == node) = true := + List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq + have keyEq : entry.1 = node := beq_iff_eq.mp condition + rw [←stateEq, locations entry membership, keyEq] + +theorem initial_well_formed + (config : Config) + (active : List Location) + (valid : config.Valid) + (activeNodup : active.Nodup) + (activeConfigured : + forall node, node ∈ active -> + node ∈ config.protocol.expectedLocations) : + WellFormed config (initial config active) := by + constructor + · simp [Global.initial, initialSystem, Function.comp_def] + · simpa [Global.initial, initialSystem, Function.comp_def] using valid.2.1 + · simp [Global.initial, initialSystem, initialNode] + · exact activeNodup + · exact activeConfigured + · simp [Global.initial] + · simp [Global.initial] + · simp [Global.initial] + · constructor <;> simp [Global.initial] + +@[simp] +theorem recordEffects_active + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).active = state.active := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).active = + state.active + rw [ih] + cases effect <;> rfl + +@[simp] +theorem recordEffects_system + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).system = state.system := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).system = + state.system + rw [ih] + cases effect <;> rfl + +@[simp] +theorem recordEffects_network + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).network = state.network := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).network = + state.network + rw [ih] + cases effect <;> rfl + +@[simp] +theorem recordEffects_sent + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).sent = state.sent := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).sent = + state.sent + rw [ih] + cases effect <;> rfl + +theorem recordEffect_preserves_histories_active + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + (wellFormed : HistoriesActive state) + (nodeActive : node ∈ state.active) : + HistoriesActive (recordEffect node nodeState state effect) := by + rcases wellFormed with ⟨openings, restarts, completed⟩ + cases effect <;> + constructor <;> + simp_all [recordEffect] + +theorem recordEffects_preserves_histories_active + {node : Location} + {nodeState : NodeState} + {effects : List Effect} + {state : State} + (wellFormed : HistoriesActive state) + (nodeActive : node ∈ state.active) : + HistoriesActive (recordEffects node nodeState effects state) := by + induction effects generalizing state with + | nil => exact wellFormed + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + apply ih + · exact recordEffect_preserves_histories_active wellFormed nodeActive + · cases effect <;> simpa [recordEffect] using nodeActive + +theorem mem_of_mem_removeOne + [BEq α] + (value member : α) + (values : List α) : + member ∈ removeOne value values -> + member ∈ values := by + induction values with + | nil => simp [removeOne] + | cons head tail ih => + simp only [removeOne] + split + · exact List.mem_cons_of_mem head + · intro membership + rw [List.mem_cons] at membership ⊢ + exact membership.imp_right ih + +theorem mem_openings_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {opening : Opening} + (membership : opening ∈ state.openings) : + opening ∈ (recordEffect node nodeState state effect).openings := by + cases effect <;> simp_all [recordEffect] + +theorem mem_restarts_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {restart : Location} + (membership : restart ∈ state.restarts) : + restart ∈ (recordEffect node nodeState state effect).restarts := by + cases effect <;> simp_all [recordEffect] + +theorem mem_completed_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {completed : Location} + (membership : completed ∈ state.completed) : + completed ∈ (recordEffect node nodeState state effect).completed := by + cases effect <;> simp_all [recordEffect] + +theorem mem_openings_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {opening : Opening} + (membership : opening ∈ state.openings) : + opening ∈ (recordEffects node nodeState effects state).openings := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_openings_recordEffect membership) + +theorem mem_restarts_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {restart : Location} + (membership : restart ∈ state.restarts) : + restart ∈ (recordEffects node nodeState effects state).restarts := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_restarts_recordEffect membership) + +theorem mem_completed_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {completed : Location} + (membership : completed ∈ state.completed) : + completed ∈ (recordEffects node nodeState effects state).completed := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_completed_recordEffect membership) + +theorem replaceNode_keys + (target : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) : + (replaceNode target nextState nodes).map Prod.fst = + nodes.map Prod.fst := by + induction nodes with + | nil => rfl + | cons entry tail ih => + simp only [replaceNode, List.map_cons] + split + · + rename_i condition + have same : entry.1 = target := beq_iff_eq.mp condition + simp only [List.cons.injEq] + constructor + · exact same.symm + · simpa [replaceNode] using ih + · + simp only [List.cons.injEq, true_and] + simpa [replaceNode] using ih + +theorem replaceNode_locations + (target : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) + (locations : + forall entry, entry ∈ nodes -> + entry.2.location = entry.1) + (nextLocation : nextState.location = target) : + forall entry, entry ∈ replaceNode target nextState nodes -> + entry.2.location = entry.1 := by + intro entry membership + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · exact nextLocation + · exact locations previous previousMember + +theorem findNode_replaceNode_ne + (target other : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) + (different : other ≠ target) : + ((replaceNode target nextState nodes).find? + fun entry => entry.1 == other).map Prod.snd = + (nodes.find? fun entry => entry.1 == other).map Prod.snd := by + let replace : Prod Location NodeState -> Prod Location NodeState := + fun entry => + if entry.1 == target then (target, nextState) else entry + change + Option.map Prod.snd + (List.find? (fun entry => entry.1 == other) + (nodes.map replace)) = + Option.map Prod.snd + (List.find? (fun entry => entry.1 == other) nodes) + rw [List.find?_map] + have predicate : + ((fun entry : Prod Location NodeState => entry.1 == other) ∘ + replace) = + (fun entry => entry.1 == other) := by + funext entry + by_cases atTarget : entry.1 = target + · simp [replace, atTarget] + · simp [replace, atTarget] + rw [predicate] + cases found : + List.find? (fun entry : Prod Location NodeState => + entry.1 == other) nodes with + | none => simp + | some entry => + have condition : + (entry.1 == other) = true := + List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == other) found + have entryOther : entry.1 = other := + beq_iff_eq.mp condition + have notTarget : entry.1 ≠ target := by + simpa [entryOther] using different + simp [replace, notTarget] + +theorem systemStep_node_keys_eq + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (transition : + systemStep config before target event = some (after, output)) : + after.nodes.map Prod.fst = before.nodes.map Prod.fst := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with ⟨node, _, stateEq, _⟩ + rw [←stateEq] + exact replaceNode_keys target + (step config node event).state before.nodes + +theorem systemStep_preserves_node_locations + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (locations : + forall entry, entry ∈ before.nodes -> + entry.2.location = entry.1) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.location = entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, stateEq, _⟩ + rw [←stateEq] + apply replaceNode_locations + · exact locations + · calc + (step config node event).state.location = + node.location := step_preserves_location config node event + _ = key := + locations (key, node) (List.mem_of_find?_eq_some found) + _ = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + +theorem systemStep_other_node_eq + {config : Protocol.Config} + {before after : SystemState} + {target other : Location} + {event : Event} + {output : StepOutput} + (different : other ≠ target) + (transition : + systemStep config before target event = some (after, output)) : + (after.nodes.find? fun entry => entry.1 == other).map Prod.snd = + (before.nodes.find? fun entry => entry.1 == other).map Prod.snd := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with ⟨node, _, stateEq, _⟩ + rw [←stateEq] + exact findNode_replaceNode_ne target other + (step config node event).state before.nodes different + +theorem next_active_eq + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + after.active = before.active := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, _, system, output, _, rfl⟩ + simp + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, system, output, _, _, rfl⟩ + simp + +theorem next_node_keys_eq + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + after.system.nodes.map Prod.fst = + before.system.nodes.map Prod.fst := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, _, system, output, systemStep, rfl⟩ + simpa using systemStep_node_keys_eq systemStep + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, system, output, systemStep, _, rfl⟩ + simpa using systemStep_node_keys_eq systemStep + +theorem retry_system_eq + {config : Config} + {before after : State} + {source : Location} + (transition : next config before (.retry source) = some after) : + after.system = before.system := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + +theorem deliver_network_eq + {config : Config} + {before after : State} + {envelope : Envelope} + (transition : next config before (.deliver envelope) = some after) : + after.network = removeOne envelope before.network := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + simp + +theorem timeout_network_eq + {config : Config} + {before after : State} + {target : Location} + (transition : next config before (.timeout target) = some after) : + after.network = before.network := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + simp + +theorem deliver_other_node_eq + {config : Config} + {before after : State} + {envelope : Envelope} + {other : Location} + (different : other ≠ envelope.target) + (transition : next config before (.deliver envelope) = some after) : + nodeState after other = nodeState before other := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + simp only [nodeState, recordEffects_system] + exact systemStep_other_node_eq different systemStep + +theorem timeout_other_node_eq + {config : Config} + {before after : State} + {target other : Location} + (different : other ≠ target) + (transition : next config before (.timeout target) = some after) : + nodeState after other = nodeState before other := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + simp only [nodeState, recordEffects_system] + exact systemStep_other_node_eq different systemStep + +theorem next_sent_extends + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + exists added, after.sent = before.sent ++ added := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact ⟨retryMessages config source sourceState, rfl⟩ + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + refine ⟨[], ?_⟩ + simp + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + refine ⟨[], ?_⟩ + simp + +theorem next_openings_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall opening, opening ∈ before.openings -> + opening ∈ after.openings := by + intro opening membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_openings_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_openings_recordEffects + simpa using membership + +theorem next_restarts_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall restart, restart ∈ before.restarts -> + restart ∈ after.restarts := by + intro restart membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_restarts_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_restarts_recordEffects + simpa using membership + +theorem next_completed_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall completed, completed ∈ before.completed -> + completed ∈ after.completed := by + intro completed membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_completed_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_completed_recordEffects + simpa using membership + +theorem retry_preserves_well_formed + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (transition : next config before (.retry source) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨sourceActive, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + constructor + · exact wellFormed.nodeKeys + · exact wellFormed.nodeKeysNodup + · exact wellFormed.nodeLocations + · exact wellFormed.activeNodup + · exact wellFormed.activeConfigured + · intro envelope membership + rw [List.mem_append] at membership + rcases membership with membership | membership + · exact wellFormed.sentValid envelope membership + · exact retryMessages_valid config source sourceState + sourceLocation envelope membership + · intro envelope membership + rw [List.mem_append] at membership + rcases membership with membership | membership + · exact wellFormed.sentSourceActive envelope membership + · rw [(retryMessages_source membership).1] + exact sourceActive + · intro envelope membership + rw [List.mem_append] at membership ⊢ + rcases membership with membership | membership + · exact Or.inl (wellFormed.networkSent envelope membership) + · exact Or.inr membership + · constructor + · exact wellFormed.historiesActive.openings + · exact wellFormed.historiesActive.restarts + · exact wellFormed.historiesActive.completed + +theorem deliver_preserves_well_formed + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (transition : next config before (.deliver envelope) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, targetActive, system, output, systemStep, stateEq⟩ + rw [←stateEq] + constructor + · simp only [recordEffects_system] + exact (systemStep_node_keys_eq systemStep).trans + wellFormed.nodeKeys + · rw [recordEffects_system, systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · simp only [recordEffects_system] + exact systemStep_preserves_node_locations + wellFormed.nodeLocations systemStep + · simpa using wellFormed.activeNodup + · simpa using wellFormed.activeConfigured + · intro sent membership + rw [recordEffects_sent] at membership + exact wellFormed.sentValid sent membership + · intro sent membership + rw [recordEffects_sent] at membership + rw [recordEffects_active] + exact wellFormed.sentSourceActive sent membership + · intro pending membership + rw [recordEffects_network] at membership + rw [recordEffects_sent] + exact wellFormed.networkSent pending + (mem_of_mem_removeOne envelope pending before.network membership) + · apply recordEffects_preserves_histories_active + · constructor + · simpa using wellFormed.historiesActive.openings + · simpa using wellFormed.historiesActive.restarts + · simpa using wellFormed.historiesActive.completed + · simpa using targetActive + +theorem timeout_preserves_well_formed + {config : Config} + {before after : State} + {target : Location} + (wellFormed : WellFormed config before) + (transition : next config before (.timeout target) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨targetActive, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + constructor + · simp only [recordEffects_system] + exact (systemStep_node_keys_eq systemStep).trans + wellFormed.nodeKeys + · rw [recordEffects_system, systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · simp only [recordEffects_system] + exact systemStep_preserves_node_locations + wellFormed.nodeLocations systemStep + · simpa using wellFormed.activeNodup + · simpa using wellFormed.activeConfigured + · intro sent membership + rw [recordEffects_sent] at membership + exact wellFormed.sentValid sent membership + · intro sent membership + rw [recordEffects_sent] at membership + rw [recordEffects_active] + exact wellFormed.sentSourceActive sent membership + · intro pending membership + rw [recordEffects_network] at membership + rw [recordEffects_sent] + exact wellFormed.networkSent pending membership + · apply recordEffects_preserves_histories_active + · constructor + · simpa using wellFormed.historiesActive.openings + · simpa using wellFormed.historiesActive.restarts + · simpa using wellFormed.historiesActive.completed + · simpa using targetActive + +theorem next_preserves_well_formed + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (transition : next config before action = some after) : + WellFormed config after := by + cases action with + | retry source => + exact retry_preserves_well_formed wellFormed transition + | deliver envelope => + exact deliver_preserves_well_formed wellFormed transition + | timeout target => + exact timeout_preserves_well_formed wellFormed transition + +theorem reachable_well_formed + {config : Config} + {state : State} + (reachable : Reachable config state) : + WellFormed config state := by + induction reachable with + | initial active valid nodup configured => + exact initial_well_formed config active valid nodup configured + | step reachable transition wellFormed => + exact next_preserves_well_formed wellFormed transition + +theorem reachable_config_valid + {config : Config} + {state : State} + (reachable : Reachable config state) : + config.Valid := by + induction reachable with + | initial active valid nodup configured => exact valid + | step reachable transition valid => exact valid + +end DisasterRecovery.Protocol.Global From 065dea3c2163feaab8821b7d890ee22ad98ce5eb Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:07:15 +0100 Subject: [PATCH 04/35] Prove quorum and committed-prefix safety Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery/DisasterRecovery.lean | 2 + .../DisasterRecovery/Protocol/Committed.lean | 258 +++ .../DisasterRecovery/Protocol/Quorum.lean | 1467 +++++++++++++++++ 3 files changed, 1727 insertions(+) create mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean diff --git a/lean/disaster-recovery/DisasterRecovery.lean b/lean/disaster-recovery/DisasterRecovery.lean index c20571142be1..e316316223a6 100644 --- a/lean/disaster-recovery/DisasterRecovery.lean +++ b/lean/disaster-recovery/DisasterRecovery.lean @@ -2,3 +2,5 @@ import DisasterRecovery.Protocol.Model import DisasterRecovery.Protocol.Temporal import DisasterRecovery.Protocol.Global import DisasterRecovery.Protocol.Invariants +import DisasterRecovery.Protocol.Quorum +import DisasterRecovery.Protocol.Committed diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean new file mode 100644 index 000000000000..aeaec563bea1 --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean @@ -0,0 +1,258 @@ +import DisasterRecovery.Protocol.Quorum +import Mathlib.Tactic + +namespace DisasterRecovery.Protocol + +namespace TxID + +def PrefixOf (left right : TxID) : Prop := + left.view < right.view \/ + (left.view = right.view /\ left.seqno <= right.seqno) + +theorem prefix_refl (txid : TxID) : PrefixOf txid txid := by + simp [PrefixOf] + +theorem prefix_trans + {first second third : TxID} + (firstSecond : PrefixOf first second) + (secondThird : PrefixOf second third) : + PrefixOf first third := by + simp [PrefixOf] at firstSecond secondThird ⊢ + omega + +end TxID + +namespace Global + +theorem prefix_of_score_true + (leftName rightName : Location) + (left right : TxID) + (score : + txScoreGreater leftName left rightName right = true) : + TxID.PrefixOf right left := by + simp [txScoreGreater] at score + simp [TxID.PrefixOf] + omega + +theorem prefix_of_score_false + (leftName rightName : Location) + (left right : TxID) + (score : + txScoreGreater leftName left rightName right = false) : + TxID.PrefixOf left right := by + simp [txScoreGreater] at score + simp [TxID.PrefixOf] + omega + +theorem current_prefix_selectMaximum + (current candidate : Prod Location TxID) : + TxID.PrefixOf current.2 + (selectMaximum current candidate).2 := by + unfold selectMaximum + split + · rename_i score + exact prefix_of_score_true + candidate.1 current.1 candidate.2 current.2 score + · exact TxID.prefix_refl current.2 + +theorem candidate_prefix_selectMaximum + (current candidate : Prod Location TxID) : + TxID.PrefixOf candidate.2 + (selectMaximum current candidate).2 := by + unfold selectMaximum + split + · exact TxID.prefix_refl candidate.2 + · rename_i score + exact prefix_of_score_false + candidate.1 current.1 candidate.2 current.2 + (Bool.eq_false_iff.mpr score) + +theorem foldl_selectMaximum_upper_bound + (current member : Prod Location TxID) + (tail : List (Prod Location TxID)) + (membership : member = current \/ member ∈ tail) : + TxID.PrefixOf member.2 + (tail.foldl selectMaximum current).2 := by + induction tail generalizing current member with + | nil => + simp at membership + subst member + exact TxID.prefix_refl current.2 + | cons candidate rest ih => + simp only [List.foldl_cons] + rcases membership with currentMember | tailMember + · subst member + exact TxID.prefix_trans + (current_prefix_selectMaximum current candidate) + (ih (selectMaximum current candidate) + (selectMaximum current candidate) (Or.inl rfl)) + · rw [List.mem_cons] at tailMember + rcases tailMember with candidateMember | restMember + · subst member + exact TxID.prefix_trans + (candidate_prefix_selectMaximum current candidate) + (ih (selectMaximum current candidate) + (selectMaximum current candidate) (Or.inl rfl)) + · exact ih (selectMaximum current candidate) member + (Or.inr restMember) + +theorem maximumGossip_upper_bound + {gossips : List (Prod Location TxID)} + {selected member : Prod Location TxID} + (maximum : maximumGossip gossips = some selected) + (membership : member ∈ gossips) : + TxID.PrefixOf member.2 selected.2 := by + cases gossips with + | nil => simp at membership + | cons head tail => + simp [maximumGossip] at maximum + rw [←maximum] + apply foldl_selectMaximum_upper_bound head member tail + simpa using membership + +theorem foldl_selectMaximum_mem + (current : Prod Location TxID) + (tail : List (Prod Location TxID)) : + tail.foldl selectMaximum current ∈ current :: tail := by + induction tail generalizing current with + | nil => simp + | cons candidate rest ih => + simp only [List.foldl_cons] + have selected : + selectMaximum current candidate = current \/ + selectMaximum current candidate = candidate := by + unfold selectMaximum + split <;> simp + have member := + ih (selectMaximum current candidate) + rw [List.mem_cons] at member + rcases member with currentMember | restMember + · rw [currentMember] + rcases selected with selected | selected + · simp [selected] + · simp [selected] + · simp [restMember] + +theorem maximumGossip_mem + {gossips : List (Prod Location TxID)} + {selected : Prod Location TxID} + (maximum : maximumGossip gossips = some selected) : + selected ∈ gossips := by + cases gossips with + | nil => simp [maximumGossip] at maximum + | cons head tail => + simp [maximumGossip] at maximum + rw [←maximum] + exact foldl_selectMaximum_mem head tail + +theorem recoveredTxID_of_mem + {config : Config} + {location : Location} + {txid : TxID} + (valid : config.Valid) + (membership : (location, txid) ∈ config.recovered) : + recoveredTxID config location = some txid := by + have keysNodup : (config.recovered.map Prod.fst).Nodup := by + rw [valid.2.2] + exact valid.2.1 + unfold recoveredTxID + cases found : + config.recovered.find? fun entry => entry.1 == location with + | none => + rw [List.find?_eq_none] at found + exact False.elim + (found (location, txid) membership (by simp)) + | some entry => + have foundMember : entry ∈ config.recovered := + List.mem_of_find?_eq_some found + have foundLocation : entry.1 = location := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location TxID => + entry.1 == location) found) + have same : + entry = (location, txid) := + eq_of_key_eq keysNodup foundMember membership foundLocation + simp [same] + +def FullGossipSelection + (config : Config) + (state : State) + (opener : Location) : Prop := + exists vote, + vote ∈ state.sent /\ + vote.payload = .vote /\ + vote.target = opener /\ + forall gossip, + gossip ∈ vote.sourceState.gossips <-> + gossip ∈ config.recovered + +def DurableCommit (config : Config) (committed : TxID) : Prop := + exists location txid, + (location, txid) ∈ config.recovered /\ + TxID.PrefixOf committed txid + +theorem full_gossip_selection_preserves_commit + {config : Config} + {state : State} + {opener : Location} + {committed : TxID} + (reachable : Reachable config state) + (full : FullGossipSelection config state opener) + (durable : DurableCommit config committed) : + exists recovered, + recoveredTxID config opener = some recovered /\ + TxID.PrefixOf committed recovered := by + have configValid := reachable_config_valid reachable + have wellFormed := reachable_well_formed reachable + have invariant := reachable_quorum_invariant reachable + rcases full with + ⟨vote, sent, payload, target, complete⟩ + have voteState := + retry_vote_state (wellFormed.sentValid vote sent) payload + rcases invariant.sentVotesSelected vote sent payload with + ⟨selectedTarget, selectedTxID, choice, selected⟩ + have selectedTargetEq : selectedTarget = vote.target := + Option.some.inj (choice.symm.trans voteState.2) + rw [selectedTargetEq, target] at selected + rcases durable with + ⟨durableLocation, durableTxID, durableMember, committedDurable⟩ + have durableGossip : + (durableLocation, durableTxID) ∈ vote.sourceState.gossips := + (complete (durableLocation, durableTxID)).2 durableMember + have durableMaximum := + maximumGossip_upper_bound selected durableGossip + have selectedGossip : + (opener, selectedTxID) ∈ vote.sourceState.gossips := + maximumGossip_mem selected + have selectedRecovered : + (opener, selectedTxID) ∈ config.recovered := + (complete (opener, selectedTxID)).1 selectedGossip + exact + ⟨selectedTxID, + recoveredTxID_of_mem configValid selectedRecovered, + TxID.prefix_trans committedDurable durableMaximum⟩ + +/-- +Quorum opening scopes the result to an actual decision, while the separate +`FullGossipSelection` premise carries the completeness requirement. Quorum +opening alone does not imply complete gossip because voting may follow a +gossip timeout. +-/ +theorem quorum_open_preserves_commit + {config : Config} + {state : State} + {opener : Location} + {committed : TxID} + (reachable : Reachable config state) + (_opened : QuorumOpened state opener) + (full : FullGossipSelection config state opener) + (durable : DurableCommit config committed) : + exists recovered, + recoveredTxID config opener = some recovered /\ + TxID.PrefixOf committed recovered := + full_gossip_selection_preserves_commit reachable full durable + +end Global + +end DisasterRecovery.Protocol diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean new file mode 100644 index 000000000000..7413f3f435ee --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean @@ -0,0 +1,1467 @@ +import DisasterRecovery.Protocol.Invariants +import Mathlib.Tactic + +namespace DisasterRecovery.Protocol.Global + +def SentVote (state : State) (voter target : Location) : Prop := + exists envelope, + envelope ∈ state.sent /\ + envelope.source = voter /\ + envelope.target = target /\ + envelope.payload = .vote + +def NodeVotesNodup (state : State) : Prop := + forall entry, entry ∈ state.system.nodes -> + entry.2.votes.Nodup + +def NodeVotesSent (state : State) : Prop := + forall entry, entry ∈ state.system.nodes -> + forall voter, voter ∈ entry.2.votes -> + SentVote state voter entry.1 + +def SentVotesFunctional (state : State) : Prop := + forall voter first second, + SentVote state voter first -> + SentVote state voter second -> + first = second + +def SentVoteStable (state : State) : Prop := + forall envelope, envelope ∈ state.sent -> + envelope.payload = .vote -> + forall entry, entry ∈ state.system.nodes -> + entry.1 = envelope.source -> + entry.2.phase ≠ .gossiping /\ + (entry.2.phase = .voting -> + entry.2.chosen = some envelope.target) + +def NodeVotingSelection (state : NodeState) : Prop := + exists target txid, + state.chosen = some target /\ + maximumGossip state.gossips = some (target, txid) + +def VotingSelectionsValid (state : State) : Prop := + forall entry, entry ∈ state.system.nodes -> + entry.2.phase = .voting -> + NodeVotingSelection entry.2 + +def SentVotesSelected (state : State) : Prop := + forall envelope, envelope ∈ state.sent -> + envelope.payload = .vote -> + NodeVotingSelection envelope.sourceState + +structure Opening.Valid + (config : Config) + (globalState : State) + (opening : Opening) : Prop where + location : opening.state.location = opening.node + phase : opening.state.phase = .opening + kind : opening.state.openKind = some opening.kind + votesNodup : opening.state.votes.Nodup + quorum : + opening.kind = .quorum -> + voteQuorum config.protocol <= opening.state.votes.length + votesSent : + forall voter, voter ∈ opening.state.votes -> + SentVote globalState voter opening.node + +def OpeningsValid (config : Config) (state : State) : Prop := + forall opening, opening ∈ state.openings -> + opening.Valid config state + +structure QuorumInvariant (config : Config) (state : State) : Prop where + votesNodup : NodeVotesNodup state + votesSent : NodeVotesSent state + sentVoteStable : SentVoteStable state + sentVotesFunctional : SentVotesFunctional state + votingSelections : VotingSelectionsValid state + sentVotesSelected : SentVotesSelected state + openingsValid : OpeningsValid config state + +theorem insertVote_nodup + (source : Location) + {votes : List Location} + (nodup : votes.Nodup) : + (insertVote source votes).Nodup := by + unfold insertVote + split + · exact nodup + · rename_i absent + apply (List.mergeSort_perm _ _).symm.nodup + rw [List.nodup_cons] + exact + ⟨fun member => absent (List.contains_iff_mem.mpr member), nodup⟩ + +theorem mem_insertVote + {member source : Location} + {votes : List Location} + (membership : member ∈ insertVote source votes) : + member ∈ votes \/ member = source := by + unfold insertVote at membership + split at membership + · exact Or.inl membership + · have unsorted := + (List.mergeSort_perm _ _).mem_iff.mp membership + rw [List.mem_cons] at unsorted + exact unsorted.symm + +theorem step_preserves_votes_nodup + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (nodup : state.votes.Nodup) : + (step config state event).state.votes.Nodup := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] + all_goals + repeat first | split | simp_all [insertVote_nodup] + +def acceptedVoteSource : Event -> Option Location + | .receiveVote source .accepted => some source + | _ => none + +theorem step_votes_shape + (config : Protocol.Config) + (state : NodeState) + (event : Event) : + (step config state event).state.votes = state.votes \/ + exists source, + acceptedVoteSource event = some source /\ + (step config state event).state.votes = + insertVote source state.votes := by + cases event + all_goals try cases_type Validation + all_goals + simp [acceptedVoteSource, step, rejected, advance, advanceTimeoutLane] + all_goals repeat first | split | simp_all + +theorem step_vote_origin + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (voter : Location) + (membership : voter ∈ (step config state event).state.votes) : + voter ∈ state.votes \/ + acceptedVoteSource event = some voter := by + rcases step_votes_shape config state event with + unchanged | ⟨source, sourceEq, changed⟩ + · rw [unchanged] at membership + exact Or.inl membership + · rw [changed] at membership + rcases mem_insertVote membership with old | added + · exact Or.inl old + · subst source + exact Or.inr sourceEq + +theorem step_preserves_non_gossiping + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (pastGossip : state.phase ≠ .gossiping) : + (step config state event).state.phase ≠ .gossiping := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] + all_goals repeat first | split | simp_all + +theorem voting_step_preserves_choice + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (pastGossip : state.phase ≠ .gossiping) + (stillVoting : (step config state event).state.phase = .voting) : + state.phase = .voting /\ + (step config state event).state.chosen = state.chosen := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] at stillVoting ⊢ + all_goals repeat first | split at stillVoting | split | simp_all + +theorem step_preserves_voting_selection + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (before : + state.phase = .voting -> + NodeVotingSelection state) + (voting : (step config state event).state.phase = .voting) : + NodeVotingSelection (step config state event).state := by + cases event + all_goals try cases_type Validation + all_goals + simp [NodeVotingSelection, step, rejected, advance, + advanceTimeoutLane, validTimeout] at before voting ⊢ + all_goals + repeat first | split at voting | split | simp_all | aesop + +theorem retry_vote_state + {config : Config} + {envelope : Envelope} + (valid : envelope.Valid config) + (vote : envelope.payload = .vote) : + envelope.sourceState.phase = .voting /\ + envelope.sourceState.chosen = some envelope.target := by + rcases valid_envelope_effect valid with + ⟨effect, member, created⟩ + cases effect with + | sendGossip target => + cases found : recoveredTxID config envelope.source with + | none => + simp [messageForEffect, found] at created + | some txid => + simp [messageForEffect, found] at created + rw [←created] at vote + contradiction + | sendVote target => + simp [messageForEffect] at created + rw [←created] at vote ⊢ + cases phase : envelope.sourceState.phase <;> + simp [step, phase] at member + next => + cases chosen : envelope.sourceState.chosen <;> + simp_all + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] at vote + contradiction + | opening kind => + simp [messageForEffect] at created + | restart chosen => + simp [messageForEffect] at created + | completed => + simp [messageForEffect] at created + | rejected reason => + simp [messageForEffect] at created + +theorem opening_effect_state + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (kind : OpenKind) + (opening : .opening kind ∈ (step config state event).effects) : + (step config state event).state.phase = .opening /\ + (step config state event).state.openKind = some kind := by + cases event + all_goals try cases_type Validation + all_goals + simp [step, rejected, advance, advanceTimeoutLane, validTimeout] + at opening ⊢ + all_goals + repeat first | split at opening | split | simp_all | aesop + +theorem quorum_effect_has_threshold + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (opening : + .opening .quorum ∈ (step config state event).effects) : + voteQuorum config <= + (step config state event).state.votes.length := by + cases event + all_goals try cases_type Validation + all_goals + simp [step, rejected, advance, advanceTimeoutLane, validTimeout] + at opening ⊢ + all_goals + repeat first | split at opening | split | simp_all | aesop + +theorem sentVote_mono + {before after : State} + {voter target : Location} + (sent : forall envelope, envelope ∈ before.sent -> + envelope ∈ after.sent) + (vote : SentVote before voter target) : + SentVote after voter target := by + rcases vote with + ⟨envelope, membership, source, destination, payload⟩ + exact + ⟨envelope, sent envelope membership, source, destination, payload⟩ + +theorem opening_valid_of_sent_eq + {config : Config} + {before after : State} + {opening : Opening} + (sentEq : after.sent = before.sent) + (valid : opening.Valid config before) : + opening.Valid config after := by + rcases valid with + ⟨location, phase, kind, nodup, quorum, votesSent⟩ + constructor + · exact location + · exact phase + · exact kind + · exact nodup + · exact quorum + · intro voter membership + apply sentVote_mono + · intro envelope sent + rw [sentEq] + exact sent + · exact votesSent voter membership + +theorem opening_valid_mono + {config : Config} + {before after : State} + {opening : Opening} + (sent : + forall envelope, envelope ∈ before.sent -> + envelope ∈ after.sent) + (valid : opening.Valid config before) : + opening.Valid config after := by + rcases valid with + ⟨location, phase, kind, nodup, quorum, votesSent⟩ + constructor + · exact location + · exact phase + · exact kind + · exact nodup + · exact quorum + · intro voter membership + exact sentVote_mono sent (votesSent voter membership) + +theorem recordEffect_preserves_openings_valid + {config : Config} + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + (valid : OpeningsValid config state) + (newValid : + forall kind, + effect = .opening kind -> + Opening.Valid config state + { node, kind, state := nodeState }) : + OpeningsValid config + (recordEffect node nodeState state effect) := by + intro opening membership + cases effect with + | opening kind => + simp [recordEffect] at membership + rcases membership with rfl | old + · apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state (.opening kind)) + rfl + exact newValid kind rfl + · apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state (.opening kind)) + rfl + exact valid opening old + | sendGossip target => + exact valid opening membership + | sendVote target => + exact valid opening membership + | sendIAmOpen target => + exact valid opening membership + | restart target => + apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state (.restart target)) + rfl + exact valid opening membership + | completed => + apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state .completed) + rfl + exact valid opening membership + | rejected reason => + exact valid opening membership + +theorem recordEffects_preserves_openings_valid + {config : Config} + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + (valid : OpeningsValid config state) + (newValid : + forall kind, + .opening kind ∈ effects -> + Opening.Valid config state + { node, kind, state := nodeState }) : + OpeningsValid config + (recordEffects node nodeState effects state) := by + induction effects generalizing state with + | nil => exact valid + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + apply ih + · apply recordEffect_preserves_openings_valid valid + intro kind effectEq + subst effect + exact newValid kind (by simp) + · intro kind membership + apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state effect) + (by cases effect <;> rfl) + exact newValid kind (by simp [membership]) + +theorem eventFor_vote_source + {envelope : Envelope} + {voter : Location} + (source : + acceptedVoteSource (eventFor envelope) = some voter) : + envelope.payload = .vote /\ + envelope.source = voter := by + cases payload : envelope.payload <;> + simp_all [eventFor, acceptedVoteSource] + +theorem systemStep_preserves_votes_nodup + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (nodup : + forall entry, entry ∈ before.nodes -> + entry.2.votes.Nodup) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.votes.Nodup := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, stateEq, _⟩ + rw [←stateEq] + intro entry membership + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · apply step_preserves_votes_nodup + exact nodup (key, node) (List.mem_of_find?_eq_some found) + · exact nodup previous previousMember + +theorem systemStep_preserves_voting_selections + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (valid : + forall entry, entry ∈ before.nodes -> + entry.2.phase = .voting -> + NodeVotingSelection entry.2) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.phase = .voting -> + NodeVotingSelection entry.2 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership voting + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + apply step_preserves_voting_selection config node event + · exact valid (key, node) + (List.mem_of_find?_eq_some found) + · simpa [atTarget, outputEq] using voting + · rename_i notTarget + exact valid previous previousMember + (by simpa [notTarget] using voting) + +theorem systemStep_output_location + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (locations : + forall entry, entry ∈ before.nodes -> + entry.2.location = entry.1) + (transition : + systemStep config before target event = some (after, output)) : + output.state.location = target := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, _, outputEq⟩ + calc + output.state.location = + node.location := by + rw [←outputEq] + exact step_preserves_location config node event + _ = key := + locations (key, node) (List.mem_of_find?_eq_some found) + _ = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + +theorem systemStep_output_mem + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (transition : + systemStep config before target event = some (after, output)) : + (target, output.state) ∈ after.nodes := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq, replaceNode, List.mem_map] + refine ⟨(key, node), List.mem_of_find?_eq_some found, ?_⟩ + have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + simp [keyEq, outputEq] + +theorem systemStep_opening_effect_state + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {kind : OpenKind} + (transition : + systemStep config before target event = some (after, output)) + (opening : .opening kind ∈ output.effects) : + output.state.phase = .opening /\ + output.state.openKind = some kind := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, _, _, outputEq⟩ + rw [←outputEq] at opening ⊢ + exact opening_effect_state config node event kind opening + +theorem systemStep_quorum_effect_has_threshold + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (transition : + systemStep config before target event = some (after, output)) + (opening : .opening .quorum ∈ output.effects) : + voteQuorum config <= output.state.votes.length := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, _, _, outputEq⟩ + rw [←outputEq] at opening ⊢ + exact quorum_effect_has_threshold config node event opening + +theorem initial_node_votes_nodup + (config : Config) + (active : List Location) : + NodeVotesNodup (initial config active) := by + simp [NodeVotesNodup, Global.initial, initialSystem, initialNode] + +theorem initial_node_votes_sent + (config : Config) + (active : List Location) : + NodeVotesSent (initial config active) := by + simp [NodeVotesSent, Global.initial, initialSystem, initialNode] + +theorem initial_sent_votes_functional + (config : Config) + (active : List Location) : + SentVotesFunctional (initial config active) := by + simp [SentVotesFunctional, SentVote, Global.initial] + +theorem initial_sent_vote_stable + (config : Config) + (active : List Location) : + SentVoteStable (initial config active) := by + simp [SentVoteStable, Global.initial] + +theorem initial_voting_selections + (config : Config) + (active : List Location) : + VotingSelectionsValid (initial config active) := by + simp [VotingSelectionsValid, Global.initial, initialSystem, initialNode] + +theorem initial_sent_votes_selected + (config : Config) + (active : List Location) : + SentVotesSelected (initial config active) := by + simp [SentVotesSelected, Global.initial] + +theorem initial_openings_valid + (config : Config) + (active : List Location) : + OpeningsValid config (initial config active) := by + simp [OpeningsValid, Global.initial] + +theorem systemStep_preserves_node_votes_sent + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {beforeState afterState : State} + (beforeSystem : beforeState.system = before) + (votesSent : NodeVotesSent beforeState) + (carry : + forall voter destination, + SentVote beforeState voter destination -> + SentVote afterState voter destination) + (introduced : + forall voter, + acceptedVoteSource event = some voter -> + SentVote afterState voter target) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + forall voter, voter ∈ entry.2.votes -> + SentVote afterState voter entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership voter vote + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + have targetEq : previous.1 = target := + beq_iff_eq.mp atTarget + rcases step_vote_origin config node event voter + (by simpa [outputEq, atTarget] using vote) with + old | added + · have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + apply carry + rw [←keyEq] + exact votesSent (key, node) + (by + rw [beforeSystem] + exact List.mem_of_find?_eq_some found) + voter old + · exact introduced voter added + · rename_i notTarget + apply carry + exact votesSent previous + (by + rw [beforeSystem] + exact previousMember) + voter (by simpa [notTarget] using vote) + +theorem eq_of_key_eq + {α : Type} + {nodes : List (Prod Location α)} + (nodup : (nodes.map Prod.fst).Nodup) + {first second : Prod Location α} + (firstMember : first ∈ nodes) + (secondMember : second ∈ nodes) + (keyEq : first.1 = second.1) : + first = second := by + induction nodes generalizing first second with + | nil => simp at firstMember + | cons head tail ih => + rw [List.map_cons, List.nodup_cons] at nodup + rcases nodup with ⟨headFresh, tailNodup⟩ + rw [List.mem_cons] at firstMember secondMember + rcases firstMember with rfl | firstTail + · rcases secondMember with rfl | secondTail + · rfl + · exfalso + apply headFresh + rw [List.mem_map] + exact ⟨second, secondTail, keyEq.symm⟩ + · rcases secondMember with rfl | secondTail + · exfalso + apply headFresh + rw [List.mem_map] + exact ⟨first, firstTail, keyEq⟩ + · exact ih tailNodup firstTail secondTail keyEq + +theorem systemStep_preserves_vote_stability + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {envelope : Envelope} + (stable : + forall entry, entry ∈ before.nodes -> + entry.1 = envelope.source -> + entry.2.phase ≠ .gossiping /\ + (entry.2.phase = .voting -> + entry.2.chosen = some envelope.target)) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.1 = envelope.source -> + entry.2.phase ≠ .gossiping /\ + (entry.2.phase = .voting -> + entry.2.chosen = some envelope.target) := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership sourceEq + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + have targetEq : previous.1 = target := + beq_iff_eq.mp atTarget + have targetSource : target = envelope.source := by + simpa [atTarget] using sourceEq + have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + have beforeStable := + stable (key, node) (List.mem_of_find?_eq_some found) + (keyEq.trans targetSource) + constructor + · exact step_preserves_non_gossiping config node event + beforeStable.1 + · intro voting + rcases voting_step_preserves_choice config node event + beforeStable.1 voting with ⟨beforeVoting, chosenEq⟩ + rw [chosenEq] + exact beforeStable.2 beforeVoting + · rename_i notTarget + exact stable previous previousMember + (by simpa [notTarget] using sourceEq) + +theorem next_preserves_node_votes_nodup + {config : Config} + {before after : State} + {action : Action} + (nodup : NodeVotesNodup before) + (transition : next config before action = some after) : + NodeVotesNodup after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact nodup + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, rfl⟩ + intro entry membership + rw [recordEffects_system] at membership + exact systemStep_preserves_votes_nodup nodup systemStep + entry membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, rfl⟩ + intro entry membership + rw [recordEffects_system] at membership + exact systemStep_preserves_votes_nodup nodup systemStep + entry membership + +theorem next_preserves_voting_selections + {config : Config} + {before after : State} + {action : Action} + (valid : VotingSelectionsValid before) + (transition : next config before action = some after) : + VotingSelectionsValid after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact valid + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, rfl⟩ + intro entry membership voting + rw [recordEffects_system] at membership + exact systemStep_preserves_voting_selections valid systemStep + entry membership voting + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, rfl⟩ + intro entry membership voting + rw [recordEffects_system] at membership + exact systemStep_preserves_voting_selections valid systemStep + entry membership voting + +theorem retry_preserves_sent_votes_selected + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (votingSelections : VotingSelectionsValid before) + (selected : SentVotesSelected before) + (transition : next config before (.retry source) = some after) : + SentVotesSelected after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + intro envelope membership payload + rw [List.mem_append] at membership + rcases membership with old | added + · exact selected envelope old payload + · have valid : envelope.Valid config := + retryMessages_valid config source sourceState sourceLocation + envelope added + have voteState := retry_vote_state valid payload + have identity := retryMessages_source added + rw [identity.2] at voteState + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have sourceSelection := + votingSelections entry (List.mem_of_find?_eq_some findEq) + (by simpa [stateEq] using voteState.1) + simpa [identity.2, stateEq] using sourceSelection + +theorem deliver_preserves_sent_votes_selected + {config : Config} + {before after : State} + {envelope : Envelope} + (selected : SentVotesSelected before) + (transition : next config before (.deliver envelope) = some after) : + SentVotesSelected after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, stateEq⟩ + rw [←stateEq] + intro vote membership payload + rw [recordEffects_sent] at membership + exact selected vote membership payload + +theorem timeout_preserves_sent_votes_selected + {config : Config} + {before after : State} + {target : Location} + (selected : SentVotesSelected before) + (transition : next config before (.timeout target) = some after) : + SentVotesSelected after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, stateEq⟩ + rw [←stateEq] + intro vote membership payload + rw [recordEffects_sent] at membership + exact selected vote membership payload + +theorem retry_preserves_node_votes_sent + {config : Config} + {before after : State} + {source : Location} + (votesSent : NodeVotesSent before) + (transition : next config before (.retry source) = some after) : + NodeVotesSent after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + intro entry membership voter vote + apply sentVote_mono (before := before) + · intro envelope sent + exact List.mem_append_left _ sent + · exact votesSent entry membership voter vote + +theorem deliver_preserves_node_votes_sent + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (votesSent : NodeVotesSent before) + (transition : next config before (.deliver envelope) = some after) : + NodeVotesSent after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨inNetwork, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro entry membership voter vote + rw [recordEffects_system] at membership + let afterState := + recordEffects envelope.target output.state output.effects + { + before with + system + network := removeOne envelope before.network + } + have carry : + forall oldVoter oldTarget, + SentVote before oldVoter oldTarget -> + SentVote afterState oldVoter oldTarget := by + intro oldVoter oldTarget oldVote + apply sentVote_mono (before := before) (after := afterState) + · intro sent sentMember + simpa [afterState] using sentMember + · exact oldVote + have introducedVote : + forall newVoter, + acceptedVoteSource (eventFor envelope) = some newVoter -> + SentVote afterState newVoter envelope.target := by + intro newVoter introduced + rcases eventFor_vote_source introduced with + ⟨payload, source⟩ + subst newVoter + refine ⟨envelope, ?_, rfl, rfl, payload⟩ + simp [afterState] + exact wellFormed.networkSent envelope + inNetwork + exact systemStep_preserves_node_votes_sent + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl votesSent carry introducedVote systemStep + entry membership voter vote + +theorem timeout_preserves_node_votes_sent + {config : Config} + {before after : State} + {target : Location} + (votesSent : NodeVotesSent before) + (transition : next config before (.timeout target) = some after) : + NodeVotesSent after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro entry membership voter vote + rw [recordEffects_system] at membership + let afterState := + recordEffects target output.state output.effects + { before with system } + have carry : + forall oldVoter oldTarget, + SentVote before oldVoter oldTarget -> + SentVote afterState oldVoter oldTarget := by + intro oldVoter oldTarget oldVote + apply sentVote_mono (before := before) (after := afterState) + · intro sent sentMember + simpa [afterState] using sentMember + · exact oldVote + have introducedVote : + forall newVoter, + acceptedVoteSource Event.timeout = some newVoter -> + SentVote afterState newVoter target := by + intro newVoter introduced + simp [acceptedVoteSource] at introduced + exact systemStep_preserves_node_votes_sent + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl votesSent carry introducedVote systemStep + entry membership voter vote + +theorem retry_preserves_openings_valid + {config : Config} + {before after : State} + {source : Location} + (valid : OpeningsValid config before) + (transition : next config before (.retry source) = some after) : + OpeningsValid config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + intro opening membership + apply opening_valid_mono + · intro envelope sent + exact List.mem_append_left _ sent + · exact valid opening membership + +theorem deliver_preserves_openings_valid + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (votesNodup : NodeVotesNodup before) + (votesSent : NodeVotesSent before) + (valid : OpeningsValid config before) + (transition : next config before (.deliver envelope) = some after) : + OpeningsValid config after := by + have afterNodup := + next_preserves_node_votes_nodup votesNodup transition + have afterVotesSent := + deliver_preserves_node_votes_sent wellFormed votesSent transition + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] at afterNodup afterVotesSent ⊢ + let delivered : State := { + before with + system + network := removeOne envelope before.network + } + apply recordEffects_preserves_openings_valid + · intro opening membership + apply opening_valid_of_sent_eq + (before := before) (after := delivered) rfl + exact valid opening membership + · intro kind openingEffect + have effectState := + systemStep_opening_effect_state systemStep openingEffect + constructor + · exact systemStep_output_location + wellFormed.nodeLocations systemStep + · exact effectState.1 + · exact effectState.2 + · apply afterNodup (envelope.target, output.state) + rw [recordEffects_system] + exact systemStep_output_mem systemStep + · intro quorumKind + have kindEq : kind = .quorum := by simpa using quorumKind + rw [kindEq] at openingEffect + simpa using + systemStep_quorum_effect_has_threshold systemStep openingEffect + · intro voter vote + have sent := + afterVotesSent (envelope.target, output.state) + (by + rw [recordEffects_system] + exact systemStep_output_mem systemStep) + voter vote + simpa [SentVote, delivered] using sent + +theorem timeout_preserves_openings_valid + {config : Config} + {before after : State} + {target : Location} + (wellFormed : WellFormed config before) + (votesNodup : NodeVotesNodup before) + (votesSent : NodeVotesSent before) + (valid : OpeningsValid config before) + (transition : next config before (.timeout target) = some after) : + OpeningsValid config after := by + have afterNodup := + next_preserves_node_votes_nodup votesNodup transition + have afterVotesSent := + timeout_preserves_node_votes_sent votesSent transition + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] at afterNodup afterVotesSent ⊢ + let timedOut : State := { before with system } + apply recordEffects_preserves_openings_valid + · intro opening membership + apply opening_valid_of_sent_eq + (before := before) (after := timedOut) rfl + exact valid opening membership + · intro kind openingEffect + have effectState := + systemStep_opening_effect_state systemStep openingEffect + constructor + · exact systemStep_output_location + wellFormed.nodeLocations systemStep + · exact effectState.1 + · exact effectState.2 + · apply afterNodup (target, output.state) + rw [recordEffects_system] + exact systemStep_output_mem systemStep + · intro quorumKind + have kindEq : kind = .quorum := by simpa using quorumKind + rw [kindEq] at openingEffect + simpa using + systemStep_quorum_effect_has_threshold systemStep openingEffect + · intro voter vote + have sent := + afterVotesSent (target, output.state) + (by + rw [recordEffects_system] + exact systemStep_output_mem systemStep) + voter vote + simpa [SentVote, timedOut] using sent + +theorem retry_preserves_sent_vote_stable + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (stable : SentVoteStable before) + (transition : next config before (.retry source) = some after) : + SentVoteStable after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + intro envelope membership payload entry entryMember keyEq + rw [List.mem_append] at membership + rcases membership with old | added + · exact stable envelope old payload entry entryMember keyEq + · have valid : envelope.Valid config := + retryMessages_valid config source sourceState sourceLocation + envelope added + have voteState := retry_vote_state valid payload + rcases retryMessages_source added with + ⟨sourceEq, stateEq⟩ + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨foundEntry, findEq, foundStateEq⟩ + have foundMember : foundEntry ∈ before.system.nodes := + List.mem_of_find?_eq_some findEq + have foundKey : foundEntry.1 = source := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == source) findEq) + have sameEntry : entry = foundEntry := + eq_of_key_eq wellFormed.nodeKeysNodup entryMember foundMember + ((keyEq.trans sourceEq).trans foundKey.symm) + subst entry + rw [foundStateEq, ←stateEq] + exact ⟨by simp [voteState.1], fun _ => voteState.2⟩ + +theorem deliver_preserves_sent_vote_stable + {config : Config} + {before after : State} + {delivered : Envelope} + (stable : SentVoteStable before) + (transition : next config before (.deliver delivered) = some after) : + SentVoteStable after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro envelope membership payload entry entryMember keyEq + rw [recordEffects_sent] at membership + rw [recordEffects_system] at entryMember + exact systemStep_preserves_vote_stability + (fun previous previousMember source => + stable envelope membership payload previous previousMember source) + systemStep entry entryMember keyEq + +theorem timeout_preserves_sent_vote_stable + {config : Config} + {before after : State} + {target : Location} + (stable : SentVoteStable before) + (transition : next config before (.timeout target) = some after) : + SentVoteStable after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro envelope membership payload entry entryMember keyEq + rw [recordEffects_sent] at membership + rw [recordEffects_system] at entryMember + exact systemStep_preserves_vote_stability + (fun previous previousMember source => + stable envelope membership payload previous previousMember source) + systemStep entry entryMember keyEq + +theorem sentVote_stable_at_node + {state : State} + {voter target : Location} + {current : NodeState} + (stable : SentVoteStable state) + (vote : SentVote state voter target) + (found : nodeState state voter = some current) : + current.phase ≠ .gossiping /\ + (current.phase = .voting -> + current.chosen = some target) := by + rcases vote with + ⟨envelope, sent, sourceEq, targetEq, payload⟩ + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have entryMember : entry ∈ state.system.nodes := + List.mem_of_find?_eq_some findEq + have entryKey : entry.1 = voter := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == voter) findEq) + have result := + stable envelope sent payload entry entryMember + (entryKey.trans sourceEq.symm) + rw [stateEq] at result + simpa [targetEq] using result + +theorem retry_preserves_sent_votes_functional + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (functional : SentVotesFunctional before) + (stable : SentVoteStable before) + (transition : next config before (.retry source) = some after) : + SentVotesFunctional after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + have classify : + forall voter target, + SentVote + { + before with + network := before.network ++ + retryMessages config source sourceState + sent := before.sent ++ + retryMessages config source sourceState + } + voter target -> + SentVote before voter target \/ + (voter = source /\ + sourceState.phase = .voting /\ + sourceState.chosen = some target) := by + intro voter target vote + rcases vote with + ⟨envelope, membership, sourceEq, targetEq, payload⟩ + rw [List.mem_append] at membership + rcases membership with old | added + · exact Or.inl + ⟨envelope, old, sourceEq, targetEq, payload⟩ + · have valid : envelope.Valid config := + retryMessages_valid config source sourceState sourceLocation + envelope added + have voteState := retry_vote_state valid payload + have retryIdentity := retryMessages_source added + rw [retryIdentity.2] at voteState + exact Or.inr + ⟨sourceEq.symm.trans retryIdentity.1, + voteState.1, + by simpa [targetEq] using voteState.2⟩ + intro voter first second firstVote secondVote + rcases classify voter first firstVote with + firstOld | ⟨firstSource, firstPhase, firstChoice⟩ + · rcases classify voter second secondVote with + secondOld | ⟨secondSource, secondPhase, secondChoice⟩ + · exact functional voter first second firstOld secondOld + · have oldState := + sentVote_stable_at_node stable firstOld + (by simpa [secondSource] using found) + have oldChoice := oldState.2 secondPhase + rw [oldChoice] at secondChoice + exact Option.some.inj secondChoice + · rcases classify voter second secondVote with + secondOld | ⟨secondSource, secondPhase, secondChoice⟩ + · have oldState := + sentVote_stable_at_node stable secondOld + (by simpa [firstSource] using found) + have oldChoice := oldState.2 firstPhase + rw [oldChoice] at firstChoice + exact (Option.some.inj firstChoice).symm + · rw [firstChoice] at secondChoice + exact Option.some.inj secondChoice + +theorem deliver_preserves_sent_votes_functional + {config : Config} + {before after : State} + {envelope : Envelope} + (functional : SentVotesFunctional before) + (transition : next config before (.deliver envelope) = some after) : + SentVotesFunctional after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, stateEq⟩ + rw [←stateEq] + intro voter first second firstVote secondVote + apply functional voter first second + · simpa [SentVote] using firstVote + · simpa [SentVote] using secondVote + +theorem timeout_preserves_sent_votes_functional + {config : Config} + {before after : State} + {target : Location} + (functional : SentVotesFunctional before) + (transition : next config before (.timeout target) = some after) : + SentVotesFunctional after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, stateEq⟩ + rw [←stateEq] + intro voter first second firstVote secondVote + apply functional voter first second + · simpa [SentVote] using firstVote + · simpa [SentVote] using secondVote + +theorem initial_quorum_invariant + (config : Config) + (active : List Location) : + QuorumInvariant config (initial config active) := { + votesNodup := initial_node_votes_nodup config active + votesSent := initial_node_votes_sent config active + sentVoteStable := initial_sent_vote_stable config active + sentVotesFunctional := initial_sent_votes_functional config active + votingSelections := initial_voting_selections config active + sentVotesSelected := initial_sent_votes_selected config active + openingsValid := initial_openings_valid config active +} + +theorem next_preserves_quorum_invariant + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (invariant : QuorumInvariant config before) + (transition : next config before action = some after) : + QuorumInvariant config after := by + cases action with + | retry source => + constructor + · exact next_preserves_node_votes_nodup + invariant.votesNodup transition + · exact retry_preserves_node_votes_sent + invariant.votesSent transition + · exact retry_preserves_sent_vote_stable + wellFormed invariant.sentVoteStable transition + · exact retry_preserves_sent_votes_functional + wellFormed invariant.sentVotesFunctional + invariant.sentVoteStable transition + · exact next_preserves_voting_selections + invariant.votingSelections transition + · exact retry_preserves_sent_votes_selected + wellFormed invariant.votingSelections + invariant.sentVotesSelected transition + · exact retry_preserves_openings_valid + invariant.openingsValid transition + | deliver envelope => + constructor + · exact next_preserves_node_votes_nodup + invariant.votesNodup transition + · exact deliver_preserves_node_votes_sent + wellFormed invariant.votesSent transition + · exact deliver_preserves_sent_vote_stable + invariant.sentVoteStable transition + · exact deliver_preserves_sent_votes_functional + invariant.sentVotesFunctional transition + · exact next_preserves_voting_selections + invariant.votingSelections transition + · exact deliver_preserves_sent_votes_selected + invariant.sentVotesSelected transition + · exact deliver_preserves_openings_valid + wellFormed invariant.votesNodup invariant.votesSent + invariant.openingsValid transition + | timeout target => + constructor + · exact next_preserves_node_votes_nodup + invariant.votesNodup transition + · exact timeout_preserves_node_votes_sent + invariant.votesSent transition + · exact timeout_preserves_sent_vote_stable + invariant.sentVoteStable transition + · exact timeout_preserves_sent_votes_functional + invariant.sentVotesFunctional transition + · exact next_preserves_voting_selections + invariant.votingSelections transition + · exact timeout_preserves_sent_votes_selected + invariant.sentVotesSelected transition + · exact timeout_preserves_openings_valid + wellFormed invariant.votesNodup invariant.votesSent + invariant.openingsValid transition + +theorem reachable_quorum_invariant + {config : Config} + {state : State} + (reachable : Reachable config state) : + QuorumInvariant config state := by + induction reachable with + | initial active valid nodup configured => + exact initial_quorum_invariant config active + | step reachable transition invariant => + exact next_preserves_quorum_invariant + (reachable_well_formed reachable) invariant transition + +theorem quorum_lists_intersect + {α : Type} + [DecidableEq α] + (expected first second : List α) + (firstNodup : first.Nodup) + (secondNodup : second.Nodup) + (firstSubset : + forall value, value ∈ first -> value ∈ expected) + (secondSubset : + forall value, value ∈ second -> value ∈ expected) + (firstQuorum : + expected.length / 2 + 1 <= first.length) + (secondQuorum : + expected.length / 2 + 1 <= second.length) : + exists value, value ∈ first /\ value ∈ second := by + by_contra noShared + push_neg at noShared + have disjoint : Disjoint first.toFinset second.toFinset := + Finset.disjoint_left.mpr (by + intro value firstMember secondMember + exact noShared value + (List.mem_toFinset.mp firstMember) + (List.mem_toFinset.mp secondMember)) + have unionSubset : + first.toFinset ∪ second.toFinset ⊆ expected.toFinset := by + intro value membership + rw [Finset.mem_union] at membership + rw [List.mem_toFinset] + exact membership.elim + (fun member => + firstSubset value (List.mem_toFinset.mp member)) + (fun member => + secondSubset value (List.mem_toFinset.mp member)) + have unionCard := Finset.card_le_card unionSubset + rw [Finset.card_union_of_disjoint disjoint, + List.toFinset_card_of_nodup firstNodup, + List.toFinset_card_of_nodup secondNodup] at unionCard + have expectedCard := List.toFinset_card_le expected + omega + +def QuorumOpened (state : State) (node : Location) : Prop := + exists opening, + opening ∈ state.openings /\ + opening.node = node /\ + opening.kind = .quorum + +theorem opening_vote_configured + {config : Config} + {state : State} + {opening : Opening} + (wellFormed : WellFormed config state) + (valid : opening.Valid config state) + {voter : Location} + (vote : voter ∈ opening.state.votes) : + voter ∈ config.protocol.expectedLocations := by + rcases valid.votesSent voter vote with + ⟨envelope, sent, sourceEq, _, _⟩ + apply wellFormed.activeConfigured voter + simpa [sourceEq] using + wellFormed.sentSourceActive envelope sent + +theorem quorum_opener_unique + {config : Config} + {state : State} + {first second : Location} + (reachable : Reachable config state) + (firstOpened : QuorumOpened state first) + (secondOpened : QuorumOpened state second) : + first = second := by + have wellFormed := reachable_well_formed reachable + have invariant := reachable_quorum_invariant reachable + rcases firstOpened with + ⟨firstOpening, firstMember, firstNode, firstKind⟩ + rcases secondOpened with + ⟨secondOpening, secondMember, secondNode, secondKind⟩ + have firstValid := + invariant.openingsValid firstOpening firstMember + have secondValid := + invariant.openingsValid secondOpening secondMember + rcases quorum_lists_intersect + config.protocol.expectedLocations + firstOpening.state.votes + secondOpening.state.votes + firstValid.votesNodup + secondValid.votesNodup + (fun voter vote => + opening_vote_configured wellFormed firstValid vote) + (fun voter vote => + opening_vote_configured wellFormed secondValid vote) + (by + simpa [voteQuorum] using firstValid.quorum firstKind) + (by + simpa [voteQuorum] using secondValid.quorum secondKind) with + ⟨voter, firstVote, secondVote⟩ + have targetEq := + invariant.sentVotesFunctional voter + firstOpening.node secondOpening.node + (firstValid.votesSent voter firstVote) + (secondValid.votesSent voter secondVote) + exact firstNode.symm.trans (targetEq.trans secondNode) + +end DisasterRecovery.Protocol.Global From 47343b0dc7d22deebcd48ca16524083deac159e5 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:07:24 +0100 Subject: [PATCH 05/35] Prove fair global recovery progress Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery/DisasterRecovery.lean | 1 + .../Protocol/GlobalTemporal.lean | 3168 +++++++++++++++++ 2 files changed, 3169 insertions(+) create mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean diff --git a/lean/disaster-recovery/DisasterRecovery.lean b/lean/disaster-recovery/DisasterRecovery.lean index e316316223a6..009747c71664 100644 --- a/lean/disaster-recovery/DisasterRecovery.lean +++ b/lean/disaster-recovery/DisasterRecovery.lean @@ -4,3 +4,4 @@ import DisasterRecovery.Protocol.Global import DisasterRecovery.Protocol.Invariants import DisasterRecovery.Protocol.Quorum import DisasterRecovery.Protocol.Committed +import DisasterRecovery.Protocol.GlobalTemporal diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean new file mode 100644 index 000000000000..c7cac044b5f6 --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean @@ -0,0 +1,3168 @@ +import DisasterRecovery.Protocol.Committed +import DisasterRecovery.Protocol.Temporal +import Mathlib.Tactic + +namespace DisasterRecovery.Protocol.Global + +structure Execution (config : Config) where + states : Nat -> State + actions : Nat -> Action + step_succ : forall n, + next config (states n) (actions n) = some (states (n + 1)) + +def HasPhase (state : State) (node : Location) (phase : Phase) : Prop := + exists nodeState, + Global.nodeState state node = some nodeState /\ + nodeState.phase = phase + +def HasGossip (state : State) (node : Location) : Prop := + exists nodeState, + Global.nodeState state node = some nodeState /\ + nodeState.gossips ≠ [] + +def HasVote (state : State) (node : Location) : Prop := + exists nodeState, + Global.nodeState state node = some nodeState /\ + nodeState.votes ≠ [] + +def LaneAdvanced (state : State) (node : Location) : Prop := + exists nodeState, + Global.nodeState state node = some nodeState /\ + nodeState.timeoutState ≠ .gossiping + +theorem hasPhase_unique + {state : State} + {node : Location} + {first second : Phase} + (firstPhase : HasPhase state node first) + (secondPhase : HasPhase state node second) : + first = second := by + rcases firstPhase with ⟨firstState, firstFound, firstEq⟩ + rcases secondPhase with ⟨secondState, secondFound, secondEq⟩ + rw [firstFound] at secondFound + injection secondFound with stateEq + subst secondState + exact firstEq.symm.trans secondEq + +def Terminal (state : State) (node : Location) : Prop := + node ∈ state.restarts \/ node ∈ state.completed + +def CompletedOpen (state : State) (node : Location) : Prop := + node ∈ state.completed + +def AnnouncementsLive (state : State) : Prop := + forall envelope, envelope ∈ state.sent -> + envelope.payload = .iAmOpen -> + HasPhase state envelope.source .opening \/ + CompletedOpen state envelope.source + +def SentAnnouncementTo (state : State) (target : Location) : Prop := + exists envelope, + envelope ∈ state.sent /\ + envelope.target = target /\ + envelope.payload = .iAmOpen + +def JoiningAnnouncements (state : State) : Prop := + forall entry, entry ∈ state.system.nodes -> + entry.2.phase = .joining -> + SentAnnouncementTo state entry.1 + +def OpenCompleted (state : State) : Prop := + forall entry, entry ∈ state.system.nodes -> + entry.2.phase = .open -> + CompletedOpen state entry.1 + +def AdvancedNodesActive (state : State) : Prop := + forall entry, entry ∈ state.system.nodes -> + entry.2.phase ≠ .gossiping -> + entry.1 ∈ state.active + +def OpenerWitness (state : State) : Prop := + exists node, + HasPhase state node .opening \/ + CompletedOpen state node + +def OnlyOpenerCompletesFrom + {config : Config} + (execution : Execution config) + (start : Nat) + (opener : Location) : Prop := + forall n node, + start <= n -> + CompletedOpen (execution.states n) node -> + node = opener + +def QuorumOnlyCompletions + {config : Config} + (execution : Execution config) : Prop := + forall n node, + CompletedOpen (execution.states n) node -> + QuorumOpened (execution.states n) node + +def SentAnnouncement + (state : State) + (source target : Location) : Prop := + exists envelope, + envelope ∈ state.sent /\ + envelope.source = source /\ + envelope.target = target /\ + envelope.payload = .iAmOpen + +def BroadcastBeforeCompletion + {config : Config} + (execution : Execution config) : Prop := + forall n opener, + CompletedOpen (execution.states n) opener -> + forall target, target ∈ (execution.states n).active -> + target ≠ opener -> + SentAnnouncement (execution.states n) opener target + +def AnnouncementsResolved (state : State) : Prop := + forall envelope, envelope ∈ state.sent -> + envelope.payload = .iAmOpen -> + envelope ∈ state.network \/ + Terminal state envelope.target \/ + HasPhase state envelope.target .opening + +def Enabled (config : Config) (state : State) (action : Action) : Prop := + exists nextState, next config state action = some nextState + +def LaneValid (state : NodeState) : Prop := + (state.phase = .gossiping -> + state.timeoutState = .gossiping) /\ + (state.phase = .voting -> + state.timeoutState = .gossiping \/ + state.timeoutState = .voting) /\ + (state.phase = .opening -> + state.timeoutState = .gossiping \/ + state.timeoutState = .voting \/ + state.timeoutState = .opening) /\ + (state.phase = .gossiping -> + state.chosen = none) + +def NodeLanesValid (state : State) : Prop := + forall entry, entry ∈ state.system.nodes -> + LaneValid entry.2 + +theorem step_preserves_lane + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (valid : LaneValid state) : + LaneValid (step config state event).state := by + cases event + all_goals try cases_type Validation + all_goals + simp [LaneValid, step, rejected, advance, advanceTimeoutLane, + advanceTimeoutState, validTimeout] at valid ⊢ + all_goals repeat first | split | simp_all | aesop + +theorem step_preserves_advanced_lane + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (advanced : state.timeoutState ≠ .gossiping) : + (step config state event).state.timeoutState ≠ .gossiping := by + cases event + all_goals try cases_type Validation + all_goals + simp [step, rejected, advance, validTimeout, advanceTimeoutLane, + advanceTimeoutState] at advanced ⊢ + all_goals repeat first | split | simp_all + +theorem systemStep_preserves_lanes + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (valid : + forall entry, entry ∈ before.nodes -> + LaneValid entry.2) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + LaneValid entry.2 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · apply step_preserves_lane config node event + exact valid (key, node) (List.mem_of_find?_eq_some found) + · exact valid previous previousMember + +theorem initial_lanes_valid + (config : Config) + (active : List Location) : + NodeLanesValid (initial config active) := by + simp [NodeLanesValid, LaneValid, Global.initial, initialSystem, + initialNode] + +theorem next_preserves_lanes + {config : Config} + {before after : State} + {action : Action} + (valid : NodeLanesValid before) + (transition : next config before action = some after) : + NodeLanesValid after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact valid + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, rfl⟩ + intro entry membership + rw [recordEffects_system] at membership + exact systemStep_preserves_lanes valid systemStep + entry membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, rfl⟩ + intro entry membership + rw [recordEffects_system] at membership + exact systemStep_preserves_lanes valid systemStep + entry membership + +theorem reachable_lanes_valid + {config : Config} + {state : State} + (reachable : Reachable config state) : + NodeLanesValid state := by + induction reachable with + | initial active valid nodup configured => + exact initial_lanes_valid config active + | step reachable transition valid => + exact next_preserves_lanes valid transition + +theorem nodeState_eq_of_mem + {state : State} + {node : Location} + {foundState : NodeState} + (keysNodup : (state.system.nodes.map Prod.fst).Nodup) + (membership : (node, foundState) ∈ state.system.nodes) : + Global.nodeState state node = some foundState := by + unfold Global.nodeState + cases found : + state.system.nodes.find? fun entry => entry.1 == node with + | none => + rw [List.find?_eq_none] at found + exact False.elim + (found (node, foundState) membership (by simp)) + | some entry => + have foundMember : entry ∈ state.system.nodes := + List.mem_of_find?_eq_some found + have foundKey : entry.1 = node := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) found) + have same : entry = (node, foundState) := + eq_of_key_eq keysNodup foundMember membership foundKey + simp [same] + +theorem node_property_of_nodeState + {state : State} + {node : Location} + {foundState : NodeState} + {predicate : NodeState -> Prop} + (property : + forall entry, entry ∈ state.system.nodes -> + predicate entry.2) + (found : Global.nodeState state node = some foundState) : + predicate foundState := by + rw [Global.nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + rw [←stateEq] + exact property entry (List.mem_of_find?_eq_some findEq) + +theorem deliver_target_state + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (transition : next config before (.deliver envelope) = some after) : + exists output, + Global.nodeState after envelope.target = some output.state /\ + systemStep config.protocol before.system envelope.target + (eventFor envelope) = some (after.system, output) := by + have afterWellFormed := + next_preserves_well_formed wellFormed transition + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] at afterWellFormed ⊢ + refine ⟨output, ?_, ?_⟩ + · apply nodeState_eq_of_mem afterWellFormed.nodeKeysNodup + rw [recordEffects_system] + exact systemStep_output_mem systemStep + · simpa using systemStep + +theorem timeout_target_state + {config : Config} + {before after : State} + {target : Location} + (wellFormed : WellFormed config before) + (transition : next config before (.timeout target) = some after) : + exists output, + Global.nodeState after target = some output.state /\ + output.accepted = true /\ + systemStep config.protocol before.system target .timeout = + some (after.system, output) := by + have afterWellFormed := + next_preserves_well_formed wellFormed transition + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, accepted, stateEq⟩ + rw [←stateEq] at afterWellFormed ⊢ + refine ⟨output, ?_, accepted, ?_⟩ + · apply nodeState_eq_of_mem afterWellFormed.nodeKeysNodup + rw [recordEffects_system] + exact systemStep_output_mem systemStep + · simpa using systemStep + +theorem systemStep_output_eq + {config : Protocol.Config} + {global : State} + {after : SystemState} + {target : Location} + {event : Event} + {state : NodeState} + {output : StepOutput} + (found : Global.nodeState global target = some state) + (transition : + systemStep config global.system target event = some (after, output)) : + output = step config state event := by + change + (do + let node <- Global.nodeState global target + let result := step config node event + pure ({ + nodes := replaceNode target result.state global.system.nodes + }, result)) = some (after, output) at transition + rw [found] at transition + simp at transition + exact transition.2.symm + +theorem completed_effect_recorded + {node : Location} + {nodeState : NodeState} + {effects : List Effect} + {state : State} + (completed : .completed ∈ effects) : + node ∈ (recordEffects node nodeState effects state).completed := by + induction effects generalizing state with + | nil => simp at completed + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + rw [List.mem_cons] at completed + rcases completed with rfl | inTail + · apply mem_completed_recordEffects + simp [recordEffect] + · exact ih inTail + +theorem restart_effect_recorded + {node chosen : Location} + {nodeState : NodeState} + {effects : List Effect} + {state : State} + (restart : .restart chosen ∈ effects) : + node ∈ (recordEffects node nodeState effects state).restarts := by + induction effects generalizing state with + | nil => simp at restart + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + rw [List.mem_cons] at restart + rcases restart with rfl | inTail + · apply mem_restarts_recordEffects + simp [recordEffect] + · exact ih inTail + +theorem mem_removeOne_or_eq + [BEq α] + [LawfulBEq α] + {member removed : α} + {values : List α} + (membership : member ∈ values) : + member ∈ removeOne removed values \/ member = removed := by + induction values with + | nil => simp at membership + | cons head tail ih => + rw [List.mem_cons] at membership + rcases membership with rfl | inTail + · by_cases equal : member = removed + · exact Or.inr equal + · exact Or.inl (by simp [removeOne, equal]) + · simp only [removeOne] + split + · exact Or.inl inTail + · rcases ih inTail with still | equal + · exact Or.inl (by simp [still]) + · exact Or.inr equal + +structure Fair + {config : Config} + (execution : Execution config) : Prop where + retry : + forall start node phase, + node ∈ (execution.states start).active -> + HasPhase (execution.states start) node phase -> + (phase = .gossiping \/ phase = .voting \/ phase = .opening) -> + Enabled config (execution.states start) (.retry node) -> + EventuallyFrom start (fun n => + Not (HasPhase (execution.states n) node phase) \/ + execution.actions n = .retry node) + delivery : + forall start envelope, + envelope ∈ (execution.states start).network -> + EventuallyFrom start (fun n => + execution.actions n = .deliver envelope) + timeout : + forall start node phase, + node ∈ (execution.states start).active -> + HasPhase (execution.states start) node phase -> + (phase = .gossiping \/ phase = .voting \/ phase = .opening) -> + Enabled config (execution.states start) (.timeout node) -> + EventuallyFrom start (fun n => + Not (HasPhase (execution.states n) node phase) \/ + execution.actions n = .timeout node) + openingTimeout : + forall start node, + node ∈ (execution.states start).active -> + HasPhase (execution.states start) node .opening -> + Enabled config (execution.states start) (.timeout node) -> + EventuallyFrom start (fun n => + CompletedOpen (execution.states n) node \/ + (HasPhase (execution.states n) node .opening /\ + execution.actions n = .timeout node)) + +theorem execution_reachable + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) : + forall n, Reachable config (execution.states n) := by + intro n + induction n with + | zero => exact initial + | succ n reachable => + exact Reachable.step reachable (execution.step_succ n) + +theorem execution_active_eq + {config : Config} + (execution : Execution config) : + forall n, (execution.states n).active = (execution.states 0).active := by + intro n + induction n with + | zero => rfl + | succ n activeEq => + exact (next_active_eq (execution.step_succ n)).trans activeEq + +theorem active_at + {config : Config} + (execution : Execution config) + {node : Location} + (active : node ∈ (execution.states 0).active) : + forall n, node ∈ (execution.states n).active := by + intro n + rw [execution_active_eq execution n] + exact active + +theorem recovered_for_configured + {config : Config} + (valid : config.Valid) + {node : Location} + (configured : node ∈ config.protocol.expectedLocations) : + exists txid, recoveredTxID config node = some txid := by + rw [←valid.2.2] at configured + rcases List.mem_map.mp configured with + ⟨entry, membership, keyEq⟩ + rcases entry with ⟨location, txid⟩ + simp at keyEq + subst location + refine ⟨txid, ?_⟩ + apply recoveredTxID_of_mem valid + exact membership + +theorem active_nodeState + {config : Config} + {state : State} + (wellFormed : WellFormed config state) + {node : Location} + (active : node ∈ state.active) : + exists nodeState, + Global.nodeState state node = some nodeState := by + have configured := wellFormed.activeConfigured node active + rw [←wellFormed.nodeKeys] at configured + rcases List.mem_map.mp configured with + ⟨entry, membership, keyEq⟩ + refine ⟨entry.2, ?_⟩ + apply nodeState_eq_of_mem wellFormed.nodeKeysNodup + rcases entry with ⟨location, nodeState⟩ + simp at keyEq + subst location + exact membership + +theorem retryMessages_self_gossip + {config : Config} + {node : Location} + {state : NodeState} + {txid : TxID} + (phase : state.phase = .gossiping) + (configured : node ∈ config.protocol.expectedLocations) + (recovered : recoveredTxID config node = some txid) : + { + source := node + target := node + payload := Payload.gossip txid + sourceState := state + } ∈ retryMessages config node state := by + rw [retryMessages, List.mem_filterMap] + refine ⟨.sendGossip node, ?_, ?_⟩ + · simpa [step, phase] using configured + · simp [messageForEffect, recovered] + +theorem retryMessages_vote + {config : Config} + {node target : Location} + {state : NodeState} + (phase : state.phase = .voting) + (chosen : state.chosen = some target) : + { + source := node + target + payload := Payload.vote + sourceState := state + } ∈ retryMessages config node state := by + rw [retryMessages, List.mem_filterMap] + refine ⟨.sendVote target, ?_, rfl⟩ + simp [step, phase, chosen] + +theorem retry_iamopen_state + {config : Config} + {envelope : Envelope} + (valid : envelope.Valid config) + (announcement : envelope.payload = .iAmOpen) : + envelope.sourceState.phase = .opening := by + rcases valid_envelope_effect valid with + ⟨effect, member, created⟩ + cases effect with + | sendGossip target => + cases found : recoveredTxID config envelope.source with + | none => simp [messageForEffect, found] at created + | some txid => + simp [messageForEffect, found] at created + rw [←created] at announcement + contradiction + | sendVote target => + simp [messageForEffect] at created + rw [←created] at announcement + contradiction + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] at announcement ⊢ + cases phase : envelope.sourceState.phase + case opening => rfl + case voting => + cases chosen : envelope.sourceState.chosen <;> + simp [step, phase, chosen] at member + all_goals simp [step, phase] at member + | opening kind => simp [messageForEffect] at created + | restart chosen => simp [messageForEffect] at created + | completed => simp [messageForEffect] at created + | rejected reason => simp [messageForEffect] at created + +def acceptedIAmOpenSource : Event -> Option Location + | .receiveIAmOpen source .accepted => some source + | _ => none + +theorem step_joining_origin + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (joining : (step config state event).state.phase = .joining) : + state.phase = .joining \/ + exists source, acceptedIAmOpenSource event = some source := by + cases event + all_goals try cases_type Validation + all_goals + simp [acceptedIAmOpenSource, step, rejected, advance, + advanceTimeoutLane] at joining ⊢ + all_goals + repeat first | split at joining | split | simp_all | aesop + +theorem step_open_origin + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (opened : (step config state event).state.phase = .open) : + state.phase = .open \/ + .completed ∈ (step config state event).effects := by + cases event + all_goals try cases_type Validation + all_goals + simp [step, rejected, advance, advanceTimeoutLane, validTimeout] + at opened ⊢ + all_goals + repeat first | split at opened | split | simp_all | aesop + +theorem iamopen_delivery_outcome + (config : Protocol.Config) + (state : NodeState) + (source : Location) : + let output := step config state (.receiveIAmOpen source .accepted) + output.state.phase = .opening \/ + output.state.phase = .open \/ + exists chosen, .restart chosen ∈ output.effects := by + cases phase : state.phase <;> + simp [step, phase, rejected, advance, advanceTimeoutLane] + +theorem iamopen_open_predecessor + (config : Protocol.Config) + (state : NodeState) + (source : Location) + (opened : + (step config state (.receiveIAmOpen source .accepted)).state.phase = + .open) : + state.phase = .open := by + cases phase : state.phase <;> + simp [step, phase, rejected, advance, advanceTimeoutLane] at opened + rfl + +theorem eventFor_iamopen_source + {envelope : Envelope} + {source : Location} + (accepted : + acceptedIAmOpenSource (eventFor envelope) = some source) : + envelope.payload = .iAmOpen /\ + envelope.source = source := by + cases payload : envelope.payload <;> + simp_all [eventFor, acceptedIAmOpenSource] + +theorem retry_gossip_enabled + {config : Config} + {state : State} + {node : Location} + (valid : config.Valid) + (wellFormed : WellFormed config state) + (active : node ∈ state.active) + (phase : HasPhase state node .gossiping) : + Enabled config state (.retry node) := by + rcases phase with ⟨nodeState, found, gossiping⟩ + have configured := wellFormed.activeConfigured node active + rcases recovered_for_configured valid configured with + ⟨txid, recovered⟩ + have message := + retryMessages_self_gossip gossiping configured recovered + have messagesNonempty : + retryMessages config node nodeState ≠ [] := by + intro empty + rw [empty] at message + simp at message + refine ⟨{ + state with + network := state.network ++ retryMessages config node nodeState + sent := state.sent ++ retryMessages config node nodeState + }, ?_⟩ + simp [next, active, found, messagesNonempty] + +theorem retry_voting_enabled + {config : Config} + {state : State} + {node target : Location} + {nodeState : NodeState} + (active : node ∈ state.active) + (found : Global.nodeState state node = some nodeState) + (phase : nodeState.phase = .voting) + (chosen : nodeState.chosen = some target) : + Enabled config state (.retry node) := by + have message := retryMessages_vote (config := config) + (node := node) phase chosen + have messagesNonempty : + retryMessages config node nodeState ≠ [] := by + intro empty + rw [empty] at message + simp at message + refine ⟨{ + state with + network := state.network ++ retryMessages config node nodeState + sent := state.sent ++ retryMessages config node nodeState + }, ?_⟩ + simp [next, active, found, messagesNonempty] + +theorem delivery_enabled + {config : Config} + {state : State} + {envelope : Envelope} + (wellFormed : WellFormed config state) + (network : envelope ∈ state.network) + (targetActive : envelope.target ∈ state.active) : + Enabled config state (.deliver envelope) := by + rcases active_nodeState wellFormed targetActive with + ⟨targetState, found⟩ + let output := step config.protocol targetState (eventFor envelope) + let system : SystemState := { + nodes := replaceNode envelope.target output.state state.system.nodes + } + let delivered : State := { + state with + system + network := removeOne envelope state.network + } + have stepResult : + systemStep config.protocol state.system envelope.target + (eventFor envelope) = some (system, output) := by + change + (do + let node <- Global.nodeState state envelope.target + let result := step config.protocol node (eventFor envelope) + pure ({ + nodes := + replaceNode envelope.target result.state state.system.nodes + }, result)) = some (system, output) + rw [found] + rfl + refine + ⟨recordEffects envelope.target output.state output.effects delivered, ?_⟩ + simp [next, network, targetActive, stepResult, output, system, + delivered] + +theorem timeout_enabled_of_accepted + {config : Config} + {state : State} + {node : Location} + {nodeState : NodeState} + (active : node ∈ state.active) + (found : Global.nodeState state node = some nodeState) + (accepted : (step config.protocol nodeState .timeout).accepted = true) : + Enabled config state (.timeout node) := by + let output := step config.protocol nodeState .timeout + let system : SystemState := { + nodes := replaceNode node output.state state.system.nodes + } + have stepResult : + systemStep config.protocol state.system node .timeout = + some (system, output) := by + change + (do + let current <- Global.nodeState state node + let result := step config.protocol current .timeout + pure ({ + nodes := replaceNode node result.state state.system.nodes + }, result)) = some (system, output) + rw [found] + rfl + refine + ⟨recordEffects node output.state output.effects + { state with system }, ?_⟩ + simp [next, active, stepResult, accepted, output, system] + +theorem retry_gossip_enqueued + {config : Config} + {before after : State} + {node : Location} + (valid : config.Valid) + (wellFormed : WellFormed config before) + (phase : HasPhase before node .gossiping) + (transition : next config before (.retry node) = some after) : + exists envelope, + envelope ∈ after.network /\ + envelope.source = node /\ + envelope.target = node /\ + exists txid, envelope.payload = .gossip txid := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨active, sourceState, found, _, stateEq⟩ + rcases phase with ⟨phaseState, foundPhase, gossiping⟩ + have configured := + wellFormed.activeConfigured node active + rcases recovered_for_configured valid configured with + ⟨txid, recovered⟩ + rw [found] at foundPhase + injection foundPhase with stateEq' + subst phaseState + let envelope : Envelope := { + source := node + target := node + payload := .gossip txid + sourceState + } + have message : envelope ∈ retryMessages config node sourceState := + retryMessages_self_gossip gossiping configured recovered + rw [←stateEq] + exact + ⟨envelope, List.mem_append_right _ message, rfl, rfl, txid, rfl⟩ + +theorem retry_vote_enqueued + {config : Config} + {before after : State} + {node target : Location} + {nodeState : NodeState} + (found : Global.nodeState before node = some nodeState) + (phase : nodeState.phase = .voting) + (chosen : nodeState.chosen = some target) + (transition : next config before (.retry node) = some after) : + exists envelope, + envelope ∈ after.network /\ + envelope.source = node /\ + envelope.target = target /\ + envelope.payload = .vote := by + have message := retryMessages_vote (config := config) + (node := node) phase chosen + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, actualState, actualFound, _, stateEq⟩ + rw [found] at actualFound + injection actualFound with actualEq + subst actualState + let envelope : Envelope := { + source := node + target + payload := .vote + sourceState := nodeState + } + rw [←stateEq] + exact + ⟨envelope, List.mem_append_right _ message, rfl, rfl, rfl⟩ + +theorem insertGossip_nonempty + (source : Location) + (txid : TxID) + (gossips : List (Prod Location TxID)) : + insertGossip source txid gossips ≠ [] := by + unfold insertGossip + split + · rename_i present + intro empty + subst gossips + simp at present + · intro empty + have lengths := + (List.mergeSort_perm ((source, txid) :: gossips) + (fun left right => left.1 <= right.1)).length_eq + rw [empty] at lengths + simp at lengths + +theorem maximumGossip_some + {gossips : List (Prod Location TxID)} + (nonempty : gossips ≠ []) : + exists selected, maximumGossip gossips = some selected := by + cases gossips with + | nil => contradiction + | cons head tail => + exact ⟨tail.foldl selectMaximum head, rfl⟩ + +theorem gossip_receive_progress + (config : Protocol.Config) + (state : NodeState) + (source : Location) + (txid : TxID) + (valid : LaneValid state) + (phase : state.phase = .gossiping) : + let output := + step config state (.receiveGossip source txid .accepted) + output.state.phase ≠ .gossiping \/ + output.state.gossips ≠ [] := by + have chosen := valid.2.2.2 phase + have nonempty := insertGossip_nonempty source txid state.gossips + obtain ⟨selected, maximum⟩ := maximumGossip_some nonempty + simp [step, phase, chosen, rejected, advance, advanceTimeoutLane, + validTimeout] + repeat first | split | simp_all + +theorem gossip_timeout_progress + (config : Protocol.Config) + (state : NodeState) + (valid : LaneValid state) + (phase : state.phase = .gossiping) + (accepted : (step config state .timeout).accepted = true) : + (step config state .timeout).state.phase = .voting := by + have lane := valid.1 phase + simp [step, phase, lane, rejected, advance, advanceTimeoutLane, + validTimeout] at accepted ⊢ + repeat first | split at accepted | split | simp_all + +theorem gossip_timeout_enabled_local + (config : Protocol.Config) + (state : NodeState) + (valid : LaneValid state) + (phase : state.phase = .gossiping) + (nonempty : state.gossips ≠ []) : + (step config state .timeout).accepted = true := by + have lane := valid.1 phase + obtain ⟨selected, maximum⟩ := maximumGossip_some nonempty + simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, + maximum] + +theorem gossip_timeout_enabled + {config : Config} + {state : State} + {node : Location} + (active : node ∈ state.active) + (lanes : NodeLanesValid state) + (phase : HasPhase state node .gossiping) + (gossip : HasGossip state node) : + Enabled config state (.timeout node) := by + rcases phase with ⟨phaseState, foundPhase, gossiping⟩ + rcases gossip with ⟨gossipState, foundGossip, nonempty⟩ + rw [foundPhase] at foundGossip + injection foundGossip with stateEq + subst gossipState + have lane := node_property_of_nodeState lanes foundPhase + apply timeout_enabled_of_accepted active foundPhase + exact gossip_timeout_enabled_local config.protocol phaseState lane + gossiping nonempty + +def openingDistance : Phase -> Nat + | .gossiping => 3 + | .voting => 2 + | .opening => 1 + | .joining | .open => 0 + +theorem opening_timeout_local + (config : Protocol.Config) + (state : NodeState) + (valid : LaneValid state) + (phase : state.phase = .opening) : + let output := step config state .timeout + (output.effects = [.completed] /\ output.state.phase = .open) \/ + (output.state.phase = .opening /\ + openingDistance output.state.timeoutState < + openingDistance state.timeoutState) := by + rcases valid.2.2.1 phase with lane | lane | lane + · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, + advanceTimeoutState, openingDistance] + · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, + advanceTimeoutState, openingDistance] + · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, + advanceTimeoutState, openingDistance] + +theorem opening_step_distance_le + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (valid : LaneValid state) + (phase : state.phase = .opening) + (after : (step config state event).state.phase = .opening) : + openingDistance (step config state event).state.timeoutState <= + openingDistance state.timeoutState := by + cases event with + | receiveGossip source txid validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + repeat first | split | simp_all + | receiveVote source validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + | receiveIAmOpen source validation => + cases validation <;> simp [step, phase, rejected] + | timeout => + rcases opening_timeout_local config state valid phase with + done | progress + · rw [done.2] at after + contradiction + · exact Nat.le_of_lt progress.2 + | retry => simp [step] + +theorem opening_step_or_completed + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (phase : state.phase = .opening) : + (step config state event).state.phase = .opening \/ + ((step config state event).state.phase = .open /\ + .completed ∈ (step config state event).effects) := by + cases event with + | receiveGossip source txid validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + repeat first | split | simp_all + | receiveVote source validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + | receiveIAmOpen source validation => + cases validation <;> simp [step, phase, rejected] + | timeout => + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + split <;> simp_all + | retry => simp [step, phase] + +theorem opening_non_timeout + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (phase : state.phase = .opening) + (notTimeout : event ≠ .timeout) : + (step config state event).state.phase = .opening /\ + (step config state event).state.timeoutState = + state.timeoutState := by + cases event with + | receiveGossip source txid validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + repeat first | split | simp_all + | receiveVote source validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + | receiveIAmOpen source validation => + cases validation <;> simp [step, phase, rejected] + | timeout => contradiction + | retry => exact ⟨phase, rfl⟩ + +theorem opening_timeout_enabled + {config : Config} + {state : State} + {node : Location} + (active : node ∈ state.active) + (phase : HasPhase state node .opening) : + Enabled config state (.timeout node) := by + rcases phase with ⟨nodeState, found, opening⟩ + apply timeout_enabled_of_accepted active found + simp [step, opening, advance, rejected] + repeat first | split | simp_all + +theorem timeout_opening_step + {config : Config} + {before after : State} + {node : Location} + {beforeState : NodeState} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (foundBefore : + Global.nodeState before node = some beforeState) + (opening : beforeState.phase = .opening) + (transition : next config before (.timeout node) = some after) : + CompletedOpen after node \/ + (exists nextState : NodeState, + Global.nodeState after node = some nextState /\ + nextState.phase = .opening /\ + openingDistance nextState.timeoutState < + openingDistance beforeState.timeoutState) := by + have lane : LaneValid beforeState := by + apply node_property_of_nodeState (predicate := LaneValid) + · exact lanes + · exact foundBefore + have timeoutResult : + ((step config.protocol beforeState .timeout).effects = + [.completed] /\ + (step config.protocol beforeState .timeout).state.phase = .open) \/ + ((step config.protocol beforeState .timeout).state.phase = + .opening /\ + openingDistance + (step config.protocol beforeState .timeout).state.timeoutState < + openingDistance beforeState.timeoutState) := + opening_timeout_local config.protocol beforeState lane opening + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + have outputEq := systemStep_output_eq foundBefore systemStep + rw [←outputEq] at timeoutResult + rw [←stateEq] + rcases timeoutResult with completed | progress + · exact Or.inl (by + rcases completed with ⟨effects, _⟩ + rw [effects] + simp [CompletedOpen, recordEffects, recordEffect]) + · exact Or.inr + ⟨output.state, + (by + apply nodeState_eq_of_mem + · rw [recordEffects_system, + systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · rw [recordEffects_system] + exact systemStep_output_mem systemStep), + progress.1, + by simpa using progress.2⟩ + +theorem next_opening_progress + {config : Config} + {before after : State} + {node : Location} + {beforeState : NodeState} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (foundBefore : + Global.nodeState before node = some beforeState) + (opening : beforeState.phase = .opening) + (transition : next config before action = some after) : + CompletedOpen after node \/ + (exists afterState : NodeState, + Global.nodeState after node = some afterState /\ + afterState.phase = .opening /\ + openingDistance afterState.timeoutState <= + openingDistance beforeState.timeoutState) := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact Or.inr + ⟨beforeState, foundBefore, opening, Nat.le_refl _⟩ + | deliver envelope => + by_cases target : node = envelope.target + · subst node + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + have preserved := + opening_non_timeout config.protocol beforeState + (eventFor envelope) opening + (by + cases payloadEq : envelope.payload <;> + simp [eventFor, payloadEq]) + rw [←outputEq] at preserved + exact Or.inr + ⟨output.state, foundAfter, preserved.1, + by rw [preserved.2]⟩ + · have unchanged := deliver_other_node_eq target transition + rw [foundBefore] at unchanged + exact Or.inr + ⟨beforeState, by simp [unchanged], opening, Nat.le_refl _⟩ + | timeout target => + by_cases same : node = target + · subst node + rcases timeout_opening_step wellFormed lanes foundBefore + opening transition with + completed | ⟨nextState, foundAfter, nextOpening, distance⟩ + · exact Or.inl completed + · exact Or.inr + ⟨nextState, foundAfter, nextOpening, + Nat.le_of_lt distance⟩ + · have unchanged := timeout_other_node_eq same transition + rw [foundBefore] at unchanged + exact Or.inr + ⟨beforeState, by simp [unchanged], opening, Nat.le_refl _⟩ + +theorem insertVote_nonempty + (source : Location) + (votes : List Location) : + insertVote source votes ≠ [] := by + unfold insertVote + split + · rename_i present + intro empty + subst votes + simp at present + · intro empty + have lengths := + (List.mergeSort_perm (source :: votes) + (fun left right => left <= right)).length_eq + rw [empty] at lengths + simp at lengths + +theorem step_preserves_nonempty_votes + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (nonempty : state.votes ≠ []) : + (step config state event).state.votes ≠ [] := by + rcases step_votes_shape config state event with + unchanged | ⟨source, _, changed⟩ + · rw [unchanged] + exact nonempty + · rw [changed] + exact insertVote_nonempty source state.votes + +theorem next_preserves_hasVote + {config : Config} + {before after : State} + {action : Action} + {node : Location} + (wellFormed : WellFormed config before) + (vote : HasVote before node) + (transition : next config before action = some after) : + HasVote after node := by + rcases vote with ⟨beforeState, foundBefore, nonempty⟩ + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact ⟨beforeState, foundBefore, nonempty⟩ + | deliver envelope => + by_cases target : node = envelope.target + · subst node + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact step_preserves_nonempty_votes + config.protocol beforeState (eventFor envelope) nonempty⟩ + · have unchanged := deliver_other_node_eq target transition + rw [foundBefore] at unchanged + exact ⟨beforeState, by simp [unchanged], nonempty⟩ + | timeout target => + by_cases same : node = target + · subst node + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact step_preserves_nonempty_votes + config.protocol beforeState .timeout nonempty⟩ + · have unchanged := timeout_other_node_eq same transition + rw [foundBefore] at unchanged + exact ⟨beforeState, by simp [unchanged], nonempty⟩ + +theorem hasVote_mono + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (vote : HasVote (execution.states start) node) : + HasVote (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact vote + | succ finish order vote => + exact next_preserves_hasVote + (reachable_well_formed + (execution_reachable execution initial finish)) + vote (execution.step_succ finish) + +theorem next_preserves_advanced_lane + {config : Config} + {before after : State} + {action : Action} + {node : Location} + (wellFormed : WellFormed config before) + (advanced : LaneAdvanced before node) + (transition : next config before action = some after) : + LaneAdvanced after node := by + rcases advanced with ⟨beforeState, foundBefore, lane⟩ + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact ⟨beforeState, foundBefore, lane⟩ + | deliver envelope => + by_cases target : node = envelope.target + · subst node + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact step_preserves_advanced_lane + config.protocol beforeState (eventFor envelope) lane⟩ + · have unchanged := deliver_other_node_eq target transition + rw [foundBefore] at unchanged + exact ⟨beforeState, by simp [unchanged], lane⟩ + | timeout target => + by_cases same : node = target + · subst node + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact step_preserves_advanced_lane + config.protocol beforeState .timeout lane⟩ + · have unchanged := timeout_other_node_eq same transition + rw [foundBefore] at unchanged + exact ⟨beforeState, by simp [unchanged], lane⟩ + +theorem advanced_lane_mono + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (advanced : LaneAdvanced (execution.states start) node) : + LaneAdvanced (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact advanced + | succ finish order advanced => + exact next_preserves_advanced_lane + (reachable_well_formed + (execution_reachable execution initial finish)) + advanced (execution.step_succ finish) + +theorem opening_progress_between + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start finish : Nat} + {node : Location} + {startState : NodeState} + (order : start <= finish) + (foundStart : + Global.nodeState (execution.states start) node = some startState) + (openingStart : startState.phase = .opening) + (notCompleted : + Not (CompletedOpen (execution.states finish) node)) : + exists finishState : NodeState, + Global.nodeState (execution.states finish) node = some finishState /\ + finishState.phase = .opening /\ + openingDistance finishState.timeoutState <= + openingDistance startState.timeoutState := by + induction finish, order using Nat.le_induction with + | base => + exact + ⟨startState, foundStart, openingStart, Nat.le_refl _⟩ + | succ finish order ih => + have notCompletedBefore : + Not (CompletedOpen (execution.states finish) node) := by + intro completed + exact notCompleted + (next_completed_monotonic + (execution.step_succ finish) node completed) + rcases ih notCompletedBefore with + ⟨beforeState, foundBefore, openingBefore, distanceBefore⟩ + rcases next_opening_progress + (reachable_well_formed + (execution_reachable execution initial finish)) + (reachable_lanes_valid + (execution_reachable execution initial finish)) + foundBefore openingBefore (execution.step_succ finish) with + completed | + ⟨afterState, foundAfter, openingAfter, distanceAfter⟩ + · contradiction + · exact + ⟨afterState, foundAfter, openingAfter, + Nat.le_trans distanceAfter distanceBefore⟩ + +theorem deliver_gossip_progress + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (payload : exists txid, envelope.payload = .gossip txid) + (phase : HasPhase before envelope.target .gossiping) + (transition : next config before (.deliver envelope) = some after) : + Not (HasPhase after envelope.target .gossiping) \/ + HasGossip after envelope.target := by + rcases phase with ⟨beforeState, foundBefore, gossiping⟩ + rcases payload with ⟨txid, payload⟩ + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + have lane := + node_property_of_nodeState lanes foundBefore + simp [eventFor, payload] at outputEq + have progress := + gossip_receive_progress config.protocol beforeState + envelope.source txid lane gossiping + rw [←outputEq] at progress + rcases progress with left | right + · exact Or.inl (by + intro stillGossiping + rcases stillGossiping with ⟨state, found, phase⟩ + rw [foundAfter] at found + injection found with stateEq + subst state + exact left phase) + · exact Or.inr ⟨output.state, foundAfter, right⟩ + +theorem timeout_gossip_progress + {config : Config} + {before after : State} + {node : Location} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (phase : HasPhase before node .gossiping) + (transition : next config before (.timeout node) = some after) : + HasPhase after node .voting := by + rcases phase with ⟨beforeState, foundBefore, gossiping⟩ + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, accepted, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + have lane := + node_property_of_nodeState lanes foundBefore + have voting := + gossip_timeout_progress config.protocol beforeState lane + gossiping (by simpa [outputEq] using accepted) + exact + ⟨output.state, foundAfter, by simpa [outputEq] using voting⟩ + +theorem vote_receive_progress + (config : Protocol.Config) + (state : NodeState) + (source : Location) + (phase : state.phase = .voting) : + let output := step config state (.receiveVote source .accepted) + output.state.phase ≠ .voting \/ output.state.votes ≠ [] := by + have nonempty := insertVote_nonempty source state.votes + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + repeat first | split | simp_all + +theorem voting_timeout_local + (config : Protocol.Config) + (state : NodeState) + (valid : LaneValid state) + (phase : state.phase = .voting) + (nonempty : state.votes ≠ []) : + let output := step config state .timeout + output.state.phase = .opening \/ + (output.state.phase = .voting /\ + output.state.timeoutState = .voting) := by + rcases valid.2.1 phase with lane | lane + · simp [step, phase, lane, rejected, advance, validTimeout, + advanceTimeoutLane, advanceTimeoutState] + repeat first | split | simp_all + · simp [step, phase, lane, nonempty, rejected, advance, validTimeout, + advanceTimeoutLane, advanceTimeoutState] + +theorem aligned_voting_timeout_opens + (config : Protocol.Config) + (state : NodeState) + (phase : state.phase = .voting) + (lane : state.timeoutState = .voting) + (nonempty : state.votes ≠ []) : + (step config state .timeout).state.phase = .opening := by + simp [step, phase, lane, nonempty, rejected, advance, validTimeout, + advanceTimeoutLane] + +theorem deliver_vote_progress + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (payload : envelope.payload = .vote) + (phase : HasPhase before envelope.target .voting) + (transition : next config before (.deliver envelope) = some after) : + Not (HasPhase after envelope.target .voting) \/ + HasVote after envelope.target := by + rcases phase with ⟨beforeState, foundBefore, voting⟩ + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + simp [eventFor, payload] at outputEq + have progress := + vote_receive_progress config.protocol beforeState + envelope.source voting + rw [←outputEq] at progress + rcases progress with left | right + · exact Or.inl (by + intro stillVoting + rcases stillVoting with ⟨state, found, phase⟩ + rw [foundAfter] at found + injection found with stateEq + subst state + exact left phase) + · exact Or.inr ⟨output.state, foundAfter, right⟩ + +theorem deliver_iamopen_resolves + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (openCompleted : OpenCompleted before) + (payload : envelope.payload = .iAmOpen) + (transition : next config before (.deliver envelope) = some after) : + Terminal after envelope.target \/ + HasPhase after envelope.target .opening := by + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, targetActive, system, output, systemStep, stateEq⟩ + rcases active_nodeState wellFormed targetActive with + ⟨beforeState, foundBefore⟩ + have outputEq := systemStep_output_eq foundBefore systemStep + simp [eventFor, payload] at outputEq + have outcome := + iamopen_delivery_outcome config.protocol beforeState envelope.source + rw [←outputEq] at outcome + rw [←stateEq] + rcases outcome with opening | opened | ⟨chosen, restarted⟩ + · exact Or.inr + ⟨output.state, + by + apply nodeState_eq_of_mem + · rw [recordEffects_system, + systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · rw [recordEffects_system] + exact systemStep_output_mem systemStep, + opening⟩ + · have beforeOpen := + iamopen_open_predecessor config.protocol beforeState + envelope.source (by simpa [outputEq] using opened) + have completedBefore : CompletedOpen before envelope.target := by + rw [Global.nodeState, Option.map_eq_some_iff] at foundBefore + rcases foundBefore with ⟨entry, findEq, stateEq⟩ + have keyEq : entry.1 = envelope.target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == envelope.target) findEq) + rw [←keyEq] + apply openCompleted entry (List.mem_of_find?_eq_some findEq) + simpa [stateEq] using beforeOpen + exact Or.inl (Or.inr + (mem_completed_recordEffects completedBefore)) + · exact Or.inl (Or.inl + (restart_effect_recorded restarted)) + +theorem voting_timeout_enabled + {config : Config} + {state : State} + {node : Location} + (active : node ∈ state.active) + (phase : HasPhase state node .voting) : + Enabled config state (.timeout node) := by + rcases phase with ⟨nodeState, found, voting⟩ + apply timeout_enabled_of_accepted active found + simp [step, voting, advance, rejected] + repeat first | split | simp_all + +theorem timeout_voting_step + {config : Config} + {before after : State} + {node : Location} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (phase : HasPhase before node .voting) + (vote : HasVote before node) + (transition : next config before (.timeout node) = some after) : + HasPhase after node .opening \/ + (exists nextState : NodeState, + Global.nodeState after node = some nextState /\ + nextState.phase = .voting /\ + nextState.timeoutState = .voting /\ + nextState.votes ≠ []) := by + rcases phase with ⟨beforeState, foundBefore, voting⟩ + rcases vote with ⟨voteState, foundVote, nonempty⟩ + rw [foundBefore] at foundVote + injection foundVote with stateEq + subst voteState + have lane : LaneValid beforeState := by + apply node_property_of_nodeState (predicate := LaneValid) + · exact lanes + · exact foundBefore + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + have outputEq := systemStep_output_eq foundBefore systemStep + have progress := + voting_timeout_local config.protocol beforeState lane voting nonempty + rw [←outputEq] at progress + rcases progress with opening | waiting + · exact Or.inl ⟨output.state, foundAfter, opening⟩ + · exact Or.inr + ⟨output.state, foundAfter, waiting.1, waiting.2, + by + rw [outputEq] + exact step_preserves_nonempty_votes + config.protocol beforeState .timeout nonempty⟩ + +theorem aligned_timeout_voting_opens + {config : Config} + {before after : State} + {node : Location} + {nodeState : NodeState} + (wellFormed : WellFormed config before) + (found : Global.nodeState before node = some nodeState) + (phase : nodeState.phase = .voting) + (lane : nodeState.timeoutState = .voting) + (nonempty : nodeState.votes ≠ []) + (transition : next config before (.timeout node) = some after) : + HasPhase after node .opening := by + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + have outputEq := systemStep_output_eq found systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact aligned_voting_timeout_opens config.protocol nodeState + phase lane nonempty⟩ + +theorem fair_gossip_progress + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + {node : Location} + (active : node ∈ (execution.states start).active) + (phase : HasPhase (execution.states start) node .gossiping) : + EventuallyFrom start (fun n => + Not (HasPhase (execution.states n) node .gossiping)) := by + have reachable (n : Nat) := + execution_reachable execution initial n + have configValid := reachable_config_valid (reachable start) + have retryEnabled := + retry_gossip_enabled configValid + (reachable_well_formed (reachable start)) active phase + rcases fair.retry start node .gossiping active phase + (Or.inl rfl) retryEnabled with + ⟨retryAt, startRetry, leftGossip | retryAction⟩ + · exact ⟨retryAt, startRetry, leftGossip⟩ + · by_cases retryPhase : + HasPhase (execution.states retryAt) node .gossiping + · have retryStep : + next config (execution.states retryAt) (.retry node) = + some (execution.states (retryAt + 1)) := by + simpa [retryAction] using execution.step_succ retryAt + rcases retry_gossip_enqueued configValid + (reachable_well_formed (reachable retryAt)) + retryPhase retryStep with + ⟨envelope, pending, sourceEq, targetEq, txid, payload⟩ + rcases fair.delivery (retryAt + 1) envelope pending with + ⟨deliverAt, retryDeliver, deliverAction⟩ + by_cases deliverPhase : + HasPhase (execution.states deliverAt) node .gossiping + · have deliverStep : + next config (execution.states deliverAt) + (.deliver envelope) = + some (execution.states (deliverAt + 1)) := by + simpa [deliverAction] using execution.step_succ deliverAt + have delivered := + deliver_gossip_progress + (reachable_well_formed (reachable deliverAt)) + (reachable_lanes_valid (reachable deliverAt)) + ⟨txid, payload⟩ + (by simpa [targetEq] using deliverPhase) + deliverStep + rcases delivered with leftAfter | hasGossip + · exact + ⟨deliverAt + 1, by omega, by simpa [targetEq] using leftAfter⟩ + · by_cases afterPhase : + HasPhase (execution.states (deliverAt + 1)) node .gossiping + · have timeoutEnabled := + gossip_timeout_enabled + (config := config) + (by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution start] at active + exact active) + (reachable_lanes_valid (reachable (deliverAt + 1))) + afterPhase + (by simpa [targetEq] using hasGossip) + rcases fair.timeout (deliverAt + 1) node .gossiping + (by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution start] at active + exact active) + afterPhase (Or.inl rfl) timeoutEnabled with + ⟨timeoutAt, deliverTimeout, leftBeforeTimeout | timeoutAction⟩ + · exact ⟨timeoutAt, by omega, leftBeforeTimeout⟩ + · by_cases timeoutPhase : + HasPhase (execution.states timeoutAt) node .gossiping + · have timeoutStep : + next config (execution.states timeoutAt) + (.timeout node) = + some (execution.states (timeoutAt + 1)) := by + simpa [timeoutAction] using + execution.step_succ timeoutAt + have voting := + timeout_gossip_progress + (reachable_well_formed (reachable timeoutAt)) + (reachable_lanes_valid (reachable timeoutAt)) + timeoutPhase timeoutStep + refine ⟨timeoutAt + 1, by omega, ?_⟩ + intro impossible + have phases := hasPhase_unique voting impossible + contradiction + · exact ⟨timeoutAt, by omega, timeoutPhase⟩ + · exact ⟨deliverAt + 1, by omega, afterPhase⟩ + · exact ⟨deliverAt, by omega, deliverPhase⟩ + · exact ⟨retryAt, startRetry, retryPhase⟩ + +theorem next_gossiping_predecessor + {config : Config} + {before after : State} + {action : Action} + {node : Location} + (wellFormed : WellFormed config before) + (transition : next config before action = some after) + (afterGossip : HasPhase after node .gossiping) : + HasPhase before node .gossiping := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] at afterGossip + exact afterGossip + | deliver envelope => + by_cases target : node = envelope.target + · subst node + have details := transition + simp [next, Option.bind_eq_some_iff] at details + have targetActive := details.2.1 + rcases active_nodeState wellFormed targetActive with + ⟨beforeState, foundBefore⟩ + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + rcases afterGossip with ⟨afterState, found, phase⟩ + rw [foundAfter] at found + injection found with stateEq + subst afterState + have outputEq := + systemStep_output_eq foundBefore systemStep + have beforePhase : beforeState.phase = .gossiping := by + by_contra notGossip + have notAfter := + step_preserves_non_gossiping config.protocol beforeState + (eventFor envelope) notGossip + rw [←outputEq] at notAfter + exact notAfter phase + exact ⟨beforeState, foundBefore, beforePhase⟩ + · rcases afterGossip with ⟨afterState, foundAfter, phase⟩ + have unchanged := + deliver_other_node_eq target transition + rw [foundAfter] at unchanged + cases foundBefore : + Global.nodeState before node with + | none => simp [foundBefore] at unchanged + | some beforeState => + rw [foundBefore] at unchanged + injection unchanged with stateEq + subst beforeState + exact ⟨afterState, foundBefore, phase⟩ + | timeout target => + by_cases same : node = target + · subst node + have details := transition + simp [next, Option.bind_eq_some_iff] at details + have targetActive := details.1 + rcases active_nodeState wellFormed targetActive with + ⟨beforeState, foundBefore⟩ + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + rcases afterGossip with ⟨afterState, found, phase⟩ + rw [foundAfter] at found + injection found with stateEq + subst afterState + have outputEq := + systemStep_output_eq foundBefore systemStep + have beforePhase : beforeState.phase = .gossiping := by + by_contra notGossip + have notAfter := + step_preserves_non_gossiping config.protocol beforeState + .timeout notGossip + rw [←outputEq] at notAfter + exact notAfter phase + exact ⟨beforeState, foundBefore, beforePhase⟩ + · rcases afterGossip with ⟨afterState, foundAfter, phase⟩ + have unchanged := + timeout_other_node_eq same transition + rw [foundAfter] at unchanged + cases foundBefore : + Global.nodeState before node with + | none => simp [foundBefore] at unchanged + | some beforeState => + rw [foundBefore] at unchanged + injection unchanged with stateEq + subst beforeState + exact ⟨afterState, foundBefore, phase⟩ + +theorem not_gossiping_mono + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (notGossip : + Not (HasPhase (execution.states start) node .gossiping)) : + Not (HasPhase (execution.states finish) node .gossiping) := by + induction finish, order using Nat.le_induction with + | base => exact notGossip + | succ finish order notGossip => + intro gossip + exact notGossip + (next_gossiping_predecessor + (reachable_well_formed + (execution_reachable execution initial finish)) + (execution.step_succ finish) gossip) + +theorem eventually_list + {predicate : Nat -> Location -> Prop} + {start : Nat} + (nodes : List Location) + (eventual : + forall node, node ∈ nodes -> + EventuallyFrom start (fun n => predicate n node)) + (monotonic : + forall node first second, + first <= second -> + predicate first node -> + predicate second node) : + EventuallyFrom start (fun n => + forall node, node ∈ nodes -> predicate n node) := by + revert eventual + induction nodes with + | nil => + intro eventual + exact ⟨start, Nat.le_refl start, by simp⟩ + | cons head tail ih => + intro eventual + rcases eventual head (by simp) with + ⟨headAt, startHead, headHolds⟩ + rcases ih + (fun node membership => eventual node (by simp [membership])) with + ⟨tailAt, startTail, tailHolds⟩ + refine + ⟨max headAt tailAt, by omega, ?_⟩ + intro node membership + rw [List.mem_cons] at membership + rcases membership with rfl | inTail + · exact monotonic _ headAt (max headAt tailAt) + (Nat.le_max_left _ _) headHolds + · exact monotonic node tailAt (max headAt tailAt) + (Nat.le_max_right _ _) (tailHolds node inTail) + +theorem fair_all_leave_gossip + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (start : Nat) : + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + Not (HasPhase (execution.states n) node .gossiping)) := by + apply eventually_list (execution.states start).active + · intro node active + by_cases phase : + HasPhase (execution.states start) node .gossiping + · exact fair_gossip_progress execution initial fair active phase + · exact ⟨start, Nat.le_refl start, phase⟩ + · intro node first second order notGossip + exact not_gossiping_mono execution initial order notGossip + +theorem terminal_mono_step + {config : Config} + {before after : State} + {action : Action} + {node : Location} + (transition : next config before action = some after) + (terminal : Terminal before node) : + Terminal after node := by + rcases terminal with restarted | completed + · exact Or.inl (next_restarts_monotonic transition node restarted) + · exact Or.inr (next_completed_monotonic transition node completed) + +theorem terminal_mono + {config : Config} + (execution : Execution config) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (terminal : Terminal (execution.states start) node) : + Terminal (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact terminal + | succ finish order terminal => + exact terminal_mono_step (execution.step_succ finish) terminal + +theorem completed_mono + {config : Config} + (execution : Execution config) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (completed : CompletedOpen (execution.states start) node) : + CompletedOpen (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact completed + | succ finish order completed => + exact next_completed_monotonic + (execution.step_succ finish) node completed + +theorem quorumOpened_mono + {config : Config} + (execution : Execution config) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (opened : QuorumOpened (execution.states start) node) : + QuorumOpened (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact opened + | succ finish order opened => + rcases opened with + ⟨opening, membership, openingNode, kind⟩ + exact + ⟨opening, + next_openings_monotonic + (execution.step_succ finish) opening membership, + openingNode, + kind⟩ + +theorem fair_opening_completes + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + {node : Location} + (active : node ∈ (execution.states start).active) + (phase : HasPhase (execution.states start) node .opening) : + EventuallyFrom start (fun n => + CompletedOpen (execution.states n) node) := by + rcases phase with ⟨startState, foundStart, openingStart⟩ + have auxiliary : + forall distance start state, + openingDistance state.timeoutState = distance -> + node ∈ (execution.states start).active -> + Global.nodeState (execution.states start) node = some state -> + state.phase = .opening -> + EventuallyFrom start (fun n => + CompletedOpen (execution.states n) node) := by + intro distance + induction distance using Nat.strong_induction_on with + | h distance ih => + intro start state distanceEq active found opening + have enabled := + opening_timeout_enabled (config := config) + active ⟨state, found, opening⟩ + rcases fair.openingTimeout start node active + ⟨state, found, opening⟩ enabled with + ⟨timeoutAt, startTimeout, + completed | ⟨stillOpening, timeoutAction⟩⟩ + · exact ⟨timeoutAt, startTimeout, completed⟩ + · by_cases completedBefore : + CompletedOpen (execution.states timeoutAt) node + · exact ⟨timeoutAt, startTimeout, completedBefore⟩ + · rcases opening_progress_between execution initial startTimeout + found opening completedBefore with + ⟨timeoutState, foundTimeout, openingTimeout, + distanceTimeout⟩ + have timeoutStep : + next config (execution.states timeoutAt) + (.timeout node) = + some (execution.states (timeoutAt + 1)) := by + simpa [timeoutAction] using execution.step_succ timeoutAt + rcases timeout_opening_step + (reachable_well_formed + (execution_reachable execution initial timeoutAt)) + (reachable_lanes_valid + (execution_reachable execution initial timeoutAt)) + foundTimeout openingTimeout timeoutStep with + completedAfter | + ⟨nextState, foundNext, openingNext, distanceNext⟩ + · exact ⟨timeoutAt + 1, by omega, completedAfter⟩ + · have nextLess : openingDistance nextState.timeoutState < + distance := by + rw [←distanceEq] + exact Nat.lt_of_lt_of_le distanceNext distanceTimeout + rcases ih (openingDistance nextState.timeoutState) + nextLess (timeoutAt + 1) nextState rfl + (by + rw [execution_active_eq execution (timeoutAt + 1)] + rw [execution_active_eq execution start] at active + exact active) + foundNext openingNext with + ⟨completedAt, nextCompleted, completed⟩ + exact ⟨completedAt, by omega, completed⟩ + exact auxiliary (openingDistance startState.timeoutState) + start startState rfl active foundStart openingStart + +theorem initial_announcements_live + (config : Config) + (active : List Location) : + AnnouncementsLive (initial config active) := by + simp [AnnouncementsLive, Global.initial] + +theorem next_preserves_announcements_live + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (live : AnnouncementsLive before) + (transition : next config before action = some after) : + AnnouncementsLive after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, found, _, stateEq⟩ + have sourceLocation := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + intro envelope membership payload + rw [List.mem_append] at membership + rcases membership with old | added + · exact live envelope old payload + · have valid : envelope.Valid config := + retryMessages_valid config source sourceState sourceLocation + envelope added + have opening := retry_iamopen_state valid payload + have identity := retryMessages_source added + rw [identity.2] at opening + exact Or.inl + ⟨sourceState, + by simpa [identity.1] using found, + opening⟩ + | deliver delivered => + intro envelope membership payload + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq, recordEffects_sent] at membership + rcases live envelope membership payload with + opening | completed + · rcases opening with ⟨sourceState, found, phase⟩ + rcases next_opening_progress wellFormed lanes found phase + transition with + completed | ⟨afterState, foundAfter, phaseAfter, _⟩ + · exact Or.inr completed + · exact Or.inl ⟨afterState, foundAfter, phaseAfter⟩ + · exact Or.inr + (next_completed_monotonic transition envelope.source completed) + | timeout target => + intro envelope membership payload + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq, recordEffects_sent] at membership + rcases live envelope membership payload with + opening | completed + · rcases opening with ⟨sourceState, found, phase⟩ + rcases next_opening_progress wellFormed lanes found phase + transition with + completed | ⟨afterState, foundAfter, phaseAfter, _⟩ + · exact Or.inr completed + · exact Or.inl ⟨afterState, foundAfter, phaseAfter⟩ + · exact Or.inr + (next_completed_monotonic transition envelope.source completed) + +theorem reachable_announcements_live + {config : Config} + {state : State} + (reachable : Reachable config state) : + AnnouncementsLive state := by + induction reachable with + | initial active valid nodup configured => + exact initial_announcements_live config active + | step reachable transition live => + exact next_preserves_announcements_live + (reachable_well_formed reachable) + (reachable_lanes_valid reachable) + live transition + +theorem initial_announcements_resolved + (config : Config) + (active : List Location) : + AnnouncementsResolved (initial config active) := by + simp [AnnouncementsResolved, Global.initial] + +theorem next_preserves_announcements_resolved + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (openCompleted : OpenCompleted before) + (resolved : AnnouncementsResolved before) + (transition : next config before action = some after) : + AnnouncementsResolved after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + intro envelope membership payload + rw [List.mem_append] at membership + rcases membership with old | added + · rcases resolved envelope old payload with + pending | terminal | opening + · exact Or.inl (List.mem_append_left _ pending) + · exact Or.inr (Or.inl terminal) + · exact Or.inr (Or.inr opening) + · exact Or.inl (List.mem_append_right _ added) + | deliver delivered => + intro envelope membership payload + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq, recordEffects_sent] at membership + rcases resolved envelope membership payload with + pending | terminal | opening + · rcases mem_removeOne_or_eq pending with remains | equal + · exact Or.inl (by + rw [←stateEq, recordEffects_network] + exact remains) + · subst envelope + rcases deliver_iamopen_resolves wellFormed openCompleted payload + transition with + terminal | opening + · exact Or.inr (Or.inl terminal) + · exact Or.inr (Or.inr opening) + · exact Or.inr (Or.inl + (terminal_mono_step transition terminal)) + · rcases opening with ⟨sourceState, found, phase⟩ + rcases next_opening_progress wellFormed lanes found phase + transition with + completed | ⟨afterState, foundAfter, phaseAfter, _⟩ + · exact Or.inr (Or.inl (Or.inr completed)) + · exact Or.inr (Or.inr + ⟨afterState, foundAfter, phaseAfter⟩) + | timeout target => + intro envelope membership payload + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq, recordEffects_sent] at membership + rcases resolved envelope membership payload with + pending | terminal | opening + · exact Or.inl (by + rw [←stateEq, recordEffects_network] + exact pending) + · exact Or.inr (Or.inl + (terminal_mono_step transition terminal)) + · rcases opening with ⟨sourceState, found, phase⟩ + rcases next_opening_progress wellFormed lanes found phase + transition with + completed | ⟨afterState, foundAfter, phaseAfter, _⟩ + · exact Or.inr (Or.inl (Or.inr completed)) + · exact Or.inr (Or.inr + ⟨afterState, foundAfter, phaseAfter⟩) + +theorem systemStep_preserves_joining_announcements + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {beforeState afterState : State} + (beforeSystem : beforeState.system = before) + (valid : JoiningAnnouncements beforeState) + (carry : + forall destination, + SentAnnouncementTo beforeState destination -> + SentAnnouncementTo afterState destination) + (introduced : + (exists source, acceptedIAmOpenSource event = some source) -> + SentAnnouncementTo afterState target) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.phase = .joining -> + SentAnnouncementTo afterState entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership joining + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + rcases step_joining_origin config node event + (by simpa [atTarget, outputEq] using joining) with + old | received + · have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + rw [←keyEq] + apply carry + apply valid (key, node) + · rw [beforeSystem] + exact List.mem_of_find?_eq_some found + · exact old + · exact introduced received + · rename_i notTarget + apply carry + apply valid previous + · rw [beforeSystem] + exact previousMember + · simpa [notTarget] using joining + +theorem initial_joining_announcements + (config : Config) + (active : List Location) : + JoiningAnnouncements (initial config active) := by + simp [JoiningAnnouncements, Global.initial, initialSystem, initialNode] + +theorem next_preserves_joining_announcements + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (valid : JoiningAnnouncements before) + (transition : next config before action = some after) : + JoiningAnnouncements after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + intro entry membership joining + rcases valid entry membership joining with + ⟨envelope, sent, target, payload⟩ + exact + ⟨envelope, List.mem_append_left _ sent, target, payload⟩ + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨inNetwork, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro entry membership joining + rw [recordEffects_system] at membership + let afterState := + recordEffects envelope.target output.state output.effects + { + before with + system + network := removeOne envelope before.network + } + have carry : + forall destination, + SentAnnouncementTo before destination -> + SentAnnouncementTo afterState destination := by + intro destination announcement + rcases announcement with + ⟨sentEnvelope, sent, target, payload⟩ + exact + ⟨sentEnvelope, by simpa [afterState] using sent, + target, payload⟩ + have introduced : + (exists source, + acceptedIAmOpenSource (eventFor envelope) = some source) -> + SentAnnouncementTo afterState envelope.target := by + rintro ⟨source, accepted⟩ + rcases eventFor_iamopen_source accepted with + ⟨payload, _⟩ + exact + ⟨envelope, + by + simp [afterState] + exact wellFormed.networkSent envelope inNetwork, + rfl, payload⟩ + exact systemStep_preserves_joining_announcements + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl valid carry introduced systemStep + entry membership joining + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro entry membership joining + rw [recordEffects_system] at membership + let afterState := + recordEffects target output.state output.effects + { before with system } + have carry : + forall destination, + SentAnnouncementTo before destination -> + SentAnnouncementTo afterState destination := by + intro destination announcement + rcases announcement with + ⟨sentEnvelope, sent, target, payload⟩ + exact + ⟨sentEnvelope, by simpa [afterState] using sent, + target, payload⟩ + have introduced : + (exists source, + acceptedIAmOpenSource Event.timeout = some source) -> + SentAnnouncementTo afterState target := by + rintro ⟨source, accepted⟩ + simp [acceptedIAmOpenSource] at accepted + exact systemStep_preserves_joining_announcements + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl valid carry introduced systemStep + entry membership joining + +theorem reachable_joining_announcements + {config : Config} + {state : State} + (reachable : Reachable config state) : + JoiningAnnouncements state := by + induction reachable with + | initial active valid nodup configured => + exact initial_joining_announcements config active + | step reachable transition valid => + exact next_preserves_joining_announcements + (reachable_well_formed reachable) valid transition + +theorem systemStep_preserves_open_completed + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {beforeState afterState : State} + (beforeSystem : beforeState.system = before) + (valid : OpenCompleted beforeState) + (carry : + forall node, + CompletedOpen beforeState node -> + CompletedOpen afterState node) + (introduced : + .completed ∈ output.effects -> + CompletedOpen afterState target) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.phase = .open -> + CompletedOpen afterState entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership opened + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + rcases step_open_origin config node event + (by simpa [atTarget, outputEq] using opened) with + old | completed + · have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + rw [←keyEq] + apply carry + apply valid (key, node) + · rw [beforeSystem] + exact List.mem_of_find?_eq_some found + · exact old + · rw [outputEq] at completed + exact introduced completed + · rename_i notTarget + apply carry + apply valid previous + · rw [beforeSystem] + exact previousMember + · simpa [notTarget] using opened + +theorem initial_open_completed + (config : Config) + (active : List Location) : + OpenCompleted (initial config active) := by + simp [OpenCompleted, Global.initial, initialSystem, initialNode] + +theorem next_preserves_open_completed + {config : Config} + {before after : State} + {action : Action} + (valid : OpenCompleted before) + (transition : next config before action = some after) : + OpenCompleted after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact valid + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro entry membership opened + rw [recordEffects_system] at membership + let afterState := + recordEffects envelope.target output.state output.effects + { + before with + system + network := removeOne envelope before.network + } + have carry : + forall node, + CompletedOpen before node -> + CompletedOpen afterState node := by + intro node completed + apply mem_completed_recordEffects + exact completed + have introduced : + .completed ∈ output.effects -> + CompletedOpen afterState envelope.target := by + intro completed + exact completed_effect_recorded completed + exact systemStep_preserves_open_completed + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl valid carry introduced systemStep entry membership opened + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro entry membership opened + rw [recordEffects_system] at membership + let afterState := + recordEffects target output.state output.effects + { before with system } + have carry : + forall node, + CompletedOpen before node -> + CompletedOpen afterState node := by + intro node completed + apply mem_completed_recordEffects + exact completed + have introduced : + .completed ∈ output.effects -> + CompletedOpen afterState target := by + intro completed + exact completed_effect_recorded completed + exact systemStep_preserves_open_completed + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl valid carry introduced systemStep entry membership opened + +theorem reachable_open_completed + {config : Config} + {state : State} + (reachable : Reachable config state) : + OpenCompleted state := by + induction reachable with + | initial active valid nodup configured => + exact initial_open_completed config active + | step reachable transition valid => + exact next_preserves_open_completed valid transition + +theorem reachable_announcements_resolved + {config : Config} + {state : State} + (reachable : Reachable config state) : + AnnouncementsResolved state := by + induction reachable with + | initial active valid nodup configured => + exact initial_announcements_resolved config active + | step reachable transition resolved => + exact next_preserves_announcements_resolved + (reachable_well_formed reachable) + (reachable_lanes_valid reachable) + (reachable_open_completed reachable) + resolved transition + +theorem open_node_completed + {state : State} + {node : Location} + {nodeState : NodeState} + (valid : OpenCompleted state) + (found : Global.nodeState state node = some nodeState) + (opened : nodeState.phase = .open) : + CompletedOpen state node := by + rw [Global.nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have keyEq : entry.1 = node := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq) + rw [←keyEq] + apply valid entry (List.mem_of_find?_eq_some findEq) + simpa [stateEq] using opened + +theorem joining_node_announcement + {state : State} + {node : Location} + {nodeState : NodeState} + (valid : JoiningAnnouncements state) + (found : Global.nodeState state node = some nodeState) + (joining : nodeState.phase = .joining) : + SentAnnouncementTo state node := by + rw [Global.nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have keyEq : entry.1 = node := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq) + rw [←keyEq] + apply valid entry (List.mem_of_find?_eq_some findEq) + simpa [stateEq] using joining + +theorem openerWitness_of_later_phase + {config : Config} + {state : State} + {node : Location} + (reachable : Reachable config state) + (active : node ∈ state.active) + (notGossip : Not (HasPhase state node .gossiping)) + (notVoting : Not (HasPhase state node .voting)) : + OpenerWitness state := by + rcases active_nodeState (reachable_well_formed reachable) active with + ⟨nodeState, found⟩ + cases phase : nodeState.phase with + | gossiping => + exact False.elim + (notGossip ⟨nodeState, found, phase⟩) + | voting => + exact False.elim + (notVoting ⟨nodeState, found, phase⟩) + | opening => + exact ⟨node, Or.inl ⟨nodeState, found, phase⟩⟩ + | joining => + rcases joining_node_announcement + (reachable_joining_announcements reachable) + found phase with + ⟨envelope, sent, target, payload⟩ + rcases reachable_announcements_live reachable + envelope sent payload with + opening | completed + · exact ⟨envelope.source, Or.inl opening⟩ + · exact ⟨envelope.source, Or.inr completed⟩ + | «open» => + exact + ⟨node, Or.inr + (open_node_completed + (reachable_open_completed reachable) found phase)⟩ + +theorem openerWitness_after_leave_voting + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start later : Nat} + {node : Location} + (order : start <= later) + (allPastGossip : + forall activeNode, + activeNode ∈ (execution.states start).active -> + Not (HasPhase (execution.states start) + activeNode .gossiping)) + (active : node ∈ (execution.states later).active) + (notVoting : + Not (HasPhase (execution.states later) node .voting)) : + OpenerWitness (execution.states later) := by + have activeStart : node ∈ (execution.states start).active := by + rw [execution_active_eq execution later] at active + rw [execution_active_eq execution start] + exact active + have notGossip := + not_gossiping_mono execution initial order + (allPastGossip node activeStart) + exact openerWitness_of_later_phase + (execution_reachable execution initial later) + active notGossip notVoting + +theorem systemStep_preserves_advanced_active + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {active : List Location} + (valid : + forall entry, entry ∈ before.nodes -> + entry.2.phase ≠ .gossiping -> + entry.1 ∈ active) + (targetActive : target ∈ active) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.phase ≠ .gossiping -> + entry.1 ∈ active := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership advanced + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · exact targetActive + · rename_i notTarget + exact valid previous previousMember + (by simpa [notTarget] using advanced) + +theorem initial_advanced_active + (config : Config) + (active : List Location) : + AdvancedNodesActive (initial config active) := by + simp [AdvancedNodesActive, Global.initial, initialSystem, initialNode] + +theorem next_preserves_advanced_active + {config : Config} + {before after : State} + {action : Action} + (valid : AdvancedNodesActive before) + (transition : next config before action = some after) : + AdvancedNodesActive after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact valid + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, targetActive, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro entry membership advanced + rw [recordEffects_system] at membership + simpa using + systemStep_preserves_advanced_active + valid targetActive systemStep entry membership advanced + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨targetActive, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro entry membership advanced + rw [recordEffects_system] at membership + simpa using + systemStep_preserves_advanced_active + valid targetActive systemStep entry membership advanced + +theorem reachable_advanced_active + {config : Config} + {state : State} + (reachable : Reachable config state) : + AdvancedNodesActive state := by + induction reachable with + | initial active valid nodup configured => + exact initial_advanced_active config active + | step reachable transition valid => + exact next_preserves_advanced_active valid transition + +theorem hasPhase_active + {config : Config} + {state : State} + {node : Location} + {phase : Phase} + (reachable : Reachable config state) + (hasPhase : HasPhase state node phase) + (advancedPhase : phase ≠ .gossiping) : + node ∈ state.active := by + rcases hasPhase with ⟨nodeState, found, phaseEq⟩ + rw [Global.nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have keyEq : entry.1 = node := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq) + rw [←keyEq] + apply reachable_advanced_active reachable entry + (List.mem_of_find?_eq_some findEq) + rw [stateEq, phaseEq] + exact advancedPhase + +theorem fair_opener_witness + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + (activeNonempty : (execution.states start).active ≠ []) + (allPastGossip : + forall node, node ∈ (execution.states start).active -> + Not (HasPhase (execution.states start) node .gossiping)) : + EventuallyFrom start (fun n => + OpenerWitness (execution.states n)) := by + obtain ⟨voter, voterActive⟩ := + List.exists_mem_of_ne_nil _ activeNonempty + by_cases voting : + HasPhase (execution.states start) voter .voting + · rcases voting with ⟨voterState, foundVoter, voterVoting⟩ + have selectionProperty := + node_property_of_nodeState + (predicate := fun state => + state.phase = .voting -> NodeVotingSelection state) + (reachable_quorum_invariant + (execution_reachable execution initial start)).votingSelections + foundVoter + rcases selectionProperty voterVoting with + ⟨target, txid, chosen, maximum⟩ + have retryEnabled := + retry_voting_enabled (config := config) + voterActive foundVoter voterVoting chosen + rcases fair.retry start voter .voting voterActive + ⟨voterState, foundVoter, voterVoting⟩ + (Or.inr (Or.inl rfl)) retryEnabled with + ⟨retryAt, startRetry, leftVoting | retryAction⟩ + · exact + ⟨retryAt, startRetry, + openerWitness_after_leave_voting execution initial + startRetry allPastGossip + (by + rw [execution_active_eq execution retryAt] + rw [execution_active_eq execution start] at voterActive + exact voterActive) + leftVoting⟩ + · by_cases retryVoting : + HasPhase (execution.states retryAt) voter .voting + · rcases retryVoting with + ⟨retryState, foundRetry, votingRetry⟩ + have retrySelectionProperty := + node_property_of_nodeState + (predicate := fun state => + state.phase = .voting -> NodeVotingSelection state) + (reachable_quorum_invariant + (execution_reachable execution initial retryAt)).votingSelections + foundRetry + rcases retrySelectionProperty votingRetry with + ⟨retryTarget, retryTxID, retryChosen, retryMaximum⟩ + have retryStep : + next config (execution.states retryAt) (.retry voter) = + some (execution.states (retryAt + 1)) := by + simpa [retryAction] using execution.step_succ retryAt + rcases retry_vote_enqueued foundRetry votingRetry retryChosen + retryStep with + ⟨voteEnvelope, pending, voteSource, voteTarget, votePayload⟩ + rcases fair.delivery (retryAt + 1) voteEnvelope pending with + ⟨deliverAt, retryDeliver, deliverAction⟩ + have deliverStep : + next config (execution.states deliverAt) + (.deliver voteEnvelope) = + some (execution.states (deliverAt + 1)) := by + simpa [deliverAction] using execution.step_succ deliverAt + have deliverDetails := deliverStep + simp [next, Option.bind_eq_some_iff] at deliverDetails + have targetActive : voteEnvelope.target ∈ + (execution.states deliverAt).active := + deliverDetails.2.1 + by_cases targetVoting : + HasPhase (execution.states deliverAt) + voteEnvelope.target .voting + · rcases deliver_vote_progress + (reachable_well_formed + (execution_reachable execution initial deliverAt)) + votePayload targetVoting deliverStep with + leftAfter | hasVote + · have activeAfter : voteEnvelope.target ∈ + (execution.states (deliverAt + 1)).active := by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution deliverAt] at targetActive + exact targetActive + exact + ⟨deliverAt + 1, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip activeAfter leftAfter⟩ + · by_cases votingAfter : + HasPhase (execution.states (deliverAt + 1)) + voteEnvelope.target .voting + · have activeAfter : voteEnvelope.target ∈ + (execution.states (deliverAt + 1)).active := by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution deliverAt] at targetActive + exact targetActive + have timeoutEnabled := + voting_timeout_enabled (config := config) + activeAfter votingAfter + rcases fair.timeout (deliverAt + 1) + voteEnvelope.target .voting activeAfter votingAfter + (Or.inr (Or.inl rfl)) timeoutEnabled with + ⟨timeoutAt, deliverTimeout, + leftBeforeTimeout | timeoutAction⟩ + · exact + ⟨timeoutAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution timeoutAt] + rw [execution_active_eq execution + (deliverAt + 1)] at activeAfter + exact activeAfter) + leftBeforeTimeout⟩ + · by_cases votingAtTimeout : + HasPhase (execution.states timeoutAt) + voteEnvelope.target .voting + · have voteAtTimeout := + hasVote_mono execution initial deliverTimeout hasVote + have timeoutStep : + next config (execution.states timeoutAt) + (.timeout voteEnvelope.target) = + some (execution.states (timeoutAt + 1)) := by + simpa [timeoutAction] using + execution.step_succ timeoutAt + rcases timeout_voting_step + (reachable_well_formed + (execution_reachable execution initial timeoutAt)) + (reachable_lanes_valid + (execution_reachable execution initial timeoutAt)) + votingAtTimeout voteAtTimeout timeoutStep with + opened | + ⟨waitingState, foundWaiting, waitingPhase, + waitingLane, waitingVotes⟩ + · exact + ⟨timeoutAt + 1, by omega, + ⟨voteEnvelope.target, Or.inl opened⟩⟩ + · have activeWaiting : voteEnvelope.target ∈ + (execution.states (timeoutAt + 1)).active := by + rw [execution_active_eq execution (timeoutAt + 1)] + rw [execution_active_eq execution + (deliverAt + 1)] at activeAfter + exact activeAfter + have secondEnabled := + voting_timeout_enabled (config := config) + activeWaiting + ⟨waitingState, foundWaiting, waitingPhase⟩ + rcases fair.timeout (timeoutAt + 1) + voteEnvelope.target .voting activeWaiting + ⟨waitingState, foundWaiting, waitingPhase⟩ + (Or.inr (Or.inl rfl)) secondEnabled with + ⟨secondAt, firstSecond, + leftBeforeSecond | secondAction⟩ + · exact + ⟨secondAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution secondAt] + rw [execution_active_eq execution + (timeoutAt + 1)] at activeWaiting + exact activeWaiting) + leftBeforeSecond⟩ + · by_cases votingAtSecond : + HasPhase (execution.states secondAt) + voteEnvelope.target .voting + · rcases votingAtSecond with + ⟨secondState, foundSecond, secondPhase⟩ + have votesSecond := + hasVote_mono execution initial firstSecond + ⟨waitingState, foundWaiting, waitingVotes⟩ + rcases votesSecond with + ⟨voteState, foundVotes, secondVotes⟩ + rw [foundSecond] at foundVotes + injection foundVotes with voteStateEq + subst voteState + have advancedSecond := + advanced_lane_mono execution initial firstSecond + ⟨waitingState, foundWaiting, by simp [waitingLane]⟩ + rcases advancedSecond with + ⟨laneState, foundLane, advanced⟩ + rw [foundSecond] at foundLane + injection foundLane with laneStateEq + subst laneState + have laneValid : LaneValid secondState := by + apply node_property_of_nodeState + (predicate := LaneValid) + · exact reachable_lanes_valid + (execution_reachable execution initial secondAt) + · exact foundSecond + have secondLane : secondState.timeoutState = + .voting := by + rcases laneValid.2.1 secondPhase with + gossipLane | votingLane + · contradiction + · exact votingLane + have secondStep : + next config (execution.states secondAt) + (.timeout voteEnvelope.target) = + some (execution.states (secondAt + 1)) := by + simpa [secondAction] using + execution.step_succ secondAt + have opened := + aligned_timeout_voting_opens + (reachable_well_formed + (execution_reachable execution initial secondAt)) + foundSecond secondPhase secondLane secondVotes + secondStep + exact + ⟨secondAt + 1, by omega, + ⟨voteEnvelope.target, Or.inl opened⟩⟩ + · exact + ⟨secondAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution secondAt] + rw [execution_active_eq execution + (timeoutAt + 1)] at activeWaiting + exact activeWaiting) + votingAtSecond⟩ + · exact + ⟨timeoutAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution timeoutAt] + rw [execution_active_eq execution + (deliverAt + 1)] at activeAfter + exact activeAfter) + votingAtTimeout⟩ + · exact + ⟨deliverAt + 1, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution deliverAt] + at targetActive + exact targetActive) + votingAfter⟩ + · exact + ⟨deliverAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip targetActive targetVoting⟩ + · exact + ⟨retryAt, startRetry, + openerWitness_after_leave_voting execution initial + startRetry allPastGossip + (by + rw [execution_active_eq execution retryAt] + rw [execution_active_eq execution start] at voterActive + exact voterActive) + retryVoting⟩ + · exact + ⟨start, Nat.le_refl start, + openerWitness_after_leave_voting execution initial + (Nat.le_refl start) allPastGossip voterActive voting⟩ + +theorem openerWitness_eventually_completes + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + (witness : OpenerWitness (execution.states start)) : + EventuallyFrom start (fun n => + exists node, CompletedOpen (execution.states n) node) := by + rcases witness with ⟨node, opening | completed⟩ + · have active := + hasPhase_active (execution_reachable execution initial start) + opening (by simp) + rcases fair_opening_completes execution initial fair active opening with + ⟨completedAt, order, completed⟩ + exact ⟨completedAt, order, node, completed⟩ + · exact ⟨start, Nat.le_refl start, node, completed⟩ + +theorem fair_some_opener_completes + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (activeNonempty : (execution.states 0).active ≠ []) : + EventuallyFrom 0 (fun n => + exists node, CompletedOpen (execution.states n) node) := by + rcases fair_all_leave_gossip execution initial fair 0 with + ⟨pastGossipAt, _, allPastGossip⟩ + have nonemptyAt : + (execution.states pastGossipAt).active ≠ [] := by + rw [execution_active_eq execution pastGossipAt] + exact activeNonempty + have allPastAt : + forall node, node ∈ (execution.states pastGossipAt).active -> + Not (HasPhase (execution.states pastGossipAt) + node .gossiping) := by + intro node active + rw [execution_active_eq execution pastGossipAt] at active + exact allPastGossip node active + rcases fair_opener_witness execution initial fair nonemptyAt + allPastAt with + ⟨witnessAt, pastWitness, witness⟩ + rcases openerWitness_eventually_completes execution initial fair + witness with + ⟨completedAt, witnessCompleted, completed⟩ + exact ⟨completedAt, by omega, completed⟩ + +theorem fair_target_terminal_after_completion + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener target : Location} + (completed : CompletedOpen (execution.states start) opener) + (active : target ∈ (execution.states start).active) : + EventuallyFrom start (fun n => + Terminal (execution.states n) target) := by + by_cases same : target = opener + · subst target + exact ⟨start, Nat.le_refl start, Or.inr completed⟩ + · rcases broadcast start opener completed target active same with + ⟨envelope, sent, sourceEq, targetEq, payload⟩ + rcases reachable_announcements_resolved + (execution_reachable execution initial start) + envelope sent payload with + pending | terminal | opening + · rcases fair.delivery start envelope pending with + ⟨deliverAt, startDelivery, deliverAction⟩ + have deliverStep : + next config (execution.states deliverAt) (.deliver envelope) = + some (execution.states (deliverAt + 1)) := by + simpa [deliverAction] using execution.step_succ deliverAt + rcases deliver_iamopen_resolves + (reachable_well_formed + (execution_reachable execution initial deliverAt)) + (reachable_open_completed + (execution_reachable execution initial deliverAt)) + payload deliverStep with + terminal | targetOpening + · exact + ⟨deliverAt + 1, by omega, by simpa [targetEq] using terminal⟩ + · have openingActive := + hasPhase_active + (execution_reachable execution initial (deliverAt + 1)) + targetOpening (by simp) + rcases fair_opening_completes execution initial fair + openingActive targetOpening with + ⟨completedAt, deliveryCompleted, targetCompleted⟩ + exact + ⟨completedAt, by omega, + by simpa [targetEq] using (Or.inr targetCompleted)⟩ + · exact + ⟨start, Nat.le_refl start, by simpa [targetEq] using terminal⟩ + · have openingActive := + hasPhase_active + (execution_reachable execution initial start) + opening (by simp) + rcases fair_opening_completes execution initial fair + openingActive opening with + ⟨completedAt, startCompleted, targetCompleted⟩ + exact + ⟨completedAt, startCompleted, + by simpa [targetEq] using (Or.inr targetCompleted)⟩ + +theorem fair_all_terminal_after_completion + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener : Location} + (completed : CompletedOpen (execution.states start) opener) : + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + Terminal (execution.states n) node) := by + apply eventually_list (execution.states start).active + · intro node active + exact fair_target_terminal_after_completion + execution initial fair broadcast completed active + · intro node first second order terminal + exact terminal_mono execution order terminal + +theorem global_progress + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + (activeNonempty : (execution.states 0).active ≠ []) : + EventuallyFrom 0 (fun n => + exists node, CompletedOpen (execution.states n) node) /\ + EventuallyFrom 0 (fun n => + forall node, node ∈ (execution.states 0).active -> + Terminal (execution.states n) node) := by + have completed := + fair_some_opener_completes execution initial fair activeNonempty + constructor + · exact completed + · rcases completed with + ⟨completedAt, _, opener, openerCompleted⟩ + rcases fair_all_terminal_after_completion execution initial fair + broadcast openerCompleted with + ⟨terminalAt, completedTerminal, allTerminal⟩ + refine ⟨terminalAt, by omega, ?_⟩ + intro node active + apply allTerminal node + rw [execution_active_eq execution completedAt] + exact active + +theorem single_completion_path_joins_others + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener : Location} + (completed : CompletedOpen (execution.states start) opener) + (onlyOpener : OnlyOpenerCompletesFrom execution start opener) : + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + node = opener \/ node ∈ (execution.states n).restarts) := by + apply eventually_list (execution.states start).active + · intro node active + by_cases same : node = opener + · exact ⟨start, Nat.le_refl start, Or.inl same⟩ + · rcases fair_target_terminal_after_completion + execution initial fair broadcast completed active with + ⟨terminalAt, startTerminal, terminal⟩ + rcases terminal with restarted | targetCompleted + · exact ⟨terminalAt, startTerminal, Or.inr restarted⟩ + · exact False.elim + (same + (onlyOpener terminalAt node startTerminal targetCompleted)) + · intro node first second order joined + rcases joined with same | restarted + · exact Or.inl same + · exact Or.inr + (by + induction second, order using Nat.le_induction with + | base => exact restarted + | succ second order restarted => + exact next_restarts_monotonic + (execution.step_succ second) node restarted) + +theorem quorum_path_progress + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener : Location} + (opened : QuorumOpened (execution.states start) opener) + (completed : CompletedOpen (execution.states start) opener) + (quorumOnly : QuorumOnlyCompletions execution) : + QuorumOpened (execution.states start) opener /\ + CompletedOpen (execution.states start) opener /\ + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + node = opener \/ node ∈ (execution.states n).restarts) := by + have onlyOpener : + OnlyOpenerCompletesFrom execution start opener := by + intro n node startN nodeCompleted + exact quorum_opener_unique + (execution_reachable execution initial n) + (quorumOnly n node nodeCompleted) + (quorumOpened_mono execution startN opened) + exact + ⟨opened, completed, + single_completion_path_joins_others + execution initial fair broadcast completed onlyOpener⟩ + +end DisasterRecovery.Protocol.Global From 8a330b9ffa1012d185e8c37a71e3a514b07646cd Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:14:12 +0100 Subject: [PATCH 06/35] Add canonical Lean checks and CI Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .github/workflows/README.md | 9 ++ .github/workflows/lean-disaster-recovery.yml | 46 ++++++ lean/disaster-recovery/AxiomChecks.lean | 21 +++ lean/disaster-recovery/CanonicalTests.lean | 145 +++++++++++++++++++ lean/disaster-recovery/README.md | 88 +++++++++++ lean/disaster-recovery/lakefile.toml | 5 + 6 files changed, 314 insertions(+) create mode 100644 .github/workflows/lean-disaster-recovery.yml create mode 100644 lean/disaster-recovery/AxiomChecks.lean create mode 100644 lean/disaster-recovery/CanonicalTests.lean create mode 100644 lean/disaster-recovery/README.md diff --git a/.github/workflows/README.md b/.github/workflows/README.md index 4eb030772236..ef1e552a3623 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -101,6 +101,15 @@ Runs on pull requests that change `tla/` or `src/consensus/aft/raft.h`. File: `tla-shallow.yml` 3rd party dependencies: None +# Lean Disaster Recovery + +Builds the canonical Lean disaster recovery model, checks its proofs without +warnings or project `sorryAx` dependencies, and runs its executable canonical +behavior checks on relevant pull requests. + +File: `lean-disaster-recovery.yml` +3rd party dependencies: None + # Vendored Dependency Verification Verifies that files under `3rdparty/` match the Git commits or release artifacts diff --git a/.github/workflows/lean-disaster-recovery.yml b/.github/workflows/lean-disaster-recovery.yml new file mode 100644 index 000000000000..7ce96fd45232 --- /dev/null +++ b/.github/workflows/lean-disaster-recovery.yml @@ -0,0 +1,46 @@ +name: "Lean Disaster Recovery" + +on: + pull_request: + paths: + - "lean/disaster-recovery/**" + - ".github/workflows/lean-disaster-recovery.yml" + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +permissions: read-all + +jobs: + canonical-model: + name: Canonical model and proofs + runs-on: ubuntu-latest + timeout-minutes: 30 + + steps: + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Lean + shell: bash + run: | + set -euo pipefail + sudo apt-get update + sudo apt-get install -y elan + elan toolchain install "$(cat lean/disaster-recovery/lean-toolchain)" + + - name: Restore Mathlib cache + working-directory: lean/disaster-recovery + shell: bash + run: | + set -euo pipefail + lake exe cache get + + - name: Build and check canonical model + working-directory: lean/disaster-recovery + shell: bash + run: | + set -euo pipefail + lake build + lake env lean -DwarningAsError=true AxiomChecks.lean + lake exe canonical-checks diff --git a/lean/disaster-recovery/AxiomChecks.lean b/lean/disaster-recovery/AxiomChecks.lean new file mode 100644 index 000000000000..a962639129b0 --- /dev/null +++ b/lean/disaster-recovery/AxiomChecks.lean @@ -0,0 +1,21 @@ +import DisasterRecovery +import Lean.Elab.Command +import Lean.Util.CollectAxioms + +open Lean Elab Command + +elab "#assert_no_project_sorries" : command => do + let env <- getEnv + let mut offenders : Array Name := #[] + for (name, _) in env.constants.toList do + if name.toString.startsWith "DisasterRecovery" then + let axioms <- liftCoreM <| Lean.collectAxioms name + if axioms.contains (Name.mkSimple "sorryAx") then + offenders := offenders.push name + unless offenders.isEmpty do + throwError "declarations contain sorryAx: {offenders}" + +#assert_no_project_sorries + +def main : IO Unit := + pure () diff --git a/lean/disaster-recovery/CanonicalTests.lean b/lean/disaster-recovery/CanonicalTests.lean new file mode 100644 index 000000000000..451d0d6a6f76 --- /dev/null +++ b/lean/disaster-recovery/CanonicalTests.lean @@ -0,0 +1,145 @@ +import DisasterRecovery.Protocol.Temporal + +open DisasterRecovery.Protocol + +private def expect (condition : Bool) (message : String) : IO Unit := + unless condition do throw (IO.userError message) + +private def eventsFor (config : Config) : List Event := + let messages := config.expectedLocations.flatMap fun source => + [ + .receiveGossip source { view := 0, seqno := source.length } .accepted, + .receiveGossip source { view := 0, seqno := source.length } .rejected, + .receiveVote source .accepted, + .receiveVote source .rejected, + .receiveIAmOpen source .accepted, + .receiveIAmOpen source .rejected + ] + messages ++ [.timeout, .retry] + +private def invariant (state : NodeState) : Bool := + let chosenReady := + if state.phase == .voting then state.chosen.isSome else true + let openingKind := + if state.phase == .opening || state.phase == .open then + state.openKind.isSome + else + true + let restartOnlyJoining := + if state.restartRequested then state.phase == .joining else true + chosenReady && openingKind && restartOnlyJoining + +private def enumerate (config : Config) (location : Location) : IO (Prod Nat Nat) := do + let initial := initialNode location + let mut states := #[initial] + let mut seen : Std.HashMap String Nat := {} + seen := seen.insert (stateKey initial) 0 + let mut cursor := 0 + let mut edges := 0 + while cursor < states.size do + let state := states[cursor]! + expect (invariant state) s!"canonical invariant failed: {stateKey state}" + for event in eventsFor config do + let next := (step config state event).state + edges := edges + 1 + let key := stateKey next + if !seen.contains key then + seen := seen.insert key states.size + states := states.push next + cursor := cursor + 1 + pure (states.size, edges) + +def main : IO UInt32 := do + let config : Config := { + instanceId := "canonical-tests" + expectedLocations := ["A", "B"] + } + expect config.isValid "canonical test configuration is invalid" + expect + (!({ instanceId := "invalid", expectedLocations := ["A", "A"] } : + Config).isValid) + "duplicate expected locations were accepted" + expect (voteQuorum config == 2) "two-node strict majority must be two" + + let initial := initialNode "A" + expect initial.gossips.isEmpty "canonical C++ state must start without gossip" + + let first := step config initial + (.receiveGossip "A" { view := 1, seqno := 10 } .accepted) + expect (first.state.phase == .gossiping) "one of two gossips advanced early" + let duplicate := step config first.state + (.receiveGossip "A" { view := 99, seqno := 99 } .accepted) + expect (duplicate.state == first.state) + "duplicate gossip source changed its recorded TxID" + let second := step config first.state + (.receiveGossip "B" { view := 2, seqno := 1 } .accepted) + expect (second.state.phase == .voting) "all expected gossips did not advance" + expect (second.state.chosen == some "B") "full TxID maximum was not chosen" + + let tiedA := step config initial + (.receiveGossip "A" { view := 2, seqno := 1 } .accepted) + let tiedB := step config tiedA.state + (.receiveGossip "B" { view := 2, seqno := 1 } .accepted) + expect (tiedB.state.chosen == some "B") + "location name did not break an equal TxID tie lexicographically" + + let frozen := step config second.state + (.receiveGossip "C" { view := 9, seqno := 9 } .accepted) + expect (!frozen.accepted && frozen.state == second.state) + "gossip did not freeze after choosing a node" + + let oneVote := step config second.state (.receiveVote "A" .accepted) + expect (oneVote.state.phase == .voting) "even-node quorum used legacy threshold" + let twoVotes := step config oneVote.state (.receiveVote "B" .accepted) + expect (twoVotes.state.phase == .opening) "strict voting quorum did not open" + expect (twoVotes.state.openKind == some .quorum) "quorum path mislabeled" + + let emptyVoting := { + initial with + phase := .voting + timeoutState := .voting + chosen := some "A" + } + let noVotes := step config emptyVoting .timeout + expect (noVotes.state == emptyVoting) + "aligned voting timeout with zero votes advanced" + + let oneVoteWaiting := { emptyVoting with votes := ["A"] } + let failover := step config oneVoteWaiting .timeout + expect (failover.state.phase == .opening) "failover vote did not open" + expect (failover.state.openKind == some .failover) "failover path mislabeled" + + let opening := { + twoVotes.state with + timeoutState := .opening + } + let complete := step config opening .timeout + expect (complete.state.phase == .open) "Opening timeout did not reach Open" + + let joining := step config initial + (.receiveIAmOpen "B" .accepted) + expect (joining.state.phase == .joining && joining.state.restartRequested) + "IAmOpen did not request joining restart" + + let retry := step config second.state .retry + expect + (retry.effects == + [.sendVote "B", .sendGossip "A", .sendGossip "B"]) + "Voting retry did not send vote before continuing gossip" + + let unexpectedConfig : Config := { + instanceId := "unexpected" + expectedLocations := ["A"] + } + let unexpected := step unexpectedConfig (initialNode "A") + (.receiveGossip "OUTSIDE" { view := 1, seqno := 1 } .accepted) + expect (unexpected.state.phase == .voting) + "model no longer exposes C++ acceptance of unexpected validated locations" + + let (oneStates, oneEdges) <- enumerate + { instanceId := "n1", expectedLocations := ["A"] } "A" + let (twoStates, twoEdges) <- enumerate config "A" + IO.println s!"canonical n=1: {oneStates} states, {oneEdges} event edges" + IO.println s!"canonical n=2: {twoStates} states, {twoEdges} event edges" + IO.println "all canonical semantic and proof checks passed" + pure 0 diff --git a/lean/disaster-recovery/README.md b/lean/disaster-recovery/README.md new file mode 100644 index 000000000000..c4621834fc66 --- /dev/null +++ b/lean/disaster-recovery/README.md @@ -0,0 +1,88 @@ +# Lean disaster recovery model + +This package contains the canonical Lean model of CCF's C++ recovery decision +protocol and its permanent safety and liveness proofs. It is pinned to Lean +4.28.0 and Mathlib `v4.28.0`. + +## Model + +`DisasterRecovery.Protocol.Model` models one protocol node. Its state machine +covers Gossiping, Voting, Opening, Joining, and Open, including the separate +timeout lane, retries, duplicate receives, strict-majority voting, failover, +restart, and completion. + +`DisasterRecovery.Protocol.Global` lifts the local transition function to a +system with active nodes, in-flight messages, immutable send history, and +terminal effects. Deliveries consume previously sent envelopes, so receives +cannot appear without a modeled send. + +The model follows the current C++ behavior in which a successfully validated +location is not rejected merely because it is absent from +`expectedLocations`. In particular, an accepted gossip from an unexpected +location can satisfy a size threshold. `CanonicalTests.lean` checks this +intentional accepted-unexpected-location behavior so that the implementation +discrepancy remains explicit. + +`Validation.accepted` and `Validation.rejected` are the boundary at which the +model receives the result of C++ quote and certificate validation. The model +does not formalize or prove the cryptography that produces that result. + +## Proof coverage and limits + +`DisasterRecovery.Protocol.Temporal` proves local safety properties and +Opening-to-Open progress under weak timeout fairness. + +`DisasterRecovery.Protocol.Invariants` proves global well-formedness, +message provenance, locality of transitions, append-only send history, and +monotonic terminal histories for reachable states. + +`DisasterRecovery.Protocol.Quorum` proves that votes are unique and backed by +prior sends, strict-majority quorums intersect, and any two quorum openings in +a reachable execution select the same opener. This safety result does not +require fairness. + +`DisasterRecovery.Protocol.Committed` proves TxID maximum properties and +committed-prefix preservation under two explicit premises: + +- `DurableCommit` requires at least one configured recovered ledger to cover + the committed TxID. +- `FullGossipSelection` requires a real sent vote whose selection snapshot + contains exactly the configured recovered TxIDs. + +A quorum opening alone does not imply `FullGossipSelection`, because voting may +begin after a gossip timeout. The committed-prefix result deliberately does not +derive or hide either durability or full-gossip evidence. + +`DisasterRecovery.Protocol.GlobalTemporal` proves conditional global progress. +Its theorems assume the relevant retry, message-delivery, and timeout fairness +premises. Progress for every active node additionally requires +`BroadcastBeforeCompletion`: an opener must send its `IAmOpen` announcement to +every other active node before it completes. Ordinary weak fairness does not +order actions that are enabled only for a finite interval, so this broadcast +ordering is a separate premise. The proofs do not construct a scheduler that +satisfies the fairness and broadcast-before-completion premises. + +## Files + +| File | Purpose | +| --- | --- | +| `DisasterRecovery/Protocol/Model.lean` | C++-aligned local transition model | +| `DisasterRecovery/Protocol/Temporal.lean` | Local safety and liveness | +| `DisasterRecovery/Protocol/Global.lean` | Distributed transition semantics | +| `DisasterRecovery/Protocol/Invariants.lean` | Reachability invariants | +| `DisasterRecovery/Protocol/Quorum.lean` | Quorum uniqueness | +| `DisasterRecovery/Protocol/Committed.lean` | Committed-prefix safety | +| `DisasterRecovery/Protocol/GlobalTemporal.lean` | Global liveness | +| `CanonicalTests.lean` | Executable canonical behavior checks | +| `AxiomChecks.lean` | Transitive project `sorryAx` rejection | + +## Validation + +Run from this directory: + +```console +lake exe cache get +lake build +lake env lean -DwarningAsError=true AxiomChecks.lean +lake exe canonical-checks +``` diff --git a/lean/disaster-recovery/lakefile.toml b/lean/disaster-recovery/lakefile.toml index df0456dcd8c3..ac7b91709c40 100644 --- a/lean/disaster-recovery/lakefile.toml +++ b/lean/disaster-recovery/lakefile.toml @@ -3,6 +3,7 @@ version = "0.1.0" moreLeanArgs = ["-DwarningAsError=true"] defaultTargets = [ "DisasterRecovery", + "canonical-checks", ] [[require]] @@ -12,3 +13,7 @@ rev = "v4.28.0" [[lean_lib]] name = "DisasterRecovery" + +[[lean_exe]] +name = "canonical-checks" +root = "CanonicalTests" From 4c2283026154b8a1a372006c5a4b4cd8f4153ea7 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:14:40 +0100 Subject: [PATCH 07/35] Format Lean disaster recovery documentation Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery/README.md | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/lean/disaster-recovery/README.md b/lean/disaster-recovery/README.md index c4621834fc66..130468ca3862 100644 --- a/lean/disaster-recovery/README.md +++ b/lean/disaster-recovery/README.md @@ -64,17 +64,17 @@ satisfies the fairness and broadcast-before-completion premises. ## Files -| File | Purpose | -| --- | --- | -| `DisasterRecovery/Protocol/Model.lean` | C++-aligned local transition model | -| `DisasterRecovery/Protocol/Temporal.lean` | Local safety and liveness | -| `DisasterRecovery/Protocol/Global.lean` | Distributed transition semantics | -| `DisasterRecovery/Protocol/Invariants.lean` | Reachability invariants | -| `DisasterRecovery/Protocol/Quorum.lean` | Quorum uniqueness | -| `DisasterRecovery/Protocol/Committed.lean` | Committed-prefix safety | -| `DisasterRecovery/Protocol/GlobalTemporal.lean` | Global liveness | -| `CanonicalTests.lean` | Executable canonical behavior checks | -| `AxiomChecks.lean` | Transitive project `sorryAx` rejection | +| File | Purpose | +| ----------------------------------------------- | -------------------------------------- | +| `DisasterRecovery/Protocol/Model.lean` | C++-aligned local transition model | +| `DisasterRecovery/Protocol/Temporal.lean` | Local safety and liveness | +| `DisasterRecovery/Protocol/Global.lean` | Distributed transition semantics | +| `DisasterRecovery/Protocol/Invariants.lean` | Reachability invariants | +| `DisasterRecovery/Protocol/Quorum.lean` | Quorum uniqueness | +| `DisasterRecovery/Protocol/Committed.lean` | Committed-prefix safety | +| `DisasterRecovery/Protocol/GlobalTemporal.lean` | Global liveness | +| `CanonicalTests.lean` | Executable canonical behavior checks | +| `AxiomChecks.lean` | Transitive project `sorryAx` rejection | ## Validation From c3447aaef5fd844073f17de551cd6e804fbceb2e Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 16:13:44 +0100 Subject: [PATCH 08/35] Normalize Lean source line endings Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- .../DisasterRecovery/Protocol/Global.lean | 332 +-- .../DisasterRecovery/Protocol/Invariants.lean | 1798 ++++++++--------- 2 files changed, 1065 insertions(+), 1065 deletions(-) diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean index c29b83a1305f..80e395678134 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean @@ -1,166 +1,166 @@ -import DisasterRecovery.Protocol.Model - -namespace DisasterRecovery.Protocol.Global - -structure Config where - protocol : Protocol.Config - recovered : List (Prod Location TxID) -deriving Repr, BEq - -def Config.Valid (config : Config) : Prop := - config.protocol.isValid = true /\ - config.protocol.expectedLocations.Nodup /\ - config.recovered.map Prod.fst = config.protocol.expectedLocations - -def recoveredTxID (config : Config) (source : Location) : Option TxID := - (config.recovered.find? fun entry => entry.1 == source).map Prod.snd - -inductive Payload where - | gossip (txid : TxID) - | vote - | iAmOpen -deriving Repr, BEq, ReflBEq, LawfulBEq - -structure Envelope where - source : Location - target : Location - payload : Payload - sourceState : NodeState -deriving Repr, BEq, ReflBEq, LawfulBEq - -structure Opening where - node : Location - kind : OpenKind - state : NodeState -deriving Repr, BEq - -structure State where - system : SystemState - active : List Location - network : List Envelope := [] - sent : List Envelope := [] - openings : List Opening := [] - restarts : List Location := [] - completed : List Location := [] -deriving Repr, BEq - -inductive Action where - | retry (source : Location) - | deliver (envelope : Envelope) - | timeout (target : Location) -deriving Repr, BEq - -def nodeState (state : State) (node : Location) : Option NodeState := - (state.system.nodes.find? fun entry => entry.1 == node).map Prod.snd - -def messageForEffect - (config : Config) - (source : Location) - (sourceState : NodeState) : Effect -> Option Envelope - | .sendGossip target => do - let txid <- recoveredTxID config source - pure { source, target, payload := .gossip txid, sourceState } - | .sendVote target => - some { source, target, payload := .vote, sourceState } - | .sendIAmOpen target => - some { source, target, payload := .iAmOpen, sourceState } - | _ => none - -def retryMessages - (config : Config) - (source : Location) - (sourceState : NodeState) : List Envelope := - (step config.protocol sourceState .retry).effects.filterMap - (messageForEffect config source sourceState) - -def Envelope.Valid (config : Config) (envelope : Envelope) : Prop := - envelope.sourceState.location = envelope.source /\ - envelope ∈ retryMessages config envelope.source envelope.sourceState - -def eventFor (envelope : Envelope) : Event := - match envelope.payload with - | .gossip txid => .receiveGossip envelope.source txid .accepted - | .vote => .receiveVote envelope.source .accepted - | .iAmOpen => .receiveIAmOpen envelope.source .accepted - -def removeOne [BEq α] (value : α) : List α -> List α - | [] => [] - | head :: tail => - if head == value then tail else head :: removeOne value tail - -def recordEffect - (node : Location) - (nodeState : NodeState) - (state : State) : Effect -> State - | .opening kind => - { - state with - openings := { node, kind, state := nodeState } :: state.openings - } - | .restart _ => - { state with restarts := node :: state.restarts } - | .completed => - { state with completed := node :: state.completed } - | _ => state - -def recordEffects - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : State := - effects.foldl (recordEffect node nodeState) state - -def initial (config : Config) (active : List Location) : State := { - system := initialSystem config.protocol - active -} - -def next (config : Config) (state : State) : Action -> Option State - | .retry source => do - guard (state.active.contains source) - let sourceState <- nodeState state source - let messages := retryMessages config source sourceState - guard (!messages.isEmpty) - pure { - state with - network := state.network ++ messages - sent := state.sent ++ messages - } - | .deliver envelope => do - guard (state.network.contains envelope) - guard (state.active.contains envelope.target) - let (system, output) <- - systemStep config.protocol state.system envelope.target - (eventFor envelope) - let delivered := { - state with - system - network := removeOne envelope state.network - } - pure - (recordEffects envelope.target output.state output.effects delivered) - | .timeout target => do - guard (state.active.contains target) - let (system, output) <- - systemStep config.protocol state.system target .timeout - guard output.accepted - pure - (recordEffects target output.state output.effects { state with system }) - -inductive Reachable (config : Config) : State -> Prop where - | initial - (active : List Location) - (valid : config.Valid) - (nodup : active.Nodup) - (configured : - forall node, node ∈ active -> - node ∈ config.protocol.expectedLocations) : - Reachable config (Global.initial config active) - | step - {state nextState : State} - {action : Action} - (reachable : Reachable config state) - (transition : next config state action = some nextState) : - Reachable config nextState - -end DisasterRecovery.Protocol.Global +import DisasterRecovery.Protocol.Model + +namespace DisasterRecovery.Protocol.Global + +structure Config where + protocol : Protocol.Config + recovered : List (Prod Location TxID) +deriving Repr, BEq + +def Config.Valid (config : Config) : Prop := + config.protocol.isValid = true /\ + config.protocol.expectedLocations.Nodup /\ + config.recovered.map Prod.fst = config.protocol.expectedLocations + +def recoveredTxID (config : Config) (source : Location) : Option TxID := + (config.recovered.find? fun entry => entry.1 == source).map Prod.snd + +inductive Payload where + | gossip (txid : TxID) + | vote + | iAmOpen +deriving Repr, BEq, ReflBEq, LawfulBEq + +structure Envelope where + source : Location + target : Location + payload : Payload + sourceState : NodeState +deriving Repr, BEq, ReflBEq, LawfulBEq + +structure Opening where + node : Location + kind : OpenKind + state : NodeState +deriving Repr, BEq + +structure State where + system : SystemState + active : List Location + network : List Envelope := [] + sent : List Envelope := [] + openings : List Opening := [] + restarts : List Location := [] + completed : List Location := [] +deriving Repr, BEq + +inductive Action where + | retry (source : Location) + | deliver (envelope : Envelope) + | timeout (target : Location) +deriving Repr, BEq + +def nodeState (state : State) (node : Location) : Option NodeState := + (state.system.nodes.find? fun entry => entry.1 == node).map Prod.snd + +def messageForEffect + (config : Config) + (source : Location) + (sourceState : NodeState) : Effect -> Option Envelope + | .sendGossip target => do + let txid <- recoveredTxID config source + pure { source, target, payload := .gossip txid, sourceState } + | .sendVote target => + some { source, target, payload := .vote, sourceState } + | .sendIAmOpen target => + some { source, target, payload := .iAmOpen, sourceState } + | _ => none + +def retryMessages + (config : Config) + (source : Location) + (sourceState : NodeState) : List Envelope := + (step config.protocol sourceState .retry).effects.filterMap + (messageForEffect config source sourceState) + +def Envelope.Valid (config : Config) (envelope : Envelope) : Prop := + envelope.sourceState.location = envelope.source /\ + envelope ∈ retryMessages config envelope.source envelope.sourceState + +def eventFor (envelope : Envelope) : Event := + match envelope.payload with + | .gossip txid => .receiveGossip envelope.source txid .accepted + | .vote => .receiveVote envelope.source .accepted + | .iAmOpen => .receiveIAmOpen envelope.source .accepted + +def removeOne [BEq α] (value : α) : List α -> List α + | [] => [] + | head :: tail => + if head == value then tail else head :: removeOne value tail + +def recordEffect + (node : Location) + (nodeState : NodeState) + (state : State) : Effect -> State + | .opening kind => + { + state with + openings := { node, kind, state := nodeState } :: state.openings + } + | .restart _ => + { state with restarts := node :: state.restarts } + | .completed => + { state with completed := node :: state.completed } + | _ => state + +def recordEffects + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : State := + effects.foldl (recordEffect node nodeState) state + +def initial (config : Config) (active : List Location) : State := { + system := initialSystem config.protocol + active +} + +def next (config : Config) (state : State) : Action -> Option State + | .retry source => do + guard (state.active.contains source) + let sourceState <- nodeState state source + let messages := retryMessages config source sourceState + guard (!messages.isEmpty) + pure { + state with + network := state.network ++ messages + sent := state.sent ++ messages + } + | .deliver envelope => do + guard (state.network.contains envelope) + guard (state.active.contains envelope.target) + let (system, output) <- + systemStep config.protocol state.system envelope.target + (eventFor envelope) + let delivered := { + state with + system + network := removeOne envelope state.network + } + pure + (recordEffects envelope.target output.state output.effects delivered) + | .timeout target => do + guard (state.active.contains target) + let (system, output) <- + systemStep config.protocol state.system target .timeout + guard output.accepted + pure + (recordEffects target output.state output.effects { state with system }) + +inductive Reachable (config : Config) : State -> Prop where + | initial + (active : List Location) + (valid : config.Valid) + (nodup : active.Nodup) + (configured : + forall node, node ∈ active -> + node ∈ config.protocol.expectedLocations) : + Reachable config (Global.initial config active) + | step + {state nextState : State} + {action : Action} + (reachable : Reachable config state) + (transition : next config state action = some nextState) : + Reachable config nextState + +end DisasterRecovery.Protocol.Global diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean index 3fa11e0bcdd1..dbe145561f17 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean @@ -1,899 +1,899 @@ -import DisasterRecovery.Protocol.Global -import Mathlib.Tactic - -namespace DisasterRecovery.Protocol.Global - -structure HistoriesActive (state : State) : Prop where - openings : - forall opening, opening ∈ state.openings -> - opening.node ∈ state.active - restarts : - forall node, node ∈ state.restarts -> - node ∈ state.active - completed : - forall node, node ∈ state.completed -> - node ∈ state.active - -structure WellFormed (config : Config) (state : State) : Prop where - nodeKeys : - state.system.nodes.map Prod.fst = - config.protocol.expectedLocations - nodeKeysNodup : (state.system.nodes.map Prod.fst).Nodup - nodeLocations : - forall entry, entry ∈ state.system.nodes -> - entry.2.location = entry.1 - activeNodup : state.active.Nodup - activeConfigured : - forall node, node ∈ state.active -> - node ∈ config.protocol.expectedLocations - sentValid : - forall envelope, envelope ∈ state.sent -> - envelope.Valid config - sentSourceActive : - forall envelope, envelope ∈ state.sent -> - envelope.source ∈ state.active - networkSent : - forall envelope, envelope ∈ state.network -> - envelope ∈ state.sent - historiesActive : HistoriesActive state - -theorem messageForEffect_source - {config : Config} - {source : Location} - {sourceState : NodeState} - {effect : Effect} - {envelope : Envelope} - (created : - messageForEffect config source sourceState effect = some envelope) : - envelope.source = source /\ - envelope.sourceState = sourceState := by - cases effect with - | sendGossip target => - cases found : recoveredTxID config source with - | none => - simp [messageForEffect, found] at created - | some txid => - simp [messageForEffect, found] at created - rw [←created] - exact ⟨rfl, rfl⟩ - | sendVote target => - simp [messageForEffect] at created - rw [←created] - exact ⟨rfl, rfl⟩ - | sendIAmOpen target => - simp [messageForEffect] at created - rw [←created] - exact ⟨rfl, rfl⟩ - | opening kind => - simp_all [messageForEffect] - | restart chosen => - simp_all [messageForEffect] - | completed => - simp_all [messageForEffect] - | rejected reason => - simp_all [messageForEffect] - -theorem retryMessages_source - {config : Config} - {source : Location} - {sourceState : NodeState} - {envelope : Envelope} - (created : - envelope ∈ retryMessages config source sourceState) : - envelope.source = source /\ - envelope.sourceState = sourceState := by - rw [retryMessages, List.mem_filterMap] at created - rcases created with ⟨effect, _, produced⟩ - exact messageForEffect_source produced - -theorem retryMessages_valid - (config : Config) - (source : Location) - (sourceState : NodeState) - (sourceLocation : sourceState.location = source) : - forall envelope, - envelope ∈ retryMessages config source sourceState -> - envelope.Valid config := by - intro envelope created - rcases retryMessages_source created with - ⟨sourceEq, stateEq⟩ - constructor - · rw [stateEq, sourceEq] - exact sourceLocation - · rw [sourceEq, stateEq] - exact created - -theorem valid_envelope_effect - {config : Config} - {envelope : Envelope} - (valid : envelope.Valid config) : - exists effect, - effect ∈ - (step config.protocol envelope.sourceState .retry).effects /\ - messageForEffect config envelope.source - envelope.sourceState effect = some envelope := by - rcases valid with ⟨_, created⟩ - rw [retryMessages, List.mem_filterMap] at created - exact created - -theorem valid_gossip_uses_recovered_txid - {config : Config} - {envelope : Envelope} - {txid : TxID} - (valid : envelope.Valid config) - (gossip : envelope.payload = .gossip txid) : - recoveredTxID config envelope.source = some txid := by - rcases valid_envelope_effect valid with - ⟨effect, _, created⟩ - cases effect with - | sendGossip target => - cases found : recoveredTxID config envelope.source with - | none => - simp [messageForEffect, found] at created - | some recovered => - simp [messageForEffect, found] at created - rw [←created] at gossip - injection gossip with same - subst recovered - rfl - | sendVote target => - simp [messageForEffect] at created - rw [←created] at gossip - contradiction - | sendIAmOpen target => - simp [messageForEffect] at created - rw [←created] at gossip - contradiction - | opening kind => - simp [messageForEffect] at created - | restart chosen => - simp [messageForEffect] at created - | completed => - simp [messageForEffect] at created - | rejected reason => - simp [messageForEffect] at created - -theorem step_preserves_location - (config : Protocol.Config) - (state : NodeState) - (event : Event) : - (step config state event).state.location = state.location := by - cases event <;> - simp [step, rejected, advance, advanceTimeoutLane] - all_goals repeat first | split | simp_all - -theorem nodeState_location - {state : State} - {node : Location} - {foundState : NodeState} - (locations : - forall entry, entry ∈ state.system.nodes -> - entry.2.location = entry.1) - (found : nodeState state node = some foundState) : - foundState.location = node := by - rw [nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have membership : entry ∈ state.system.nodes := - List.mem_of_find?_eq_some findEq - have condition : (entry.1 == node) = true := - List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) findEq - have keyEq : entry.1 = node := beq_iff_eq.mp condition - rw [←stateEq, locations entry membership, keyEq] - -theorem initial_well_formed - (config : Config) - (active : List Location) - (valid : config.Valid) - (activeNodup : active.Nodup) - (activeConfigured : - forall node, node ∈ active -> - node ∈ config.protocol.expectedLocations) : - WellFormed config (initial config active) := by - constructor - · simp [Global.initial, initialSystem, Function.comp_def] - · simpa [Global.initial, initialSystem, Function.comp_def] using valid.2.1 - · simp [Global.initial, initialSystem, initialNode] - · exact activeNodup - · exact activeConfigured - · simp [Global.initial] - · simp [Global.initial] - · simp [Global.initial] - · constructor <;> simp [Global.initial] - -@[simp] -theorem recordEffects_active - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : - (recordEffects node nodeState effects state).active = state.active := by - induction effects generalizing state with - | nil => rfl - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - change - (recordEffects node nodeState tail - (recordEffect node nodeState state effect)).active = - state.active - rw [ih] - cases effect <;> rfl - -@[simp] -theorem recordEffects_system - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : - (recordEffects node nodeState effects state).system = state.system := by - induction effects generalizing state with - | nil => rfl - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - change - (recordEffects node nodeState tail - (recordEffect node nodeState state effect)).system = - state.system - rw [ih] - cases effect <;> rfl - -@[simp] -theorem recordEffects_network - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : - (recordEffects node nodeState effects state).network = state.network := by - induction effects generalizing state with - | nil => rfl - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - change - (recordEffects node nodeState tail - (recordEffect node nodeState state effect)).network = - state.network - rw [ih] - cases effect <;> rfl - -@[simp] -theorem recordEffects_sent - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : - (recordEffects node nodeState effects state).sent = state.sent := by - induction effects generalizing state with - | nil => rfl - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - change - (recordEffects node nodeState tail - (recordEffect node nodeState state effect)).sent = - state.sent - rw [ih] - cases effect <;> rfl - -theorem recordEffect_preserves_histories_active - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - (wellFormed : HistoriesActive state) - (nodeActive : node ∈ state.active) : - HistoriesActive (recordEffect node nodeState state effect) := by - rcases wellFormed with ⟨openings, restarts, completed⟩ - cases effect <;> - constructor <;> - simp_all [recordEffect] - -theorem recordEffects_preserves_histories_active - {node : Location} - {nodeState : NodeState} - {effects : List Effect} - {state : State} - (wellFormed : HistoriesActive state) - (nodeActive : node ∈ state.active) : - HistoriesActive (recordEffects node nodeState effects state) := by - induction effects generalizing state with - | nil => exact wellFormed - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - apply ih - · exact recordEffect_preserves_histories_active wellFormed nodeActive - · cases effect <;> simpa [recordEffect] using nodeActive - -theorem mem_of_mem_removeOne - [BEq α] - (value member : α) - (values : List α) : - member ∈ removeOne value values -> - member ∈ values := by - induction values with - | nil => simp [removeOne] - | cons head tail ih => - simp only [removeOne] - split - · exact List.mem_cons_of_mem head - · intro membership - rw [List.mem_cons] at membership ⊢ - exact membership.imp_right ih - -theorem mem_openings_recordEffect - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - {opening : Opening} - (membership : opening ∈ state.openings) : - opening ∈ (recordEffect node nodeState state effect).openings := by - cases effect <;> simp_all [recordEffect] - -theorem mem_restarts_recordEffect - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - {restart : Location} - (membership : restart ∈ state.restarts) : - restart ∈ (recordEffect node nodeState state effect).restarts := by - cases effect <;> simp_all [recordEffect] - -theorem mem_completed_recordEffect - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - {completed : Location} - (membership : completed ∈ state.completed) : - completed ∈ (recordEffect node nodeState state effect).completed := by - cases effect <;> simp_all [recordEffect] - -theorem mem_openings_recordEffects - {node : Location} - {nodeState : NodeState} - {state : State} - {effects : List Effect} - {opening : Opening} - (membership : opening ∈ state.openings) : - opening ∈ (recordEffects node nodeState effects state).openings := by - induction effects generalizing state with - | nil => exact membership - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - exact ih (mem_openings_recordEffect membership) - -theorem mem_restarts_recordEffects - {node : Location} - {nodeState : NodeState} - {state : State} - {effects : List Effect} - {restart : Location} - (membership : restart ∈ state.restarts) : - restart ∈ (recordEffects node nodeState effects state).restarts := by - induction effects generalizing state with - | nil => exact membership - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - exact ih (mem_restarts_recordEffect membership) - -theorem mem_completed_recordEffects - {node : Location} - {nodeState : NodeState} - {state : State} - {effects : List Effect} - {completed : Location} - (membership : completed ∈ state.completed) : - completed ∈ (recordEffects node nodeState effects state).completed := by - induction effects generalizing state with - | nil => exact membership - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - exact ih (mem_completed_recordEffect membership) - -theorem replaceNode_keys - (target : Location) - (nextState : NodeState) - (nodes : List (Prod Location NodeState)) : - (replaceNode target nextState nodes).map Prod.fst = - nodes.map Prod.fst := by - induction nodes with - | nil => rfl - | cons entry tail ih => - simp only [replaceNode, List.map_cons] - split - · - rename_i condition - have same : entry.1 = target := beq_iff_eq.mp condition - simp only [List.cons.injEq] - constructor - · exact same.symm - · simpa [replaceNode] using ih - · - simp only [List.cons.injEq, true_and] - simpa [replaceNode] using ih - -theorem replaceNode_locations - (target : Location) - (nextState : NodeState) - (nodes : List (Prod Location NodeState)) - (locations : - forall entry, entry ∈ nodes -> - entry.2.location = entry.1) - (nextLocation : nextState.location = target) : - forall entry, entry ∈ replaceNode target nextState nodes -> - entry.2.location = entry.1 := by - intro entry membership - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · exact nextLocation - · exact locations previous previousMember - -theorem findNode_replaceNode_ne - (target other : Location) - (nextState : NodeState) - (nodes : List (Prod Location NodeState)) - (different : other ≠ target) : - ((replaceNode target nextState nodes).find? - fun entry => entry.1 == other).map Prod.snd = - (nodes.find? fun entry => entry.1 == other).map Prod.snd := by - let replace : Prod Location NodeState -> Prod Location NodeState := - fun entry => - if entry.1 == target then (target, nextState) else entry - change - Option.map Prod.snd - (List.find? (fun entry => entry.1 == other) - (nodes.map replace)) = - Option.map Prod.snd - (List.find? (fun entry => entry.1 == other) nodes) - rw [List.find?_map] - have predicate : - ((fun entry : Prod Location NodeState => entry.1 == other) ∘ - replace) = - (fun entry => entry.1 == other) := by - funext entry - by_cases atTarget : entry.1 = target - · simp [replace, atTarget] - · simp [replace, atTarget] - rw [predicate] - cases found : - List.find? (fun entry : Prod Location NodeState => - entry.1 == other) nodes with - | none => simp - | some entry => - have condition : - (entry.1 == other) = true := - List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == other) found - have entryOther : entry.1 = other := - beq_iff_eq.mp condition - have notTarget : entry.1 ≠ target := by - simpa [entryOther] using different - simp [replace, notTarget] - -theorem systemStep_node_keys_eq - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (transition : - systemStep config before target event = some (after, output)) : - after.nodes.map Prod.fst = before.nodes.map Prod.fst := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with ⟨node, _, stateEq, _⟩ - rw [←stateEq] - exact replaceNode_keys target - (step config node event).state before.nodes - -theorem systemStep_preserves_node_locations - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (locations : - forall entry, entry ∈ before.nodes -> - entry.2.location = entry.1) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.location = entry.1 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, stateEq, _⟩ - rw [←stateEq] - apply replaceNode_locations - · exact locations - · calc - (step config node event).state.location = - node.location := step_preserves_location config node event - _ = key := - locations (key, node) (List.mem_of_find?_eq_some found) - _ = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - -theorem systemStep_other_node_eq - {config : Protocol.Config} - {before after : SystemState} - {target other : Location} - {event : Event} - {output : StepOutput} - (different : other ≠ target) - (transition : - systemStep config before target event = some (after, output)) : - (after.nodes.find? fun entry => entry.1 == other).map Prod.snd = - (before.nodes.find? fun entry => entry.1 == other).map Prod.snd := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with ⟨node, _, stateEq, _⟩ - rw [←stateEq] - exact findNode_replaceNode_ne target other - (step config node event).state before.nodes different - -theorem next_active_eq - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - after.active = before.active := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - rfl - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, _, system, output, _, rfl⟩ - simp - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, system, output, _, _, rfl⟩ - simp - -theorem next_node_keys_eq - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - after.system.nodes.map Prod.fst = - before.system.nodes.map Prod.fst := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - rfl - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, _, system, output, systemStep, rfl⟩ - simpa using systemStep_node_keys_eq systemStep - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, system, output, systemStep, _, rfl⟩ - simpa using systemStep_node_keys_eq systemStep - -theorem retry_system_eq - {config : Config} - {before after : State} - {source : Location} - (transition : next config before (.retry source) = some after) : - after.system = before.system := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - rfl - -theorem deliver_network_eq - {config : Config} - {before after : State} - {envelope : Envelope} - (transition : next config before (.deliver envelope) = some after) : - after.network = removeOne envelope before.network := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - simp - -theorem timeout_network_eq - {config : Config} - {before after : State} - {target : Location} - (transition : next config before (.timeout target) = some after) : - after.network = before.network := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - simp - -theorem deliver_other_node_eq - {config : Config} - {before after : State} - {envelope : Envelope} - {other : Location} - (different : other ≠ envelope.target) - (transition : next config before (.deliver envelope) = some after) : - nodeState after other = nodeState before other := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] - simp only [nodeState, recordEffects_system] - exact systemStep_other_node_eq different systemStep - -theorem timeout_other_node_eq - {config : Config} - {before after : State} - {target other : Location} - (different : other ≠ target) - (transition : next config before (.timeout target) = some after) : - nodeState after other = nodeState before other := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - simp only [nodeState, recordEffects_system] - exact systemStep_other_node_eq different systemStep - -theorem next_sent_extends - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - exists added, after.sent = before.sent ++ added := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact ⟨retryMessages config source sourceState, rfl⟩ - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - refine ⟨[], ?_⟩ - simp - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - refine ⟨[], ?_⟩ - simp - -theorem next_openings_monotonic - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - forall opening, opening ∈ before.openings -> - opening ∈ after.openings := by - intro opening membership - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact membership - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - apply mem_openings_recordEffects - simpa using membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - apply mem_openings_recordEffects - simpa using membership - -theorem next_restarts_monotonic - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - forall restart, restart ∈ before.restarts -> - restart ∈ after.restarts := by - intro restart membership - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact membership - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - apply mem_restarts_recordEffects - simpa using membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - apply mem_restarts_recordEffects - simpa using membership - -theorem next_completed_monotonic - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - forall completed, completed ∈ before.completed -> - completed ∈ after.completed := by - intro completed membership - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact membership - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - apply mem_completed_recordEffects - simpa using membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - apply mem_completed_recordEffects - simpa using membership - -theorem retry_preserves_well_formed - {config : Config} - {before after : State} - {source : Location} - (wellFormed : WellFormed config before) - (transition : next config before (.retry source) = some after) : - WellFormed config after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨sourceActive, sourceState, found, _, stateEq⟩ - have sourceLocation : sourceState.location = source := - nodeState_location wellFormed.nodeLocations found - rw [←stateEq] - constructor - · exact wellFormed.nodeKeys - · exact wellFormed.nodeKeysNodup - · exact wellFormed.nodeLocations - · exact wellFormed.activeNodup - · exact wellFormed.activeConfigured - · intro envelope membership - rw [List.mem_append] at membership - rcases membership with membership | membership - · exact wellFormed.sentValid envelope membership - · exact retryMessages_valid config source sourceState - sourceLocation envelope membership - · intro envelope membership - rw [List.mem_append] at membership - rcases membership with membership | membership - · exact wellFormed.sentSourceActive envelope membership - · rw [(retryMessages_source membership).1] - exact sourceActive - · intro envelope membership - rw [List.mem_append] at membership ⊢ - rcases membership with membership | membership - · exact Or.inl (wellFormed.networkSent envelope membership) - · exact Or.inr membership - · constructor - · exact wellFormed.historiesActive.openings - · exact wellFormed.historiesActive.restarts - · exact wellFormed.historiesActive.completed - -theorem deliver_preserves_well_formed - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (transition : next config before (.deliver envelope) = some after) : - WellFormed config after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, targetActive, system, output, systemStep, stateEq⟩ - rw [←stateEq] - constructor - · simp only [recordEffects_system] - exact (systemStep_node_keys_eq systemStep).trans - wellFormed.nodeKeys - · rw [recordEffects_system, systemStep_node_keys_eq systemStep] - exact wellFormed.nodeKeysNodup - · simp only [recordEffects_system] - exact systemStep_preserves_node_locations - wellFormed.nodeLocations systemStep - · simpa using wellFormed.activeNodup - · simpa using wellFormed.activeConfigured - · intro sent membership - rw [recordEffects_sent] at membership - exact wellFormed.sentValid sent membership - · intro sent membership - rw [recordEffects_sent] at membership - rw [recordEffects_active] - exact wellFormed.sentSourceActive sent membership - · intro pending membership - rw [recordEffects_network] at membership - rw [recordEffects_sent] - exact wellFormed.networkSent pending - (mem_of_mem_removeOne envelope pending before.network membership) - · apply recordEffects_preserves_histories_active - · constructor - · simpa using wellFormed.historiesActive.openings - · simpa using wellFormed.historiesActive.restarts - · simpa using wellFormed.historiesActive.completed - · simpa using targetActive - -theorem timeout_preserves_well_formed - {config : Config} - {before after : State} - {target : Location} - (wellFormed : WellFormed config before) - (transition : next config before (.timeout target) = some after) : - WellFormed config after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨targetActive, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - constructor - · simp only [recordEffects_system] - exact (systemStep_node_keys_eq systemStep).trans - wellFormed.nodeKeys - · rw [recordEffects_system, systemStep_node_keys_eq systemStep] - exact wellFormed.nodeKeysNodup - · simp only [recordEffects_system] - exact systemStep_preserves_node_locations - wellFormed.nodeLocations systemStep - · simpa using wellFormed.activeNodup - · simpa using wellFormed.activeConfigured - · intro sent membership - rw [recordEffects_sent] at membership - exact wellFormed.sentValid sent membership - · intro sent membership - rw [recordEffects_sent] at membership - rw [recordEffects_active] - exact wellFormed.sentSourceActive sent membership - · intro pending membership - rw [recordEffects_network] at membership - rw [recordEffects_sent] - exact wellFormed.networkSent pending membership - · apply recordEffects_preserves_histories_active - · constructor - · simpa using wellFormed.historiesActive.openings - · simpa using wellFormed.historiesActive.restarts - · simpa using wellFormed.historiesActive.completed - · simpa using targetActive - -theorem next_preserves_well_formed - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (transition : next config before action = some after) : - WellFormed config after := by - cases action with - | retry source => - exact retry_preserves_well_formed wellFormed transition - | deliver envelope => - exact deliver_preserves_well_formed wellFormed transition - | timeout target => - exact timeout_preserves_well_formed wellFormed transition - -theorem reachable_well_formed - {config : Config} - {state : State} - (reachable : Reachable config state) : - WellFormed config state := by - induction reachable with - | initial active valid nodup configured => - exact initial_well_formed config active valid nodup configured - | step reachable transition wellFormed => - exact next_preserves_well_formed wellFormed transition - -theorem reachable_config_valid - {config : Config} - {state : State} - (reachable : Reachable config state) : - config.Valid := by - induction reachable with - | initial active valid nodup configured => exact valid - | step reachable transition valid => exact valid - -end DisasterRecovery.Protocol.Global +import DisasterRecovery.Protocol.Global +import Mathlib.Tactic + +namespace DisasterRecovery.Protocol.Global + +structure HistoriesActive (state : State) : Prop where + openings : + forall opening, opening ∈ state.openings -> + opening.node ∈ state.active + restarts : + forall node, node ∈ state.restarts -> + node ∈ state.active + completed : + forall node, node ∈ state.completed -> + node ∈ state.active + +structure WellFormed (config : Config) (state : State) : Prop where + nodeKeys : + state.system.nodes.map Prod.fst = + config.protocol.expectedLocations + nodeKeysNodup : (state.system.nodes.map Prod.fst).Nodup + nodeLocations : + forall entry, entry ∈ state.system.nodes -> + entry.2.location = entry.1 + activeNodup : state.active.Nodup + activeConfigured : + forall node, node ∈ state.active -> + node ∈ config.protocol.expectedLocations + sentValid : + forall envelope, envelope ∈ state.sent -> + envelope.Valid config + sentSourceActive : + forall envelope, envelope ∈ state.sent -> + envelope.source ∈ state.active + networkSent : + forall envelope, envelope ∈ state.network -> + envelope ∈ state.sent + historiesActive : HistoriesActive state + +theorem messageForEffect_source + {config : Config} + {source : Location} + {sourceState : NodeState} + {effect : Effect} + {envelope : Envelope} + (created : + messageForEffect config source sourceState effect = some envelope) : + envelope.source = source /\ + envelope.sourceState = sourceState := by + cases effect with + | sendGossip target => + cases found : recoveredTxID config source with + | none => + simp [messageForEffect, found] at created + | some txid => + simp [messageForEffect, found] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | sendVote target => + simp [messageForEffect] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | opening kind => + simp_all [messageForEffect] + | restart chosen => + simp_all [messageForEffect] + | completed => + simp_all [messageForEffect] + | rejected reason => + simp_all [messageForEffect] + +theorem retryMessages_source + {config : Config} + {source : Location} + {sourceState : NodeState} + {envelope : Envelope} + (created : + envelope ∈ retryMessages config source sourceState) : + envelope.source = source /\ + envelope.sourceState = sourceState := by + rw [retryMessages, List.mem_filterMap] at created + rcases created with ⟨effect, _, produced⟩ + exact messageForEffect_source produced + +theorem retryMessages_valid + (config : Config) + (source : Location) + (sourceState : NodeState) + (sourceLocation : sourceState.location = source) : + forall envelope, + envelope ∈ retryMessages config source sourceState -> + envelope.Valid config := by + intro envelope created + rcases retryMessages_source created with + ⟨sourceEq, stateEq⟩ + constructor + · rw [stateEq, sourceEq] + exact sourceLocation + · rw [sourceEq, stateEq] + exact created + +theorem valid_envelope_effect + {config : Config} + {envelope : Envelope} + (valid : envelope.Valid config) : + exists effect, + effect ∈ + (step config.protocol envelope.sourceState .retry).effects /\ + messageForEffect config envelope.source + envelope.sourceState effect = some envelope := by + rcases valid with ⟨_, created⟩ + rw [retryMessages, List.mem_filterMap] at created + exact created + +theorem valid_gossip_uses_recovered_txid + {config : Config} + {envelope : Envelope} + {txid : TxID} + (valid : envelope.Valid config) + (gossip : envelope.payload = .gossip txid) : + recoveredTxID config envelope.source = some txid := by + rcases valid_envelope_effect valid with + ⟨effect, _, created⟩ + cases effect with + | sendGossip target => + cases found : recoveredTxID config envelope.source with + | none => + simp [messageForEffect, found] at created + | some recovered => + simp [messageForEffect, found] at created + rw [←created] at gossip + injection gossip with same + subst recovered + rfl + | sendVote target => + simp [messageForEffect] at created + rw [←created] at gossip + contradiction + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] at gossip + contradiction + | opening kind => + simp [messageForEffect] at created + | restart chosen => + simp [messageForEffect] at created + | completed => + simp [messageForEffect] at created + | rejected reason => + simp [messageForEffect] at created + +theorem step_preserves_location + (config : Protocol.Config) + (state : NodeState) + (event : Event) : + (step config state event).state.location = state.location := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] + all_goals repeat first | split | simp_all + +theorem nodeState_location + {state : State} + {node : Location} + {foundState : NodeState} + (locations : + forall entry, entry ∈ state.system.nodes -> + entry.2.location = entry.1) + (found : nodeState state node = some foundState) : + foundState.location = node := by + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have membership : entry ∈ state.system.nodes := + List.mem_of_find?_eq_some findEq + have condition : (entry.1 == node) = true := + List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq + have keyEq : entry.1 = node := beq_iff_eq.mp condition + rw [←stateEq, locations entry membership, keyEq] + +theorem initial_well_formed + (config : Config) + (active : List Location) + (valid : config.Valid) + (activeNodup : active.Nodup) + (activeConfigured : + forall node, node ∈ active -> + node ∈ config.protocol.expectedLocations) : + WellFormed config (initial config active) := by + constructor + · simp [Global.initial, initialSystem, Function.comp_def] + · simpa [Global.initial, initialSystem, Function.comp_def] using valid.2.1 + · simp [Global.initial, initialSystem, initialNode] + · exact activeNodup + · exact activeConfigured + · simp [Global.initial] + · simp [Global.initial] + · simp [Global.initial] + · constructor <;> simp [Global.initial] + +@[simp] +theorem recordEffects_active + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).active = state.active := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).active = + state.active + rw [ih] + cases effect <;> rfl + +@[simp] +theorem recordEffects_system + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).system = state.system := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).system = + state.system + rw [ih] + cases effect <;> rfl + +@[simp] +theorem recordEffects_network + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).network = state.network := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).network = + state.network + rw [ih] + cases effect <;> rfl + +@[simp] +theorem recordEffects_sent + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).sent = state.sent := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).sent = + state.sent + rw [ih] + cases effect <;> rfl + +theorem recordEffect_preserves_histories_active + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + (wellFormed : HistoriesActive state) + (nodeActive : node ∈ state.active) : + HistoriesActive (recordEffect node nodeState state effect) := by + rcases wellFormed with ⟨openings, restarts, completed⟩ + cases effect <;> + constructor <;> + simp_all [recordEffect] + +theorem recordEffects_preserves_histories_active + {node : Location} + {nodeState : NodeState} + {effects : List Effect} + {state : State} + (wellFormed : HistoriesActive state) + (nodeActive : node ∈ state.active) : + HistoriesActive (recordEffects node nodeState effects state) := by + induction effects generalizing state with + | nil => exact wellFormed + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + apply ih + · exact recordEffect_preserves_histories_active wellFormed nodeActive + · cases effect <;> simpa [recordEffect] using nodeActive + +theorem mem_of_mem_removeOne + [BEq α] + (value member : α) + (values : List α) : + member ∈ removeOne value values -> + member ∈ values := by + induction values with + | nil => simp [removeOne] + | cons head tail ih => + simp only [removeOne] + split + · exact List.mem_cons_of_mem head + · intro membership + rw [List.mem_cons] at membership ⊢ + exact membership.imp_right ih + +theorem mem_openings_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {opening : Opening} + (membership : opening ∈ state.openings) : + opening ∈ (recordEffect node nodeState state effect).openings := by + cases effect <;> simp_all [recordEffect] + +theorem mem_restarts_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {restart : Location} + (membership : restart ∈ state.restarts) : + restart ∈ (recordEffect node nodeState state effect).restarts := by + cases effect <;> simp_all [recordEffect] + +theorem mem_completed_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {completed : Location} + (membership : completed ∈ state.completed) : + completed ∈ (recordEffect node nodeState state effect).completed := by + cases effect <;> simp_all [recordEffect] + +theorem mem_openings_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {opening : Opening} + (membership : opening ∈ state.openings) : + opening ∈ (recordEffects node nodeState effects state).openings := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_openings_recordEffect membership) + +theorem mem_restarts_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {restart : Location} + (membership : restart ∈ state.restarts) : + restart ∈ (recordEffects node nodeState effects state).restarts := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_restarts_recordEffect membership) + +theorem mem_completed_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {completed : Location} + (membership : completed ∈ state.completed) : + completed ∈ (recordEffects node nodeState effects state).completed := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_completed_recordEffect membership) + +theorem replaceNode_keys + (target : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) : + (replaceNode target nextState nodes).map Prod.fst = + nodes.map Prod.fst := by + induction nodes with + | nil => rfl + | cons entry tail ih => + simp only [replaceNode, List.map_cons] + split + · + rename_i condition + have same : entry.1 = target := beq_iff_eq.mp condition + simp only [List.cons.injEq] + constructor + · exact same.symm + · simpa [replaceNode] using ih + · + simp only [List.cons.injEq, true_and] + simpa [replaceNode] using ih + +theorem replaceNode_locations + (target : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) + (locations : + forall entry, entry ∈ nodes -> + entry.2.location = entry.1) + (nextLocation : nextState.location = target) : + forall entry, entry ∈ replaceNode target nextState nodes -> + entry.2.location = entry.1 := by + intro entry membership + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · exact nextLocation + · exact locations previous previousMember + +theorem findNode_replaceNode_ne + (target other : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) + (different : other ≠ target) : + ((replaceNode target nextState nodes).find? + fun entry => entry.1 == other).map Prod.snd = + (nodes.find? fun entry => entry.1 == other).map Prod.snd := by + let replace : Prod Location NodeState -> Prod Location NodeState := + fun entry => + if entry.1 == target then (target, nextState) else entry + change + Option.map Prod.snd + (List.find? (fun entry => entry.1 == other) + (nodes.map replace)) = + Option.map Prod.snd + (List.find? (fun entry => entry.1 == other) nodes) + rw [List.find?_map] + have predicate : + ((fun entry : Prod Location NodeState => entry.1 == other) ∘ + replace) = + (fun entry => entry.1 == other) := by + funext entry + by_cases atTarget : entry.1 = target + · simp [replace, atTarget] + · simp [replace, atTarget] + rw [predicate] + cases found : + List.find? (fun entry : Prod Location NodeState => + entry.1 == other) nodes with + | none => simp + | some entry => + have condition : + (entry.1 == other) = true := + List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == other) found + have entryOther : entry.1 = other := + beq_iff_eq.mp condition + have notTarget : entry.1 ≠ target := by + simpa [entryOther] using different + simp [replace, notTarget] + +theorem systemStep_node_keys_eq + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (transition : + systemStep config before target event = some (after, output)) : + after.nodes.map Prod.fst = before.nodes.map Prod.fst := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with ⟨node, _, stateEq, _⟩ + rw [←stateEq] + exact replaceNode_keys target + (step config node event).state before.nodes + +theorem systemStep_preserves_node_locations + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (locations : + forall entry, entry ∈ before.nodes -> + entry.2.location = entry.1) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.location = entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, stateEq, _⟩ + rw [←stateEq] + apply replaceNode_locations + · exact locations + · calc + (step config node event).state.location = + node.location := step_preserves_location config node event + _ = key := + locations (key, node) (List.mem_of_find?_eq_some found) + _ = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + +theorem systemStep_other_node_eq + {config : Protocol.Config} + {before after : SystemState} + {target other : Location} + {event : Event} + {output : StepOutput} + (different : other ≠ target) + (transition : + systemStep config before target event = some (after, output)) : + (after.nodes.find? fun entry => entry.1 == other).map Prod.snd = + (before.nodes.find? fun entry => entry.1 == other).map Prod.snd := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with ⟨node, _, stateEq, _⟩ + rw [←stateEq] + exact findNode_replaceNode_ne target other + (step config node event).state before.nodes different + +theorem next_active_eq + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + after.active = before.active := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, _, system, output, _, rfl⟩ + simp + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, system, output, _, _, rfl⟩ + simp + +theorem next_node_keys_eq + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + after.system.nodes.map Prod.fst = + before.system.nodes.map Prod.fst := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, _, system, output, systemStep, rfl⟩ + simpa using systemStep_node_keys_eq systemStep + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, system, output, systemStep, _, rfl⟩ + simpa using systemStep_node_keys_eq systemStep + +theorem retry_system_eq + {config : Config} + {before after : State} + {source : Location} + (transition : next config before (.retry source) = some after) : + after.system = before.system := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + +theorem deliver_network_eq + {config : Config} + {before after : State} + {envelope : Envelope} + (transition : next config before (.deliver envelope) = some after) : + after.network = removeOne envelope before.network := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + simp + +theorem timeout_network_eq + {config : Config} + {before after : State} + {target : Location} + (transition : next config before (.timeout target) = some after) : + after.network = before.network := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + simp + +theorem deliver_other_node_eq + {config : Config} + {before after : State} + {envelope : Envelope} + {other : Location} + (different : other ≠ envelope.target) + (transition : next config before (.deliver envelope) = some after) : + nodeState after other = nodeState before other := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + simp only [nodeState, recordEffects_system] + exact systemStep_other_node_eq different systemStep + +theorem timeout_other_node_eq + {config : Config} + {before after : State} + {target other : Location} + (different : other ≠ target) + (transition : next config before (.timeout target) = some after) : + nodeState after other = nodeState before other := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + simp only [nodeState, recordEffects_system] + exact systemStep_other_node_eq different systemStep + +theorem next_sent_extends + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + exists added, after.sent = before.sent ++ added := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact ⟨retryMessages config source sourceState, rfl⟩ + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + refine ⟨[], ?_⟩ + simp + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + refine ⟨[], ?_⟩ + simp + +theorem next_openings_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall opening, opening ∈ before.openings -> + opening ∈ after.openings := by + intro opening membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_openings_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_openings_recordEffects + simpa using membership + +theorem next_restarts_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall restart, restart ∈ before.restarts -> + restart ∈ after.restarts := by + intro restart membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_restarts_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_restarts_recordEffects + simpa using membership + +theorem next_completed_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall completed, completed ∈ before.completed -> + completed ∈ after.completed := by + intro completed membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_completed_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_completed_recordEffects + simpa using membership + +theorem retry_preserves_well_formed + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (transition : next config before (.retry source) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨sourceActive, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + constructor + · exact wellFormed.nodeKeys + · exact wellFormed.nodeKeysNodup + · exact wellFormed.nodeLocations + · exact wellFormed.activeNodup + · exact wellFormed.activeConfigured + · intro envelope membership + rw [List.mem_append] at membership + rcases membership with membership | membership + · exact wellFormed.sentValid envelope membership + · exact retryMessages_valid config source sourceState + sourceLocation envelope membership + · intro envelope membership + rw [List.mem_append] at membership + rcases membership with membership | membership + · exact wellFormed.sentSourceActive envelope membership + · rw [(retryMessages_source membership).1] + exact sourceActive + · intro envelope membership + rw [List.mem_append] at membership ⊢ + rcases membership with membership | membership + · exact Or.inl (wellFormed.networkSent envelope membership) + · exact Or.inr membership + · constructor + · exact wellFormed.historiesActive.openings + · exact wellFormed.historiesActive.restarts + · exact wellFormed.historiesActive.completed + +theorem deliver_preserves_well_formed + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (transition : next config before (.deliver envelope) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, targetActive, system, output, systemStep, stateEq⟩ + rw [←stateEq] + constructor + · simp only [recordEffects_system] + exact (systemStep_node_keys_eq systemStep).trans + wellFormed.nodeKeys + · rw [recordEffects_system, systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · simp only [recordEffects_system] + exact systemStep_preserves_node_locations + wellFormed.nodeLocations systemStep + · simpa using wellFormed.activeNodup + · simpa using wellFormed.activeConfigured + · intro sent membership + rw [recordEffects_sent] at membership + exact wellFormed.sentValid sent membership + · intro sent membership + rw [recordEffects_sent] at membership + rw [recordEffects_active] + exact wellFormed.sentSourceActive sent membership + · intro pending membership + rw [recordEffects_network] at membership + rw [recordEffects_sent] + exact wellFormed.networkSent pending + (mem_of_mem_removeOne envelope pending before.network membership) + · apply recordEffects_preserves_histories_active + · constructor + · simpa using wellFormed.historiesActive.openings + · simpa using wellFormed.historiesActive.restarts + · simpa using wellFormed.historiesActive.completed + · simpa using targetActive + +theorem timeout_preserves_well_formed + {config : Config} + {before after : State} + {target : Location} + (wellFormed : WellFormed config before) + (transition : next config before (.timeout target) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨targetActive, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + constructor + · simp only [recordEffects_system] + exact (systemStep_node_keys_eq systemStep).trans + wellFormed.nodeKeys + · rw [recordEffects_system, systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · simp only [recordEffects_system] + exact systemStep_preserves_node_locations + wellFormed.nodeLocations systemStep + · simpa using wellFormed.activeNodup + · simpa using wellFormed.activeConfigured + · intro sent membership + rw [recordEffects_sent] at membership + exact wellFormed.sentValid sent membership + · intro sent membership + rw [recordEffects_sent] at membership + rw [recordEffects_active] + exact wellFormed.sentSourceActive sent membership + · intro pending membership + rw [recordEffects_network] at membership + rw [recordEffects_sent] + exact wellFormed.networkSent pending membership + · apply recordEffects_preserves_histories_active + · constructor + · simpa using wellFormed.historiesActive.openings + · simpa using wellFormed.historiesActive.restarts + · simpa using wellFormed.historiesActive.completed + · simpa using targetActive + +theorem next_preserves_well_formed + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (transition : next config before action = some after) : + WellFormed config after := by + cases action with + | retry source => + exact retry_preserves_well_formed wellFormed transition + | deliver envelope => + exact deliver_preserves_well_formed wellFormed transition + | timeout target => + exact timeout_preserves_well_formed wellFormed transition + +theorem reachable_well_formed + {config : Config} + {state : State} + (reachable : Reachable config state) : + WellFormed config state := by + induction reachable with + | initial active valid nodup configured => + exact initial_well_formed config active valid nodup configured + | step reachable transition wellFormed => + exact next_preserves_well_formed wellFormed transition + +theorem reachable_config_valid + {config : Config} + {state : State} + (reachable : Reachable config state) : + config.Valid := by + induction reachable with + | initial active valid nodup configured => exact valid + | step reachable transition valid => exact valid + +end DisasterRecovery.Protocol.Global From 7ed0e2fd7874aea578b7a5d538d9e34c14a0a542 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Mon, 7 Sep 2026 19:05:45 +0100 Subject: [PATCH 09/35] Separate Lean review contracts from proof implementations Keep protocol definitions and explicit system properties on the human-review surface. Move proof implementations to checked helper lemmas and use standard Lake build, axiom lint, and import coverage checks. Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- .gitattributes | 5 +- .github/workflows/README.md | 10 +- .github/workflows/lean-disaster-recovery.yml | 5 +- lean/disaster-recovery/AxiomChecks.lean | 21 - lean/disaster-recovery/CanonicalTests.lean | 2 +- lean/disaster-recovery/DisasterRecovery.lean | 14 +- .../DisasterRecovery/Proofs/Committed.lean | 243 ++ .../Proofs/GlobalTemporal.lean | 3002 +++++++++++++++++ .../DisasterRecovery/Proofs/Invariants.lean | 870 +++++ .../DisasterRecovery/Proofs/Quorum.lean | 1389 ++++++++ .../DisasterRecovery/Proofs/Temporal.lean | 197 ++ .../DisasterRecovery/Properties.lean | 209 ++ .../DisasterRecovery/Protocol/Committed.lean | 226 +- .../Protocol/GlobalTemporal.lean | 2992 +--------------- .../DisasterRecovery/Protocol/Invariants.lean | 862 +---- .../DisasterRecovery/Protocol/Quorum.lean | 1380 +------- .../DisasterRecovery/Protocol/Temporal.lean | 190 +- lean/disaster-recovery/README.md | 86 +- lean/disaster-recovery/lake-manifest.json | 12 + lean/disaster-recovery/lakefile.toml | 8 + 20 files changed, 6034 insertions(+), 5689 deletions(-) delete mode 100644 lean/disaster-recovery/AxiomChecks.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Proofs/Invariants.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean create mode 100644 lean/disaster-recovery/DisasterRecovery/Properties.lean diff --git a/.gitattributes b/.gitattributes index 05028087a749..dadda9180eae 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8,4 +8,7 @@ src/crypto/test/cbor_fuzz_corpus/* binary *.h linguist-language=C++ *.cpp linguist-language=C++ -.*canary merge=keeplocal \ No newline at end of file +.*canary merge=keeplocal + +lean/disaster-recovery/DisasterRecovery/Proofs/**/*.lean linguist-generated=true +lean/disaster-recovery/DisasterRecovery.lean text eol=lf \ No newline at end of file diff --git a/.github/workflows/README.md b/.github/workflows/README.md index ef1e552a3623..fa2bf87b8674 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -103,9 +103,13 @@ File: `tla-shallow.yml` # Lean Disaster Recovery -Builds the canonical Lean disaster recovery model, checks its proofs without -warnings or project `sorryAx` dependencies, and runs its executable canonical -behavior checks on relevant pull requests. +Builds the canonical Lean disaster recovery model with `lake build --wfail`, +audits its transitive axiom dependencies with `lake lint`, and runs its +executable canonical behavior checks on relevant pull requests. +The build and audit include both the human-reviewed model and system properties +and the proof implementation files marked as generated for review purposes. +The standard `mk_all --check` command ensures that the audit root imports every +library module, so newly added proofs cannot silently escape the checks. File: `lean-disaster-recovery.yml` 3rd party dependencies: None diff --git a/.github/workflows/lean-disaster-recovery.yml b/.github/workflows/lean-disaster-recovery.yml index 7ce96fd45232..31085ba5efaa 100644 --- a/.github/workflows/lean-disaster-recovery.yml +++ b/.github/workflows/lean-disaster-recovery.yml @@ -41,6 +41,7 @@ jobs: shell: bash run: | set -euo pipefail - lake build - lake env lean -DwarningAsError=true AxiomChecks.lean + lake exe mk_all --check --lib DisasterRecovery + lake build --wfail + lake lint lake exe canonical-checks diff --git a/lean/disaster-recovery/AxiomChecks.lean b/lean/disaster-recovery/AxiomChecks.lean deleted file mode 100644 index a962639129b0..000000000000 --- a/lean/disaster-recovery/AxiomChecks.lean +++ /dev/null @@ -1,21 +0,0 @@ -import DisasterRecovery -import Lean.Elab.Command -import Lean.Util.CollectAxioms - -open Lean Elab Command - -elab "#assert_no_project_sorries" : command => do - let env <- getEnv - let mut offenders : Array Name := #[] - for (name, _) in env.constants.toList do - if name.toString.startsWith "DisasterRecovery" then - let axioms <- liftCoreM <| Lean.collectAxioms name - if axioms.contains (Name.mkSimple "sorryAx") then - offenders := offenders.push name - unless offenders.isEmpty do - throwError "declarations contain sorryAx: {offenders}" - -#assert_no_project_sorries - -def main : IO Unit := - pure () diff --git a/lean/disaster-recovery/CanonicalTests.lean b/lean/disaster-recovery/CanonicalTests.lean index 451d0d6a6f76..426f5a1ea432 100644 --- a/lean/disaster-recovery/CanonicalTests.lean +++ b/lean/disaster-recovery/CanonicalTests.lean @@ -141,5 +141,5 @@ def main : IO UInt32 := do let (twoStates, twoEdges) <- enumerate config "A" IO.println s!"canonical n=1: {oneStates} states, {oneEdges} event edges" IO.println s!"canonical n=2: {twoStates} states, {twoEdges} event edges" - IO.println "all canonical semantic and proof checks passed" + IO.println "all canonical semantic checks passed" pure 0 diff --git a/lean/disaster-recovery/DisasterRecovery.lean b/lean/disaster-recovery/DisasterRecovery.lean index 009747c71664..5c3139abf786 100644 --- a/lean/disaster-recovery/DisasterRecovery.lean +++ b/lean/disaster-recovery/DisasterRecovery.lean @@ -1,7 +1,13 @@ -import DisasterRecovery.Protocol.Model -import DisasterRecovery.Protocol.Temporal +import DisasterRecovery.Proofs.Committed +import DisasterRecovery.Proofs.GlobalTemporal +import DisasterRecovery.Proofs.Invariants +import DisasterRecovery.Proofs.Quorum +import DisasterRecovery.Proofs.Temporal +import DisasterRecovery.Properties +import DisasterRecovery.Protocol.Committed import DisasterRecovery.Protocol.Global +import DisasterRecovery.Protocol.GlobalTemporal import DisasterRecovery.Protocol.Invariants +import DisasterRecovery.Protocol.Model import DisasterRecovery.Protocol.Quorum -import DisasterRecovery.Protocol.Committed -import DisasterRecovery.Protocol.GlobalTemporal +import DisasterRecovery.Protocol.Temporal diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean new file mode 100644 index 000000000000..a4df56469242 --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean @@ -0,0 +1,243 @@ +import DisasterRecovery.Protocol.Committed +import DisasterRecovery.Proofs.Quorum +import Mathlib.Tactic + +/-! +Machine-checked proof implementations. Review the system-level statements in +`DisasterRecovery.Properties` and assumptions in `DisasterRecovery.Protocol.Committed`. +-/ + +namespace DisasterRecovery.Protocol + +namespace TxID + +lemma prefix_refl (txid : TxID) : PrefixOf txid txid := by + simp [PrefixOf] + +lemma prefix_trans + {first second third : TxID} + (firstSecond : PrefixOf first second) + (secondThird : PrefixOf second third) : + PrefixOf first third := by + simp [PrefixOf] at firstSecond secondThird ⊢ + omega + +end TxID + +namespace Global + +lemma prefix_of_score_true + (leftName rightName : Location) + (left right : TxID) + (score : + txScoreGreater leftName left rightName right = true) : + TxID.PrefixOf right left := by + simp [txScoreGreater] at score + simp [TxID.PrefixOf] + omega + +lemma prefix_of_score_false + (leftName rightName : Location) + (left right : TxID) + (score : + txScoreGreater leftName left rightName right = false) : + TxID.PrefixOf left right := by + simp [txScoreGreater] at score + simp [TxID.PrefixOf] + omega + +lemma current_prefix_selectMaximum + (current candidate : Prod Location TxID) : + TxID.PrefixOf current.2 + (selectMaximum current candidate).2 := by + unfold selectMaximum + split + · rename_i score + exact prefix_of_score_true + candidate.1 current.1 candidate.2 current.2 score + · exact TxID.prefix_refl current.2 + +lemma candidate_prefix_selectMaximum + (current candidate : Prod Location TxID) : + TxID.PrefixOf candidate.2 + (selectMaximum current candidate).2 := by + unfold selectMaximum + split + · exact TxID.prefix_refl candidate.2 + · rename_i score + exact prefix_of_score_false + candidate.1 current.1 candidate.2 current.2 + (Bool.eq_false_iff.mpr score) + +lemma foldl_selectMaximum_upper_bound + (current member : Prod Location TxID) + (tail : List (Prod Location TxID)) + (membership : member = current \/ member ∈ tail) : + TxID.PrefixOf member.2 + (tail.foldl selectMaximum current).2 := by + induction tail generalizing current member with + | nil => + simp at membership + subst member + exact TxID.prefix_refl current.2 + | cons candidate rest ih => + simp only [List.foldl_cons] + rcases membership with currentMember | tailMember + · subst member + exact TxID.prefix_trans + (current_prefix_selectMaximum current candidate) + (ih (selectMaximum current candidate) + (selectMaximum current candidate) (Or.inl rfl)) + · rw [List.mem_cons] at tailMember + rcases tailMember with candidateMember | restMember + · subst member + exact TxID.prefix_trans + (candidate_prefix_selectMaximum current candidate) + (ih (selectMaximum current candidate) + (selectMaximum current candidate) (Or.inl rfl)) + · exact ih (selectMaximum current candidate) member + (Or.inr restMember) + +lemma maximumGossip_upper_bound + {gossips : List (Prod Location TxID)} + {selected member : Prod Location TxID} + (maximum : maximumGossip gossips = some selected) + (membership : member ∈ gossips) : + TxID.PrefixOf member.2 selected.2 := by + cases gossips with + | nil => simp at membership + | cons head tail => + simp [maximumGossip] at maximum + rw [←maximum] + apply foldl_selectMaximum_upper_bound head member tail + simpa using membership + +lemma foldl_selectMaximum_mem + (current : Prod Location TxID) + (tail : List (Prod Location TxID)) : + tail.foldl selectMaximum current ∈ current :: tail := by + induction tail generalizing current with + | nil => simp + | cons candidate rest ih => + simp only [List.foldl_cons] + have selected : + selectMaximum current candidate = current \/ + selectMaximum current candidate = candidate := by + unfold selectMaximum + split <;> simp + have member := + ih (selectMaximum current candidate) + rw [List.mem_cons] at member + rcases member with currentMember | restMember + · rw [currentMember] + rcases selected with selected | selected + · simp [selected] + · simp [selected] + · simp [restMember] + +lemma maximumGossip_mem + {gossips : List (Prod Location TxID)} + {selected : Prod Location TxID} + (maximum : maximumGossip gossips = some selected) : + selected ∈ gossips := by + cases gossips with + | nil => simp [maximumGossip] at maximum + | cons head tail => + simp [maximumGossip] at maximum + rw [←maximum] + exact foldl_selectMaximum_mem head tail + +lemma recoveredTxID_of_mem + {config : Config} + {location : Location} + {txid : TxID} + (valid : config.Valid) + (membership : (location, txid) ∈ config.recovered) : + recoveredTxID config location = some txid := by + have keysNodup : (config.recovered.map Prod.fst).Nodup := by + rw [valid.2.2] + exact valid.2.1 + unfold recoveredTxID + cases found : + config.recovered.find? fun entry => entry.1 == location with + | none => + rw [List.find?_eq_none] at found + exact False.elim + (found (location, txid) membership (by simp)) + | some entry => + have foundMember : entry ∈ config.recovered := + List.mem_of_find?_eq_some found + have foundLocation : entry.1 = location := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location TxID => + entry.1 == location) found) + have same : + entry = (location, txid) := + eq_of_key_eq keysNodup foundMember membership foundLocation + simp [same] + +lemma full_gossip_selection_preserves_commit + {config : Config} + {state : State} + {opener : Location} + {committed : TxID} + (reachable : Reachable config state) + (full : FullGossipSelection config state opener) + (durable : DurableCommit config committed) : + exists recovered, + recoveredTxID config opener = some recovered /\ + TxID.PrefixOf committed recovered := by + have configValid := reachable_config_valid reachable + have wellFormed := reachable_well_formed reachable + have invariant := reachable_quorum_invariant reachable + rcases full with + ⟨vote, sent, payload, target, complete⟩ + have voteState := + retry_vote_state (wellFormed.sentValid vote sent) payload + rcases invariant.sentVotesSelected vote sent payload with + ⟨selectedTarget, selectedTxID, choice, selected⟩ + have selectedTargetEq : selectedTarget = vote.target := + Option.some.inj (choice.symm.trans voteState.2) + rw [selectedTargetEq, target] at selected + rcases durable with + ⟨durableLocation, durableTxID, durableMember, committedDurable⟩ + have durableGossip : + (durableLocation, durableTxID) ∈ vote.sourceState.gossips := + (complete (durableLocation, durableTxID)).2 durableMember + have durableMaximum := + maximumGossip_upper_bound selected durableGossip + have selectedGossip : + (opener, selectedTxID) ∈ vote.sourceState.gossips := + maximumGossip_mem selected + have selectedRecovered : + (opener, selectedTxID) ∈ config.recovered := + (complete (opener, selectedTxID)).1 selectedGossip + exact + ⟨selectedTxID, + recoveredTxID_of_mem configValid selectedRecovered, + TxID.prefix_trans committedDurable durableMaximum⟩ + +/-- +Quorum opening scopes the result to an actual decision, while the separate +`FullGossipSelection` premise carries the completeness requirement. Quorum +opening alone does not imply complete gossip because voting may follow a +gossip timeout. +-/ +lemma quorum_open_preserves_commit + {config : Config} + {state : State} + {opener : Location} + {committed : TxID} + (reachable : Reachable config state) + (_opened : QuorumOpened state opener) + (full : FullGossipSelection config state opener) + (durable : DurableCommit config committed) : + exists recovered, + recoveredTxID config opener = some recovered /\ + TxID.PrefixOf committed recovered := + full_gossip_selection_preserves_commit reachable full durable + +end Global + +end DisasterRecovery.Protocol diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean new file mode 100644 index 000000000000..79c9db807a0d --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean @@ -0,0 +1,3002 @@ +import DisasterRecovery.Protocol.GlobalTemporal +import DisasterRecovery.Proofs.Committed +import DisasterRecovery.Proofs.Temporal +import Mathlib.Tactic + +/-! +Machine-checked proof implementations. Review the system-level statements in +`DisasterRecovery.Properties` and assumptions in `DisasterRecovery.Protocol.GlobalTemporal`. +-/ + +namespace DisasterRecovery.Protocol.Global + +lemma hasPhase_unique + {state : State} + {node : Location} + {first second : Phase} + (firstPhase : HasPhase state node first) + (secondPhase : HasPhase state node second) : + first = second := by + rcases firstPhase with ⟨firstState, firstFound, firstEq⟩ + rcases secondPhase with ⟨secondState, secondFound, secondEq⟩ + rw [firstFound] at secondFound + injection secondFound with stateEq + subst secondState + exact firstEq.symm.trans secondEq + +lemma step_preserves_lane + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (valid : LaneValid state) : + LaneValid (step config state event).state := by + cases event + all_goals try cases_type Validation + all_goals + simp [LaneValid, step, rejected, advance, advanceTimeoutLane, + advanceTimeoutState, validTimeout] at valid ⊢ + all_goals repeat first | split | simp_all | aesop + +lemma step_preserves_advanced_lane + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (advanced : state.timeoutState ≠ .gossiping) : + (step config state event).state.timeoutState ≠ .gossiping := by + cases event + all_goals try cases_type Validation + all_goals + simp [step, rejected, advance, validTimeout, advanceTimeoutLane, + advanceTimeoutState] at advanced ⊢ + all_goals repeat first | split | simp_all + +lemma systemStep_preserves_lanes + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (valid : + forall entry, entry ∈ before.nodes -> + LaneValid entry.2) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + LaneValid entry.2 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · apply step_preserves_lane config node event + exact valid (key, node) (List.mem_of_find?_eq_some found) + · exact valid previous previousMember + +lemma initial_lanes_valid + (config : Config) + (active : List Location) : + NodeLanesValid (initial config active) := by + simp [NodeLanesValid, LaneValid, Global.initial, initialSystem, + initialNode] + +lemma next_preserves_lanes + {config : Config} + {before after : State} + {action : Action} + (valid : NodeLanesValid before) + (transition : next config before action = some after) : + NodeLanesValid after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact valid + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, rfl⟩ + intro entry membership + rw [recordEffects_system] at membership + exact systemStep_preserves_lanes valid systemStep + entry membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, rfl⟩ + intro entry membership + rw [recordEffects_system] at membership + exact systemStep_preserves_lanes valid systemStep + entry membership + +lemma reachable_lanes_valid + {config : Config} + {state : State} + (reachable : Reachable config state) : + NodeLanesValid state := by + induction reachable with + | initial active valid nodup configured => + exact initial_lanes_valid config active + | step reachable transition valid => + exact next_preserves_lanes valid transition + +lemma nodeState_eq_of_mem + {state : State} + {node : Location} + {foundState : NodeState} + (keysNodup : (state.system.nodes.map Prod.fst).Nodup) + (membership : (node, foundState) ∈ state.system.nodes) : + Global.nodeState state node = some foundState := by + unfold Global.nodeState + cases found : + state.system.nodes.find? fun entry => entry.1 == node with + | none => + rw [List.find?_eq_none] at found + exact False.elim + (found (node, foundState) membership (by simp)) + | some entry => + have foundMember : entry ∈ state.system.nodes := + List.mem_of_find?_eq_some found + have foundKey : entry.1 = node := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) found) + have same : entry = (node, foundState) := + eq_of_key_eq keysNodup foundMember membership foundKey + simp [same] + +lemma node_property_of_nodeState + {state : State} + {node : Location} + {foundState : NodeState} + {predicate : NodeState -> Prop} + (property : + forall entry, entry ∈ state.system.nodes -> + predicate entry.2) + (found : Global.nodeState state node = some foundState) : + predicate foundState := by + rw [Global.nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + rw [←stateEq] + exact property entry (List.mem_of_find?_eq_some findEq) + +lemma deliver_target_state + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (transition : next config before (.deliver envelope) = some after) : + exists output, + Global.nodeState after envelope.target = some output.state /\ + systemStep config.protocol before.system envelope.target + (eventFor envelope) = some (after.system, output) := by + have afterWellFormed := + next_preserves_well_formed wellFormed transition + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] at afterWellFormed ⊢ + refine ⟨output, ?_, ?_⟩ + · apply nodeState_eq_of_mem afterWellFormed.nodeKeysNodup + rw [recordEffects_system] + exact systemStep_output_mem systemStep + · simpa using systemStep + +lemma timeout_target_state + {config : Config} + {before after : State} + {target : Location} + (wellFormed : WellFormed config before) + (transition : next config before (.timeout target) = some after) : + exists output, + Global.nodeState after target = some output.state /\ + output.accepted = true /\ + systemStep config.protocol before.system target .timeout = + some (after.system, output) := by + have afterWellFormed := + next_preserves_well_formed wellFormed transition + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, accepted, stateEq⟩ + rw [←stateEq] at afterWellFormed ⊢ + refine ⟨output, ?_, accepted, ?_⟩ + · apply nodeState_eq_of_mem afterWellFormed.nodeKeysNodup + rw [recordEffects_system] + exact systemStep_output_mem systemStep + · simpa using systemStep + +lemma systemStep_output_eq + {config : Protocol.Config} + {global : State} + {after : SystemState} + {target : Location} + {event : Event} + {state : NodeState} + {output : StepOutput} + (found : Global.nodeState global target = some state) + (transition : + systemStep config global.system target event = some (after, output)) : + output = step config state event := by + change + (do + let node <- Global.nodeState global target + let result := step config node event + pure ({ + nodes := replaceNode target result.state global.system.nodes + }, result)) = some (after, output) at transition + rw [found] at transition + simp at transition + exact transition.2.symm + +lemma completed_effect_recorded + {node : Location} + {nodeState : NodeState} + {effects : List Effect} + {state : State} + (completed : .completed ∈ effects) : + node ∈ (recordEffects node nodeState effects state).completed := by + induction effects generalizing state with + | nil => simp at completed + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + rw [List.mem_cons] at completed + rcases completed with rfl | inTail + · apply mem_completed_recordEffects + simp [recordEffect] + · exact ih inTail + +lemma restart_effect_recorded + {node chosen : Location} + {nodeState : NodeState} + {effects : List Effect} + {state : State} + (restart : .restart chosen ∈ effects) : + node ∈ (recordEffects node nodeState effects state).restarts := by + induction effects generalizing state with + | nil => simp at restart + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + rw [List.mem_cons] at restart + rcases restart with rfl | inTail + · apply mem_restarts_recordEffects + simp [recordEffect] + · exact ih inTail + +lemma mem_removeOne_or_eq + [BEq α] + [LawfulBEq α] + {member removed : α} + {values : List α} + (membership : member ∈ values) : + member ∈ removeOne removed values \/ member = removed := by + induction values with + | nil => simp at membership + | cons head tail ih => + rw [List.mem_cons] at membership + rcases membership with rfl | inTail + · by_cases equal : member = removed + · exact Or.inr equal + · exact Or.inl (by simp [removeOne, equal]) + · simp only [removeOne] + split + · exact Or.inl inTail + · rcases ih inTail with still | equal + · exact Or.inl (by simp [still]) + · exact Or.inr equal + +lemma execution_reachable + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) : + forall n, Reachable config (execution.states n) := by + intro n + induction n with + | zero => exact initial + | succ n reachable => + exact Reachable.step reachable (execution.step_succ n) + +lemma execution_active_eq + {config : Config} + (execution : Execution config) : + forall n, (execution.states n).active = (execution.states 0).active := by + intro n + induction n with + | zero => rfl + | succ n activeEq => + exact (next_active_eq (execution.step_succ n)).trans activeEq + +lemma active_at + {config : Config} + (execution : Execution config) + {node : Location} + (active : node ∈ (execution.states 0).active) : + forall n, node ∈ (execution.states n).active := by + intro n + rw [execution_active_eq execution n] + exact active + +lemma recovered_for_configured + {config : Config} + (valid : config.Valid) + {node : Location} + (configured : node ∈ config.protocol.expectedLocations) : + exists txid, recoveredTxID config node = some txid := by + rw [←valid.2.2] at configured + rcases List.mem_map.mp configured with + ⟨entry, membership, keyEq⟩ + rcases entry with ⟨location, txid⟩ + simp at keyEq + subst location + refine ⟨txid, ?_⟩ + apply recoveredTxID_of_mem valid + exact membership + +lemma active_nodeState + {config : Config} + {state : State} + (wellFormed : WellFormed config state) + {node : Location} + (active : node ∈ state.active) : + exists nodeState, + Global.nodeState state node = some nodeState := by + have configured := wellFormed.activeConfigured node active + rw [←wellFormed.nodeKeys] at configured + rcases List.mem_map.mp configured with + ⟨entry, membership, keyEq⟩ + refine ⟨entry.2, ?_⟩ + apply nodeState_eq_of_mem wellFormed.nodeKeysNodup + rcases entry with ⟨location, nodeState⟩ + simp at keyEq + subst location + exact membership + +lemma retryMessages_self_gossip + {config : Config} + {node : Location} + {state : NodeState} + {txid : TxID} + (phase : state.phase = .gossiping) + (configured : node ∈ config.protocol.expectedLocations) + (recovered : recoveredTxID config node = some txid) : + { + source := node + target := node + payload := Payload.gossip txid + sourceState := state + } ∈ retryMessages config node state := by + rw [retryMessages, List.mem_filterMap] + refine ⟨.sendGossip node, ?_, ?_⟩ + · simpa [step, phase] using configured + · simp [messageForEffect, recovered] + +lemma retryMessages_vote + {config : Config} + {node target : Location} + {state : NodeState} + (phase : state.phase = .voting) + (chosen : state.chosen = some target) : + { + source := node + target + payload := Payload.vote + sourceState := state + } ∈ retryMessages config node state := by + rw [retryMessages, List.mem_filterMap] + refine ⟨.sendVote target, ?_, rfl⟩ + simp [step, phase, chosen] + +lemma retry_iamopen_state + {config : Config} + {envelope : Envelope} + (valid : envelope.Valid config) + (announcement : envelope.payload = .iAmOpen) : + envelope.sourceState.phase = .opening := by + rcases valid_envelope_effect valid with + ⟨effect, member, created⟩ + cases effect with + | sendGossip target => + cases found : recoveredTxID config envelope.source with + | none => simp [messageForEffect, found] at created + | some txid => + simp [messageForEffect, found] at created + rw [←created] at announcement + contradiction + | sendVote target => + simp [messageForEffect] at created + rw [←created] at announcement + contradiction + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] at announcement ⊢ + cases phase : envelope.sourceState.phase + case opening => rfl + case voting => + cases chosen : envelope.sourceState.chosen <;> + simp [step, phase, chosen] at member + all_goals simp [step, phase] at member + | opening kind => simp [messageForEffect] at created + | restart chosen => simp [messageForEffect] at created + | completed => simp [messageForEffect] at created + | rejected reason => simp [messageForEffect] at created + +lemma step_joining_origin + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (joining : (step config state event).state.phase = .joining) : + state.phase = .joining \/ + exists source, acceptedIAmOpenSource event = some source := by + cases event + all_goals try cases_type Validation + all_goals + simp [acceptedIAmOpenSource, step, rejected, advance, + advanceTimeoutLane] at joining ⊢ + all_goals + repeat first | split at joining | split | simp_all | aesop + +lemma step_open_origin + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (opened : (step config state event).state.phase = .open) : + state.phase = .open \/ + .completed ∈ (step config state event).effects := by + cases event + all_goals try cases_type Validation + all_goals + simp [step, rejected, advance, advanceTimeoutLane, validTimeout] + at opened ⊢ + all_goals + repeat first | split at opened | split | simp_all | aesop + +lemma iamopen_delivery_outcome + (config : Protocol.Config) + (state : NodeState) + (source : Location) : + let output := step config state (.receiveIAmOpen source .accepted) + output.state.phase = .opening \/ + output.state.phase = .open \/ + exists chosen, .restart chosen ∈ output.effects := by + cases phase : state.phase <;> + simp [step, phase, rejected, advance, advanceTimeoutLane] + +lemma iamopen_open_predecessor + (config : Protocol.Config) + (state : NodeState) + (source : Location) + (opened : + (step config state (.receiveIAmOpen source .accepted)).state.phase = + .open) : + state.phase = .open := by + cases phase : state.phase <;> + simp [step, phase, rejected, advance, advanceTimeoutLane] at opened + rfl + +lemma eventFor_iamopen_source + {envelope : Envelope} + {source : Location} + (accepted : + acceptedIAmOpenSource (eventFor envelope) = some source) : + envelope.payload = .iAmOpen /\ + envelope.source = source := by + cases payload : envelope.payload <;> + simp_all [eventFor, acceptedIAmOpenSource] + +lemma retry_gossip_enabled + {config : Config} + {state : State} + {node : Location} + (valid : config.Valid) + (wellFormed : WellFormed config state) + (active : node ∈ state.active) + (phase : HasPhase state node .gossiping) : + Enabled config state (.retry node) := by + rcases phase with ⟨nodeState, found, gossiping⟩ + have configured := wellFormed.activeConfigured node active + rcases recovered_for_configured valid configured with + ⟨txid, recovered⟩ + have message := + retryMessages_self_gossip gossiping configured recovered + have messagesNonempty : + retryMessages config node nodeState ≠ [] := by + intro empty + rw [empty] at message + simp at message + refine ⟨{ + state with + network := state.network ++ retryMessages config node nodeState + sent := state.sent ++ retryMessages config node nodeState + }, ?_⟩ + simp [next, active, found, messagesNonempty] + +lemma retry_voting_enabled + {config : Config} + {state : State} + {node target : Location} + {nodeState : NodeState} + (active : node ∈ state.active) + (found : Global.nodeState state node = some nodeState) + (phase : nodeState.phase = .voting) + (chosen : nodeState.chosen = some target) : + Enabled config state (.retry node) := by + have message := retryMessages_vote (config := config) + (node := node) phase chosen + have messagesNonempty : + retryMessages config node nodeState ≠ [] := by + intro empty + rw [empty] at message + simp at message + refine ⟨{ + state with + network := state.network ++ retryMessages config node nodeState + sent := state.sent ++ retryMessages config node nodeState + }, ?_⟩ + simp [next, active, found, messagesNonempty] + +lemma delivery_enabled + {config : Config} + {state : State} + {envelope : Envelope} + (wellFormed : WellFormed config state) + (network : envelope ∈ state.network) + (targetActive : envelope.target ∈ state.active) : + Enabled config state (.deliver envelope) := by + rcases active_nodeState wellFormed targetActive with + ⟨targetState, found⟩ + let output := step config.protocol targetState (eventFor envelope) + let system : SystemState := { + nodes := replaceNode envelope.target output.state state.system.nodes + } + let delivered : State := { + state with + system + network := removeOne envelope state.network + } + have stepResult : + systemStep config.protocol state.system envelope.target + (eventFor envelope) = some (system, output) := by + change + (do + let node <- Global.nodeState state envelope.target + let result := step config.protocol node (eventFor envelope) + pure ({ + nodes := + replaceNode envelope.target result.state state.system.nodes + }, result)) = some (system, output) + rw [found] + rfl + refine + ⟨recordEffects envelope.target output.state output.effects delivered, ?_⟩ + simp [next, network, targetActive, stepResult, output, system, + delivered] + +lemma timeout_enabled_of_accepted + {config : Config} + {state : State} + {node : Location} + {nodeState : NodeState} + (active : node ∈ state.active) + (found : Global.nodeState state node = some nodeState) + (accepted : (step config.protocol nodeState .timeout).accepted = true) : + Enabled config state (.timeout node) := by + let output := step config.protocol nodeState .timeout + let system : SystemState := { + nodes := replaceNode node output.state state.system.nodes + } + have stepResult : + systemStep config.protocol state.system node .timeout = + some (system, output) := by + change + (do + let current <- Global.nodeState state node + let result := step config.protocol current .timeout + pure ({ + nodes := replaceNode node result.state state.system.nodes + }, result)) = some (system, output) + rw [found] + rfl + refine + ⟨recordEffects node output.state output.effects + { state with system }, ?_⟩ + simp [next, active, stepResult, accepted, output, system] + +lemma retry_gossip_enqueued + {config : Config} + {before after : State} + {node : Location} + (valid : config.Valid) + (wellFormed : WellFormed config before) + (phase : HasPhase before node .gossiping) + (transition : next config before (.retry node) = some after) : + exists envelope, + envelope ∈ after.network /\ + envelope.source = node /\ + envelope.target = node /\ + exists txid, envelope.payload = .gossip txid := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨active, sourceState, found, _, stateEq⟩ + rcases phase with ⟨phaseState, foundPhase, gossiping⟩ + have configured := + wellFormed.activeConfigured node active + rcases recovered_for_configured valid configured with + ⟨txid, recovered⟩ + rw [found] at foundPhase + injection foundPhase with stateEq' + subst phaseState + let envelope : Envelope := { + source := node + target := node + payload := .gossip txid + sourceState + } + have message : envelope ∈ retryMessages config node sourceState := + retryMessages_self_gossip gossiping configured recovered + rw [←stateEq] + exact + ⟨envelope, List.mem_append_right _ message, rfl, rfl, txid, rfl⟩ + +lemma retry_vote_enqueued + {config : Config} + {before after : State} + {node target : Location} + {nodeState : NodeState} + (found : Global.nodeState before node = some nodeState) + (phase : nodeState.phase = .voting) + (chosen : nodeState.chosen = some target) + (transition : next config before (.retry node) = some after) : + exists envelope, + envelope ∈ after.network /\ + envelope.source = node /\ + envelope.target = target /\ + envelope.payload = .vote := by + have message := retryMessages_vote (config := config) + (node := node) phase chosen + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, actualState, actualFound, _, stateEq⟩ + rw [found] at actualFound + injection actualFound with actualEq + subst actualState + let envelope : Envelope := { + source := node + target + payload := .vote + sourceState := nodeState + } + rw [←stateEq] + exact + ⟨envelope, List.mem_append_right _ message, rfl, rfl, rfl⟩ + +lemma insertGossip_nonempty + (source : Location) + (txid : TxID) + (gossips : List (Prod Location TxID)) : + insertGossip source txid gossips ≠ [] := by + unfold insertGossip + split + · rename_i present + intro empty + subst gossips + simp at present + · intro empty + have lengths := + (List.mergeSort_perm ((source, txid) :: gossips) + (fun left right => left.1 <= right.1)).length_eq + rw [empty] at lengths + simp at lengths + +lemma maximumGossip_some + {gossips : List (Prod Location TxID)} + (nonempty : gossips ≠ []) : + exists selected, maximumGossip gossips = some selected := by + cases gossips with + | nil => contradiction + | cons head tail => + exact ⟨tail.foldl selectMaximum head, rfl⟩ + +lemma gossip_receive_progress + (config : Protocol.Config) + (state : NodeState) + (source : Location) + (txid : TxID) + (valid : LaneValid state) + (phase : state.phase = .gossiping) : + let output := + step config state (.receiveGossip source txid .accepted) + output.state.phase ≠ .gossiping \/ + output.state.gossips ≠ [] := by + have chosen := valid.2.2.2 phase + have nonempty := insertGossip_nonempty source txid state.gossips + obtain ⟨selected, maximum⟩ := maximumGossip_some nonempty + simp [step, phase, chosen, rejected, advance, advanceTimeoutLane, + validTimeout] + repeat first | split | simp_all + +lemma gossip_timeout_progress + (config : Protocol.Config) + (state : NodeState) + (valid : LaneValid state) + (phase : state.phase = .gossiping) + (accepted : (step config state .timeout).accepted = true) : + (step config state .timeout).state.phase = .voting := by + have lane := valid.1 phase + simp [step, phase, lane, rejected, advance, advanceTimeoutLane, + validTimeout] at accepted ⊢ + repeat first | split at accepted | split | simp_all + +lemma gossip_timeout_enabled_local + (config : Protocol.Config) + (state : NodeState) + (valid : LaneValid state) + (phase : state.phase = .gossiping) + (nonempty : state.gossips ≠ []) : + (step config state .timeout).accepted = true := by + have lane := valid.1 phase + obtain ⟨selected, maximum⟩ := maximumGossip_some nonempty + simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, + maximum] + +lemma gossip_timeout_enabled + {config : Config} + {state : State} + {node : Location} + (active : node ∈ state.active) + (lanes : NodeLanesValid state) + (phase : HasPhase state node .gossiping) + (gossip : HasGossip state node) : + Enabled config state (.timeout node) := by + rcases phase with ⟨phaseState, foundPhase, gossiping⟩ + rcases gossip with ⟨gossipState, foundGossip, nonempty⟩ + rw [foundPhase] at foundGossip + injection foundGossip with stateEq + subst gossipState + have lane := node_property_of_nodeState lanes foundPhase + apply timeout_enabled_of_accepted active foundPhase + exact gossip_timeout_enabled_local config.protocol phaseState lane + gossiping nonempty + +lemma opening_timeout_local + (config : Protocol.Config) + (state : NodeState) + (valid : LaneValid state) + (phase : state.phase = .opening) : + let output := step config state .timeout + (output.effects = [.completed] /\ output.state.phase = .open) \/ + (output.state.phase = .opening /\ + openingDistance output.state.timeoutState < + openingDistance state.timeoutState) := by + rcases valid.2.2.1 phase with lane | lane | lane + · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, + advanceTimeoutState, openingDistance] + · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, + advanceTimeoutState, openingDistance] + · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, + advanceTimeoutState, openingDistance] + +lemma opening_step_distance_le + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (valid : LaneValid state) + (phase : state.phase = .opening) + (after : (step config state event).state.phase = .opening) : + openingDistance (step config state event).state.timeoutState <= + openingDistance state.timeoutState := by + cases event with + | receiveGossip source txid validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + repeat first | split | simp_all + | receiveVote source validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + | receiveIAmOpen source validation => + cases validation <;> simp [step, phase, rejected] + | timeout => + rcases opening_timeout_local config state valid phase with + done | progress + · rw [done.2] at after + contradiction + · exact Nat.le_of_lt progress.2 + | retry => simp [step] + +lemma opening_step_or_completed + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (phase : state.phase = .opening) : + (step config state event).state.phase = .opening \/ + ((step config state event).state.phase = .open /\ + .completed ∈ (step config state event).effects) := by + cases event with + | receiveGossip source txid validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + repeat first | split | simp_all + | receiveVote source validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + | receiveIAmOpen source validation => + cases validation <;> simp [step, phase, rejected] + | timeout => + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + split <;> simp_all + | retry => simp [step, phase] + +lemma opening_non_timeout + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (phase : state.phase = .opening) + (notTimeout : event ≠ .timeout) : + (step config state event).state.phase = .opening /\ + (step config state event).state.timeoutState = + state.timeoutState := by + cases event with + | receiveGossip source txid validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + repeat first | split | simp_all + | receiveVote source validation => + cases validation <;> + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + | receiveIAmOpen source validation => + cases validation <;> simp [step, phase, rejected] + | timeout => contradiction + | retry => exact ⟨phase, rfl⟩ + +lemma opening_timeout_enabled + {config : Config} + {state : State} + {node : Location} + (active : node ∈ state.active) + (phase : HasPhase state node .opening) : + Enabled config state (.timeout node) := by + rcases phase with ⟨nodeState, found, opening⟩ + apply timeout_enabled_of_accepted active found + simp [step, opening, advance, rejected] + repeat first | split | simp_all + +lemma timeout_opening_step + {config : Config} + {before after : State} + {node : Location} + {beforeState : NodeState} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (foundBefore : + Global.nodeState before node = some beforeState) + (opening : beforeState.phase = .opening) + (transition : next config before (.timeout node) = some after) : + CompletedOpen after node \/ + (exists nextState : NodeState, + Global.nodeState after node = some nextState /\ + nextState.phase = .opening /\ + openingDistance nextState.timeoutState < + openingDistance beforeState.timeoutState) := by + have lane : LaneValid beforeState := by + apply node_property_of_nodeState (predicate := LaneValid) + · exact lanes + · exact foundBefore + have timeoutResult : + ((step config.protocol beforeState .timeout).effects = + [.completed] /\ + (step config.protocol beforeState .timeout).state.phase = .open) \/ + ((step config.protocol beforeState .timeout).state.phase = + .opening /\ + openingDistance + (step config.protocol beforeState .timeout).state.timeoutState < + openingDistance beforeState.timeoutState) := + opening_timeout_local config.protocol beforeState lane opening + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + have outputEq := systemStep_output_eq foundBefore systemStep + rw [←outputEq] at timeoutResult + rw [←stateEq] + rcases timeoutResult with completed | progress + · exact Or.inl (by + rcases completed with ⟨effects, _⟩ + rw [effects] + simp [CompletedOpen, recordEffects, recordEffect]) + · exact Or.inr + ⟨output.state, + (by + apply nodeState_eq_of_mem + · rw [recordEffects_system, + systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · rw [recordEffects_system] + exact systemStep_output_mem systemStep), + progress.1, + by simpa using progress.2⟩ + +lemma next_opening_progress + {config : Config} + {before after : State} + {node : Location} + {beforeState : NodeState} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (foundBefore : + Global.nodeState before node = some beforeState) + (opening : beforeState.phase = .opening) + (transition : next config before action = some after) : + CompletedOpen after node \/ + (exists afterState : NodeState, + Global.nodeState after node = some afterState /\ + afterState.phase = .opening /\ + openingDistance afterState.timeoutState <= + openingDistance beforeState.timeoutState) := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact Or.inr + ⟨beforeState, foundBefore, opening, Nat.le_refl _⟩ + | deliver envelope => + by_cases target : node = envelope.target + · subst node + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + have preserved := + opening_non_timeout config.protocol beforeState + (eventFor envelope) opening + (by + cases payloadEq : envelope.payload <;> + simp [eventFor, payloadEq]) + rw [←outputEq] at preserved + exact Or.inr + ⟨output.state, foundAfter, preserved.1, + by rw [preserved.2]⟩ + · have unchanged := deliver_other_node_eq target transition + rw [foundBefore] at unchanged + exact Or.inr + ⟨beforeState, by simp [unchanged], opening, Nat.le_refl _⟩ + | timeout target => + by_cases same : node = target + · subst node + rcases timeout_opening_step wellFormed lanes foundBefore + opening transition with + completed | ⟨nextState, foundAfter, nextOpening, distance⟩ + · exact Or.inl completed + · exact Or.inr + ⟨nextState, foundAfter, nextOpening, + Nat.le_of_lt distance⟩ + · have unchanged := timeout_other_node_eq same transition + rw [foundBefore] at unchanged + exact Or.inr + ⟨beforeState, by simp [unchanged], opening, Nat.le_refl _⟩ + +lemma insertVote_nonempty + (source : Location) + (votes : List Location) : + insertVote source votes ≠ [] := by + unfold insertVote + split + · rename_i present + intro empty + subst votes + simp at present + · intro empty + have lengths := + (List.mergeSort_perm (source :: votes) + (fun left right => left <= right)).length_eq + rw [empty] at lengths + simp at lengths + +lemma step_preserves_nonempty_votes + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (nonempty : state.votes ≠ []) : + (step config state event).state.votes ≠ [] := by + rcases step_votes_shape config state event with + unchanged | ⟨source, _, changed⟩ + · rw [unchanged] + exact nonempty + · rw [changed] + exact insertVote_nonempty source state.votes + +lemma next_preserves_hasVote + {config : Config} + {before after : State} + {action : Action} + {node : Location} + (wellFormed : WellFormed config before) + (vote : HasVote before node) + (transition : next config before action = some after) : + HasVote after node := by + rcases vote with ⟨beforeState, foundBefore, nonempty⟩ + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact ⟨beforeState, foundBefore, nonempty⟩ + | deliver envelope => + by_cases target : node = envelope.target + · subst node + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact step_preserves_nonempty_votes + config.protocol beforeState (eventFor envelope) nonempty⟩ + · have unchanged := deliver_other_node_eq target transition + rw [foundBefore] at unchanged + exact ⟨beforeState, by simp [unchanged], nonempty⟩ + | timeout target => + by_cases same : node = target + · subst node + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact step_preserves_nonempty_votes + config.protocol beforeState .timeout nonempty⟩ + · have unchanged := timeout_other_node_eq same transition + rw [foundBefore] at unchanged + exact ⟨beforeState, by simp [unchanged], nonempty⟩ + +lemma hasVote_mono + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (vote : HasVote (execution.states start) node) : + HasVote (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact vote + | succ finish order vote => + exact next_preserves_hasVote + (reachable_well_formed + (execution_reachable execution initial finish)) + vote (execution.step_succ finish) + +lemma next_preserves_advanced_lane + {config : Config} + {before after : State} + {action : Action} + {node : Location} + (wellFormed : WellFormed config before) + (advanced : LaneAdvanced before node) + (transition : next config before action = some after) : + LaneAdvanced after node := by + rcases advanced with ⟨beforeState, foundBefore, lane⟩ + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact ⟨beforeState, foundBefore, lane⟩ + | deliver envelope => + by_cases target : node = envelope.target + · subst node + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact step_preserves_advanced_lane + config.protocol beforeState (eventFor envelope) lane⟩ + · have unchanged := deliver_other_node_eq target transition + rw [foundBefore] at unchanged + exact ⟨beforeState, by simp [unchanged], lane⟩ + | timeout target => + by_cases same : node = target + · subst node + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact step_preserves_advanced_lane + config.protocol beforeState .timeout lane⟩ + · have unchanged := timeout_other_node_eq same transition + rw [foundBefore] at unchanged + exact ⟨beforeState, by simp [unchanged], lane⟩ + +lemma advanced_lane_mono + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (advanced : LaneAdvanced (execution.states start) node) : + LaneAdvanced (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact advanced + | succ finish order advanced => + exact next_preserves_advanced_lane + (reachable_well_formed + (execution_reachable execution initial finish)) + advanced (execution.step_succ finish) + +lemma opening_progress_between + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start finish : Nat} + {node : Location} + {startState : NodeState} + (order : start <= finish) + (foundStart : + Global.nodeState (execution.states start) node = some startState) + (openingStart : startState.phase = .opening) + (notCompleted : + Not (CompletedOpen (execution.states finish) node)) : + exists finishState : NodeState, + Global.nodeState (execution.states finish) node = some finishState /\ + finishState.phase = .opening /\ + openingDistance finishState.timeoutState <= + openingDistance startState.timeoutState := by + induction finish, order using Nat.le_induction with + | base => + exact + ⟨startState, foundStart, openingStart, Nat.le_refl _⟩ + | succ finish order ih => + have notCompletedBefore : + Not (CompletedOpen (execution.states finish) node) := by + intro completed + exact notCompleted + (next_completed_monotonic + (execution.step_succ finish) node completed) + rcases ih notCompletedBefore with + ⟨beforeState, foundBefore, openingBefore, distanceBefore⟩ + rcases next_opening_progress + (reachable_well_formed + (execution_reachable execution initial finish)) + (reachable_lanes_valid + (execution_reachable execution initial finish)) + foundBefore openingBefore (execution.step_succ finish) with + completed | + ⟨afterState, foundAfter, openingAfter, distanceAfter⟩ + · contradiction + · exact + ⟨afterState, foundAfter, openingAfter, + Nat.le_trans distanceAfter distanceBefore⟩ + +lemma deliver_gossip_progress + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (payload : exists txid, envelope.payload = .gossip txid) + (phase : HasPhase before envelope.target .gossiping) + (transition : next config before (.deliver envelope) = some after) : + Not (HasPhase after envelope.target .gossiping) \/ + HasGossip after envelope.target := by + rcases phase with ⟨beforeState, foundBefore, gossiping⟩ + rcases payload with ⟨txid, payload⟩ + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + have lane := + node_property_of_nodeState lanes foundBefore + simp [eventFor, payload] at outputEq + have progress := + gossip_receive_progress config.protocol beforeState + envelope.source txid lane gossiping + rw [←outputEq] at progress + rcases progress with left | right + · exact Or.inl (by + intro stillGossiping + rcases stillGossiping with ⟨state, found, phase⟩ + rw [foundAfter] at found + injection found with stateEq + subst state + exact left phase) + · exact Or.inr ⟨output.state, foundAfter, right⟩ + +lemma timeout_gossip_progress + {config : Config} + {before after : State} + {node : Location} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (phase : HasPhase before node .gossiping) + (transition : next config before (.timeout node) = some after) : + HasPhase after node .voting := by + rcases phase with ⟨beforeState, foundBefore, gossiping⟩ + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, accepted, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + have lane := + node_property_of_nodeState lanes foundBefore + have voting := + gossip_timeout_progress config.protocol beforeState lane + gossiping (by simpa [outputEq] using accepted) + exact + ⟨output.state, foundAfter, by simpa [outputEq] using voting⟩ + +lemma vote_receive_progress + (config : Protocol.Config) + (state : NodeState) + (source : Location) + (phase : state.phase = .voting) : + let output := step config state (.receiveVote source .accepted) + output.state.phase ≠ .voting \/ output.state.votes ≠ [] := by + have nonempty := insertVote_nonempty source state.votes + simp [step, phase, rejected, advance, validTimeout, + advanceTimeoutLane] + repeat first | split | simp_all + +lemma voting_timeout_local + (config : Protocol.Config) + (state : NodeState) + (valid : LaneValid state) + (phase : state.phase = .voting) + (nonempty : state.votes ≠ []) : + let output := step config state .timeout + output.state.phase = .opening \/ + (output.state.phase = .voting /\ + output.state.timeoutState = .voting) := by + rcases valid.2.1 phase with lane | lane + · simp [step, phase, lane, rejected, advance, validTimeout, + advanceTimeoutLane, advanceTimeoutState] + repeat first | split | simp_all + · simp [step, phase, lane, nonempty, rejected, advance, validTimeout, + advanceTimeoutLane, advanceTimeoutState] + +lemma aligned_voting_timeout_opens + (config : Protocol.Config) + (state : NodeState) + (phase : state.phase = .voting) + (lane : state.timeoutState = .voting) + (nonempty : state.votes ≠ []) : + (step config state .timeout).state.phase = .opening := by + simp [step, phase, lane, nonempty, rejected, advance, validTimeout, + advanceTimeoutLane] + +lemma deliver_vote_progress + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (payload : envelope.payload = .vote) + (phase : HasPhase before envelope.target .voting) + (transition : next config before (.deliver envelope) = some after) : + Not (HasPhase after envelope.target .voting) \/ + HasVote after envelope.target := by + rcases phase with ⟨beforeState, foundBefore, voting⟩ + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + have outputEq := + systemStep_output_eq foundBefore systemStep + simp [eventFor, payload] at outputEq + have progress := + vote_receive_progress config.protocol beforeState + envelope.source voting + rw [←outputEq] at progress + rcases progress with left | right + · exact Or.inl (by + intro stillVoting + rcases stillVoting with ⟨state, found, phase⟩ + rw [foundAfter] at found + injection found with stateEq + subst state + exact left phase) + · exact Or.inr ⟨output.state, foundAfter, right⟩ + +lemma deliver_iamopen_resolves + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (openCompleted : OpenCompleted before) + (payload : envelope.payload = .iAmOpen) + (transition : next config before (.deliver envelope) = some after) : + Terminal after envelope.target \/ + HasPhase after envelope.target .opening := by + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, targetActive, system, output, systemStep, stateEq⟩ + rcases active_nodeState wellFormed targetActive with + ⟨beforeState, foundBefore⟩ + have outputEq := systemStep_output_eq foundBefore systemStep + simp [eventFor, payload] at outputEq + have outcome := + iamopen_delivery_outcome config.protocol beforeState envelope.source + rw [←outputEq] at outcome + rw [←stateEq] + rcases outcome with opening | opened | ⟨chosen, restarted⟩ + · exact Or.inr + ⟨output.state, + by + apply nodeState_eq_of_mem + · rw [recordEffects_system, + systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · rw [recordEffects_system] + exact systemStep_output_mem systemStep, + opening⟩ + · have beforeOpen := + iamopen_open_predecessor config.protocol beforeState + envelope.source (by simpa [outputEq] using opened) + have completedBefore : CompletedOpen before envelope.target := by + rw [Global.nodeState, Option.map_eq_some_iff] at foundBefore + rcases foundBefore with ⟨entry, findEq, stateEq⟩ + have keyEq : entry.1 = envelope.target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == envelope.target) findEq) + rw [←keyEq] + apply openCompleted entry (List.mem_of_find?_eq_some findEq) + simpa [stateEq] using beforeOpen + exact Or.inl (Or.inr + (mem_completed_recordEffects completedBefore)) + · exact Or.inl (Or.inl + (restart_effect_recorded restarted)) + +lemma voting_timeout_enabled + {config : Config} + {state : State} + {node : Location} + (active : node ∈ state.active) + (phase : HasPhase state node .voting) : + Enabled config state (.timeout node) := by + rcases phase with ⟨nodeState, found, voting⟩ + apply timeout_enabled_of_accepted active found + simp [step, voting, advance, rejected] + repeat first | split | simp_all + +lemma timeout_voting_step + {config : Config} + {before after : State} + {node : Location} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (phase : HasPhase before node .voting) + (vote : HasVote before node) + (transition : next config before (.timeout node) = some after) : + HasPhase after node .opening \/ + (exists nextState : NodeState, + Global.nodeState after node = some nextState /\ + nextState.phase = .voting /\ + nextState.timeoutState = .voting /\ + nextState.votes ≠ []) := by + rcases phase with ⟨beforeState, foundBefore, voting⟩ + rcases vote with ⟨voteState, foundVote, nonempty⟩ + rw [foundBefore] at foundVote + injection foundVote with stateEq + subst voteState + have lane : LaneValid beforeState := by + apply node_property_of_nodeState (predicate := LaneValid) + · exact lanes + · exact foundBefore + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + have outputEq := systemStep_output_eq foundBefore systemStep + have progress := + voting_timeout_local config.protocol beforeState lane voting nonempty + rw [←outputEq] at progress + rcases progress with opening | waiting + · exact Or.inl ⟨output.state, foundAfter, opening⟩ + · exact Or.inr + ⟨output.state, foundAfter, waiting.1, waiting.2, + by + rw [outputEq] + exact step_preserves_nonempty_votes + config.protocol beforeState .timeout nonempty⟩ + +lemma aligned_timeout_voting_opens + {config : Config} + {before after : State} + {node : Location} + {nodeState : NodeState} + (wellFormed : WellFormed config before) + (found : Global.nodeState before node = some nodeState) + (phase : nodeState.phase = .voting) + (lane : nodeState.timeoutState = .voting) + (nonempty : nodeState.votes ≠ []) + (transition : next config before (.timeout node) = some after) : + HasPhase after node .opening := by + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + have outputEq := systemStep_output_eq found systemStep + exact + ⟨output.state, foundAfter, + by + rw [outputEq] + exact aligned_voting_timeout_opens config.protocol nodeState + phase lane nonempty⟩ + +lemma fair_gossip_progress + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + {node : Location} + (active : node ∈ (execution.states start).active) + (phase : HasPhase (execution.states start) node .gossiping) : + EventuallyFrom start (fun n => + Not (HasPhase (execution.states n) node .gossiping)) := by + have reachable (n : Nat) := + execution_reachable execution initial n + have configValid := reachable_config_valid (reachable start) + have retryEnabled := + retry_gossip_enabled configValid + (reachable_well_formed (reachable start)) active phase + rcases fair.retry start node .gossiping active phase + (Or.inl rfl) retryEnabled with + ⟨retryAt, startRetry, leftGossip | retryAction⟩ + · exact ⟨retryAt, startRetry, leftGossip⟩ + · by_cases retryPhase : + HasPhase (execution.states retryAt) node .gossiping + · have retryStep : + next config (execution.states retryAt) (.retry node) = + some (execution.states (retryAt + 1)) := by + simpa [retryAction] using execution.step_succ retryAt + rcases retry_gossip_enqueued configValid + (reachable_well_formed (reachable retryAt)) + retryPhase retryStep with + ⟨envelope, pending, sourceEq, targetEq, txid, payload⟩ + rcases fair.delivery (retryAt + 1) envelope pending with + ⟨deliverAt, retryDeliver, deliverAction⟩ + by_cases deliverPhase : + HasPhase (execution.states deliverAt) node .gossiping + · have deliverStep : + next config (execution.states deliverAt) + (.deliver envelope) = + some (execution.states (deliverAt + 1)) := by + simpa [deliverAction] using execution.step_succ deliverAt + have delivered := + deliver_gossip_progress + (reachable_well_formed (reachable deliverAt)) + (reachable_lanes_valid (reachable deliverAt)) + ⟨txid, payload⟩ + (by simpa [targetEq] using deliverPhase) + deliverStep + rcases delivered with leftAfter | hasGossip + · exact + ⟨deliverAt + 1, by omega, by simpa [targetEq] using leftAfter⟩ + · by_cases afterPhase : + HasPhase (execution.states (deliverAt + 1)) node .gossiping + · have timeoutEnabled := + gossip_timeout_enabled + (config := config) + (by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution start] at active + exact active) + (reachable_lanes_valid (reachable (deliverAt + 1))) + afterPhase + (by simpa [targetEq] using hasGossip) + rcases fair.timeout (deliverAt + 1) node .gossiping + (by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution start] at active + exact active) + afterPhase (Or.inl rfl) timeoutEnabled with + ⟨timeoutAt, deliverTimeout, leftBeforeTimeout | timeoutAction⟩ + · exact ⟨timeoutAt, by omega, leftBeforeTimeout⟩ + · by_cases timeoutPhase : + HasPhase (execution.states timeoutAt) node .gossiping + · have timeoutStep : + next config (execution.states timeoutAt) + (.timeout node) = + some (execution.states (timeoutAt + 1)) := by + simpa [timeoutAction] using + execution.step_succ timeoutAt + have voting := + timeout_gossip_progress + (reachable_well_formed (reachable timeoutAt)) + (reachable_lanes_valid (reachable timeoutAt)) + timeoutPhase timeoutStep + refine ⟨timeoutAt + 1, by omega, ?_⟩ + intro impossible + have phases := hasPhase_unique voting impossible + contradiction + · exact ⟨timeoutAt, by omega, timeoutPhase⟩ + · exact ⟨deliverAt + 1, by omega, afterPhase⟩ + · exact ⟨deliverAt, by omega, deliverPhase⟩ + · exact ⟨retryAt, startRetry, retryPhase⟩ + +lemma next_gossiping_predecessor + {config : Config} + {before after : State} + {action : Action} + {node : Location} + (wellFormed : WellFormed config before) + (transition : next config before action = some after) + (afterGossip : HasPhase after node .gossiping) : + HasPhase before node .gossiping := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] at afterGossip + exact afterGossip + | deliver envelope => + by_cases target : node = envelope.target + · subst node + have details := transition + simp [next, Option.bind_eq_some_iff] at details + have targetActive := details.2.1 + rcases active_nodeState wellFormed targetActive with + ⟨beforeState, foundBefore⟩ + rcases deliver_target_state wellFormed transition with + ⟨output, foundAfter, systemStep⟩ + rcases afterGossip with ⟨afterState, found, phase⟩ + rw [foundAfter] at found + injection found with stateEq + subst afterState + have outputEq := + systemStep_output_eq foundBefore systemStep + have beforePhase : beforeState.phase = .gossiping := by + by_contra notGossip + have notAfter := + step_preserves_non_gossiping config.protocol beforeState + (eventFor envelope) notGossip + rw [←outputEq] at notAfter + exact notAfter phase + exact ⟨beforeState, foundBefore, beforePhase⟩ + · rcases afterGossip with ⟨afterState, foundAfter, phase⟩ + have unchanged := + deliver_other_node_eq target transition + rw [foundAfter] at unchanged + cases foundBefore : + Global.nodeState before node with + | none => simp [foundBefore] at unchanged + | some beforeState => + rw [foundBefore] at unchanged + injection unchanged with stateEq + subst beforeState + exact ⟨afterState, foundBefore, phase⟩ + | timeout target => + by_cases same : node = target + · subst node + have details := transition + simp [next, Option.bind_eq_some_iff] at details + have targetActive := details.1 + rcases active_nodeState wellFormed targetActive with + ⟨beforeState, foundBefore⟩ + rcases timeout_target_state wellFormed transition with + ⟨output, foundAfter, _, systemStep⟩ + rcases afterGossip with ⟨afterState, found, phase⟩ + rw [foundAfter] at found + injection found with stateEq + subst afterState + have outputEq := + systemStep_output_eq foundBefore systemStep + have beforePhase : beforeState.phase = .gossiping := by + by_contra notGossip + have notAfter := + step_preserves_non_gossiping config.protocol beforeState + .timeout notGossip + rw [←outputEq] at notAfter + exact notAfter phase + exact ⟨beforeState, foundBefore, beforePhase⟩ + · rcases afterGossip with ⟨afterState, foundAfter, phase⟩ + have unchanged := + timeout_other_node_eq same transition + rw [foundAfter] at unchanged + cases foundBefore : + Global.nodeState before node with + | none => simp [foundBefore] at unchanged + | some beforeState => + rw [foundBefore] at unchanged + injection unchanged with stateEq + subst beforeState + exact ⟨afterState, foundBefore, phase⟩ + +lemma not_gossiping_mono + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (notGossip : + Not (HasPhase (execution.states start) node .gossiping)) : + Not (HasPhase (execution.states finish) node .gossiping) := by + induction finish, order using Nat.le_induction with + | base => exact notGossip + | succ finish order notGossip => + intro gossip + exact notGossip + (next_gossiping_predecessor + (reachable_well_formed + (execution_reachable execution initial finish)) + (execution.step_succ finish) gossip) + +lemma eventually_list + {predicate : Nat -> Location -> Prop} + {start : Nat} + (nodes : List Location) + (eventual : + forall node, node ∈ nodes -> + EventuallyFrom start (fun n => predicate n node)) + (monotonic : + forall node first second, + first <= second -> + predicate first node -> + predicate second node) : + EventuallyFrom start (fun n => + forall node, node ∈ nodes -> predicate n node) := by + revert eventual + induction nodes with + | nil => + intro eventual + exact ⟨start, Nat.le_refl start, by simp⟩ + | cons head tail ih => + intro eventual + rcases eventual head (by simp) with + ⟨headAt, startHead, headHolds⟩ + rcases ih + (fun node membership => eventual node (by simp [membership])) with + ⟨tailAt, startTail, tailHolds⟩ + refine + ⟨max headAt tailAt, by omega, ?_⟩ + intro node membership + rw [List.mem_cons] at membership + rcases membership with rfl | inTail + · exact monotonic _ headAt (max headAt tailAt) + (Nat.le_max_left _ _) headHolds + · exact monotonic node tailAt (max headAt tailAt) + (Nat.le_max_right _ _) (tailHolds node inTail) + +lemma fair_all_leave_gossip + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (start : Nat) : + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + Not (HasPhase (execution.states n) node .gossiping)) := by + apply eventually_list (execution.states start).active + · intro node active + by_cases phase : + HasPhase (execution.states start) node .gossiping + · exact fair_gossip_progress execution initial fair active phase + · exact ⟨start, Nat.le_refl start, phase⟩ + · intro node first second order notGossip + exact not_gossiping_mono execution initial order notGossip + +lemma terminal_mono_step + {config : Config} + {before after : State} + {action : Action} + {node : Location} + (transition : next config before action = some after) + (terminal : Terminal before node) : + Terminal after node := by + rcases terminal with restarted | completed + · exact Or.inl (next_restarts_monotonic transition node restarted) + · exact Or.inr (next_completed_monotonic transition node completed) + +lemma terminal_mono + {config : Config} + (execution : Execution config) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (terminal : Terminal (execution.states start) node) : + Terminal (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact terminal + | succ finish order terminal => + exact terminal_mono_step (execution.step_succ finish) terminal + +lemma completed_mono + {config : Config} + (execution : Execution config) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (completed : CompletedOpen (execution.states start) node) : + CompletedOpen (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact completed + | succ finish order completed => + exact next_completed_monotonic + (execution.step_succ finish) node completed + +lemma quorumOpened_mono + {config : Config} + (execution : Execution config) + {start finish : Nat} + {node : Location} + (order : start <= finish) + (opened : QuorumOpened (execution.states start) node) : + QuorumOpened (execution.states finish) node := by + induction finish, order using Nat.le_induction with + | base => exact opened + | succ finish order opened => + rcases opened with + ⟨opening, membership, openingNode, kind⟩ + exact + ⟨opening, + next_openings_monotonic + (execution.step_succ finish) opening membership, + openingNode, + kind⟩ + +lemma fair_opening_completes + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + {node : Location} + (active : node ∈ (execution.states start).active) + (phase : HasPhase (execution.states start) node .opening) : + EventuallyFrom start (fun n => + CompletedOpen (execution.states n) node) := by + rcases phase with ⟨startState, foundStart, openingStart⟩ + have auxiliary : + forall distance start state, + openingDistance state.timeoutState = distance -> + node ∈ (execution.states start).active -> + Global.nodeState (execution.states start) node = some state -> + state.phase = .opening -> + EventuallyFrom start (fun n => + CompletedOpen (execution.states n) node) := by + intro distance + induction distance using Nat.strong_induction_on with + | h distance ih => + intro start state distanceEq active found opening + have enabled := + opening_timeout_enabled (config := config) + active ⟨state, found, opening⟩ + rcases fair.openingTimeout start node active + ⟨state, found, opening⟩ enabled with + ⟨timeoutAt, startTimeout, + completed | ⟨stillOpening, timeoutAction⟩⟩ + · exact ⟨timeoutAt, startTimeout, completed⟩ + · by_cases completedBefore : + CompletedOpen (execution.states timeoutAt) node + · exact ⟨timeoutAt, startTimeout, completedBefore⟩ + · rcases opening_progress_between execution initial startTimeout + found opening completedBefore with + ⟨timeoutState, foundTimeout, openingTimeout, + distanceTimeout⟩ + have timeoutStep : + next config (execution.states timeoutAt) + (.timeout node) = + some (execution.states (timeoutAt + 1)) := by + simpa [timeoutAction] using execution.step_succ timeoutAt + rcases timeout_opening_step + (reachable_well_formed + (execution_reachable execution initial timeoutAt)) + (reachable_lanes_valid + (execution_reachable execution initial timeoutAt)) + foundTimeout openingTimeout timeoutStep with + completedAfter | + ⟨nextState, foundNext, openingNext, distanceNext⟩ + · exact ⟨timeoutAt + 1, by omega, completedAfter⟩ + · have nextLess : openingDistance nextState.timeoutState < + distance := by + rw [←distanceEq] + exact Nat.lt_of_lt_of_le distanceNext distanceTimeout + rcases ih (openingDistance nextState.timeoutState) + nextLess (timeoutAt + 1) nextState rfl + (by + rw [execution_active_eq execution (timeoutAt + 1)] + rw [execution_active_eq execution start] at active + exact active) + foundNext openingNext with + ⟨completedAt, nextCompleted, completed⟩ + exact ⟨completedAt, by omega, completed⟩ + exact auxiliary (openingDistance startState.timeoutState) + start startState rfl active foundStart openingStart + +lemma initial_announcements_live + (config : Config) + (active : List Location) : + AnnouncementsLive (initial config active) := by + simp [AnnouncementsLive, Global.initial] + +lemma next_preserves_announcements_live + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (live : AnnouncementsLive before) + (transition : next config before action = some after) : + AnnouncementsLive after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, found, _, stateEq⟩ + have sourceLocation := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + intro envelope membership payload + rw [List.mem_append] at membership + rcases membership with old | added + · exact live envelope old payload + · have valid : envelope.Valid config := + retryMessages_valid config source sourceState sourceLocation + envelope added + have opening := retry_iamopen_state valid payload + have identity := retryMessages_source added + rw [identity.2] at opening + exact Or.inl + ⟨sourceState, + by simpa [identity.1] using found, + opening⟩ + | deliver delivered => + intro envelope membership payload + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq, recordEffects_sent] at membership + rcases live envelope membership payload with + opening | completed + · rcases opening with ⟨sourceState, found, phase⟩ + rcases next_opening_progress wellFormed lanes found phase + transition with + completed | ⟨afterState, foundAfter, phaseAfter, _⟩ + · exact Or.inr completed + · exact Or.inl ⟨afterState, foundAfter, phaseAfter⟩ + · exact Or.inr + (next_completed_monotonic transition envelope.source completed) + | timeout target => + intro envelope membership payload + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq, recordEffects_sent] at membership + rcases live envelope membership payload with + opening | completed + · rcases opening with ⟨sourceState, found, phase⟩ + rcases next_opening_progress wellFormed lanes found phase + transition with + completed | ⟨afterState, foundAfter, phaseAfter, _⟩ + · exact Or.inr completed + · exact Or.inl ⟨afterState, foundAfter, phaseAfter⟩ + · exact Or.inr + (next_completed_monotonic transition envelope.source completed) + +lemma reachable_announcements_live + {config : Config} + {state : State} + (reachable : Reachable config state) : + AnnouncementsLive state := by + induction reachable with + | initial active valid nodup configured => + exact initial_announcements_live config active + | step reachable transition live => + exact next_preserves_announcements_live + (reachable_well_formed reachable) + (reachable_lanes_valid reachable) + live transition + +lemma initial_announcements_resolved + (config : Config) + (active : List Location) : + AnnouncementsResolved (initial config active) := by + simp [AnnouncementsResolved, Global.initial] + +lemma next_preserves_announcements_resolved + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (lanes : NodeLanesValid before) + (openCompleted : OpenCompleted before) + (resolved : AnnouncementsResolved before) + (transition : next config before action = some after) : + AnnouncementsResolved after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + intro envelope membership payload + rw [List.mem_append] at membership + rcases membership with old | added + · rcases resolved envelope old payload with + pending | terminal | opening + · exact Or.inl (List.mem_append_left _ pending) + · exact Or.inr (Or.inl terminal) + · exact Or.inr (Or.inr opening) + · exact Or.inl (List.mem_append_right _ added) + | deliver delivered => + intro envelope membership payload + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq, recordEffects_sent] at membership + rcases resolved envelope membership payload with + pending | terminal | opening + · rcases mem_removeOne_or_eq pending with remains | equal + · exact Or.inl (by + rw [←stateEq, recordEffects_network] + exact remains) + · subst envelope + rcases deliver_iamopen_resolves wellFormed openCompleted payload + transition with + terminal | opening + · exact Or.inr (Or.inl terminal) + · exact Or.inr (Or.inr opening) + · exact Or.inr (Or.inl + (terminal_mono_step transition terminal)) + · rcases opening with ⟨sourceState, found, phase⟩ + rcases next_opening_progress wellFormed lanes found phase + transition with + completed | ⟨afterState, foundAfter, phaseAfter, _⟩ + · exact Or.inr (Or.inl (Or.inr completed)) + · exact Or.inr (Or.inr + ⟨afterState, foundAfter, phaseAfter⟩) + | timeout target => + intro envelope membership payload + have details := transition + simp [next, Option.bind_eq_some_iff] at details + rcases details with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq, recordEffects_sent] at membership + rcases resolved envelope membership payload with + pending | terminal | opening + · exact Or.inl (by + rw [←stateEq, recordEffects_network] + exact pending) + · exact Or.inr (Or.inl + (terminal_mono_step transition terminal)) + · rcases opening with ⟨sourceState, found, phase⟩ + rcases next_opening_progress wellFormed lanes found phase + transition with + completed | ⟨afterState, foundAfter, phaseAfter, _⟩ + · exact Or.inr (Or.inl (Or.inr completed)) + · exact Or.inr (Or.inr + ⟨afterState, foundAfter, phaseAfter⟩) + +lemma systemStep_preserves_joining_announcements + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {beforeState afterState : State} + (beforeSystem : beforeState.system = before) + (valid : JoiningAnnouncements beforeState) + (carry : + forall destination, + SentAnnouncementTo beforeState destination -> + SentAnnouncementTo afterState destination) + (introduced : + (exists source, acceptedIAmOpenSource event = some source) -> + SentAnnouncementTo afterState target) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.phase = .joining -> + SentAnnouncementTo afterState entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership joining + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + rcases step_joining_origin config node event + (by simpa [atTarget, outputEq] using joining) with + old | received + · have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + rw [←keyEq] + apply carry + apply valid (key, node) + · rw [beforeSystem] + exact List.mem_of_find?_eq_some found + · exact old + · exact introduced received + · rename_i notTarget + apply carry + apply valid previous + · rw [beforeSystem] + exact previousMember + · simpa [notTarget] using joining + +lemma initial_joining_announcements + (config : Config) + (active : List Location) : + JoiningAnnouncements (initial config active) := by + simp [JoiningAnnouncements, Global.initial, initialSystem, initialNode] + +lemma next_preserves_joining_announcements + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (valid : JoiningAnnouncements before) + (transition : next config before action = some after) : + JoiningAnnouncements after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + intro entry membership joining + rcases valid entry membership joining with + ⟨envelope, sent, target, payload⟩ + exact + ⟨envelope, List.mem_append_left _ sent, target, payload⟩ + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨inNetwork, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro entry membership joining + rw [recordEffects_system] at membership + let afterState := + recordEffects envelope.target output.state output.effects + { + before with + system + network := removeOne envelope before.network + } + have carry : + forall destination, + SentAnnouncementTo before destination -> + SentAnnouncementTo afterState destination := by + intro destination announcement + rcases announcement with + ⟨sentEnvelope, sent, target, payload⟩ + exact + ⟨sentEnvelope, by simpa [afterState] using sent, + target, payload⟩ + have introduced : + (exists source, + acceptedIAmOpenSource (eventFor envelope) = some source) -> + SentAnnouncementTo afterState envelope.target := by + rintro ⟨source, accepted⟩ + rcases eventFor_iamopen_source accepted with + ⟨payload, _⟩ + exact + ⟨envelope, + by + simp [afterState] + exact wellFormed.networkSent envelope inNetwork, + rfl, payload⟩ + exact systemStep_preserves_joining_announcements + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl valid carry introduced systemStep + entry membership joining + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro entry membership joining + rw [recordEffects_system] at membership + let afterState := + recordEffects target output.state output.effects + { before with system } + have carry : + forall destination, + SentAnnouncementTo before destination -> + SentAnnouncementTo afterState destination := by + intro destination announcement + rcases announcement with + ⟨sentEnvelope, sent, target, payload⟩ + exact + ⟨sentEnvelope, by simpa [afterState] using sent, + target, payload⟩ + have introduced : + (exists source, + acceptedIAmOpenSource Event.timeout = some source) -> + SentAnnouncementTo afterState target := by + rintro ⟨source, accepted⟩ + simp [acceptedIAmOpenSource] at accepted + exact systemStep_preserves_joining_announcements + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl valid carry introduced systemStep + entry membership joining + +lemma reachable_joining_announcements + {config : Config} + {state : State} + (reachable : Reachable config state) : + JoiningAnnouncements state := by + induction reachable with + | initial active valid nodup configured => + exact initial_joining_announcements config active + | step reachable transition valid => + exact next_preserves_joining_announcements + (reachable_well_formed reachable) valid transition + +lemma systemStep_preserves_open_completed + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {beforeState afterState : State} + (beforeSystem : beforeState.system = before) + (valid : OpenCompleted beforeState) + (carry : + forall node, + CompletedOpen beforeState node -> + CompletedOpen afterState node) + (introduced : + .completed ∈ output.effects -> + CompletedOpen afterState target) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.phase = .open -> + CompletedOpen afterState entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership opened + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + rcases step_open_origin config node event + (by simpa [atTarget, outputEq] using opened) with + old | completed + · have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + rw [←keyEq] + apply carry + apply valid (key, node) + · rw [beforeSystem] + exact List.mem_of_find?_eq_some found + · exact old + · rw [outputEq] at completed + exact introduced completed + · rename_i notTarget + apply carry + apply valid previous + · rw [beforeSystem] + exact previousMember + · simpa [notTarget] using opened + +lemma initial_open_completed + (config : Config) + (active : List Location) : + OpenCompleted (initial config active) := by + simp [OpenCompleted, Global.initial, initialSystem, initialNode] + +lemma next_preserves_open_completed + {config : Config} + {before after : State} + {action : Action} + (valid : OpenCompleted before) + (transition : next config before action = some after) : + OpenCompleted after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact valid + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro entry membership opened + rw [recordEffects_system] at membership + let afterState := + recordEffects envelope.target output.state output.effects + { + before with + system + network := removeOne envelope before.network + } + have carry : + forall node, + CompletedOpen before node -> + CompletedOpen afterState node := by + intro node completed + apply mem_completed_recordEffects + exact completed + have introduced : + .completed ∈ output.effects -> + CompletedOpen afterState envelope.target := by + intro completed + exact completed_effect_recorded completed + exact systemStep_preserves_open_completed + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl valid carry introduced systemStep entry membership opened + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro entry membership opened + rw [recordEffects_system] at membership + let afterState := + recordEffects target output.state output.effects + { before with system } + have carry : + forall node, + CompletedOpen before node -> + CompletedOpen afterState node := by + intro node completed + apply mem_completed_recordEffects + exact completed + have introduced : + .completed ∈ output.effects -> + CompletedOpen afterState target := by + intro completed + exact completed_effect_recorded completed + exact systemStep_preserves_open_completed + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl valid carry introduced systemStep entry membership opened + +lemma reachable_open_completed + {config : Config} + {state : State} + (reachable : Reachable config state) : + OpenCompleted state := by + induction reachable with + | initial active valid nodup configured => + exact initial_open_completed config active + | step reachable transition valid => + exact next_preserves_open_completed valid transition + +lemma reachable_announcements_resolved + {config : Config} + {state : State} + (reachable : Reachable config state) : + AnnouncementsResolved state := by + induction reachable with + | initial active valid nodup configured => + exact initial_announcements_resolved config active + | step reachable transition resolved => + exact next_preserves_announcements_resolved + (reachable_well_formed reachable) + (reachable_lanes_valid reachable) + (reachable_open_completed reachable) + resolved transition + +lemma open_node_completed + {state : State} + {node : Location} + {nodeState : NodeState} + (valid : OpenCompleted state) + (found : Global.nodeState state node = some nodeState) + (opened : nodeState.phase = .open) : + CompletedOpen state node := by + rw [Global.nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have keyEq : entry.1 = node := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq) + rw [←keyEq] + apply valid entry (List.mem_of_find?_eq_some findEq) + simpa [stateEq] using opened + +lemma joining_node_announcement + {state : State} + {node : Location} + {nodeState : NodeState} + (valid : JoiningAnnouncements state) + (found : Global.nodeState state node = some nodeState) + (joining : nodeState.phase = .joining) : + SentAnnouncementTo state node := by + rw [Global.nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have keyEq : entry.1 = node := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq) + rw [←keyEq] + apply valid entry (List.mem_of_find?_eq_some findEq) + simpa [stateEq] using joining + +lemma openerWitness_of_later_phase + {config : Config} + {state : State} + {node : Location} + (reachable : Reachable config state) + (active : node ∈ state.active) + (notGossip : Not (HasPhase state node .gossiping)) + (notVoting : Not (HasPhase state node .voting)) : + OpenerWitness state := by + rcases active_nodeState (reachable_well_formed reachable) active with + ⟨nodeState, found⟩ + cases phase : nodeState.phase with + | gossiping => + exact False.elim + (notGossip ⟨nodeState, found, phase⟩) + | voting => + exact False.elim + (notVoting ⟨nodeState, found, phase⟩) + | opening => + exact ⟨node, Or.inl ⟨nodeState, found, phase⟩⟩ + | joining => + rcases joining_node_announcement + (reachable_joining_announcements reachable) + found phase with + ⟨envelope, sent, target, payload⟩ + rcases reachable_announcements_live reachable + envelope sent payload with + opening | completed + · exact ⟨envelope.source, Or.inl opening⟩ + · exact ⟨envelope.source, Or.inr completed⟩ + | «open» => + exact + ⟨node, Or.inr + (open_node_completed + (reachable_open_completed reachable) found phase)⟩ + +lemma openerWitness_after_leave_voting + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + {start later : Nat} + {node : Location} + (order : start <= later) + (allPastGossip : + forall activeNode, + activeNode ∈ (execution.states start).active -> + Not (HasPhase (execution.states start) + activeNode .gossiping)) + (active : node ∈ (execution.states later).active) + (notVoting : + Not (HasPhase (execution.states later) node .voting)) : + OpenerWitness (execution.states later) := by + have activeStart : node ∈ (execution.states start).active := by + rw [execution_active_eq execution later] at active + rw [execution_active_eq execution start] + exact active + have notGossip := + not_gossiping_mono execution initial order + (allPastGossip node activeStart) + exact openerWitness_of_later_phase + (execution_reachable execution initial later) + active notGossip notVoting + +lemma systemStep_preserves_advanced_active + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {active : List Location} + (valid : + forall entry, entry ∈ before.nodes -> + entry.2.phase ≠ .gossiping -> + entry.1 ∈ active) + (targetActive : target ∈ active) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.phase ≠ .gossiping -> + entry.1 ∈ active := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership advanced + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · exact targetActive + · rename_i notTarget + exact valid previous previousMember + (by simpa [notTarget] using advanced) + +lemma initial_advanced_active + (config : Config) + (active : List Location) : + AdvancedNodesActive (initial config active) := by + simp [AdvancedNodesActive, Global.initial, initialSystem, initialNode] + +lemma next_preserves_advanced_active + {config : Config} + {before after : State} + {action : Action} + (valid : AdvancedNodesActive before) + (transition : next config before action = some after) : + AdvancedNodesActive after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + exact valid + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, targetActive, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro entry membership advanced + rw [recordEffects_system] at membership + simpa using + systemStep_preserves_advanced_active + valid targetActive systemStep entry membership advanced + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨targetActive, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro entry membership advanced + rw [recordEffects_system] at membership + simpa using + systemStep_preserves_advanced_active + valid targetActive systemStep entry membership advanced + +lemma reachable_advanced_active + {config : Config} + {state : State} + (reachable : Reachable config state) : + AdvancedNodesActive state := by + induction reachable with + | initial active valid nodup configured => + exact initial_advanced_active config active + | step reachable transition valid => + exact next_preserves_advanced_active valid transition + +lemma hasPhase_active + {config : Config} + {state : State} + {node : Location} + {phase : Phase} + (reachable : Reachable config state) + (hasPhase : HasPhase state node phase) + (advancedPhase : phase ≠ .gossiping) : + node ∈ state.active := by + rcases hasPhase with ⟨nodeState, found, phaseEq⟩ + rw [Global.nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have keyEq : entry.1 = node := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq) + rw [←keyEq] + apply reachable_advanced_active reachable entry + (List.mem_of_find?_eq_some findEq) + rw [stateEq, phaseEq] + exact advancedPhase + +lemma fair_opener_witness + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + (activeNonempty : (execution.states start).active ≠ []) + (allPastGossip : + forall node, node ∈ (execution.states start).active -> + Not (HasPhase (execution.states start) node .gossiping)) : + EventuallyFrom start (fun n => + OpenerWitness (execution.states n)) := by + obtain ⟨voter, voterActive⟩ := + List.exists_mem_of_ne_nil _ activeNonempty + by_cases voting : + HasPhase (execution.states start) voter .voting + · rcases voting with ⟨voterState, foundVoter, voterVoting⟩ + have selectionProperty := + node_property_of_nodeState + (predicate := fun state => + state.phase = .voting -> NodeVotingSelection state) + (reachable_quorum_invariant + (execution_reachable execution initial start)).votingSelections + foundVoter + rcases selectionProperty voterVoting with + ⟨target, txid, chosen, maximum⟩ + have retryEnabled := + retry_voting_enabled (config := config) + voterActive foundVoter voterVoting chosen + rcases fair.retry start voter .voting voterActive + ⟨voterState, foundVoter, voterVoting⟩ + (Or.inr (Or.inl rfl)) retryEnabled with + ⟨retryAt, startRetry, leftVoting | retryAction⟩ + · exact + ⟨retryAt, startRetry, + openerWitness_after_leave_voting execution initial + startRetry allPastGossip + (by + rw [execution_active_eq execution retryAt] + rw [execution_active_eq execution start] at voterActive + exact voterActive) + leftVoting⟩ + · by_cases retryVoting : + HasPhase (execution.states retryAt) voter .voting + · rcases retryVoting with + ⟨retryState, foundRetry, votingRetry⟩ + have retrySelectionProperty := + node_property_of_nodeState + (predicate := fun state => + state.phase = .voting -> NodeVotingSelection state) + (reachable_quorum_invariant + (execution_reachable execution initial retryAt)).votingSelections + foundRetry + rcases retrySelectionProperty votingRetry with + ⟨retryTarget, retryTxID, retryChosen, retryMaximum⟩ + have retryStep : + next config (execution.states retryAt) (.retry voter) = + some (execution.states (retryAt + 1)) := by + simpa [retryAction] using execution.step_succ retryAt + rcases retry_vote_enqueued foundRetry votingRetry retryChosen + retryStep with + ⟨voteEnvelope, pending, voteSource, voteTarget, votePayload⟩ + rcases fair.delivery (retryAt + 1) voteEnvelope pending with + ⟨deliverAt, retryDeliver, deliverAction⟩ + have deliverStep : + next config (execution.states deliverAt) + (.deliver voteEnvelope) = + some (execution.states (deliverAt + 1)) := by + simpa [deliverAction] using execution.step_succ deliverAt + have deliverDetails := deliverStep + simp [next, Option.bind_eq_some_iff] at deliverDetails + have targetActive : voteEnvelope.target ∈ + (execution.states deliverAt).active := + deliverDetails.2.1 + by_cases targetVoting : + HasPhase (execution.states deliverAt) + voteEnvelope.target .voting + · rcases deliver_vote_progress + (reachable_well_formed + (execution_reachable execution initial deliverAt)) + votePayload targetVoting deliverStep with + leftAfter | hasVote + · have activeAfter : voteEnvelope.target ∈ + (execution.states (deliverAt + 1)).active := by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution deliverAt] at targetActive + exact targetActive + exact + ⟨deliverAt + 1, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip activeAfter leftAfter⟩ + · by_cases votingAfter : + HasPhase (execution.states (deliverAt + 1)) + voteEnvelope.target .voting + · have activeAfter : voteEnvelope.target ∈ + (execution.states (deliverAt + 1)).active := by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution deliverAt] at targetActive + exact targetActive + have timeoutEnabled := + voting_timeout_enabled (config := config) + activeAfter votingAfter + rcases fair.timeout (deliverAt + 1) + voteEnvelope.target .voting activeAfter votingAfter + (Or.inr (Or.inl rfl)) timeoutEnabled with + ⟨timeoutAt, deliverTimeout, + leftBeforeTimeout | timeoutAction⟩ + · exact + ⟨timeoutAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution timeoutAt] + rw [execution_active_eq execution + (deliverAt + 1)] at activeAfter + exact activeAfter) + leftBeforeTimeout⟩ + · by_cases votingAtTimeout : + HasPhase (execution.states timeoutAt) + voteEnvelope.target .voting + · have voteAtTimeout := + hasVote_mono execution initial deliverTimeout hasVote + have timeoutStep : + next config (execution.states timeoutAt) + (.timeout voteEnvelope.target) = + some (execution.states (timeoutAt + 1)) := by + simpa [timeoutAction] using + execution.step_succ timeoutAt + rcases timeout_voting_step + (reachable_well_formed + (execution_reachable execution initial timeoutAt)) + (reachable_lanes_valid + (execution_reachable execution initial timeoutAt)) + votingAtTimeout voteAtTimeout timeoutStep with + opened | + ⟨waitingState, foundWaiting, waitingPhase, + waitingLane, waitingVotes⟩ + · exact + ⟨timeoutAt + 1, by omega, + ⟨voteEnvelope.target, Or.inl opened⟩⟩ + · have activeWaiting : voteEnvelope.target ∈ + (execution.states (timeoutAt + 1)).active := by + rw [execution_active_eq execution (timeoutAt + 1)] + rw [execution_active_eq execution + (deliverAt + 1)] at activeAfter + exact activeAfter + have secondEnabled := + voting_timeout_enabled (config := config) + activeWaiting + ⟨waitingState, foundWaiting, waitingPhase⟩ + rcases fair.timeout (timeoutAt + 1) + voteEnvelope.target .voting activeWaiting + ⟨waitingState, foundWaiting, waitingPhase⟩ + (Or.inr (Or.inl rfl)) secondEnabled with + ⟨secondAt, firstSecond, + leftBeforeSecond | secondAction⟩ + · exact + ⟨secondAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution secondAt] + rw [execution_active_eq execution + (timeoutAt + 1)] at activeWaiting + exact activeWaiting) + leftBeforeSecond⟩ + · by_cases votingAtSecond : + HasPhase (execution.states secondAt) + voteEnvelope.target .voting + · rcases votingAtSecond with + ⟨secondState, foundSecond, secondPhase⟩ + have votesSecond := + hasVote_mono execution initial firstSecond + ⟨waitingState, foundWaiting, waitingVotes⟩ + rcases votesSecond with + ⟨voteState, foundVotes, secondVotes⟩ + rw [foundSecond] at foundVotes + injection foundVotes with voteStateEq + subst voteState + have advancedSecond := + advanced_lane_mono execution initial firstSecond + ⟨waitingState, foundWaiting, by simp [waitingLane]⟩ + rcases advancedSecond with + ⟨laneState, foundLane, advanced⟩ + rw [foundSecond] at foundLane + injection foundLane with laneStateEq + subst laneState + have laneValid : LaneValid secondState := by + apply node_property_of_nodeState + (predicate := LaneValid) + · exact reachable_lanes_valid + (execution_reachable execution initial secondAt) + · exact foundSecond + have secondLane : secondState.timeoutState = + .voting := by + rcases laneValid.2.1 secondPhase with + gossipLane | votingLane + · contradiction + · exact votingLane + have secondStep : + next config (execution.states secondAt) + (.timeout voteEnvelope.target) = + some (execution.states (secondAt + 1)) := by + simpa [secondAction] using + execution.step_succ secondAt + have opened := + aligned_timeout_voting_opens + (reachable_well_formed + (execution_reachable execution initial secondAt)) + foundSecond secondPhase secondLane secondVotes + secondStep + exact + ⟨secondAt + 1, by omega, + ⟨voteEnvelope.target, Or.inl opened⟩⟩ + · exact + ⟨secondAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution secondAt] + rw [execution_active_eq execution + (timeoutAt + 1)] at activeWaiting + exact activeWaiting) + votingAtSecond⟩ + · exact + ⟨timeoutAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution timeoutAt] + rw [execution_active_eq execution + (deliverAt + 1)] at activeAfter + exact activeAfter) + votingAtTimeout⟩ + · exact + ⟨deliverAt + 1, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip + (by + rw [execution_active_eq execution (deliverAt + 1)] + rw [execution_active_eq execution deliverAt] + at targetActive + exact targetActive) + votingAfter⟩ + · exact + ⟨deliverAt, by omega, + openerWitness_after_leave_voting execution initial + (by omega) allPastGossip targetActive targetVoting⟩ + · exact + ⟨retryAt, startRetry, + openerWitness_after_leave_voting execution initial + startRetry allPastGossip + (by + rw [execution_active_eq execution retryAt] + rw [execution_active_eq execution start] at voterActive + exact voterActive) + retryVoting⟩ + · exact + ⟨start, Nat.le_refl start, + openerWitness_after_leave_voting execution initial + (Nat.le_refl start) allPastGossip voterActive voting⟩ + +lemma openerWitness_eventually_completes + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + (witness : OpenerWitness (execution.states start)) : + EventuallyFrom start (fun n => + exists node, CompletedOpen (execution.states n) node) := by + rcases witness with ⟨node, opening | completed⟩ + · have active := + hasPhase_active (execution_reachable execution initial start) + opening (by simp) + rcases fair_opening_completes execution initial fair active opening with + ⟨completedAt, order, completed⟩ + exact ⟨completedAt, order, node, completed⟩ + · exact ⟨start, Nat.le_refl start, node, completed⟩ + +lemma fair_some_opener_completes + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (activeNonempty : (execution.states 0).active ≠ []) : + EventuallyFrom 0 (fun n => + exists node, CompletedOpen (execution.states n) node) := by + rcases fair_all_leave_gossip execution initial fair 0 with + ⟨pastGossipAt, _, allPastGossip⟩ + have nonemptyAt : + (execution.states pastGossipAt).active ≠ [] := by + rw [execution_active_eq execution pastGossipAt] + exact activeNonempty + have allPastAt : + forall node, node ∈ (execution.states pastGossipAt).active -> + Not (HasPhase (execution.states pastGossipAt) + node .gossiping) := by + intro node active + rw [execution_active_eq execution pastGossipAt] at active + exact allPastGossip node active + rcases fair_opener_witness execution initial fair nonemptyAt + allPastAt with + ⟨witnessAt, pastWitness, witness⟩ + rcases openerWitness_eventually_completes execution initial fair + witness with + ⟨completedAt, witnessCompleted, completed⟩ + exact ⟨completedAt, by omega, completed⟩ + +lemma fair_target_terminal_after_completion + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener target : Location} + (completed : CompletedOpen (execution.states start) opener) + (active : target ∈ (execution.states start).active) : + EventuallyFrom start (fun n => + Terminal (execution.states n) target) := by + by_cases same : target = opener + · subst target + exact ⟨start, Nat.le_refl start, Or.inr completed⟩ + · rcases broadcast start opener completed target active same with + ⟨envelope, sent, sourceEq, targetEq, payload⟩ + rcases reachable_announcements_resolved + (execution_reachable execution initial start) + envelope sent payload with + pending | terminal | opening + · rcases fair.delivery start envelope pending with + ⟨deliverAt, startDelivery, deliverAction⟩ + have deliverStep : + next config (execution.states deliverAt) (.deliver envelope) = + some (execution.states (deliverAt + 1)) := by + simpa [deliverAction] using execution.step_succ deliverAt + rcases deliver_iamopen_resolves + (reachable_well_formed + (execution_reachable execution initial deliverAt)) + (reachable_open_completed + (execution_reachable execution initial deliverAt)) + payload deliverStep with + terminal | targetOpening + · exact + ⟨deliverAt + 1, by omega, by simpa [targetEq] using terminal⟩ + · have openingActive := + hasPhase_active + (execution_reachable execution initial (deliverAt + 1)) + targetOpening (by simp) + rcases fair_opening_completes execution initial fair + openingActive targetOpening with + ⟨completedAt, deliveryCompleted, targetCompleted⟩ + exact + ⟨completedAt, by omega, + by simpa [targetEq] using (Or.inr targetCompleted)⟩ + · exact + ⟨start, Nat.le_refl start, by simpa [targetEq] using terminal⟩ + · have openingActive := + hasPhase_active + (execution_reachable execution initial start) + opening (by simp) + rcases fair_opening_completes execution initial fair + openingActive opening with + ⟨completedAt, startCompleted, targetCompleted⟩ + exact + ⟨completedAt, startCompleted, + by simpa [targetEq] using (Or.inr targetCompleted)⟩ + +lemma fair_all_terminal_after_completion + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener : Location} + (completed : CompletedOpen (execution.states start) opener) : + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + Terminal (execution.states n) node) := by + apply eventually_list (execution.states start).active + · intro node active + exact fair_target_terminal_after_completion + execution initial fair broadcast completed active + · intro node first second order terminal + exact terminal_mono execution order terminal + +lemma global_progress + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + (activeNonempty : (execution.states 0).active ≠ []) : + EventuallyFrom 0 (fun n => + exists node, CompletedOpen (execution.states n) node) /\ + EventuallyFrom 0 (fun n => + forall node, node ∈ (execution.states 0).active -> + Terminal (execution.states n) node) := by + have completed := + fair_some_opener_completes execution initial fair activeNonempty + constructor + · exact completed + · rcases completed with + ⟨completedAt, _, opener, openerCompleted⟩ + rcases fair_all_terminal_after_completion execution initial fair + broadcast openerCompleted with + ⟨terminalAt, completedTerminal, allTerminal⟩ + refine ⟨terminalAt, by omega, ?_⟩ + intro node active + apply allTerminal node + rw [execution_active_eq execution completedAt] + exact active + +lemma single_completion_path_joins_others + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener : Location} + (completed : CompletedOpen (execution.states start) opener) + (onlyOpener : OnlyOpenerCompletesFrom execution start opener) : + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + node = opener \/ node ∈ (execution.states n).restarts) := by + apply eventually_list (execution.states start).active + · intro node active + by_cases same : node = opener + · exact ⟨start, Nat.le_refl start, Or.inl same⟩ + · rcases fair_target_terminal_after_completion + execution initial fair broadcast completed active with + ⟨terminalAt, startTerminal, terminal⟩ + rcases terminal with restarted | targetCompleted + · exact ⟨terminalAt, startTerminal, Or.inr restarted⟩ + · exact False.elim + (same + (onlyOpener terminalAt node startTerminal targetCompleted)) + · intro node first second order joined + rcases joined with same | restarted + · exact Or.inl same + · exact Or.inr + (by + induction second, order using Nat.le_induction with + | base => exact restarted + | succ second order restarted => + exact next_restarts_monotonic + (execution.step_succ second) node restarted) + +lemma quorum_path_progress + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener : Location} + (opened : QuorumOpened (execution.states start) opener) + (completed : CompletedOpen (execution.states start) opener) + (quorumOnly : QuorumOnlyCompletions execution) : + QuorumOpened (execution.states start) opener /\ + CompletedOpen (execution.states start) opener /\ + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + node = opener \/ node ∈ (execution.states n).restarts) := by + have onlyOpener : + OnlyOpenerCompletesFrom execution start opener := by + intro n node startN nodeCompleted + exact quorum_opener_unique + (execution_reachable execution initial n) + (quorumOnly n node nodeCompleted) + (quorumOpened_mono execution startN opened) + exact + ⟨opened, completed, + single_completion_path_joins_others + execution initial fair broadcast completed onlyOpener⟩ + +end DisasterRecovery.Protocol.Global diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Invariants.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Invariants.lean new file mode 100644 index 000000000000..9be993296dcc --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Invariants.lean @@ -0,0 +1,870 @@ +import DisasterRecovery.Protocol.Invariants +import Mathlib.Tactic + +/-! +Machine-checked proof implementations. Review the system-level statements in +`DisasterRecovery.Properties` and definitions in `DisasterRecovery.Protocol.Invariants`. +-/ + +namespace DisasterRecovery.Protocol.Global + +lemma messageForEffect_source + {config : Config} + {source : Location} + {sourceState : NodeState} + {effect : Effect} + {envelope : Envelope} + (created : + messageForEffect config source sourceState effect = some envelope) : + envelope.source = source /\ + envelope.sourceState = sourceState := by + cases effect with + | sendGossip target => + cases found : recoveredTxID config source with + | none => + simp [messageForEffect, found] at created + | some txid => + simp [messageForEffect, found] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | sendVote target => + simp [messageForEffect] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] + exact ⟨rfl, rfl⟩ + | opening kind => + simp_all [messageForEffect] + | restart chosen => + simp_all [messageForEffect] + | completed => + simp_all [messageForEffect] + | rejected reason => + simp_all [messageForEffect] + +lemma retryMessages_source + {config : Config} + {source : Location} + {sourceState : NodeState} + {envelope : Envelope} + (created : + envelope ∈ retryMessages config source sourceState) : + envelope.source = source /\ + envelope.sourceState = sourceState := by + rw [retryMessages, List.mem_filterMap] at created + rcases created with ⟨effect, _, produced⟩ + exact messageForEffect_source produced + +lemma retryMessages_valid + (config : Config) + (source : Location) + (sourceState : NodeState) + (sourceLocation : sourceState.location = source) : + forall envelope, + envelope ∈ retryMessages config source sourceState -> + envelope.Valid config := by + intro envelope created + rcases retryMessages_source created with + ⟨sourceEq, stateEq⟩ + constructor + · rw [stateEq, sourceEq] + exact sourceLocation + · rw [sourceEq, stateEq] + exact created + +lemma valid_envelope_effect + {config : Config} + {envelope : Envelope} + (valid : envelope.Valid config) : + exists effect, + effect ∈ + (step config.protocol envelope.sourceState .retry).effects /\ + messageForEffect config envelope.source + envelope.sourceState effect = some envelope := by + rcases valid with ⟨_, created⟩ + rw [retryMessages, List.mem_filterMap] at created + exact created + +lemma valid_gossip_uses_recovered_txid + {config : Config} + {envelope : Envelope} + {txid : TxID} + (valid : envelope.Valid config) + (gossip : envelope.payload = .gossip txid) : + recoveredTxID config envelope.source = some txid := by + rcases valid_envelope_effect valid with + ⟨effect, _, created⟩ + cases effect with + | sendGossip target => + cases found : recoveredTxID config envelope.source with + | none => + simp [messageForEffect, found] at created + | some recovered => + simp [messageForEffect, found] at created + rw [←created] at gossip + injection gossip with same + subst recovered + rfl + | sendVote target => + simp [messageForEffect] at created + rw [←created] at gossip + contradiction + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] at gossip + contradiction + | opening kind => + simp [messageForEffect] at created + | restart chosen => + simp [messageForEffect] at created + | completed => + simp [messageForEffect] at created + | rejected reason => + simp [messageForEffect] at created + +lemma step_preserves_location + (config : Protocol.Config) + (state : NodeState) + (event : Event) : + (step config state event).state.location = state.location := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] + all_goals repeat first | split | simp_all + +lemma nodeState_location + {state : State} + {node : Location} + {foundState : NodeState} + (locations : + forall entry, entry ∈ state.system.nodes -> + entry.2.location = entry.1) + (found : nodeState state node = some foundState) : + foundState.location = node := by + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have membership : entry ∈ state.system.nodes := + List.mem_of_find?_eq_some findEq + have condition : (entry.1 == node) = true := + List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == node) findEq + have keyEq : entry.1 = node := beq_iff_eq.mp condition + rw [←stateEq, locations entry membership, keyEq] + +lemma initial_well_formed + (config : Config) + (active : List Location) + (valid : config.Valid) + (activeNodup : active.Nodup) + (activeConfigured : + forall node, node ∈ active -> + node ∈ config.protocol.expectedLocations) : + WellFormed config (initial config active) := by + constructor + · simp [Global.initial, initialSystem, Function.comp_def] + · simpa [Global.initial, initialSystem, Function.comp_def] using valid.2.1 + · simp [Global.initial, initialSystem, initialNode] + · exact activeNodup + · exact activeConfigured + · simp [Global.initial] + · simp [Global.initial] + · simp [Global.initial] + · constructor <;> simp [Global.initial] + +@[simp] +lemma recordEffects_active + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).active = state.active := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).active = + state.active + rw [ih] + cases effect <;> rfl + +@[simp] +lemma recordEffects_system + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).system = state.system := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).system = + state.system + rw [ih] + cases effect <;> rfl + +@[simp] +lemma recordEffects_network + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).network = state.network := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).network = + state.network + rw [ih] + cases effect <;> rfl + +@[simp] +lemma recordEffects_sent + (node : Location) + (nodeState : NodeState) + (effects : List Effect) + (state : State) : + (recordEffects node nodeState effects state).sent = state.sent := by + induction effects generalizing state with + | nil => rfl + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + change + (recordEffects node nodeState tail + (recordEffect node nodeState state effect)).sent = + state.sent + rw [ih] + cases effect <;> rfl + +lemma recordEffect_preserves_histories_active + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + (wellFormed : HistoriesActive state) + (nodeActive : node ∈ state.active) : + HistoriesActive (recordEffect node nodeState state effect) := by + rcases wellFormed with ⟨openings, restarts, completed⟩ + cases effect <;> + constructor <;> + simp_all [recordEffect] + +lemma recordEffects_preserves_histories_active + {node : Location} + {nodeState : NodeState} + {effects : List Effect} + {state : State} + (wellFormed : HistoriesActive state) + (nodeActive : node ∈ state.active) : + HistoriesActive (recordEffects node nodeState effects state) := by + induction effects generalizing state with + | nil => exact wellFormed + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + apply ih + · exact recordEffect_preserves_histories_active wellFormed nodeActive + · cases effect <;> simpa [recordEffect] using nodeActive + +lemma mem_of_mem_removeOne + [BEq α] + (value member : α) + (values : List α) : + member ∈ removeOne value values -> + member ∈ values := by + induction values with + | nil => simp [removeOne] + | cons head tail ih => + simp only [removeOne] + split + · exact List.mem_cons_of_mem head + · intro membership + rw [List.mem_cons] at membership ⊢ + exact membership.imp_right ih + +lemma mem_openings_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {opening : Opening} + (membership : opening ∈ state.openings) : + opening ∈ (recordEffect node nodeState state effect).openings := by + cases effect <;> simp_all [recordEffect] + +lemma mem_restarts_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {restart : Location} + (membership : restart ∈ state.restarts) : + restart ∈ (recordEffect node nodeState state effect).restarts := by + cases effect <;> simp_all [recordEffect] + +lemma mem_completed_recordEffect + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + {completed : Location} + (membership : completed ∈ state.completed) : + completed ∈ (recordEffect node nodeState state effect).completed := by + cases effect <;> simp_all [recordEffect] + +lemma mem_openings_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {opening : Opening} + (membership : opening ∈ state.openings) : + opening ∈ (recordEffects node nodeState effects state).openings := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_openings_recordEffect membership) + +lemma mem_restarts_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {restart : Location} + (membership : restart ∈ state.restarts) : + restart ∈ (recordEffects node nodeState effects state).restarts := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_restarts_recordEffect membership) + +lemma mem_completed_recordEffects + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + {completed : Location} + (membership : completed ∈ state.completed) : + completed ∈ (recordEffects node nodeState effects state).completed := by + induction effects generalizing state with + | nil => exact membership + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + exact ih (mem_completed_recordEffect membership) + +lemma replaceNode_keys + (target : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) : + (replaceNode target nextState nodes).map Prod.fst = + nodes.map Prod.fst := by + induction nodes with + | nil => rfl + | cons entry tail ih => + simp only [replaceNode, List.map_cons] + split + · + rename_i condition + have same : entry.1 = target := beq_iff_eq.mp condition + simp only [List.cons.injEq] + constructor + · exact same.symm + · simpa [replaceNode] using ih + · + simp only [List.cons.injEq, true_and] + simpa [replaceNode] using ih + +lemma replaceNode_locations + (target : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) + (locations : + forall entry, entry ∈ nodes -> + entry.2.location = entry.1) + (nextLocation : nextState.location = target) : + forall entry, entry ∈ replaceNode target nextState nodes -> + entry.2.location = entry.1 := by + intro entry membership + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · exact nextLocation + · exact locations previous previousMember + +lemma findNode_replaceNode_ne + (target other : Location) + (nextState : NodeState) + (nodes : List (Prod Location NodeState)) + (different : other ≠ target) : + ((replaceNode target nextState nodes).find? + fun entry => entry.1 == other).map Prod.snd = + (nodes.find? fun entry => entry.1 == other).map Prod.snd := by + let replace : Prod Location NodeState -> Prod Location NodeState := + fun entry => + if entry.1 == target then (target, nextState) else entry + change + Option.map Prod.snd + (List.find? (fun entry => entry.1 == other) + (nodes.map replace)) = + Option.map Prod.snd + (List.find? (fun entry => entry.1 == other) nodes) + rw [List.find?_map] + have predicate : + ((fun entry : Prod Location NodeState => entry.1 == other) ∘ + replace) = + (fun entry => entry.1 == other) := by + funext entry + by_cases atTarget : entry.1 = target + · simp [replace, atTarget] + · simp [replace, atTarget] + rw [predicate] + cases found : + List.find? (fun entry : Prod Location NodeState => + entry.1 == other) nodes with + | none => simp + | some entry => + have condition : + (entry.1 == other) = true := + List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == other) found + have entryOther : entry.1 = other := + beq_iff_eq.mp condition + have notTarget : entry.1 ≠ target := by + simpa [entryOther] using different + simp [replace, notTarget] + +lemma systemStep_node_keys_eq + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (transition : + systemStep config before target event = some (after, output)) : + after.nodes.map Prod.fst = before.nodes.map Prod.fst := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with ⟨node, _, stateEq, _⟩ + rw [←stateEq] + exact replaceNode_keys target + (step config node event).state before.nodes + +lemma systemStep_preserves_node_locations + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (locations : + forall entry, entry ∈ before.nodes -> + entry.2.location = entry.1) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.location = entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, stateEq, _⟩ + rw [←stateEq] + apply replaceNode_locations + · exact locations + · calc + (step config node event).state.location = + node.location := step_preserves_location config node event + _ = key := + locations (key, node) (List.mem_of_find?_eq_some found) + _ = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + +lemma systemStep_other_node_eq + {config : Protocol.Config} + {before after : SystemState} + {target other : Location} + {event : Event} + {output : StepOutput} + (different : other ≠ target) + (transition : + systemStep config before target event = some (after, output)) : + (after.nodes.find? fun entry => entry.1 == other).map Prod.snd = + (before.nodes.find? fun entry => entry.1 == other).map Prod.snd := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with ⟨node, _, stateEq, _⟩ + rw [←stateEq] + exact findNode_replaceNode_ne target other + (step config node event).state before.nodes different + +lemma next_active_eq + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + after.active = before.active := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, _, system, output, _, rfl⟩ + simp + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, system, output, _, _, rfl⟩ + simp + +lemma next_node_keys_eq + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + after.system.nodes.map Prod.fst = + before.system.nodes.map Prod.fst := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, _, system, output, systemStep, rfl⟩ + simpa using systemStep_node_keys_eq systemStep + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, system, output, systemStep, _, rfl⟩ + simpa using systemStep_node_keys_eq systemStep + +lemma retry_system_eq + {config : Config} + {before after : State} + {source : Location} + (transition : next config before (.retry source) = some after) : + after.system = before.system := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + rfl + +lemma deliver_network_eq + {config : Config} + {before after : State} + {envelope : Envelope} + (transition : next config before (.deliver envelope) = some after) : + after.network = removeOne envelope before.network := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + simp + +lemma timeout_network_eq + {config : Config} + {before after : State} + {target : Location} + (transition : next config before (.timeout target) = some after) : + after.network = before.network := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + simp + +lemma deliver_other_node_eq + {config : Config} + {before after : State} + {envelope : Envelope} + {other : Location} + (different : other ≠ envelope.target) + (transition : next config before (.deliver envelope) = some after) : + nodeState after other = nodeState before other := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + simp only [nodeState, recordEffects_system] + exact systemStep_other_node_eq different systemStep + +lemma timeout_other_node_eq + {config : Config} + {before after : State} + {target other : Location} + (different : other ≠ target) + (transition : next config before (.timeout target) = some after) : + nodeState after other = nodeState before other := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + simp only [nodeState, recordEffects_system] + exact systemStep_other_node_eq different systemStep + +lemma next_sent_extends + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + exists added, after.sent = before.sent ++ added := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact ⟨retryMessages config source sourceState, rfl⟩ + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + refine ⟨[], ?_⟩ + simp + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + refine ⟨[], ?_⟩ + simp + +lemma next_openings_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall opening, opening ∈ before.openings -> + opening ∈ after.openings := by + intro opening membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_openings_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_openings_recordEffects + simpa using membership + +lemma next_restarts_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall restart, restart ∈ before.restarts -> + restart ∈ after.restarts := by + intro restart membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_restarts_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_restarts_recordEffects + simpa using membership + +lemma next_completed_monotonic + {config : Config} + {before after : State} + {action : Action} + (transition : next config before action = some after) : + forall completed, completed ∈ before.completed -> + completed ∈ after.completed := by + intro completed membership + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact membership + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, rfl⟩ + apply mem_completed_recordEffects + simpa using membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, rfl⟩ + apply mem_completed_recordEffects + simpa using membership + +lemma retry_preserves_well_formed + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (transition : next config before (.retry source) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨sourceActive, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + constructor + · exact wellFormed.nodeKeys + · exact wellFormed.nodeKeysNodup + · exact wellFormed.nodeLocations + · exact wellFormed.activeNodup + · exact wellFormed.activeConfigured + · intro envelope membership + rw [List.mem_append] at membership + rcases membership with membership | membership + · exact wellFormed.sentValid envelope membership + · exact retryMessages_valid config source sourceState + sourceLocation envelope membership + · intro envelope membership + rw [List.mem_append] at membership + rcases membership with membership | membership + · exact wellFormed.sentSourceActive envelope membership + · rw [(retryMessages_source membership).1] + exact sourceActive + · intro envelope membership + rw [List.mem_append] at membership ⊢ + rcases membership with membership | membership + · exact Or.inl (wellFormed.networkSent envelope membership) + · exact Or.inr membership + · constructor + · exact wellFormed.historiesActive.openings + · exact wellFormed.historiesActive.restarts + · exact wellFormed.historiesActive.completed + +lemma deliver_preserves_well_formed + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (transition : next config before (.deliver envelope) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, targetActive, system, output, systemStep, stateEq⟩ + rw [←stateEq] + constructor + · simp only [recordEffects_system] + exact (systemStep_node_keys_eq systemStep).trans + wellFormed.nodeKeys + · rw [recordEffects_system, systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · simp only [recordEffects_system] + exact systemStep_preserves_node_locations + wellFormed.nodeLocations systemStep + · simpa using wellFormed.activeNodup + · simpa using wellFormed.activeConfigured + · intro sent membership + rw [recordEffects_sent] at membership + exact wellFormed.sentValid sent membership + · intro sent membership + rw [recordEffects_sent] at membership + rw [recordEffects_active] + exact wellFormed.sentSourceActive sent membership + · intro pending membership + rw [recordEffects_network] at membership + rw [recordEffects_sent] + exact wellFormed.networkSent pending + (mem_of_mem_removeOne envelope pending before.network membership) + · apply recordEffects_preserves_histories_active + · constructor + · simpa using wellFormed.historiesActive.openings + · simpa using wellFormed.historiesActive.restarts + · simpa using wellFormed.historiesActive.completed + · simpa using targetActive + +lemma timeout_preserves_well_formed + {config : Config} + {before after : State} + {target : Location} + (wellFormed : WellFormed config before) + (transition : next config before (.timeout target) = some after) : + WellFormed config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨targetActive, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + constructor + · simp only [recordEffects_system] + exact (systemStep_node_keys_eq systemStep).trans + wellFormed.nodeKeys + · rw [recordEffects_system, systemStep_node_keys_eq systemStep] + exact wellFormed.nodeKeysNodup + · simp only [recordEffects_system] + exact systemStep_preserves_node_locations + wellFormed.nodeLocations systemStep + · simpa using wellFormed.activeNodup + · simpa using wellFormed.activeConfigured + · intro sent membership + rw [recordEffects_sent] at membership + exact wellFormed.sentValid sent membership + · intro sent membership + rw [recordEffects_sent] at membership + rw [recordEffects_active] + exact wellFormed.sentSourceActive sent membership + · intro pending membership + rw [recordEffects_network] at membership + rw [recordEffects_sent] + exact wellFormed.networkSent pending membership + · apply recordEffects_preserves_histories_active + · constructor + · simpa using wellFormed.historiesActive.openings + · simpa using wellFormed.historiesActive.restarts + · simpa using wellFormed.historiesActive.completed + · simpa using targetActive + +lemma next_preserves_well_formed + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (transition : next config before action = some after) : + WellFormed config after := by + cases action with + | retry source => + exact retry_preserves_well_formed wellFormed transition + | deliver envelope => + exact deliver_preserves_well_formed wellFormed transition + | timeout target => + exact timeout_preserves_well_formed wellFormed transition + +lemma reachable_well_formed + {config : Config} + {state : State} + (reachable : Reachable config state) : + WellFormed config state := by + induction reachable with + | initial active valid nodup configured => + exact initial_well_formed config active valid nodup configured + | step reachable transition wellFormed => + exact next_preserves_well_formed wellFormed transition + +lemma reachable_config_valid + {config : Config} + {state : State} + (reachable : Reachable config state) : + config.Valid := by + induction reachable with + | initial active valid nodup configured => exact valid + | step reachable transition valid => exact valid + +end DisasterRecovery.Protocol.Global diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean new file mode 100644 index 000000000000..48bde6e6e2a3 --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean @@ -0,0 +1,1389 @@ +import DisasterRecovery.Protocol.Quorum +import DisasterRecovery.Proofs.Invariants +import Mathlib.Tactic + +/-! +Machine-checked proof implementations. Review the system-level statements in +`DisasterRecovery.Properties` and definitions in `DisasterRecovery.Protocol.Quorum`. +-/ + +namespace DisasterRecovery.Protocol.Global + +lemma insertVote_nodup + (source : Location) + {votes : List Location} + (nodup : votes.Nodup) : + (insertVote source votes).Nodup := by + unfold insertVote + split + · exact nodup + · rename_i absent + apply (List.mergeSort_perm _ _).symm.nodup + rw [List.nodup_cons] + exact + ⟨fun member => absent (List.contains_iff_mem.mpr member), nodup⟩ + +lemma mem_insertVote + {member source : Location} + {votes : List Location} + (membership : member ∈ insertVote source votes) : + member ∈ votes \/ member = source := by + unfold insertVote at membership + split at membership + · exact Or.inl membership + · have unsorted := + (List.mergeSort_perm _ _).mem_iff.mp membership + rw [List.mem_cons] at unsorted + exact unsorted.symm + +lemma step_preserves_votes_nodup + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (nodup : state.votes.Nodup) : + (step config state event).state.votes.Nodup := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] + all_goals + repeat first | split | simp_all [insertVote_nodup] + +lemma step_votes_shape + (config : Protocol.Config) + (state : NodeState) + (event : Event) : + (step config state event).state.votes = state.votes \/ + exists source, + acceptedVoteSource event = some source /\ + (step config state event).state.votes = + insertVote source state.votes := by + cases event + all_goals try cases_type Validation + all_goals + simp [acceptedVoteSource, step, rejected, advance, advanceTimeoutLane] + all_goals repeat first | split | simp_all + +lemma step_vote_origin + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (voter : Location) + (membership : voter ∈ (step config state event).state.votes) : + voter ∈ state.votes \/ + acceptedVoteSource event = some voter := by + rcases step_votes_shape config state event with + unchanged | ⟨source, sourceEq, changed⟩ + · rw [unchanged] at membership + exact Or.inl membership + · rw [changed] at membership + rcases mem_insertVote membership with old | added + · exact Or.inl old + · subst source + exact Or.inr sourceEq + +lemma step_preserves_non_gossiping + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (pastGossip : state.phase ≠ .gossiping) : + (step config state event).state.phase ≠ .gossiping := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] + all_goals repeat first | split | simp_all + +lemma voting_step_preserves_choice + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (pastGossip : state.phase ≠ .gossiping) + (stillVoting : (step config state event).state.phase = .voting) : + state.phase = .voting /\ + (step config state event).state.chosen = state.chosen := by + cases event <;> + simp [step, rejected, advance, advanceTimeoutLane] at stillVoting ⊢ + all_goals repeat first | split at stillVoting | split | simp_all + +lemma step_preserves_voting_selection + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (before : + state.phase = .voting -> + NodeVotingSelection state) + (voting : (step config state event).state.phase = .voting) : + NodeVotingSelection (step config state event).state := by + cases event + all_goals try cases_type Validation + all_goals + simp [NodeVotingSelection, step, rejected, advance, + advanceTimeoutLane, validTimeout] at before voting ⊢ + all_goals + repeat first | split at voting | split | simp_all | aesop + +lemma retry_vote_state + {config : Config} + {envelope : Envelope} + (valid : envelope.Valid config) + (vote : envelope.payload = .vote) : + envelope.sourceState.phase = .voting /\ + envelope.sourceState.chosen = some envelope.target := by + rcases valid_envelope_effect valid with + ⟨effect, member, created⟩ + cases effect with + | sendGossip target => + cases found : recoveredTxID config envelope.source with + | none => + simp [messageForEffect, found] at created + | some txid => + simp [messageForEffect, found] at created + rw [←created] at vote + contradiction + | sendVote target => + simp [messageForEffect] at created + rw [←created] at vote ⊢ + cases phase : envelope.sourceState.phase <;> + simp [step, phase] at member + next => + cases chosen : envelope.sourceState.chosen <;> + simp_all + | sendIAmOpen target => + simp [messageForEffect] at created + rw [←created] at vote + contradiction + | opening kind => + simp [messageForEffect] at created + | restart chosen => + simp [messageForEffect] at created + | completed => + simp [messageForEffect] at created + | rejected reason => + simp [messageForEffect] at created + +lemma opening_effect_state + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (kind : OpenKind) + (opening : .opening kind ∈ (step config state event).effects) : + (step config state event).state.phase = .opening /\ + (step config state event).state.openKind = some kind := by + cases event + all_goals try cases_type Validation + all_goals + simp [step, rejected, advance, advanceTimeoutLane, validTimeout] + at opening ⊢ + all_goals + repeat first | split at opening | split | simp_all | aesop + +lemma quorum_effect_has_threshold + (config : Protocol.Config) + (state : NodeState) + (event : Event) + (opening : + .opening .quorum ∈ (step config state event).effects) : + voteQuorum config <= + (step config state event).state.votes.length := by + cases event + all_goals try cases_type Validation + all_goals + simp [step, rejected, advance, advanceTimeoutLane, validTimeout] + at opening ⊢ + all_goals + repeat first | split at opening | split | simp_all | aesop + +lemma sentVote_mono + {before after : State} + {voter target : Location} + (sent : forall envelope, envelope ∈ before.sent -> + envelope ∈ after.sent) + (vote : SentVote before voter target) : + SentVote after voter target := by + rcases vote with + ⟨envelope, membership, source, destination, payload⟩ + exact + ⟨envelope, sent envelope membership, source, destination, payload⟩ + +lemma opening_valid_of_sent_eq + {config : Config} + {before after : State} + {opening : Opening} + (sentEq : after.sent = before.sent) + (valid : opening.Valid config before) : + opening.Valid config after := by + rcases valid with + ⟨location, phase, kind, nodup, quorum, votesSent⟩ + constructor + · exact location + · exact phase + · exact kind + · exact nodup + · exact quorum + · intro voter membership + apply sentVote_mono + · intro envelope sent + rw [sentEq] + exact sent + · exact votesSent voter membership + +lemma opening_valid_mono + {config : Config} + {before after : State} + {opening : Opening} + (sent : + forall envelope, envelope ∈ before.sent -> + envelope ∈ after.sent) + (valid : opening.Valid config before) : + opening.Valid config after := by + rcases valid with + ⟨location, phase, kind, nodup, quorum, votesSent⟩ + constructor + · exact location + · exact phase + · exact kind + · exact nodup + · exact quorum + · intro voter membership + exact sentVote_mono sent (votesSent voter membership) + +lemma recordEffect_preserves_openings_valid + {config : Config} + {node : Location} + {nodeState : NodeState} + {state : State} + {effect : Effect} + (valid : OpeningsValid config state) + (newValid : + forall kind, + effect = .opening kind -> + Opening.Valid config state + { node, kind, state := nodeState }) : + OpeningsValid config + (recordEffect node nodeState state effect) := by + intro opening membership + cases effect with + | opening kind => + simp [recordEffect] at membership + rcases membership with rfl | old + · apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state (.opening kind)) + rfl + exact newValid kind rfl + · apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state (.opening kind)) + rfl + exact valid opening old + | sendGossip target => + exact valid opening membership + | sendVote target => + exact valid opening membership + | sendIAmOpen target => + exact valid opening membership + | restart target => + apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state (.restart target)) + rfl + exact valid opening membership + | completed => + apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state .completed) + rfl + exact valid opening membership + | rejected reason => + exact valid opening membership + +lemma recordEffects_preserves_openings_valid + {config : Config} + {node : Location} + {nodeState : NodeState} + {state : State} + {effects : List Effect} + (valid : OpeningsValid config state) + (newValid : + forall kind, + .opening kind ∈ effects -> + Opening.Valid config state + { node, kind, state := nodeState }) : + OpeningsValid config + (recordEffects node nodeState effects state) := by + induction effects generalizing state with + | nil => exact valid + | cons effect tail ih => + simp only [recordEffects, List.foldl_cons] + apply ih + · apply recordEffect_preserves_openings_valid valid + intro kind effectEq + subst effect + exact newValid kind (by simp) + · intro kind membership + apply opening_valid_of_sent_eq + (before := state) + (after := recordEffect node nodeState state effect) + (by cases effect <;> rfl) + exact newValid kind (by simp [membership]) + +lemma eventFor_vote_source + {envelope : Envelope} + {voter : Location} + (source : + acceptedVoteSource (eventFor envelope) = some voter) : + envelope.payload = .vote /\ + envelope.source = voter := by + cases payload : envelope.payload <;> + simp_all [eventFor, acceptedVoteSource] + +lemma systemStep_preserves_votes_nodup + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (nodup : + forall entry, entry ∈ before.nodes -> + entry.2.votes.Nodup) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.votes.Nodup := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, stateEq, _⟩ + rw [←stateEq] + intro entry membership + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · apply step_preserves_votes_nodup + exact nodup (key, node) (List.mem_of_find?_eq_some found) + · exact nodup previous previousMember + +lemma systemStep_preserves_voting_selections + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (valid : + forall entry, entry ∈ before.nodes -> + entry.2.phase = .voting -> + NodeVotingSelection entry.2) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.2.phase = .voting -> + NodeVotingSelection entry.2 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership voting + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + apply step_preserves_voting_selection config node event + · exact valid (key, node) + (List.mem_of_find?_eq_some found) + · simpa [atTarget, outputEq] using voting + · rename_i notTarget + exact valid previous previousMember + (by simpa [notTarget] using voting) + +lemma systemStep_output_location + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (locations : + forall entry, entry ∈ before.nodes -> + entry.2.location = entry.1) + (transition : + systemStep config before target event = some (after, output)) : + output.state.location = target := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, _, outputEq⟩ + calc + output.state.location = + node.location := by + rw [←outputEq] + exact step_preserves_location config node event + _ = key := + locations (key, node) (List.mem_of_find?_eq_some found) + _ = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + +lemma systemStep_output_mem + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (transition : + systemStep config before target event = some (after, output)) : + (target, output.state) ∈ after.nodes := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq, replaceNode, List.mem_map] + refine ⟨(key, node), List.mem_of_find?_eq_some found, ?_⟩ + have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + simp [keyEq, outputEq] + +lemma systemStep_opening_effect_state + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {kind : OpenKind} + (transition : + systemStep config before target event = some (after, output)) + (opening : .opening kind ∈ output.effects) : + output.state.phase = .opening /\ + output.state.openKind = some kind := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, _, _, outputEq⟩ + rw [←outputEq] at opening ⊢ + exact opening_effect_state config node event kind opening + +lemma systemStep_quorum_effect_has_threshold + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + (transition : + systemStep config before target event = some (after, output)) + (opening : .opening .quorum ∈ output.effects) : + voteQuorum config <= output.state.votes.length := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, _, _, outputEq⟩ + rw [←outputEq] at opening ⊢ + exact quorum_effect_has_threshold config node event opening + +lemma initial_node_votes_nodup + (config : Config) + (active : List Location) : + NodeVotesNodup (initial config active) := by + simp [NodeVotesNodup, Global.initial, initialSystem, initialNode] + +lemma initial_node_votes_sent + (config : Config) + (active : List Location) : + NodeVotesSent (initial config active) := by + simp [NodeVotesSent, Global.initial, initialSystem, initialNode] + +lemma initial_sent_votes_functional + (config : Config) + (active : List Location) : + SentVotesFunctional (initial config active) := by + simp [SentVotesFunctional, SentVote, Global.initial] + +lemma initial_sent_vote_stable + (config : Config) + (active : List Location) : + SentVoteStable (initial config active) := by + simp [SentVoteStable, Global.initial] + +lemma initial_voting_selections + (config : Config) + (active : List Location) : + VotingSelectionsValid (initial config active) := by + simp [VotingSelectionsValid, Global.initial, initialSystem, initialNode] + +lemma initial_sent_votes_selected + (config : Config) + (active : List Location) : + SentVotesSelected (initial config active) := by + simp [SentVotesSelected, Global.initial] + +lemma initial_openings_valid + (config : Config) + (active : List Location) : + OpeningsValid config (initial config active) := by + simp [OpeningsValid, Global.initial] + +lemma systemStep_preserves_node_votes_sent + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {beforeState afterState : State} + (beforeSystem : beforeState.system = before) + (votesSent : NodeVotesSent beforeState) + (carry : + forall voter destination, + SentVote beforeState voter destination -> + SentVote afterState voter destination) + (introduced : + forall voter, + acceptedVoteSource event = some voter -> + SentVote afterState voter target) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + forall voter, voter ∈ entry.2.votes -> + SentVote afterState voter entry.1 := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership voter vote + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + have targetEq : previous.1 = target := + beq_iff_eq.mp atTarget + rcases step_vote_origin config node event voter + (by simpa [outputEq, atTarget] using vote) with + old | added + · have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + apply carry + rw [←keyEq] + exact votesSent (key, node) + (by + rw [beforeSystem] + exact List.mem_of_find?_eq_some found) + voter old + · exact introduced voter added + · rename_i notTarget + apply carry + exact votesSent previous + (by + rw [beforeSystem] + exact previousMember) + voter (by simpa [notTarget] using vote) + +lemma eq_of_key_eq + {α : Type} + {nodes : List (Prod Location α)} + (nodup : (nodes.map Prod.fst).Nodup) + {first second : Prod Location α} + (firstMember : first ∈ nodes) + (secondMember : second ∈ nodes) + (keyEq : first.1 = second.1) : + first = second := by + induction nodes generalizing first second with + | nil => simp at firstMember + | cons head tail ih => + rw [List.map_cons, List.nodup_cons] at nodup + rcases nodup with ⟨headFresh, tailNodup⟩ + rw [List.mem_cons] at firstMember secondMember + rcases firstMember with rfl | firstTail + · rcases secondMember with rfl | secondTail + · rfl + · exfalso + apply headFresh + rw [List.mem_map] + exact ⟨second, secondTail, keyEq.symm⟩ + · rcases secondMember with rfl | secondTail + · exfalso + apply headFresh + rw [List.mem_map] + exact ⟨first, firstTail, keyEq⟩ + · exact ih tailNodup firstTail secondTail keyEq + +lemma systemStep_preserves_vote_stability + {config : Protocol.Config} + {before after : SystemState} + {target : Location} + {event : Event} + {output : StepOutput} + {envelope : Envelope} + (stable : + forall entry, entry ∈ before.nodes -> + entry.1 = envelope.source -> + entry.2.phase ≠ .gossiping /\ + (entry.2.phase = .voting -> + entry.2.chosen = some envelope.target)) + (transition : + systemStep config before target event = some (after, output)) : + forall entry, entry ∈ after.nodes -> + entry.1 = envelope.source -> + entry.2.phase ≠ .gossiping /\ + (entry.2.phase = .voting -> + entry.2.chosen = some envelope.target) := by + simp [systemStep, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ + rw [←systemEq] + intro entry membership sourceEq + rw [replaceNode, List.mem_map] at membership + rcases membership with ⟨previous, previousMember, rfl⟩ + split + · rename_i atTarget + have targetEq : previous.1 = target := + beq_iff_eq.mp atTarget + have targetSource : target = envelope.source := by + simpa [atTarget] using sourceEq + have keyEq : key = target := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == target) found) + have beforeStable := + stable (key, node) (List.mem_of_find?_eq_some found) + (keyEq.trans targetSource) + constructor + · exact step_preserves_non_gossiping config node event + beforeStable.1 + · intro voting + rcases voting_step_preserves_choice config node event + beforeStable.1 voting with ⟨beforeVoting, chosenEq⟩ + rw [chosenEq] + exact beforeStable.2 beforeVoting + · rename_i notTarget + exact stable previous previousMember + (by simpa [notTarget] using sourceEq) + +lemma next_preserves_node_votes_nodup + {config : Config} + {before after : State} + {action : Action} + (nodup : NodeVotesNodup before) + (transition : next config before action = some after) : + NodeVotesNodup after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact nodup + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, rfl⟩ + intro entry membership + rw [recordEffects_system] at membership + exact systemStep_preserves_votes_nodup nodup systemStep + entry membership + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, rfl⟩ + intro entry membership + rw [recordEffects_system] at membership + exact systemStep_preserves_votes_nodup nodup systemStep + entry membership + +lemma next_preserves_voting_selections + {config : Config} + {before after : State} + {action : Action} + (valid : VotingSelectionsValid before) + (transition : next config before action = some after) : + VotingSelectionsValid after := by + cases action with + | retry source => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + exact valid + | deliver envelope => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, rfl⟩ + intro entry membership voting + rw [recordEffects_system] at membership + exact systemStep_preserves_voting_selections valid systemStep + entry membership voting + | timeout target => + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, rfl⟩ + intro entry membership voting + rw [recordEffects_system] at membership + exact systemStep_preserves_voting_selections valid systemStep + entry membership voting + +lemma retry_preserves_sent_votes_selected + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (votingSelections : VotingSelectionsValid before) + (selected : SentVotesSelected before) + (transition : next config before (.retry source) = some after) : + SentVotesSelected after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + intro envelope membership payload + rw [List.mem_append] at membership + rcases membership with old | added + · exact selected envelope old payload + · have valid : envelope.Valid config := + retryMessages_valid config source sourceState sourceLocation + envelope added + have voteState := retry_vote_state valid payload + have identity := retryMessages_source added + rw [identity.2] at voteState + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have sourceSelection := + votingSelections entry (List.mem_of_find?_eq_some findEq) + (by simpa [stateEq] using voteState.1) + simpa [identity.2, stateEq] using sourceSelection + +lemma deliver_preserves_sent_votes_selected + {config : Config} + {before after : State} + {envelope : Envelope} + (selected : SentVotesSelected before) + (transition : next config before (.deliver envelope) = some after) : + SentVotesSelected after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, stateEq⟩ + rw [←stateEq] + intro vote membership payload + rw [recordEffects_sent] at membership + exact selected vote membership payload + +lemma timeout_preserves_sent_votes_selected + {config : Config} + {before after : State} + {target : Location} + (selected : SentVotesSelected before) + (transition : next config before (.timeout target) = some after) : + SentVotesSelected after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, stateEq⟩ + rw [←stateEq] + intro vote membership payload + rw [recordEffects_sent] at membership + exact selected vote membership payload + +lemma retry_preserves_node_votes_sent + {config : Config} + {before after : State} + {source : Location} + (votesSent : NodeVotesSent before) + (transition : next config before (.retry source) = some after) : + NodeVotesSent after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, rfl⟩ + intro entry membership voter vote + apply sentVote_mono (before := before) + · intro envelope sent + exact List.mem_append_left _ sent + · exact votesSent entry membership voter vote + +lemma deliver_preserves_node_votes_sent + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (votesSent : NodeVotesSent before) + (transition : next config before (.deliver envelope) = some after) : + NodeVotesSent after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨inNetwork, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro entry membership voter vote + rw [recordEffects_system] at membership + let afterState := + recordEffects envelope.target output.state output.effects + { + before with + system + network := removeOne envelope before.network + } + have carry : + forall oldVoter oldTarget, + SentVote before oldVoter oldTarget -> + SentVote afterState oldVoter oldTarget := by + intro oldVoter oldTarget oldVote + apply sentVote_mono (before := before) (after := afterState) + · intro sent sentMember + simpa [afterState] using sentMember + · exact oldVote + have introducedVote : + forall newVoter, + acceptedVoteSource (eventFor envelope) = some newVoter -> + SentVote afterState newVoter envelope.target := by + intro newVoter introduced + rcases eventFor_vote_source introduced with + ⟨payload, source⟩ + subst newVoter + refine ⟨envelope, ?_, rfl, rfl, payload⟩ + simp [afterState] + exact wellFormed.networkSent envelope + inNetwork + exact systemStep_preserves_node_votes_sent + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl votesSent carry introducedVote systemStep + entry membership voter vote + +lemma timeout_preserves_node_votes_sent + {config : Config} + {before after : State} + {target : Location} + (votesSent : NodeVotesSent before) + (transition : next config before (.timeout target) = some after) : + NodeVotesSent after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro entry membership voter vote + rw [recordEffects_system] at membership + let afterState := + recordEffects target output.state output.effects + { before with system } + have carry : + forall oldVoter oldTarget, + SentVote before oldVoter oldTarget -> + SentVote afterState oldVoter oldTarget := by + intro oldVoter oldTarget oldVote + apply sentVote_mono (before := before) (after := afterState) + · intro sent sentMember + simpa [afterState] using sentMember + · exact oldVote + have introducedVote : + forall newVoter, + acceptedVoteSource Event.timeout = some newVoter -> + SentVote afterState newVoter target := by + intro newVoter introduced + simp [acceptedVoteSource] at introduced + exact systemStep_preserves_node_votes_sent + (before := before.system) + (after := system) + (beforeState := before) + (afterState := afterState) + rfl votesSent carry introducedVote systemStep + entry membership voter vote + +lemma retry_preserves_openings_valid + {config : Config} + {before after : State} + {source : Location} + (valid : OpeningsValid config before) + (transition : next config before (.retry source) = some after) : + OpeningsValid config after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with ⟨_, sourceState, _, _, stateEq⟩ + rw [←stateEq] + intro opening membership + apply opening_valid_mono + · intro envelope sent + exact List.mem_append_left _ sent + · exact valid opening membership + +lemma deliver_preserves_openings_valid + {config : Config} + {before after : State} + {envelope : Envelope} + (wellFormed : WellFormed config before) + (votesNodup : NodeVotesNodup before) + (votesSent : NodeVotesSent before) + (valid : OpeningsValid config before) + (transition : next config before (.deliver envelope) = some after) : + OpeningsValid config after := by + have afterNodup := + next_preserves_node_votes_nodup votesNodup transition + have afterVotesSent := + deliver_preserves_node_votes_sent wellFormed votesSent transition + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] at afterNodup afterVotesSent ⊢ + let delivered : State := { + before with + system + network := removeOne envelope before.network + } + apply recordEffects_preserves_openings_valid + · intro opening membership + apply opening_valid_of_sent_eq + (before := before) (after := delivered) rfl + exact valid opening membership + · intro kind openingEffect + have effectState := + systemStep_opening_effect_state systemStep openingEffect + constructor + · exact systemStep_output_location + wellFormed.nodeLocations systemStep + · exact effectState.1 + · exact effectState.2 + · apply afterNodup (envelope.target, output.state) + rw [recordEffects_system] + exact systemStep_output_mem systemStep + · intro quorumKind + have kindEq : kind = .quorum := by simpa using quorumKind + rw [kindEq] at openingEffect + simpa using + systemStep_quorum_effect_has_threshold systemStep openingEffect + · intro voter vote + have sent := + afterVotesSent (envelope.target, output.state) + (by + rw [recordEffects_system] + exact systemStep_output_mem systemStep) + voter vote + simpa [SentVote, delivered] using sent + +lemma timeout_preserves_openings_valid + {config : Config} + {before after : State} + {target : Location} + (wellFormed : WellFormed config before) + (votesNodup : NodeVotesNodup before) + (votesSent : NodeVotesSent before) + (valid : OpeningsValid config before) + (transition : next config before (.timeout target) = some after) : + OpeningsValid config after := by + have afterNodup := + next_preserves_node_votes_nodup votesNodup transition + have afterVotesSent := + timeout_preserves_node_votes_sent votesSent transition + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] at afterNodup afterVotesSent ⊢ + let timedOut : State := { before with system } + apply recordEffects_preserves_openings_valid + · intro opening membership + apply opening_valid_of_sent_eq + (before := before) (after := timedOut) rfl + exact valid opening membership + · intro kind openingEffect + have effectState := + systemStep_opening_effect_state systemStep openingEffect + constructor + · exact systemStep_output_location + wellFormed.nodeLocations systemStep + · exact effectState.1 + · exact effectState.2 + · apply afterNodup (target, output.state) + rw [recordEffects_system] + exact systemStep_output_mem systemStep + · intro quorumKind + have kindEq : kind = .quorum := by simpa using quorumKind + rw [kindEq] at openingEffect + simpa using + systemStep_quorum_effect_has_threshold systemStep openingEffect + · intro voter vote + have sent := + afterVotesSent (target, output.state) + (by + rw [recordEffects_system] + exact systemStep_output_mem systemStep) + voter vote + simpa [SentVote, timedOut] using sent + +lemma retry_preserves_sent_vote_stable + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (stable : SentVoteStable before) + (transition : next config before (.retry source) = some after) : + SentVoteStable after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + intro envelope membership payload entry entryMember keyEq + rw [List.mem_append] at membership + rcases membership with old | added + · exact stable envelope old payload entry entryMember keyEq + · have valid : envelope.Valid config := + retryMessages_valid config source sourceState sourceLocation + envelope added + have voteState := retry_vote_state valid payload + rcases retryMessages_source added with + ⟨sourceEq, stateEq⟩ + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨foundEntry, findEq, foundStateEq⟩ + have foundMember : foundEntry ∈ before.system.nodes := + List.mem_of_find?_eq_some findEq + have foundKey : foundEntry.1 = source := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == source) findEq) + have sameEntry : entry = foundEntry := + eq_of_key_eq wellFormed.nodeKeysNodup entryMember foundMember + ((keyEq.trans sourceEq).trans foundKey.symm) + subst entry + rw [foundStateEq, ←stateEq] + exact ⟨by simp [voteState.1], fun _ => voteState.2⟩ + +lemma deliver_preserves_sent_vote_stable + {config : Config} + {before after : State} + {delivered : Envelope} + (stable : SentVoteStable before) + (transition : next config before (.deliver delivered) = some after) : + SentVoteStable after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, systemStep, stateEq⟩ + rw [←stateEq] + intro envelope membership payload entry entryMember keyEq + rw [recordEffects_sent] at membership + rw [recordEffects_system] at entryMember + exact systemStep_preserves_vote_stability + (fun previous previousMember source => + stable envelope membership payload previous previousMember source) + systemStep entry entryMember keyEq + +lemma timeout_preserves_sent_vote_stable + {config : Config} + {before after : State} + {target : Location} + (stable : SentVoteStable before) + (transition : next config before (.timeout target) = some after) : + SentVoteStable after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, systemStep, _, stateEq⟩ + rw [←stateEq] + intro envelope membership payload entry entryMember keyEq + rw [recordEffects_sent] at membership + rw [recordEffects_system] at entryMember + exact systemStep_preserves_vote_stability + (fun previous previousMember source => + stable envelope membership payload previous previousMember source) + systemStep entry entryMember keyEq + +lemma sentVote_stable_at_node + {state : State} + {voter target : Location} + {current : NodeState} + (stable : SentVoteStable state) + (vote : SentVote state voter target) + (found : nodeState state voter = some current) : + current.phase ≠ .gossiping /\ + (current.phase = .voting -> + current.chosen = some target) := by + rcases vote with + ⟨envelope, sent, sourceEq, targetEq, payload⟩ + rw [nodeState, Option.map_eq_some_iff] at found + rcases found with ⟨entry, findEq, stateEq⟩ + have entryMember : entry ∈ state.system.nodes := + List.mem_of_find?_eq_some findEq + have entryKey : entry.1 = voter := + beq_iff_eq.mp + (List.find?_some + (p := fun entry : Prod Location NodeState => + entry.1 == voter) findEq) + have result := + stable envelope sent payload entry entryMember + (entryKey.trans sourceEq.symm) + rw [stateEq] at result + simpa [targetEq] using result + +lemma retry_preserves_sent_votes_functional + {config : Config} + {before after : State} + {source : Location} + (wellFormed : WellFormed config before) + (functional : SentVotesFunctional before) + (stable : SentVoteStable before) + (transition : next config before (.retry source) = some after) : + SentVotesFunctional after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, sourceState, found, _, stateEq⟩ + have sourceLocation : sourceState.location = source := + nodeState_location wellFormed.nodeLocations found + rw [←stateEq] + have classify : + forall voter target, + SentVote + { + before with + network := before.network ++ + retryMessages config source sourceState + sent := before.sent ++ + retryMessages config source sourceState + } + voter target -> + SentVote before voter target \/ + (voter = source /\ + sourceState.phase = .voting /\ + sourceState.chosen = some target) := by + intro voter target vote + rcases vote with + ⟨envelope, membership, sourceEq, targetEq, payload⟩ + rw [List.mem_append] at membership + rcases membership with old | added + · exact Or.inl + ⟨envelope, old, sourceEq, targetEq, payload⟩ + · have valid : envelope.Valid config := + retryMessages_valid config source sourceState sourceLocation + envelope added + have voteState := retry_vote_state valid payload + have retryIdentity := retryMessages_source added + rw [retryIdentity.2] at voteState + exact Or.inr + ⟨sourceEq.symm.trans retryIdentity.1, + voteState.1, + by simpa [targetEq] using voteState.2⟩ + intro voter first second firstVote secondVote + rcases classify voter first firstVote with + firstOld | ⟨firstSource, firstPhase, firstChoice⟩ + · rcases classify voter second secondVote with + secondOld | ⟨secondSource, secondPhase, secondChoice⟩ + · exact functional voter first second firstOld secondOld + · have oldState := + sentVote_stable_at_node stable firstOld + (by simpa [secondSource] using found) + have oldChoice := oldState.2 secondPhase + rw [oldChoice] at secondChoice + exact Option.some.inj secondChoice + · rcases classify voter second secondVote with + secondOld | ⟨secondSource, secondPhase, secondChoice⟩ + · have oldState := + sentVote_stable_at_node stable secondOld + (by simpa [firstSource] using found) + have oldChoice := oldState.2 firstPhase + rw [oldChoice] at firstChoice + exact (Option.some.inj firstChoice).symm + · rw [firstChoice] at secondChoice + exact Option.some.inj secondChoice + +lemma deliver_preserves_sent_votes_functional + {config : Config} + {before after : State} + {envelope : Envelope} + (functional : SentVotesFunctional before) + (transition : next config before (.deliver envelope) = some after) : + SentVotesFunctional after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, _, system, output, _, stateEq⟩ + rw [←stateEq] + intro voter first second firstVote secondVote + apply functional voter first second + · simpa [SentVote] using firstVote + · simpa [SentVote] using secondVote + +lemma timeout_preserves_sent_votes_functional + {config : Config} + {before after : State} + {target : Location} + (functional : SentVotesFunctional before) + (transition : next config before (.timeout target) = some after) : + SentVotesFunctional after := by + simp [next, Option.bind_eq_some_iff] at transition + rcases transition with + ⟨_, system, output, _, _, stateEq⟩ + rw [←stateEq] + intro voter first second firstVote secondVote + apply functional voter first second + · simpa [SentVote] using firstVote + · simpa [SentVote] using secondVote + +lemma initial_quorum_invariant + (config : Config) + (active : List Location) : + QuorumInvariant config (initial config active) := { + votesNodup := initial_node_votes_nodup config active + votesSent := initial_node_votes_sent config active + sentVoteStable := initial_sent_vote_stable config active + sentVotesFunctional := initial_sent_votes_functional config active + votingSelections := initial_voting_selections config active + sentVotesSelected := initial_sent_votes_selected config active + openingsValid := initial_openings_valid config active +} + +lemma next_preserves_quorum_invariant + {config : Config} + {before after : State} + {action : Action} + (wellFormed : WellFormed config before) + (invariant : QuorumInvariant config before) + (transition : next config before action = some after) : + QuorumInvariant config after := by + cases action with + | retry source => + constructor + · exact next_preserves_node_votes_nodup + invariant.votesNodup transition + · exact retry_preserves_node_votes_sent + invariant.votesSent transition + · exact retry_preserves_sent_vote_stable + wellFormed invariant.sentVoteStable transition + · exact retry_preserves_sent_votes_functional + wellFormed invariant.sentVotesFunctional + invariant.sentVoteStable transition + · exact next_preserves_voting_selections + invariant.votingSelections transition + · exact retry_preserves_sent_votes_selected + wellFormed invariant.votingSelections + invariant.sentVotesSelected transition + · exact retry_preserves_openings_valid + invariant.openingsValid transition + | deliver envelope => + constructor + · exact next_preserves_node_votes_nodup + invariant.votesNodup transition + · exact deliver_preserves_node_votes_sent + wellFormed invariant.votesSent transition + · exact deliver_preserves_sent_vote_stable + invariant.sentVoteStable transition + · exact deliver_preserves_sent_votes_functional + invariant.sentVotesFunctional transition + · exact next_preserves_voting_selections + invariant.votingSelections transition + · exact deliver_preserves_sent_votes_selected + invariant.sentVotesSelected transition + · exact deliver_preserves_openings_valid + wellFormed invariant.votesNodup invariant.votesSent + invariant.openingsValid transition + | timeout target => + constructor + · exact next_preserves_node_votes_nodup + invariant.votesNodup transition + · exact timeout_preserves_node_votes_sent + invariant.votesSent transition + · exact timeout_preserves_sent_vote_stable + invariant.sentVoteStable transition + · exact timeout_preserves_sent_votes_functional + invariant.sentVotesFunctional transition + · exact next_preserves_voting_selections + invariant.votingSelections transition + · exact timeout_preserves_sent_votes_selected + invariant.sentVotesSelected transition + · exact timeout_preserves_openings_valid + wellFormed invariant.votesNodup invariant.votesSent + invariant.openingsValid transition + +lemma reachable_quorum_invariant + {config : Config} + {state : State} + (reachable : Reachable config state) : + QuorumInvariant config state := by + induction reachable with + | initial active valid nodup configured => + exact initial_quorum_invariant config active + | step reachable transition invariant => + exact next_preserves_quorum_invariant + (reachable_well_formed reachable) invariant transition + +lemma quorum_lists_intersect + {α : Type} + [DecidableEq α] + (expected first second : List α) + (firstNodup : first.Nodup) + (secondNodup : second.Nodup) + (firstSubset : + forall value, value ∈ first -> value ∈ expected) + (secondSubset : + forall value, value ∈ second -> value ∈ expected) + (firstQuorum : + expected.length / 2 + 1 <= first.length) + (secondQuorum : + expected.length / 2 + 1 <= second.length) : + exists value, value ∈ first /\ value ∈ second := by + by_contra noShared + push_neg at noShared + have disjoint : Disjoint first.toFinset second.toFinset := + Finset.disjoint_left.mpr (by + intro value firstMember secondMember + exact noShared value + (List.mem_toFinset.mp firstMember) + (List.mem_toFinset.mp secondMember)) + have unionSubset : + first.toFinset ∪ second.toFinset ⊆ expected.toFinset := by + intro value membership + rw [Finset.mem_union] at membership + rw [List.mem_toFinset] + exact membership.elim + (fun member => + firstSubset value (List.mem_toFinset.mp member)) + (fun member => + secondSubset value (List.mem_toFinset.mp member)) + have unionCard := Finset.card_le_card unionSubset + rw [Finset.card_union_of_disjoint disjoint, + List.toFinset_card_of_nodup firstNodup, + List.toFinset_card_of_nodup secondNodup] at unionCard + have expectedCard := List.toFinset_card_le expected + omega + +lemma opening_vote_configured + {config : Config} + {state : State} + {opening : Opening} + (wellFormed : WellFormed config state) + (valid : opening.Valid config state) + {voter : Location} + (vote : voter ∈ opening.state.votes) : + voter ∈ config.protocol.expectedLocations := by + rcases valid.votesSent voter vote with + ⟨envelope, sent, sourceEq, _, _⟩ + apply wellFormed.activeConfigured voter + simpa [sourceEq] using + wellFormed.sentSourceActive envelope sent + +lemma quorum_opener_unique + {config : Config} + {state : State} + {first second : Location} + (reachable : Reachable config state) + (firstOpened : QuorumOpened state first) + (secondOpened : QuorumOpened state second) : + first = second := by + have wellFormed := reachable_well_formed reachable + have invariant := reachable_quorum_invariant reachable + rcases firstOpened with + ⟨firstOpening, firstMember, firstNode, firstKind⟩ + rcases secondOpened with + ⟨secondOpening, secondMember, secondNode, secondKind⟩ + have firstValid := + invariant.openingsValid firstOpening firstMember + have secondValid := + invariant.openingsValid secondOpening secondMember + rcases quorum_lists_intersect + config.protocol.expectedLocations + firstOpening.state.votes + secondOpening.state.votes + firstValid.votesNodup + secondValid.votesNodup + (fun voter vote => + opening_vote_configured wellFormed firstValid vote) + (fun voter vote => + opening_vote_configured wellFormed secondValid vote) + (by + simpa [voteQuorum] using firstValid.quorum firstKind) + (by + simpa [voteQuorum] using secondValid.quorum secondKind) with + ⟨voter, firstVote, secondVote⟩ + have targetEq := + invariant.sentVotesFunctional voter + firstOpening.node secondOpening.node + (firstValid.votesSent voter firstVote) + (secondValid.votesSent voter secondVote) + exact firstNode.symm.trans (targetEq.trans secondNode) + +end DisasterRecovery.Protocol.Global diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean new file mode 100644 index 000000000000..cb1a9cab53ce --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean @@ -0,0 +1,197 @@ +import DisasterRecovery.Protocol.Temporal +import Mathlib.Tactic.Lemma + +/-! +Machine-checked proof implementations. Review the system-level statements in +`DisasterRecovery.Properties` and definitions in `DisasterRecovery.Protocol.Temporal`. +-/ + +namespace DisasterRecovery.Protocol + +lemma valid_timeout_requires_alignment + (state : NodeState) + (h : validTimeout state true = true) : + state.phase = state.timeoutState := by + simpa [validTimeout] using h + +lemma gossip_freezes_after_choice + (config : Config) + (state : NodeState) + (source : Location) + (txid : TxID) + (h : state.chosen.isSome = true) : + let output := step config state (.receiveGossip source txid .accepted) + output.state = state /\ output.accepted = false := by + cases chosen : state.chosen <;> simp_all [step, rejected] + +lemma rejected_gossip_stutters + (config : Config) + (state : NodeState) + (source : Location) + (txid : TxID) : + let output := step config state (.receiveGossip source txid .rejected) + output.state = state /\ output.accepted = false := by + simp [step, rejected] + +lemma duplicate_vote_is_idempotent + (source : Location) + (votes : List Location) + (h : votes.contains source = true) : + insertVote source votes = votes := by + unfold insertVote + rw [h] + simp + +lemma opening_rejects_iamopen + (config : Config) + (state : NodeState) + (source : Location) : + let opening := { state with phase := .opening } + let output := step config opening (.receiveIAmOpen source .accepted) + output.state = opening /\ output.accepted = false := by + simp [step, rejected] + +lemma open_rejects_iamopen + (config : Config) + (state : NodeState) + (source : Location) : + let opened := { state with phase := .open } + let output := step config opened (.receiveIAmOpen source .accepted) + output.state = opened /\ output.accepted = false := by + simp [step, rejected] + +lemma aligned_voting_timeout_without_votes_stutters + (config : Config) + (state : NodeState) : + let waiting := { + state with + phase := .voting + timeoutState := .voting + votes := [] + } + step config waiting .timeout = { state := waiting } := by + simp [step, advance, validTimeout, voteQuorum] + +lemma aligned_opening_timeout_completes + (config : Config) + (state : NodeState) : + let opening := { + state with + phase := .opening + timeoutState := .opening + } + let output := step config opening .timeout + output.state.phase = .open /\ + output.state.timeoutState = .opening /\ + output.effects = [.completed] := by + simp [step, advance, validTimeout, advanceTimeoutLane, advanceTimeoutState] + +lemma quorum_advance_opens + (config : Config) + (state : NodeState) + (phase : state.phase = .voting) + (quorum : state.votes.length >= voteQuorum config) : + let output := (advance config state false).get! + output.state.phase = .opening /\ + output.state.openKind = some .quorum /\ + output.effects = [.opening .quorum] := by + simp [advance, phase, quorum, validTimeout, advanceTimeoutLane] + +lemma aligned_empty_gossip_timeout_aborts + (config : Config) + (state : NodeState) : + let waiting := { + state with + phase := .gossiping + timeoutState := .gossiping + gossips := [] + } + let output := step config waiting .timeout + output.state = waiting /\ output.accepted = false := by + simp [step, advance, validTimeout, rejected, maximumGossip] + +lemma non_timeout_step_preserves_aligned_opening + (config : Config) + (state : NodeState) + (event : Event) + (aligned : AlignedOpening state) + (notTimeout : Not (event = .timeout)) : + AlignedOpening (step config state event).state := by + have phase := aligned.1 + have timeoutState := aligned.2 + cases event with + | receiveGossip source txid validation => + cases validation <;> + simp_all [AlignedOpening, step, rejected, advance, validTimeout, + advanceTimeoutLane] + split <;> simp_all + | receiveVote source validation => + cases validation <;> + simp_all [AlignedOpening, step, rejected, advance, validTimeout, + advanceTimeoutLane] + | receiveIAmOpen source validation => + cases validation <;> + simp_all [AlignedOpening, step, rejected] + | timeout => + exact (notTimeout rfl).elim + | retry => + simp [AlignedOpening, step, phase, timeoutState] + +lemma aligned_timeout_transitions_to_open + (config : Config) + (state : NodeState) + (aligned : AlignedOpening state) : + (step config state .timeout).state.phase = .open := by + have phase := aligned.1 + have timeoutState := aligned.2 + simp [step, advance, validTimeout, phase, timeoutState, + advanceTimeoutLane, advanceTimeoutState] + +lemma fairness_supplies_firing + {config : Config} + (execution : Execution config) + (enabled : NodeState -> Prop) + (fired : NodeState -> Event -> Prop) + (fair : WeakFairness execution enabled fired) + (alwaysEnabled : forall n, enabled (execution.states n)) : + InfinitelyOften + (fun n => fired (execution.states n) (execution.events n)) := by + intro start + exact fair start (fun n _ => alwaysEnabled n) + +lemma fair_aligned_opening_progress + {config : Config} + (execution : Execution config) + (initial : AlignedOpening (execution.states 0)) + (fair : WeakFairness execution AlignedOpening + (fun _ event => event = .timeout)) : + EventuallyFrom 0 + (fun n => (execution.states n).phase = .open) := by + apply Classical.byContradiction + intro noOpen + have neverOpen : + forall n, Not ((execution.states n).phase = .open) := by + intro n opened + apply noOpen + exact Exists.intro n (And.intro (Nat.zero_le n) opened) + have alignedAlways : forall n, AlignedOpening (execution.states n) := by + intro n + induction n with + | zero => exact initial + | succ n aligned => + have notTimeout : Not (execution.events n = .timeout) := by + intro timeout + apply neverOpen (n + 1) + rw [execution.step_succ n, timeout] + exact aligned_timeout_transitions_to_open config _ aligned + rw [execution.step_succ n] + exact non_timeout_step_preserves_aligned_opening + config _ _ aligned notTimeout + have firing := fair 0 (fun n _ => alignedAlways n) + let n := firing.choose + have timeout := firing.choose_spec.2 + apply neverOpen (n + 1) + rw [execution.step_succ n, timeout] + exact aligned_timeout_transitions_to_open config _ (alignedAlways n) + +end DisasterRecovery.Protocol \ No newline at end of file diff --git a/lean/disaster-recovery/DisasterRecovery/Properties.lean b/lean/disaster-recovery/DisasterRecovery/Properties.lean new file mode 100644 index 000000000000..17854b30611a --- /dev/null +++ b/lean/disaster-recovery/DisasterRecovery/Properties.lean @@ -0,0 +1,209 @@ +import DisasterRecovery.Proofs.GlobalTemporal + +/-! +# Human-reviewed system properties + +Review these statements together with the definitions and assumptions in +`DisasterRecovery.Protocol`. Each theorem explicitly applies a machine-checked +lemma from `DisasterRecovery.Proofs`; changing a statement must preserve that +checked connection. Intermediate facts remain lemmas in the proof modules. +-/ + +namespace DisasterRecovery.Protocol.Properties + +/-! ## Local safety and progress -/ + +theorem gossip_freezes_after_choice + (config : Config) + (state : NodeState) + (source : Location) + (txid : TxID) + (chosen : state.chosen.isSome = true) : + let output := step config state (.receiveGossip source txid .accepted) + output.state = state /\ output.accepted = false := + DisasterRecovery.Protocol.gossip_freezes_after_choice config state source txid chosen + +theorem rejected_gossip_stutters + (config : Config) + (state : NodeState) + (source : Location) + (txid : TxID) : + let output := step config state (.receiveGossip source txid .rejected) + output.state = state /\ output.accepted = false := + DisasterRecovery.Protocol.rejected_gossip_stutters config state source txid + +theorem quorum_advance_opens + (config : Config) + (state : NodeState) + (phase : state.phase = .voting) + (quorum : state.votes.length >= voteQuorum config) : + let output := (advance config state false).get! + output.state.phase = .opening /\ + output.state.openKind = some .quorum /\ + output.effects = [.opening .quorum] := + DisasterRecovery.Protocol.quorum_advance_opens config state phase quorum + +theorem aligned_opening_timeout_completes + (config : Config) + (state : NodeState) : + let opening := { + state with + phase := .opening + timeoutState := .opening + } + let output := step config opening .timeout + output.state.phase = .open /\ + output.state.timeoutState = .opening /\ + output.effects = [.completed] := + DisasterRecovery.Protocol.aligned_opening_timeout_completes config state + +theorem fair_aligned_opening_progress + {config : Config} + (execution : Execution config) + (initial : AlignedOpening (execution.states 0)) + (fair : WeakFairness execution AlignedOpening + (fun _ event => event = .timeout)) : + EventuallyFrom 0 + (fun n => (execution.states n).phase = .open) := + DisasterRecovery.Protocol.fair_aligned_opening_progress execution initial fair + +end DisasterRecovery.Protocol.Properties + +namespace DisasterRecovery.Protocol.Global.Properties + +/-! ## Reachability and quorum safety -/ + +theorem reachable_well_formed + {config : Config} + {state : State} + (reachable : Reachable config state) : + WellFormed config state := + DisasterRecovery.Protocol.Global.reachable_well_formed reachable + +theorem reachable_quorum_invariant + {config : Config} + {state : State} + (reachable : Reachable config state) : + QuorumInvariant config state := + DisasterRecovery.Protocol.Global.reachable_quorum_invariant reachable + +theorem quorum_opener_unique + {config : Config} + {state : State} + {first second : Location} + (reachable : Reachable config state) + (firstOpened : QuorumOpened state first) + (secondOpened : QuorumOpened state second) : + first = second := + DisasterRecovery.Protocol.Global.quorum_opener_unique + reachable firstOpened secondOpened + +/-! ## Committed-prefix safety -/ + +theorem full_gossip_selection_preserves_commit + {config : Config} + {state : State} + {opener : Location} + {committed : TxID} + (reachable : Reachable config state) + (full : FullGossipSelection config state opener) + (durable : DurableCommit config committed) : + exists recovered, + recoveredTxID config opener = some recovered /\ + TxID.PrefixOf committed recovered := + DisasterRecovery.Protocol.Global.full_gossip_selection_preserves_commit + reachable full durable + +theorem quorum_open_preserves_commit + {config : Config} + {state : State} + {opener : Location} + {committed : TxID} + (reachable : Reachable config state) + (opened : QuorumOpened state opener) + (full : FullGossipSelection config state opener) + (durable : DurableCommit config committed) : + exists recovered, + recoveredTxID config opener = some recovered /\ + TxID.PrefixOf committed recovered := + DisasterRecovery.Protocol.Global.quorum_open_preserves_commit + reachable opened full durable + +/-! ## Conditional global progress -/ + +theorem fair_opening_completes + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + {start : Nat} + {node : Location} + (active : node ∈ (execution.states start).active) + (phase : HasPhase (execution.states start) node .opening) : + EventuallyFrom start (fun n => + CompletedOpen (execution.states n) node) := + DisasterRecovery.Protocol.Global.fair_opening_completes + execution initial fair active phase + +theorem fair_some_opener_completes + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (activeNonempty : (execution.states 0).active ≠ []) : + EventuallyFrom 0 (fun n => + exists node, CompletedOpen (execution.states n) node) := + DisasterRecovery.Protocol.Global.fair_some_opener_completes + execution initial fair activeNonempty + +theorem global_progress + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + (activeNonempty : (execution.states 0).active ≠ []) : + EventuallyFrom 0 (fun n => + exists node, CompletedOpen (execution.states n) node) /\ + EventuallyFrom 0 (fun n => + forall node, node ∈ (execution.states 0).active -> + Terminal (execution.states n) node) := + DisasterRecovery.Protocol.Global.global_progress + execution initial fair broadcast activeNonempty + +theorem single_completion_path_joins_others + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener : Location} + (completed : CompletedOpen (execution.states start) opener) + (onlyOpener : OnlyOpenerCompletesFrom execution start opener) : + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + node = opener \/ node ∈ (execution.states n).restarts) := + DisasterRecovery.Protocol.Global.single_completion_path_joins_others + execution initial fair broadcast completed onlyOpener + +theorem quorum_path_progress + {config : Config} + (execution : Execution config) + (initial : Reachable config (execution.states 0)) + (fair : Fair execution) + (broadcast : BroadcastBeforeCompletion execution) + {start : Nat} + {opener : Location} + (opened : QuorumOpened (execution.states start) opener) + (completed : CompletedOpen (execution.states start) opener) + (quorumOnly : QuorumOnlyCompletions execution) : + QuorumOpened (execution.states start) opener /\ + CompletedOpen (execution.states start) opener /\ + EventuallyFrom start (fun n => + forall node, node ∈ (execution.states start).active -> + node = opener \/ node ∈ (execution.states n).restarts) := + DisasterRecovery.Protocol.Global.quorum_path_progress + execution initial fair broadcast opened completed quorumOnly + +end DisasterRecovery.Protocol.Global.Properties diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean index aeaec563bea1..142d2a0735e8 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean @@ -1,5 +1,6 @@ import DisasterRecovery.Protocol.Quorum -import Mathlib.Tactic + +/-! Human-reviewed committed-prefix ordering and completeness assumptions. -/ namespace DisasterRecovery.Protocol @@ -9,172 +10,10 @@ def PrefixOf (left right : TxID) : Prop := left.view < right.view \/ (left.view = right.view /\ left.seqno <= right.seqno) -theorem prefix_refl (txid : TxID) : PrefixOf txid txid := by - simp [PrefixOf] - -theorem prefix_trans - {first second third : TxID} - (firstSecond : PrefixOf first second) - (secondThird : PrefixOf second third) : - PrefixOf first third := by - simp [PrefixOf] at firstSecond secondThird ⊢ - omega - end TxID namespace Global -theorem prefix_of_score_true - (leftName rightName : Location) - (left right : TxID) - (score : - txScoreGreater leftName left rightName right = true) : - TxID.PrefixOf right left := by - simp [txScoreGreater] at score - simp [TxID.PrefixOf] - omega - -theorem prefix_of_score_false - (leftName rightName : Location) - (left right : TxID) - (score : - txScoreGreater leftName left rightName right = false) : - TxID.PrefixOf left right := by - simp [txScoreGreater] at score - simp [TxID.PrefixOf] - omega - -theorem current_prefix_selectMaximum - (current candidate : Prod Location TxID) : - TxID.PrefixOf current.2 - (selectMaximum current candidate).2 := by - unfold selectMaximum - split - · rename_i score - exact prefix_of_score_true - candidate.1 current.1 candidate.2 current.2 score - · exact TxID.prefix_refl current.2 - -theorem candidate_prefix_selectMaximum - (current candidate : Prod Location TxID) : - TxID.PrefixOf candidate.2 - (selectMaximum current candidate).2 := by - unfold selectMaximum - split - · exact TxID.prefix_refl candidate.2 - · rename_i score - exact prefix_of_score_false - candidate.1 current.1 candidate.2 current.2 - (Bool.eq_false_iff.mpr score) - -theorem foldl_selectMaximum_upper_bound - (current member : Prod Location TxID) - (tail : List (Prod Location TxID)) - (membership : member = current \/ member ∈ tail) : - TxID.PrefixOf member.2 - (tail.foldl selectMaximum current).2 := by - induction tail generalizing current member with - | nil => - simp at membership - subst member - exact TxID.prefix_refl current.2 - | cons candidate rest ih => - simp only [List.foldl_cons] - rcases membership with currentMember | tailMember - · subst member - exact TxID.prefix_trans - (current_prefix_selectMaximum current candidate) - (ih (selectMaximum current candidate) - (selectMaximum current candidate) (Or.inl rfl)) - · rw [List.mem_cons] at tailMember - rcases tailMember with candidateMember | restMember - · subst member - exact TxID.prefix_trans - (candidate_prefix_selectMaximum current candidate) - (ih (selectMaximum current candidate) - (selectMaximum current candidate) (Or.inl rfl)) - · exact ih (selectMaximum current candidate) member - (Or.inr restMember) - -theorem maximumGossip_upper_bound - {gossips : List (Prod Location TxID)} - {selected member : Prod Location TxID} - (maximum : maximumGossip gossips = some selected) - (membership : member ∈ gossips) : - TxID.PrefixOf member.2 selected.2 := by - cases gossips with - | nil => simp at membership - | cons head tail => - simp [maximumGossip] at maximum - rw [←maximum] - apply foldl_selectMaximum_upper_bound head member tail - simpa using membership - -theorem foldl_selectMaximum_mem - (current : Prod Location TxID) - (tail : List (Prod Location TxID)) : - tail.foldl selectMaximum current ∈ current :: tail := by - induction tail generalizing current with - | nil => simp - | cons candidate rest ih => - simp only [List.foldl_cons] - have selected : - selectMaximum current candidate = current \/ - selectMaximum current candidate = candidate := by - unfold selectMaximum - split <;> simp - have member := - ih (selectMaximum current candidate) - rw [List.mem_cons] at member - rcases member with currentMember | restMember - · rw [currentMember] - rcases selected with selected | selected - · simp [selected] - · simp [selected] - · simp [restMember] - -theorem maximumGossip_mem - {gossips : List (Prod Location TxID)} - {selected : Prod Location TxID} - (maximum : maximumGossip gossips = some selected) : - selected ∈ gossips := by - cases gossips with - | nil => simp [maximumGossip] at maximum - | cons head tail => - simp [maximumGossip] at maximum - rw [←maximum] - exact foldl_selectMaximum_mem head tail - -theorem recoveredTxID_of_mem - {config : Config} - {location : Location} - {txid : TxID} - (valid : config.Valid) - (membership : (location, txid) ∈ config.recovered) : - recoveredTxID config location = some txid := by - have keysNodup : (config.recovered.map Prod.fst).Nodup := by - rw [valid.2.2] - exact valid.2.1 - unfold recoveredTxID - cases found : - config.recovered.find? fun entry => entry.1 == location with - | none => - rw [List.find?_eq_none] at found - exact False.elim - (found (location, txid) membership (by simp)) - | some entry => - have foundMember : entry ∈ config.recovered := - List.mem_of_find?_eq_some found - have foundLocation : entry.1 = location := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location TxID => - entry.1 == location) found) - have same : - entry = (location, txid) := - eq_of_key_eq keysNodup foundMember membership foundLocation - simp [same] - def FullGossipSelection (config : Config) (state : State) @@ -192,67 +31,6 @@ def DurableCommit (config : Config) (committed : TxID) : Prop := (location, txid) ∈ config.recovered /\ TxID.PrefixOf committed txid -theorem full_gossip_selection_preserves_commit - {config : Config} - {state : State} - {opener : Location} - {committed : TxID} - (reachable : Reachable config state) - (full : FullGossipSelection config state opener) - (durable : DurableCommit config committed) : - exists recovered, - recoveredTxID config opener = some recovered /\ - TxID.PrefixOf committed recovered := by - have configValid := reachable_config_valid reachable - have wellFormed := reachable_well_formed reachable - have invariant := reachable_quorum_invariant reachable - rcases full with - ⟨vote, sent, payload, target, complete⟩ - have voteState := - retry_vote_state (wellFormed.sentValid vote sent) payload - rcases invariant.sentVotesSelected vote sent payload with - ⟨selectedTarget, selectedTxID, choice, selected⟩ - have selectedTargetEq : selectedTarget = vote.target := - Option.some.inj (choice.symm.trans voteState.2) - rw [selectedTargetEq, target] at selected - rcases durable with - ⟨durableLocation, durableTxID, durableMember, committedDurable⟩ - have durableGossip : - (durableLocation, durableTxID) ∈ vote.sourceState.gossips := - (complete (durableLocation, durableTxID)).2 durableMember - have durableMaximum := - maximumGossip_upper_bound selected durableGossip - have selectedGossip : - (opener, selectedTxID) ∈ vote.sourceState.gossips := - maximumGossip_mem selected - have selectedRecovered : - (opener, selectedTxID) ∈ config.recovered := - (complete (opener, selectedTxID)).1 selectedGossip - exact - ⟨selectedTxID, - recoveredTxID_of_mem configValid selectedRecovered, - TxID.prefix_trans committedDurable durableMaximum⟩ - -/-- -Quorum opening scopes the result to an actual decision, while the separate -`FullGossipSelection` premise carries the completeness requirement. Quorum -opening alone does not imply complete gossip because voting may follow a -gossip timeout. --/ -theorem quorum_open_preserves_commit - {config : Config} - {state : State} - {opener : Location} - {committed : TxID} - (reachable : Reachable config state) - (_opened : QuorumOpened state opener) - (full : FullGossipSelection config state opener) - (durable : DurableCommit config committed) : - exists recovered, - recoveredTxID config opener = some recovered /\ - TxID.PrefixOf committed recovered := - full_gossip_selection_preserves_commit reachable full durable - end Global end DisasterRecovery.Protocol diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean index c7cac044b5f6..de535ee12fd7 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean @@ -1,6 +1,7 @@ import DisasterRecovery.Protocol.Committed import DisasterRecovery.Protocol.Temporal -import Mathlib.Tactic + +/-! Human-reviewed global execution, termination and fairness assumptions. -/ namespace DisasterRecovery.Protocol.Global @@ -30,20 +31,6 @@ def LaneAdvanced (state : State) (node : Location) : Prop := Global.nodeState state node = some nodeState /\ nodeState.timeoutState ≠ .gossiping -theorem hasPhase_unique - {state : State} - {node : Location} - {first second : Phase} - (firstPhase : HasPhase state node first) - (secondPhase : HasPhase state node second) : - first = second := by - rcases firstPhase with ⟨firstState, firstFound, firstEq⟩ - rcases secondPhase with ⟨secondState, secondFound, secondEq⟩ - rw [firstFound] at secondFound - injection secondFound with stateEq - subst secondState - exact firstEq.symm.trans secondEq - def Terminal (state : State) (node : Location) : Prop := node ∈ state.restarts \/ node ∈ state.completed @@ -144,269 +131,6 @@ def NodeLanesValid (state : State) : Prop := forall entry, entry ∈ state.system.nodes -> LaneValid entry.2 -theorem step_preserves_lane - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (valid : LaneValid state) : - LaneValid (step config state event).state := by - cases event - all_goals try cases_type Validation - all_goals - simp [LaneValid, step, rejected, advance, advanceTimeoutLane, - advanceTimeoutState, validTimeout] at valid ⊢ - all_goals repeat first | split | simp_all | aesop - -theorem step_preserves_advanced_lane - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (advanced : state.timeoutState ≠ .gossiping) : - (step config state event).state.timeoutState ≠ .gossiping := by - cases event - all_goals try cases_type Validation - all_goals - simp [step, rejected, advance, validTimeout, advanceTimeoutLane, - advanceTimeoutState] at advanced ⊢ - all_goals repeat first | split | simp_all - -theorem systemStep_preserves_lanes - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (valid : - forall entry, entry ∈ before.nodes -> - LaneValid entry.2) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - LaneValid entry.2 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · apply step_preserves_lane config node event - exact valid (key, node) (List.mem_of_find?_eq_some found) - · exact valid previous previousMember - -theorem initial_lanes_valid - (config : Config) - (active : List Location) : - NodeLanesValid (initial config active) := by - simp [NodeLanesValid, LaneValid, Global.initial, initialSystem, - initialNode] - -theorem next_preserves_lanes - {config : Config} - {before after : State} - {action : Action} - (valid : NodeLanesValid before) - (transition : next config before action = some after) : - NodeLanesValid after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact valid - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, rfl⟩ - intro entry membership - rw [recordEffects_system] at membership - exact systemStep_preserves_lanes valid systemStep - entry membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, rfl⟩ - intro entry membership - rw [recordEffects_system] at membership - exact systemStep_preserves_lanes valid systemStep - entry membership - -theorem reachable_lanes_valid - {config : Config} - {state : State} - (reachable : Reachable config state) : - NodeLanesValid state := by - induction reachable with - | initial active valid nodup configured => - exact initial_lanes_valid config active - | step reachable transition valid => - exact next_preserves_lanes valid transition - -theorem nodeState_eq_of_mem - {state : State} - {node : Location} - {foundState : NodeState} - (keysNodup : (state.system.nodes.map Prod.fst).Nodup) - (membership : (node, foundState) ∈ state.system.nodes) : - Global.nodeState state node = some foundState := by - unfold Global.nodeState - cases found : - state.system.nodes.find? fun entry => entry.1 == node with - | none => - rw [List.find?_eq_none] at found - exact False.elim - (found (node, foundState) membership (by simp)) - | some entry => - have foundMember : entry ∈ state.system.nodes := - List.mem_of_find?_eq_some found - have foundKey : entry.1 = node := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) found) - have same : entry = (node, foundState) := - eq_of_key_eq keysNodup foundMember membership foundKey - simp [same] - -theorem node_property_of_nodeState - {state : State} - {node : Location} - {foundState : NodeState} - {predicate : NodeState -> Prop} - (property : - forall entry, entry ∈ state.system.nodes -> - predicate entry.2) - (found : Global.nodeState state node = some foundState) : - predicate foundState := by - rw [Global.nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - rw [←stateEq] - exact property entry (List.mem_of_find?_eq_some findEq) - -theorem deliver_target_state - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (transition : next config before (.deliver envelope) = some after) : - exists output, - Global.nodeState after envelope.target = some output.state /\ - systemStep config.protocol before.system envelope.target - (eventFor envelope) = some (after.system, output) := by - have afterWellFormed := - next_preserves_well_formed wellFormed transition - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] at afterWellFormed ⊢ - refine ⟨output, ?_, ?_⟩ - · apply nodeState_eq_of_mem afterWellFormed.nodeKeysNodup - rw [recordEffects_system] - exact systemStep_output_mem systemStep - · simpa using systemStep - -theorem timeout_target_state - {config : Config} - {before after : State} - {target : Location} - (wellFormed : WellFormed config before) - (transition : next config before (.timeout target) = some after) : - exists output, - Global.nodeState after target = some output.state /\ - output.accepted = true /\ - systemStep config.protocol before.system target .timeout = - some (after.system, output) := by - have afterWellFormed := - next_preserves_well_formed wellFormed transition - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, accepted, stateEq⟩ - rw [←stateEq] at afterWellFormed ⊢ - refine ⟨output, ?_, accepted, ?_⟩ - · apply nodeState_eq_of_mem afterWellFormed.nodeKeysNodup - rw [recordEffects_system] - exact systemStep_output_mem systemStep - · simpa using systemStep - -theorem systemStep_output_eq - {config : Protocol.Config} - {global : State} - {after : SystemState} - {target : Location} - {event : Event} - {state : NodeState} - {output : StepOutput} - (found : Global.nodeState global target = some state) - (transition : - systemStep config global.system target event = some (after, output)) : - output = step config state event := by - change - (do - let node <- Global.nodeState global target - let result := step config node event - pure ({ - nodes := replaceNode target result.state global.system.nodes - }, result)) = some (after, output) at transition - rw [found] at transition - simp at transition - exact transition.2.symm - -theorem completed_effect_recorded - {node : Location} - {nodeState : NodeState} - {effects : List Effect} - {state : State} - (completed : .completed ∈ effects) : - node ∈ (recordEffects node nodeState effects state).completed := by - induction effects generalizing state with - | nil => simp at completed - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - rw [List.mem_cons] at completed - rcases completed with rfl | inTail - · apply mem_completed_recordEffects - simp [recordEffect] - · exact ih inTail - -theorem restart_effect_recorded - {node chosen : Location} - {nodeState : NodeState} - {effects : List Effect} - {state : State} - (restart : .restart chosen ∈ effects) : - node ∈ (recordEffects node nodeState effects state).restarts := by - induction effects generalizing state with - | nil => simp at restart - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - rw [List.mem_cons] at restart - rcases restart with rfl | inTail - · apply mem_restarts_recordEffects - simp [recordEffect] - · exact ih inTail - -theorem mem_removeOne_or_eq - [BEq α] - [LawfulBEq α] - {member removed : α} - {values : List α} - (membership : member ∈ values) : - member ∈ removeOne removed values \/ member = removed := by - induction values with - | nil => simp at membership - | cons head tail ih => - rw [List.mem_cons] at membership - rcases membership with rfl | inTail - · by_cases equal : member = removed - · exact Or.inr equal - · exact Or.inl (by simp [removeOne, equal]) - · simp only [removeOne] - split - · exact Or.inl inTail - · rcases ih inTail with still | equal - · exact Or.inl (by simp [still]) - · exact Or.inr equal - structure Fair {config : Config} (execution : Execution config) : Prop where @@ -443,2726 +167,14 @@ structure Fair (HasPhase (execution.states n) node .opening /\ execution.actions n = .timeout node)) -theorem execution_reachable - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) : - forall n, Reachable config (execution.states n) := by - intro n - induction n with - | zero => exact initial - | succ n reachable => - exact Reachable.step reachable (execution.step_succ n) - -theorem execution_active_eq - {config : Config} - (execution : Execution config) : - forall n, (execution.states n).active = (execution.states 0).active := by - intro n - induction n with - | zero => rfl - | succ n activeEq => - exact (next_active_eq (execution.step_succ n)).trans activeEq - -theorem active_at - {config : Config} - (execution : Execution config) - {node : Location} - (active : node ∈ (execution.states 0).active) : - forall n, node ∈ (execution.states n).active := by - intro n - rw [execution_active_eq execution n] - exact active - -theorem recovered_for_configured - {config : Config} - (valid : config.Valid) - {node : Location} - (configured : node ∈ config.protocol.expectedLocations) : - exists txid, recoveredTxID config node = some txid := by - rw [←valid.2.2] at configured - rcases List.mem_map.mp configured with - ⟨entry, membership, keyEq⟩ - rcases entry with ⟨location, txid⟩ - simp at keyEq - subst location - refine ⟨txid, ?_⟩ - apply recoveredTxID_of_mem valid - exact membership - -theorem active_nodeState - {config : Config} - {state : State} - (wellFormed : WellFormed config state) - {node : Location} - (active : node ∈ state.active) : - exists nodeState, - Global.nodeState state node = some nodeState := by - have configured := wellFormed.activeConfigured node active - rw [←wellFormed.nodeKeys] at configured - rcases List.mem_map.mp configured with - ⟨entry, membership, keyEq⟩ - refine ⟨entry.2, ?_⟩ - apply nodeState_eq_of_mem wellFormed.nodeKeysNodup - rcases entry with ⟨location, nodeState⟩ - simp at keyEq - subst location - exact membership - -theorem retryMessages_self_gossip - {config : Config} - {node : Location} - {state : NodeState} - {txid : TxID} - (phase : state.phase = .gossiping) - (configured : node ∈ config.protocol.expectedLocations) - (recovered : recoveredTxID config node = some txid) : - { - source := node - target := node - payload := Payload.gossip txid - sourceState := state - } ∈ retryMessages config node state := by - rw [retryMessages, List.mem_filterMap] - refine ⟨.sendGossip node, ?_, ?_⟩ - · simpa [step, phase] using configured - · simp [messageForEffect, recovered] - -theorem retryMessages_vote - {config : Config} - {node target : Location} - {state : NodeState} - (phase : state.phase = .voting) - (chosen : state.chosen = some target) : - { - source := node - target - payload := Payload.vote - sourceState := state - } ∈ retryMessages config node state := by - rw [retryMessages, List.mem_filterMap] - refine ⟨.sendVote target, ?_, rfl⟩ - simp [step, phase, chosen] - -theorem retry_iamopen_state - {config : Config} - {envelope : Envelope} - (valid : envelope.Valid config) - (announcement : envelope.payload = .iAmOpen) : - envelope.sourceState.phase = .opening := by - rcases valid_envelope_effect valid with - ⟨effect, member, created⟩ - cases effect with - | sendGossip target => - cases found : recoveredTxID config envelope.source with - | none => simp [messageForEffect, found] at created - | some txid => - simp [messageForEffect, found] at created - rw [←created] at announcement - contradiction - | sendVote target => - simp [messageForEffect] at created - rw [←created] at announcement - contradiction - | sendIAmOpen target => - simp [messageForEffect] at created - rw [←created] at announcement ⊢ - cases phase : envelope.sourceState.phase - case opening => rfl - case voting => - cases chosen : envelope.sourceState.chosen <;> - simp [step, phase, chosen] at member - all_goals simp [step, phase] at member - | opening kind => simp [messageForEffect] at created - | restart chosen => simp [messageForEffect] at created - | completed => simp [messageForEffect] at created - | rejected reason => simp [messageForEffect] at created - def acceptedIAmOpenSource : Event -> Option Location | .receiveIAmOpen source .accepted => some source | _ => none -theorem step_joining_origin - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (joining : (step config state event).state.phase = .joining) : - state.phase = .joining \/ - exists source, acceptedIAmOpenSource event = some source := by - cases event - all_goals try cases_type Validation - all_goals - simp [acceptedIAmOpenSource, step, rejected, advance, - advanceTimeoutLane] at joining ⊢ - all_goals - repeat first | split at joining | split | simp_all | aesop - -theorem step_open_origin - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (opened : (step config state event).state.phase = .open) : - state.phase = .open \/ - .completed ∈ (step config state event).effects := by - cases event - all_goals try cases_type Validation - all_goals - simp [step, rejected, advance, advanceTimeoutLane, validTimeout] - at opened ⊢ - all_goals - repeat first | split at opened | split | simp_all | aesop - -theorem iamopen_delivery_outcome - (config : Protocol.Config) - (state : NodeState) - (source : Location) : - let output := step config state (.receiveIAmOpen source .accepted) - output.state.phase = .opening \/ - output.state.phase = .open \/ - exists chosen, .restart chosen ∈ output.effects := by - cases phase : state.phase <;> - simp [step, phase, rejected, advance, advanceTimeoutLane] - -theorem iamopen_open_predecessor - (config : Protocol.Config) - (state : NodeState) - (source : Location) - (opened : - (step config state (.receiveIAmOpen source .accepted)).state.phase = - .open) : - state.phase = .open := by - cases phase : state.phase <;> - simp [step, phase, rejected, advance, advanceTimeoutLane] at opened - rfl - -theorem eventFor_iamopen_source - {envelope : Envelope} - {source : Location} - (accepted : - acceptedIAmOpenSource (eventFor envelope) = some source) : - envelope.payload = .iAmOpen /\ - envelope.source = source := by - cases payload : envelope.payload <;> - simp_all [eventFor, acceptedIAmOpenSource] - -theorem retry_gossip_enabled - {config : Config} - {state : State} - {node : Location} - (valid : config.Valid) - (wellFormed : WellFormed config state) - (active : node ∈ state.active) - (phase : HasPhase state node .gossiping) : - Enabled config state (.retry node) := by - rcases phase with ⟨nodeState, found, gossiping⟩ - have configured := wellFormed.activeConfigured node active - rcases recovered_for_configured valid configured with - ⟨txid, recovered⟩ - have message := - retryMessages_self_gossip gossiping configured recovered - have messagesNonempty : - retryMessages config node nodeState ≠ [] := by - intro empty - rw [empty] at message - simp at message - refine ⟨{ - state with - network := state.network ++ retryMessages config node nodeState - sent := state.sent ++ retryMessages config node nodeState - }, ?_⟩ - simp [next, active, found, messagesNonempty] - -theorem retry_voting_enabled - {config : Config} - {state : State} - {node target : Location} - {nodeState : NodeState} - (active : node ∈ state.active) - (found : Global.nodeState state node = some nodeState) - (phase : nodeState.phase = .voting) - (chosen : nodeState.chosen = some target) : - Enabled config state (.retry node) := by - have message := retryMessages_vote (config := config) - (node := node) phase chosen - have messagesNonempty : - retryMessages config node nodeState ≠ [] := by - intro empty - rw [empty] at message - simp at message - refine ⟨{ - state with - network := state.network ++ retryMessages config node nodeState - sent := state.sent ++ retryMessages config node nodeState - }, ?_⟩ - simp [next, active, found, messagesNonempty] - -theorem delivery_enabled - {config : Config} - {state : State} - {envelope : Envelope} - (wellFormed : WellFormed config state) - (network : envelope ∈ state.network) - (targetActive : envelope.target ∈ state.active) : - Enabled config state (.deliver envelope) := by - rcases active_nodeState wellFormed targetActive with - ⟨targetState, found⟩ - let output := step config.protocol targetState (eventFor envelope) - let system : SystemState := { - nodes := replaceNode envelope.target output.state state.system.nodes - } - let delivered : State := { - state with - system - network := removeOne envelope state.network - } - have stepResult : - systemStep config.protocol state.system envelope.target - (eventFor envelope) = some (system, output) := by - change - (do - let node <- Global.nodeState state envelope.target - let result := step config.protocol node (eventFor envelope) - pure ({ - nodes := - replaceNode envelope.target result.state state.system.nodes - }, result)) = some (system, output) - rw [found] - rfl - refine - ⟨recordEffects envelope.target output.state output.effects delivered, ?_⟩ - simp [next, network, targetActive, stepResult, output, system, - delivered] - -theorem timeout_enabled_of_accepted - {config : Config} - {state : State} - {node : Location} - {nodeState : NodeState} - (active : node ∈ state.active) - (found : Global.nodeState state node = some nodeState) - (accepted : (step config.protocol nodeState .timeout).accepted = true) : - Enabled config state (.timeout node) := by - let output := step config.protocol nodeState .timeout - let system : SystemState := { - nodes := replaceNode node output.state state.system.nodes - } - have stepResult : - systemStep config.protocol state.system node .timeout = - some (system, output) := by - change - (do - let current <- Global.nodeState state node - let result := step config.protocol current .timeout - pure ({ - nodes := replaceNode node result.state state.system.nodes - }, result)) = some (system, output) - rw [found] - rfl - refine - ⟨recordEffects node output.state output.effects - { state with system }, ?_⟩ - simp [next, active, stepResult, accepted, output, system] - -theorem retry_gossip_enqueued - {config : Config} - {before after : State} - {node : Location} - (valid : config.Valid) - (wellFormed : WellFormed config before) - (phase : HasPhase before node .gossiping) - (transition : next config before (.retry node) = some after) : - exists envelope, - envelope ∈ after.network /\ - envelope.source = node /\ - envelope.target = node /\ - exists txid, envelope.payload = .gossip txid := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨active, sourceState, found, _, stateEq⟩ - rcases phase with ⟨phaseState, foundPhase, gossiping⟩ - have configured := - wellFormed.activeConfigured node active - rcases recovered_for_configured valid configured with - ⟨txid, recovered⟩ - rw [found] at foundPhase - injection foundPhase with stateEq' - subst phaseState - let envelope : Envelope := { - source := node - target := node - payload := .gossip txid - sourceState - } - have message : envelope ∈ retryMessages config node sourceState := - retryMessages_self_gossip gossiping configured recovered - rw [←stateEq] - exact - ⟨envelope, List.mem_append_right _ message, rfl, rfl, txid, rfl⟩ - -theorem retry_vote_enqueued - {config : Config} - {before after : State} - {node target : Location} - {nodeState : NodeState} - (found : Global.nodeState before node = some nodeState) - (phase : nodeState.phase = .voting) - (chosen : nodeState.chosen = some target) - (transition : next config before (.retry node) = some after) : - exists envelope, - envelope ∈ after.network /\ - envelope.source = node /\ - envelope.target = target /\ - envelope.payload = .vote := by - have message := retryMessages_vote (config := config) - (node := node) phase chosen - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, actualState, actualFound, _, stateEq⟩ - rw [found] at actualFound - injection actualFound with actualEq - subst actualState - let envelope : Envelope := { - source := node - target - payload := .vote - sourceState := nodeState - } - rw [←stateEq] - exact - ⟨envelope, List.mem_append_right _ message, rfl, rfl, rfl⟩ - -theorem insertGossip_nonempty - (source : Location) - (txid : TxID) - (gossips : List (Prod Location TxID)) : - insertGossip source txid gossips ≠ [] := by - unfold insertGossip - split - · rename_i present - intro empty - subst gossips - simp at present - · intro empty - have lengths := - (List.mergeSort_perm ((source, txid) :: gossips) - (fun left right => left.1 <= right.1)).length_eq - rw [empty] at lengths - simp at lengths - -theorem maximumGossip_some - {gossips : List (Prod Location TxID)} - (nonempty : gossips ≠ []) : - exists selected, maximumGossip gossips = some selected := by - cases gossips with - | nil => contradiction - | cons head tail => - exact ⟨tail.foldl selectMaximum head, rfl⟩ - -theorem gossip_receive_progress - (config : Protocol.Config) - (state : NodeState) - (source : Location) - (txid : TxID) - (valid : LaneValid state) - (phase : state.phase = .gossiping) : - let output := - step config state (.receiveGossip source txid .accepted) - output.state.phase ≠ .gossiping \/ - output.state.gossips ≠ [] := by - have chosen := valid.2.2.2 phase - have nonempty := insertGossip_nonempty source txid state.gossips - obtain ⟨selected, maximum⟩ := maximumGossip_some nonempty - simp [step, phase, chosen, rejected, advance, advanceTimeoutLane, - validTimeout] - repeat first | split | simp_all - -theorem gossip_timeout_progress - (config : Protocol.Config) - (state : NodeState) - (valid : LaneValid state) - (phase : state.phase = .gossiping) - (accepted : (step config state .timeout).accepted = true) : - (step config state .timeout).state.phase = .voting := by - have lane := valid.1 phase - simp [step, phase, lane, rejected, advance, advanceTimeoutLane, - validTimeout] at accepted ⊢ - repeat first | split at accepted | split | simp_all - -theorem gossip_timeout_enabled_local - (config : Protocol.Config) - (state : NodeState) - (valid : LaneValid state) - (phase : state.phase = .gossiping) - (nonempty : state.gossips ≠ []) : - (step config state .timeout).accepted = true := by - have lane := valid.1 phase - obtain ⟨selected, maximum⟩ := maximumGossip_some nonempty - simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, - maximum] - -theorem gossip_timeout_enabled - {config : Config} - {state : State} - {node : Location} - (active : node ∈ state.active) - (lanes : NodeLanesValid state) - (phase : HasPhase state node .gossiping) - (gossip : HasGossip state node) : - Enabled config state (.timeout node) := by - rcases phase with ⟨phaseState, foundPhase, gossiping⟩ - rcases gossip with ⟨gossipState, foundGossip, nonempty⟩ - rw [foundPhase] at foundGossip - injection foundGossip with stateEq - subst gossipState - have lane := node_property_of_nodeState lanes foundPhase - apply timeout_enabled_of_accepted active foundPhase - exact gossip_timeout_enabled_local config.protocol phaseState lane - gossiping nonempty - def openingDistance : Phase -> Nat | .gossiping => 3 | .voting => 2 | .opening => 1 | .joining | .open => 0 -theorem opening_timeout_local - (config : Protocol.Config) - (state : NodeState) - (valid : LaneValid state) - (phase : state.phase = .opening) : - let output := step config state .timeout - (output.effects = [.completed] /\ output.state.phase = .open) \/ - (output.state.phase = .opening /\ - openingDistance output.state.timeoutState < - openingDistance state.timeoutState) := by - rcases valid.2.2.1 phase with lane | lane | lane - · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, - advanceTimeoutState, openingDistance] - · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, - advanceTimeoutState, openingDistance] - · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, - advanceTimeoutState, openingDistance] - -theorem opening_step_distance_le - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (valid : LaneValid state) - (phase : state.phase = .opening) - (after : (step config state event).state.phase = .opening) : - openingDistance (step config state event).state.timeoutState <= - openingDistance state.timeoutState := by - cases event with - | receiveGossip source txid validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - repeat first | split | simp_all - | receiveVote source validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - | receiveIAmOpen source validation => - cases validation <;> simp [step, phase, rejected] - | timeout => - rcases opening_timeout_local config state valid phase with - done | progress - · rw [done.2] at after - contradiction - · exact Nat.le_of_lt progress.2 - | retry => simp [step] - -theorem opening_step_or_completed - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (phase : state.phase = .opening) : - (step config state event).state.phase = .opening \/ - ((step config state event).state.phase = .open /\ - .completed ∈ (step config state event).effects) := by - cases event with - | receiveGossip source txid validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - repeat first | split | simp_all - | receiveVote source validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - | receiveIAmOpen source validation => - cases validation <;> simp [step, phase, rejected] - | timeout => - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - split <;> simp_all - | retry => simp [step, phase] - -theorem opening_non_timeout - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (phase : state.phase = .opening) - (notTimeout : event ≠ .timeout) : - (step config state event).state.phase = .opening /\ - (step config state event).state.timeoutState = - state.timeoutState := by - cases event with - | receiveGossip source txid validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - repeat first | split | simp_all - | receiveVote source validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - | receiveIAmOpen source validation => - cases validation <;> simp [step, phase, rejected] - | timeout => contradiction - | retry => exact ⟨phase, rfl⟩ - -theorem opening_timeout_enabled - {config : Config} - {state : State} - {node : Location} - (active : node ∈ state.active) - (phase : HasPhase state node .opening) : - Enabled config state (.timeout node) := by - rcases phase with ⟨nodeState, found, opening⟩ - apply timeout_enabled_of_accepted active found - simp [step, opening, advance, rejected] - repeat first | split | simp_all - -theorem timeout_opening_step - {config : Config} - {before after : State} - {node : Location} - {beforeState : NodeState} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (foundBefore : - Global.nodeState before node = some beforeState) - (opening : beforeState.phase = .opening) - (transition : next config before (.timeout node) = some after) : - CompletedOpen after node \/ - (exists nextState : NodeState, - Global.nodeState after node = some nextState /\ - nextState.phase = .opening /\ - openingDistance nextState.timeoutState < - openingDistance beforeState.timeoutState) := by - have lane : LaneValid beforeState := by - apply node_property_of_nodeState (predicate := LaneValid) - · exact lanes - · exact foundBefore - have timeoutResult : - ((step config.protocol beforeState .timeout).effects = - [.completed] /\ - (step config.protocol beforeState .timeout).state.phase = .open) \/ - ((step config.protocol beforeState .timeout).state.phase = - .opening /\ - openingDistance - (step config.protocol beforeState .timeout).state.timeoutState < - openingDistance beforeState.timeoutState) := - opening_timeout_local config.protocol beforeState lane opening - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - have outputEq := systemStep_output_eq foundBefore systemStep - rw [←outputEq] at timeoutResult - rw [←stateEq] - rcases timeoutResult with completed | progress - · exact Or.inl (by - rcases completed with ⟨effects, _⟩ - rw [effects] - simp [CompletedOpen, recordEffects, recordEffect]) - · exact Or.inr - ⟨output.state, - (by - apply nodeState_eq_of_mem - · rw [recordEffects_system, - systemStep_node_keys_eq systemStep] - exact wellFormed.nodeKeysNodup - · rw [recordEffects_system] - exact systemStep_output_mem systemStep), - progress.1, - by simpa using progress.2⟩ - -theorem next_opening_progress - {config : Config} - {before after : State} - {node : Location} - {beforeState : NodeState} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (foundBefore : - Global.nodeState before node = some beforeState) - (opening : beforeState.phase = .opening) - (transition : next config before action = some after) : - CompletedOpen after node \/ - (exists afterState : NodeState, - Global.nodeState after node = some afterState /\ - afterState.phase = .opening /\ - openingDistance afterState.timeoutState <= - openingDistance beforeState.timeoutState) := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact Or.inr - ⟨beforeState, foundBefore, opening, Nat.le_refl _⟩ - | deliver envelope => - by_cases target : node = envelope.target - · subst node - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - have preserved := - opening_non_timeout config.protocol beforeState - (eventFor envelope) opening - (by - cases payloadEq : envelope.payload <;> - simp [eventFor, payloadEq]) - rw [←outputEq] at preserved - exact Or.inr - ⟨output.state, foundAfter, preserved.1, - by rw [preserved.2]⟩ - · have unchanged := deliver_other_node_eq target transition - rw [foundBefore] at unchanged - exact Or.inr - ⟨beforeState, by simp [unchanged], opening, Nat.le_refl _⟩ - | timeout target => - by_cases same : node = target - · subst node - rcases timeout_opening_step wellFormed lanes foundBefore - opening transition with - completed | ⟨nextState, foundAfter, nextOpening, distance⟩ - · exact Or.inl completed - · exact Or.inr - ⟨nextState, foundAfter, nextOpening, - Nat.le_of_lt distance⟩ - · have unchanged := timeout_other_node_eq same transition - rw [foundBefore] at unchanged - exact Or.inr - ⟨beforeState, by simp [unchanged], opening, Nat.le_refl _⟩ - -theorem insertVote_nonempty - (source : Location) - (votes : List Location) : - insertVote source votes ≠ [] := by - unfold insertVote - split - · rename_i present - intro empty - subst votes - simp at present - · intro empty - have lengths := - (List.mergeSort_perm (source :: votes) - (fun left right => left <= right)).length_eq - rw [empty] at lengths - simp at lengths - -theorem step_preserves_nonempty_votes - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (nonempty : state.votes ≠ []) : - (step config state event).state.votes ≠ [] := by - rcases step_votes_shape config state event with - unchanged | ⟨source, _, changed⟩ - · rw [unchanged] - exact nonempty - · rw [changed] - exact insertVote_nonempty source state.votes - -theorem next_preserves_hasVote - {config : Config} - {before after : State} - {action : Action} - {node : Location} - (wellFormed : WellFormed config before) - (vote : HasVote before node) - (transition : next config before action = some after) : - HasVote after node := by - rcases vote with ⟨beforeState, foundBefore, nonempty⟩ - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact ⟨beforeState, foundBefore, nonempty⟩ - | deliver envelope => - by_cases target : node = envelope.target - · subst node - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact step_preserves_nonempty_votes - config.protocol beforeState (eventFor envelope) nonempty⟩ - · have unchanged := deliver_other_node_eq target transition - rw [foundBefore] at unchanged - exact ⟨beforeState, by simp [unchanged], nonempty⟩ - | timeout target => - by_cases same : node = target - · subst node - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact step_preserves_nonempty_votes - config.protocol beforeState .timeout nonempty⟩ - · have unchanged := timeout_other_node_eq same transition - rw [foundBefore] at unchanged - exact ⟨beforeState, by simp [unchanged], nonempty⟩ - -theorem hasVote_mono - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (vote : HasVote (execution.states start) node) : - HasVote (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact vote - | succ finish order vote => - exact next_preserves_hasVote - (reachable_well_formed - (execution_reachable execution initial finish)) - vote (execution.step_succ finish) - -theorem next_preserves_advanced_lane - {config : Config} - {before after : State} - {action : Action} - {node : Location} - (wellFormed : WellFormed config before) - (advanced : LaneAdvanced before node) - (transition : next config before action = some after) : - LaneAdvanced after node := by - rcases advanced with ⟨beforeState, foundBefore, lane⟩ - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact ⟨beforeState, foundBefore, lane⟩ - | deliver envelope => - by_cases target : node = envelope.target - · subst node - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact step_preserves_advanced_lane - config.protocol beforeState (eventFor envelope) lane⟩ - · have unchanged := deliver_other_node_eq target transition - rw [foundBefore] at unchanged - exact ⟨beforeState, by simp [unchanged], lane⟩ - | timeout target => - by_cases same : node = target - · subst node - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact step_preserves_advanced_lane - config.protocol beforeState .timeout lane⟩ - · have unchanged := timeout_other_node_eq same transition - rw [foundBefore] at unchanged - exact ⟨beforeState, by simp [unchanged], lane⟩ - -theorem advanced_lane_mono - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (advanced : LaneAdvanced (execution.states start) node) : - LaneAdvanced (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact advanced - | succ finish order advanced => - exact next_preserves_advanced_lane - (reachable_well_formed - (execution_reachable execution initial finish)) - advanced (execution.step_succ finish) - -theorem opening_progress_between - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start finish : Nat} - {node : Location} - {startState : NodeState} - (order : start <= finish) - (foundStart : - Global.nodeState (execution.states start) node = some startState) - (openingStart : startState.phase = .opening) - (notCompleted : - Not (CompletedOpen (execution.states finish) node)) : - exists finishState : NodeState, - Global.nodeState (execution.states finish) node = some finishState /\ - finishState.phase = .opening /\ - openingDistance finishState.timeoutState <= - openingDistance startState.timeoutState := by - induction finish, order using Nat.le_induction with - | base => - exact - ⟨startState, foundStart, openingStart, Nat.le_refl _⟩ - | succ finish order ih => - have notCompletedBefore : - Not (CompletedOpen (execution.states finish) node) := by - intro completed - exact notCompleted - (next_completed_monotonic - (execution.step_succ finish) node completed) - rcases ih notCompletedBefore with - ⟨beforeState, foundBefore, openingBefore, distanceBefore⟩ - rcases next_opening_progress - (reachable_well_formed - (execution_reachable execution initial finish)) - (reachable_lanes_valid - (execution_reachable execution initial finish)) - foundBefore openingBefore (execution.step_succ finish) with - completed | - ⟨afterState, foundAfter, openingAfter, distanceAfter⟩ - · contradiction - · exact - ⟨afterState, foundAfter, openingAfter, - Nat.le_trans distanceAfter distanceBefore⟩ - -theorem deliver_gossip_progress - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (payload : exists txid, envelope.payload = .gossip txid) - (phase : HasPhase before envelope.target .gossiping) - (transition : next config before (.deliver envelope) = some after) : - Not (HasPhase after envelope.target .gossiping) \/ - HasGossip after envelope.target := by - rcases phase with ⟨beforeState, foundBefore, gossiping⟩ - rcases payload with ⟨txid, payload⟩ - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - have lane := - node_property_of_nodeState lanes foundBefore - simp [eventFor, payload] at outputEq - have progress := - gossip_receive_progress config.protocol beforeState - envelope.source txid lane gossiping - rw [←outputEq] at progress - rcases progress with left | right - · exact Or.inl (by - intro stillGossiping - rcases stillGossiping with ⟨state, found, phase⟩ - rw [foundAfter] at found - injection found with stateEq - subst state - exact left phase) - · exact Or.inr ⟨output.state, foundAfter, right⟩ - -theorem timeout_gossip_progress - {config : Config} - {before after : State} - {node : Location} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (phase : HasPhase before node .gossiping) - (transition : next config before (.timeout node) = some after) : - HasPhase after node .voting := by - rcases phase with ⟨beforeState, foundBefore, gossiping⟩ - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, accepted, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - have lane := - node_property_of_nodeState lanes foundBefore - have voting := - gossip_timeout_progress config.protocol beforeState lane - gossiping (by simpa [outputEq] using accepted) - exact - ⟨output.state, foundAfter, by simpa [outputEq] using voting⟩ - -theorem vote_receive_progress - (config : Protocol.Config) - (state : NodeState) - (source : Location) - (phase : state.phase = .voting) : - let output := step config state (.receiveVote source .accepted) - output.state.phase ≠ .voting \/ output.state.votes ≠ [] := by - have nonempty := insertVote_nonempty source state.votes - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - repeat first | split | simp_all - -theorem voting_timeout_local - (config : Protocol.Config) - (state : NodeState) - (valid : LaneValid state) - (phase : state.phase = .voting) - (nonempty : state.votes ≠ []) : - let output := step config state .timeout - output.state.phase = .opening \/ - (output.state.phase = .voting /\ - output.state.timeoutState = .voting) := by - rcases valid.2.1 phase with lane | lane - · simp [step, phase, lane, rejected, advance, validTimeout, - advanceTimeoutLane, advanceTimeoutState] - repeat first | split | simp_all - · simp [step, phase, lane, nonempty, rejected, advance, validTimeout, - advanceTimeoutLane, advanceTimeoutState] - -theorem aligned_voting_timeout_opens - (config : Protocol.Config) - (state : NodeState) - (phase : state.phase = .voting) - (lane : state.timeoutState = .voting) - (nonempty : state.votes ≠ []) : - (step config state .timeout).state.phase = .opening := by - simp [step, phase, lane, nonempty, rejected, advance, validTimeout, - advanceTimeoutLane] - -theorem deliver_vote_progress - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (payload : envelope.payload = .vote) - (phase : HasPhase before envelope.target .voting) - (transition : next config before (.deliver envelope) = some after) : - Not (HasPhase after envelope.target .voting) \/ - HasVote after envelope.target := by - rcases phase with ⟨beforeState, foundBefore, voting⟩ - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - simp [eventFor, payload] at outputEq - have progress := - vote_receive_progress config.protocol beforeState - envelope.source voting - rw [←outputEq] at progress - rcases progress with left | right - · exact Or.inl (by - intro stillVoting - rcases stillVoting with ⟨state, found, phase⟩ - rw [foundAfter] at found - injection found with stateEq - subst state - exact left phase) - · exact Or.inr ⟨output.state, foundAfter, right⟩ - -theorem deliver_iamopen_resolves - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (openCompleted : OpenCompleted before) - (payload : envelope.payload = .iAmOpen) - (transition : next config before (.deliver envelope) = some after) : - Terminal after envelope.target \/ - HasPhase after envelope.target .opening := by - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, targetActive, system, output, systemStep, stateEq⟩ - rcases active_nodeState wellFormed targetActive with - ⟨beforeState, foundBefore⟩ - have outputEq := systemStep_output_eq foundBefore systemStep - simp [eventFor, payload] at outputEq - have outcome := - iamopen_delivery_outcome config.protocol beforeState envelope.source - rw [←outputEq] at outcome - rw [←stateEq] - rcases outcome with opening | opened | ⟨chosen, restarted⟩ - · exact Or.inr - ⟨output.state, - by - apply nodeState_eq_of_mem - · rw [recordEffects_system, - systemStep_node_keys_eq systemStep] - exact wellFormed.nodeKeysNodup - · rw [recordEffects_system] - exact systemStep_output_mem systemStep, - opening⟩ - · have beforeOpen := - iamopen_open_predecessor config.protocol beforeState - envelope.source (by simpa [outputEq] using opened) - have completedBefore : CompletedOpen before envelope.target := by - rw [Global.nodeState, Option.map_eq_some_iff] at foundBefore - rcases foundBefore with ⟨entry, findEq, stateEq⟩ - have keyEq : entry.1 = envelope.target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == envelope.target) findEq) - rw [←keyEq] - apply openCompleted entry (List.mem_of_find?_eq_some findEq) - simpa [stateEq] using beforeOpen - exact Or.inl (Or.inr - (mem_completed_recordEffects completedBefore)) - · exact Or.inl (Or.inl - (restart_effect_recorded restarted)) - -theorem voting_timeout_enabled - {config : Config} - {state : State} - {node : Location} - (active : node ∈ state.active) - (phase : HasPhase state node .voting) : - Enabled config state (.timeout node) := by - rcases phase with ⟨nodeState, found, voting⟩ - apply timeout_enabled_of_accepted active found - simp [step, voting, advance, rejected] - repeat first | split | simp_all - -theorem timeout_voting_step - {config : Config} - {before after : State} - {node : Location} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (phase : HasPhase before node .voting) - (vote : HasVote before node) - (transition : next config before (.timeout node) = some after) : - HasPhase after node .opening \/ - (exists nextState : NodeState, - Global.nodeState after node = some nextState /\ - nextState.phase = .voting /\ - nextState.timeoutState = .voting /\ - nextState.votes ≠ []) := by - rcases phase with ⟨beforeState, foundBefore, voting⟩ - rcases vote with ⟨voteState, foundVote, nonempty⟩ - rw [foundBefore] at foundVote - injection foundVote with stateEq - subst voteState - have lane : LaneValid beforeState := by - apply node_property_of_nodeState (predicate := LaneValid) - · exact lanes - · exact foundBefore - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - have outputEq := systemStep_output_eq foundBefore systemStep - have progress := - voting_timeout_local config.protocol beforeState lane voting nonempty - rw [←outputEq] at progress - rcases progress with opening | waiting - · exact Or.inl ⟨output.state, foundAfter, opening⟩ - · exact Or.inr - ⟨output.state, foundAfter, waiting.1, waiting.2, - by - rw [outputEq] - exact step_preserves_nonempty_votes - config.protocol beforeState .timeout nonempty⟩ - -theorem aligned_timeout_voting_opens - {config : Config} - {before after : State} - {node : Location} - {nodeState : NodeState} - (wellFormed : WellFormed config before) - (found : Global.nodeState before node = some nodeState) - (phase : nodeState.phase = .voting) - (lane : nodeState.timeoutState = .voting) - (nonempty : nodeState.votes ≠ []) - (transition : next config before (.timeout node) = some after) : - HasPhase after node .opening := by - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - have outputEq := systemStep_output_eq found systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact aligned_voting_timeout_opens config.protocol nodeState - phase lane nonempty⟩ - -theorem fair_gossip_progress - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - {node : Location} - (active : node ∈ (execution.states start).active) - (phase : HasPhase (execution.states start) node .gossiping) : - EventuallyFrom start (fun n => - Not (HasPhase (execution.states n) node .gossiping)) := by - have reachable (n : Nat) := - execution_reachable execution initial n - have configValid := reachable_config_valid (reachable start) - have retryEnabled := - retry_gossip_enabled configValid - (reachable_well_formed (reachable start)) active phase - rcases fair.retry start node .gossiping active phase - (Or.inl rfl) retryEnabled with - ⟨retryAt, startRetry, leftGossip | retryAction⟩ - · exact ⟨retryAt, startRetry, leftGossip⟩ - · by_cases retryPhase : - HasPhase (execution.states retryAt) node .gossiping - · have retryStep : - next config (execution.states retryAt) (.retry node) = - some (execution.states (retryAt + 1)) := by - simpa [retryAction] using execution.step_succ retryAt - rcases retry_gossip_enqueued configValid - (reachable_well_formed (reachable retryAt)) - retryPhase retryStep with - ⟨envelope, pending, sourceEq, targetEq, txid, payload⟩ - rcases fair.delivery (retryAt + 1) envelope pending with - ⟨deliverAt, retryDeliver, deliverAction⟩ - by_cases deliverPhase : - HasPhase (execution.states deliverAt) node .gossiping - · have deliverStep : - next config (execution.states deliverAt) - (.deliver envelope) = - some (execution.states (deliverAt + 1)) := by - simpa [deliverAction] using execution.step_succ deliverAt - have delivered := - deliver_gossip_progress - (reachable_well_formed (reachable deliverAt)) - (reachable_lanes_valid (reachable deliverAt)) - ⟨txid, payload⟩ - (by simpa [targetEq] using deliverPhase) - deliverStep - rcases delivered with leftAfter | hasGossip - · exact - ⟨deliverAt + 1, by omega, by simpa [targetEq] using leftAfter⟩ - · by_cases afterPhase : - HasPhase (execution.states (deliverAt + 1)) node .gossiping - · have timeoutEnabled := - gossip_timeout_enabled - (config := config) - (by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution start] at active - exact active) - (reachable_lanes_valid (reachable (deliverAt + 1))) - afterPhase - (by simpa [targetEq] using hasGossip) - rcases fair.timeout (deliverAt + 1) node .gossiping - (by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution start] at active - exact active) - afterPhase (Or.inl rfl) timeoutEnabled with - ⟨timeoutAt, deliverTimeout, leftBeforeTimeout | timeoutAction⟩ - · exact ⟨timeoutAt, by omega, leftBeforeTimeout⟩ - · by_cases timeoutPhase : - HasPhase (execution.states timeoutAt) node .gossiping - · have timeoutStep : - next config (execution.states timeoutAt) - (.timeout node) = - some (execution.states (timeoutAt + 1)) := by - simpa [timeoutAction] using - execution.step_succ timeoutAt - have voting := - timeout_gossip_progress - (reachable_well_formed (reachable timeoutAt)) - (reachable_lanes_valid (reachable timeoutAt)) - timeoutPhase timeoutStep - refine ⟨timeoutAt + 1, by omega, ?_⟩ - intro impossible - have phases := hasPhase_unique voting impossible - contradiction - · exact ⟨timeoutAt, by omega, timeoutPhase⟩ - · exact ⟨deliverAt + 1, by omega, afterPhase⟩ - · exact ⟨deliverAt, by omega, deliverPhase⟩ - · exact ⟨retryAt, startRetry, retryPhase⟩ - -theorem next_gossiping_predecessor - {config : Config} - {before after : State} - {action : Action} - {node : Location} - (wellFormed : WellFormed config before) - (transition : next config before action = some after) - (afterGossip : HasPhase after node .gossiping) : - HasPhase before node .gossiping := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] at afterGossip - exact afterGossip - | deliver envelope => - by_cases target : node = envelope.target - · subst node - have details := transition - simp [next, Option.bind_eq_some_iff] at details - have targetActive := details.2.1 - rcases active_nodeState wellFormed targetActive with - ⟨beforeState, foundBefore⟩ - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - rcases afterGossip with ⟨afterState, found, phase⟩ - rw [foundAfter] at found - injection found with stateEq - subst afterState - have outputEq := - systemStep_output_eq foundBefore systemStep - have beforePhase : beforeState.phase = .gossiping := by - by_contra notGossip - have notAfter := - step_preserves_non_gossiping config.protocol beforeState - (eventFor envelope) notGossip - rw [←outputEq] at notAfter - exact notAfter phase - exact ⟨beforeState, foundBefore, beforePhase⟩ - · rcases afterGossip with ⟨afterState, foundAfter, phase⟩ - have unchanged := - deliver_other_node_eq target transition - rw [foundAfter] at unchanged - cases foundBefore : - Global.nodeState before node with - | none => simp [foundBefore] at unchanged - | some beforeState => - rw [foundBefore] at unchanged - injection unchanged with stateEq - subst beforeState - exact ⟨afterState, foundBefore, phase⟩ - | timeout target => - by_cases same : node = target - · subst node - have details := transition - simp [next, Option.bind_eq_some_iff] at details - have targetActive := details.1 - rcases active_nodeState wellFormed targetActive with - ⟨beforeState, foundBefore⟩ - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - rcases afterGossip with ⟨afterState, found, phase⟩ - rw [foundAfter] at found - injection found with stateEq - subst afterState - have outputEq := - systemStep_output_eq foundBefore systemStep - have beforePhase : beforeState.phase = .gossiping := by - by_contra notGossip - have notAfter := - step_preserves_non_gossiping config.protocol beforeState - .timeout notGossip - rw [←outputEq] at notAfter - exact notAfter phase - exact ⟨beforeState, foundBefore, beforePhase⟩ - · rcases afterGossip with ⟨afterState, foundAfter, phase⟩ - have unchanged := - timeout_other_node_eq same transition - rw [foundAfter] at unchanged - cases foundBefore : - Global.nodeState before node with - | none => simp [foundBefore] at unchanged - | some beforeState => - rw [foundBefore] at unchanged - injection unchanged with stateEq - subst beforeState - exact ⟨afterState, foundBefore, phase⟩ - -theorem not_gossiping_mono - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (notGossip : - Not (HasPhase (execution.states start) node .gossiping)) : - Not (HasPhase (execution.states finish) node .gossiping) := by - induction finish, order using Nat.le_induction with - | base => exact notGossip - | succ finish order notGossip => - intro gossip - exact notGossip - (next_gossiping_predecessor - (reachable_well_formed - (execution_reachable execution initial finish)) - (execution.step_succ finish) gossip) - -theorem eventually_list - {predicate : Nat -> Location -> Prop} - {start : Nat} - (nodes : List Location) - (eventual : - forall node, node ∈ nodes -> - EventuallyFrom start (fun n => predicate n node)) - (monotonic : - forall node first second, - first <= second -> - predicate first node -> - predicate second node) : - EventuallyFrom start (fun n => - forall node, node ∈ nodes -> predicate n node) := by - revert eventual - induction nodes with - | nil => - intro eventual - exact ⟨start, Nat.le_refl start, by simp⟩ - | cons head tail ih => - intro eventual - rcases eventual head (by simp) with - ⟨headAt, startHead, headHolds⟩ - rcases ih - (fun node membership => eventual node (by simp [membership])) with - ⟨tailAt, startTail, tailHolds⟩ - refine - ⟨max headAt tailAt, by omega, ?_⟩ - intro node membership - rw [List.mem_cons] at membership - rcases membership with rfl | inTail - · exact monotonic _ headAt (max headAt tailAt) - (Nat.le_max_left _ _) headHolds - · exact monotonic node tailAt (max headAt tailAt) - (Nat.le_max_right _ _) (tailHolds node inTail) - -theorem fair_all_leave_gossip - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (start : Nat) : - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - Not (HasPhase (execution.states n) node .gossiping)) := by - apply eventually_list (execution.states start).active - · intro node active - by_cases phase : - HasPhase (execution.states start) node .gossiping - · exact fair_gossip_progress execution initial fair active phase - · exact ⟨start, Nat.le_refl start, phase⟩ - · intro node first second order notGossip - exact not_gossiping_mono execution initial order notGossip - -theorem terminal_mono_step - {config : Config} - {before after : State} - {action : Action} - {node : Location} - (transition : next config before action = some after) - (terminal : Terminal before node) : - Terminal after node := by - rcases terminal with restarted | completed - · exact Or.inl (next_restarts_monotonic transition node restarted) - · exact Or.inr (next_completed_monotonic transition node completed) - -theorem terminal_mono - {config : Config} - (execution : Execution config) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (terminal : Terminal (execution.states start) node) : - Terminal (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact terminal - | succ finish order terminal => - exact terminal_mono_step (execution.step_succ finish) terminal - -theorem completed_mono - {config : Config} - (execution : Execution config) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (completed : CompletedOpen (execution.states start) node) : - CompletedOpen (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact completed - | succ finish order completed => - exact next_completed_monotonic - (execution.step_succ finish) node completed - -theorem quorumOpened_mono - {config : Config} - (execution : Execution config) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (opened : QuorumOpened (execution.states start) node) : - QuorumOpened (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact opened - | succ finish order opened => - rcases opened with - ⟨opening, membership, openingNode, kind⟩ - exact - ⟨opening, - next_openings_monotonic - (execution.step_succ finish) opening membership, - openingNode, - kind⟩ - -theorem fair_opening_completes - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - {node : Location} - (active : node ∈ (execution.states start).active) - (phase : HasPhase (execution.states start) node .opening) : - EventuallyFrom start (fun n => - CompletedOpen (execution.states n) node) := by - rcases phase with ⟨startState, foundStart, openingStart⟩ - have auxiliary : - forall distance start state, - openingDistance state.timeoutState = distance -> - node ∈ (execution.states start).active -> - Global.nodeState (execution.states start) node = some state -> - state.phase = .opening -> - EventuallyFrom start (fun n => - CompletedOpen (execution.states n) node) := by - intro distance - induction distance using Nat.strong_induction_on with - | h distance ih => - intro start state distanceEq active found opening - have enabled := - opening_timeout_enabled (config := config) - active ⟨state, found, opening⟩ - rcases fair.openingTimeout start node active - ⟨state, found, opening⟩ enabled with - ⟨timeoutAt, startTimeout, - completed | ⟨stillOpening, timeoutAction⟩⟩ - · exact ⟨timeoutAt, startTimeout, completed⟩ - · by_cases completedBefore : - CompletedOpen (execution.states timeoutAt) node - · exact ⟨timeoutAt, startTimeout, completedBefore⟩ - · rcases opening_progress_between execution initial startTimeout - found opening completedBefore with - ⟨timeoutState, foundTimeout, openingTimeout, - distanceTimeout⟩ - have timeoutStep : - next config (execution.states timeoutAt) - (.timeout node) = - some (execution.states (timeoutAt + 1)) := by - simpa [timeoutAction] using execution.step_succ timeoutAt - rcases timeout_opening_step - (reachable_well_formed - (execution_reachable execution initial timeoutAt)) - (reachable_lanes_valid - (execution_reachable execution initial timeoutAt)) - foundTimeout openingTimeout timeoutStep with - completedAfter | - ⟨nextState, foundNext, openingNext, distanceNext⟩ - · exact ⟨timeoutAt + 1, by omega, completedAfter⟩ - · have nextLess : openingDistance nextState.timeoutState < - distance := by - rw [←distanceEq] - exact Nat.lt_of_lt_of_le distanceNext distanceTimeout - rcases ih (openingDistance nextState.timeoutState) - nextLess (timeoutAt + 1) nextState rfl - (by - rw [execution_active_eq execution (timeoutAt + 1)] - rw [execution_active_eq execution start] at active - exact active) - foundNext openingNext with - ⟨completedAt, nextCompleted, completed⟩ - exact ⟨completedAt, by omega, completed⟩ - exact auxiliary (openingDistance startState.timeoutState) - start startState rfl active foundStart openingStart - -theorem initial_announcements_live - (config : Config) - (active : List Location) : - AnnouncementsLive (initial config active) := by - simp [AnnouncementsLive, Global.initial] - -theorem next_preserves_announcements_live - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (live : AnnouncementsLive before) - (transition : next config before action = some after) : - AnnouncementsLive after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, found, _, stateEq⟩ - have sourceLocation := - nodeState_location wellFormed.nodeLocations found - rw [←stateEq] - intro envelope membership payload - rw [List.mem_append] at membership - rcases membership with old | added - · exact live envelope old payload - · have valid : envelope.Valid config := - retryMessages_valid config source sourceState sourceLocation - envelope added - have opening := retry_iamopen_state valid payload - have identity := retryMessages_source added - rw [identity.2] at opening - exact Or.inl - ⟨sourceState, - by simpa [identity.1] using found, - opening⟩ - | deliver delivered => - intro envelope membership payload - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq, recordEffects_sent] at membership - rcases live envelope membership payload with - opening | completed - · rcases opening with ⟨sourceState, found, phase⟩ - rcases next_opening_progress wellFormed lanes found phase - transition with - completed | ⟨afterState, foundAfter, phaseAfter, _⟩ - · exact Or.inr completed - · exact Or.inl ⟨afterState, foundAfter, phaseAfter⟩ - · exact Or.inr - (next_completed_monotonic transition envelope.source completed) - | timeout target => - intro envelope membership payload - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq, recordEffects_sent] at membership - rcases live envelope membership payload with - opening | completed - · rcases opening with ⟨sourceState, found, phase⟩ - rcases next_opening_progress wellFormed lanes found phase - transition with - completed | ⟨afterState, foundAfter, phaseAfter, _⟩ - · exact Or.inr completed - · exact Or.inl ⟨afterState, foundAfter, phaseAfter⟩ - · exact Or.inr - (next_completed_monotonic transition envelope.source completed) - -theorem reachable_announcements_live - {config : Config} - {state : State} - (reachable : Reachable config state) : - AnnouncementsLive state := by - induction reachable with - | initial active valid nodup configured => - exact initial_announcements_live config active - | step reachable transition live => - exact next_preserves_announcements_live - (reachable_well_formed reachable) - (reachable_lanes_valid reachable) - live transition - -theorem initial_announcements_resolved - (config : Config) - (active : List Location) : - AnnouncementsResolved (initial config active) := by - simp [AnnouncementsResolved, Global.initial] - -theorem next_preserves_announcements_resolved - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (openCompleted : OpenCompleted before) - (resolved : AnnouncementsResolved before) - (transition : next config before action = some after) : - AnnouncementsResolved after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - intro envelope membership payload - rw [List.mem_append] at membership - rcases membership with old | added - · rcases resolved envelope old payload with - pending | terminal | opening - · exact Or.inl (List.mem_append_left _ pending) - · exact Or.inr (Or.inl terminal) - · exact Or.inr (Or.inr opening) - · exact Or.inl (List.mem_append_right _ added) - | deliver delivered => - intro envelope membership payload - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq, recordEffects_sent] at membership - rcases resolved envelope membership payload with - pending | terminal | opening - · rcases mem_removeOne_or_eq pending with remains | equal - · exact Or.inl (by - rw [←stateEq, recordEffects_network] - exact remains) - · subst envelope - rcases deliver_iamopen_resolves wellFormed openCompleted payload - transition with - terminal | opening - · exact Or.inr (Or.inl terminal) - · exact Or.inr (Or.inr opening) - · exact Or.inr (Or.inl - (terminal_mono_step transition terminal)) - · rcases opening with ⟨sourceState, found, phase⟩ - rcases next_opening_progress wellFormed lanes found phase - transition with - completed | ⟨afterState, foundAfter, phaseAfter, _⟩ - · exact Or.inr (Or.inl (Or.inr completed)) - · exact Or.inr (Or.inr - ⟨afterState, foundAfter, phaseAfter⟩) - | timeout target => - intro envelope membership payload - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq, recordEffects_sent] at membership - rcases resolved envelope membership payload with - pending | terminal | opening - · exact Or.inl (by - rw [←stateEq, recordEffects_network] - exact pending) - · exact Or.inr (Or.inl - (terminal_mono_step transition terminal)) - · rcases opening with ⟨sourceState, found, phase⟩ - rcases next_opening_progress wellFormed lanes found phase - transition with - completed | ⟨afterState, foundAfter, phaseAfter, _⟩ - · exact Or.inr (Or.inl (Or.inr completed)) - · exact Or.inr (Or.inr - ⟨afterState, foundAfter, phaseAfter⟩) - -theorem systemStep_preserves_joining_announcements - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {beforeState afterState : State} - (beforeSystem : beforeState.system = before) - (valid : JoiningAnnouncements beforeState) - (carry : - forall destination, - SentAnnouncementTo beforeState destination -> - SentAnnouncementTo afterState destination) - (introduced : - (exists source, acceptedIAmOpenSource event = some source) -> - SentAnnouncementTo afterState target) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.phase = .joining -> - SentAnnouncementTo afterState entry.1 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership joining - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · rename_i atTarget - rcases step_joining_origin config node event - (by simpa [atTarget, outputEq] using joining) with - old | received - · have keyEq : key = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - rw [←keyEq] - apply carry - apply valid (key, node) - · rw [beforeSystem] - exact List.mem_of_find?_eq_some found - · exact old - · exact introduced received - · rename_i notTarget - apply carry - apply valid previous - · rw [beforeSystem] - exact previousMember - · simpa [notTarget] using joining - -theorem initial_joining_announcements - (config : Config) - (active : List Location) : - JoiningAnnouncements (initial config active) := by - simp [JoiningAnnouncements, Global.initial, initialSystem, initialNode] - -theorem next_preserves_joining_announcements - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (valid : JoiningAnnouncements before) - (transition : next config before action = some after) : - JoiningAnnouncements after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - intro entry membership joining - rcases valid entry membership joining with - ⟨envelope, sent, target, payload⟩ - exact - ⟨envelope, List.mem_append_left _ sent, target, payload⟩ - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨inNetwork, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] - intro entry membership joining - rw [recordEffects_system] at membership - let afterState := - recordEffects envelope.target output.state output.effects - { - before with - system - network := removeOne envelope before.network - } - have carry : - forall destination, - SentAnnouncementTo before destination -> - SentAnnouncementTo afterState destination := by - intro destination announcement - rcases announcement with - ⟨sentEnvelope, sent, target, payload⟩ - exact - ⟨sentEnvelope, by simpa [afterState] using sent, - target, payload⟩ - have introduced : - (exists source, - acceptedIAmOpenSource (eventFor envelope) = some source) -> - SentAnnouncementTo afterState envelope.target := by - rintro ⟨source, accepted⟩ - rcases eventFor_iamopen_source accepted with - ⟨payload, _⟩ - exact - ⟨envelope, - by - simp [afterState] - exact wellFormed.networkSent envelope inNetwork, - rfl, payload⟩ - exact systemStep_preserves_joining_announcements - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl valid carry introduced systemStep - entry membership joining - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - intro entry membership joining - rw [recordEffects_system] at membership - let afterState := - recordEffects target output.state output.effects - { before with system } - have carry : - forall destination, - SentAnnouncementTo before destination -> - SentAnnouncementTo afterState destination := by - intro destination announcement - rcases announcement with - ⟨sentEnvelope, sent, target, payload⟩ - exact - ⟨sentEnvelope, by simpa [afterState] using sent, - target, payload⟩ - have introduced : - (exists source, - acceptedIAmOpenSource Event.timeout = some source) -> - SentAnnouncementTo afterState target := by - rintro ⟨source, accepted⟩ - simp [acceptedIAmOpenSource] at accepted - exact systemStep_preserves_joining_announcements - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl valid carry introduced systemStep - entry membership joining - -theorem reachable_joining_announcements - {config : Config} - {state : State} - (reachable : Reachable config state) : - JoiningAnnouncements state := by - induction reachable with - | initial active valid nodup configured => - exact initial_joining_announcements config active - | step reachable transition valid => - exact next_preserves_joining_announcements - (reachable_well_formed reachable) valid transition - -theorem systemStep_preserves_open_completed - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {beforeState afterState : State} - (beforeSystem : beforeState.system = before) - (valid : OpenCompleted beforeState) - (carry : - forall node, - CompletedOpen beforeState node -> - CompletedOpen afterState node) - (introduced : - .completed ∈ output.effects -> - CompletedOpen afterState target) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.phase = .open -> - CompletedOpen afterState entry.1 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership opened - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · rename_i atTarget - rcases step_open_origin config node event - (by simpa [atTarget, outputEq] using opened) with - old | completed - · have keyEq : key = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - rw [←keyEq] - apply carry - apply valid (key, node) - · rw [beforeSystem] - exact List.mem_of_find?_eq_some found - · exact old - · rw [outputEq] at completed - exact introduced completed - · rename_i notTarget - apply carry - apply valid previous - · rw [beforeSystem] - exact previousMember - · simpa [notTarget] using opened - -theorem initial_open_completed - (config : Config) - (active : List Location) : - OpenCompleted (initial config active) := by - simp [OpenCompleted, Global.initial, initialSystem, initialNode] - -theorem next_preserves_open_completed - {config : Config} - {before after : State} - {action : Action} - (valid : OpenCompleted before) - (transition : next config before action = some after) : - OpenCompleted after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact valid - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] - intro entry membership opened - rw [recordEffects_system] at membership - let afterState := - recordEffects envelope.target output.state output.effects - { - before with - system - network := removeOne envelope before.network - } - have carry : - forall node, - CompletedOpen before node -> - CompletedOpen afterState node := by - intro node completed - apply mem_completed_recordEffects - exact completed - have introduced : - .completed ∈ output.effects -> - CompletedOpen afterState envelope.target := by - intro completed - exact completed_effect_recorded completed - exact systemStep_preserves_open_completed - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl valid carry introduced systemStep entry membership opened - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - intro entry membership opened - rw [recordEffects_system] at membership - let afterState := - recordEffects target output.state output.effects - { before with system } - have carry : - forall node, - CompletedOpen before node -> - CompletedOpen afterState node := by - intro node completed - apply mem_completed_recordEffects - exact completed - have introduced : - .completed ∈ output.effects -> - CompletedOpen afterState target := by - intro completed - exact completed_effect_recorded completed - exact systemStep_preserves_open_completed - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl valid carry introduced systemStep entry membership opened - -theorem reachable_open_completed - {config : Config} - {state : State} - (reachable : Reachable config state) : - OpenCompleted state := by - induction reachable with - | initial active valid nodup configured => - exact initial_open_completed config active - | step reachable transition valid => - exact next_preserves_open_completed valid transition - -theorem reachable_announcements_resolved - {config : Config} - {state : State} - (reachable : Reachable config state) : - AnnouncementsResolved state := by - induction reachable with - | initial active valid nodup configured => - exact initial_announcements_resolved config active - | step reachable transition resolved => - exact next_preserves_announcements_resolved - (reachable_well_formed reachable) - (reachable_lanes_valid reachable) - (reachable_open_completed reachable) - resolved transition - -theorem open_node_completed - {state : State} - {node : Location} - {nodeState : NodeState} - (valid : OpenCompleted state) - (found : Global.nodeState state node = some nodeState) - (opened : nodeState.phase = .open) : - CompletedOpen state node := by - rw [Global.nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have keyEq : entry.1 = node := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) findEq) - rw [←keyEq] - apply valid entry (List.mem_of_find?_eq_some findEq) - simpa [stateEq] using opened - -theorem joining_node_announcement - {state : State} - {node : Location} - {nodeState : NodeState} - (valid : JoiningAnnouncements state) - (found : Global.nodeState state node = some nodeState) - (joining : nodeState.phase = .joining) : - SentAnnouncementTo state node := by - rw [Global.nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have keyEq : entry.1 = node := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) findEq) - rw [←keyEq] - apply valid entry (List.mem_of_find?_eq_some findEq) - simpa [stateEq] using joining - -theorem openerWitness_of_later_phase - {config : Config} - {state : State} - {node : Location} - (reachable : Reachable config state) - (active : node ∈ state.active) - (notGossip : Not (HasPhase state node .gossiping)) - (notVoting : Not (HasPhase state node .voting)) : - OpenerWitness state := by - rcases active_nodeState (reachable_well_formed reachable) active with - ⟨nodeState, found⟩ - cases phase : nodeState.phase with - | gossiping => - exact False.elim - (notGossip ⟨nodeState, found, phase⟩) - | voting => - exact False.elim - (notVoting ⟨nodeState, found, phase⟩) - | opening => - exact ⟨node, Or.inl ⟨nodeState, found, phase⟩⟩ - | joining => - rcases joining_node_announcement - (reachable_joining_announcements reachable) - found phase with - ⟨envelope, sent, target, payload⟩ - rcases reachable_announcements_live reachable - envelope sent payload with - opening | completed - · exact ⟨envelope.source, Or.inl opening⟩ - · exact ⟨envelope.source, Or.inr completed⟩ - | «open» => - exact - ⟨node, Or.inr - (open_node_completed - (reachable_open_completed reachable) found phase)⟩ - -theorem openerWitness_after_leave_voting - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start later : Nat} - {node : Location} - (order : start <= later) - (allPastGossip : - forall activeNode, - activeNode ∈ (execution.states start).active -> - Not (HasPhase (execution.states start) - activeNode .gossiping)) - (active : node ∈ (execution.states later).active) - (notVoting : - Not (HasPhase (execution.states later) node .voting)) : - OpenerWitness (execution.states later) := by - have activeStart : node ∈ (execution.states start).active := by - rw [execution_active_eq execution later] at active - rw [execution_active_eq execution start] - exact active - have notGossip := - not_gossiping_mono execution initial order - (allPastGossip node activeStart) - exact openerWitness_of_later_phase - (execution_reachable execution initial later) - active notGossip notVoting - -theorem systemStep_preserves_advanced_active - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {active : List Location} - (valid : - forall entry, entry ∈ before.nodes -> - entry.2.phase ≠ .gossiping -> - entry.1 ∈ active) - (targetActive : target ∈ active) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.phase ≠ .gossiping -> - entry.1 ∈ active := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership advanced - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · exact targetActive - · rename_i notTarget - exact valid previous previousMember - (by simpa [notTarget] using advanced) - -theorem initial_advanced_active - (config : Config) - (active : List Location) : - AdvancedNodesActive (initial config active) := by - simp [AdvancedNodesActive, Global.initial, initialSystem, initialNode] - -theorem next_preserves_advanced_active - {config : Config} - {before after : State} - {action : Action} - (valid : AdvancedNodesActive before) - (transition : next config before action = some after) : - AdvancedNodesActive after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact valid - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, targetActive, system, output, systemStep, stateEq⟩ - rw [←stateEq] - intro entry membership advanced - rw [recordEffects_system] at membership - simpa using - systemStep_preserves_advanced_active - valid targetActive systemStep entry membership advanced - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨targetActive, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - intro entry membership advanced - rw [recordEffects_system] at membership - simpa using - systemStep_preserves_advanced_active - valid targetActive systemStep entry membership advanced - -theorem reachable_advanced_active - {config : Config} - {state : State} - (reachable : Reachable config state) : - AdvancedNodesActive state := by - induction reachable with - | initial active valid nodup configured => - exact initial_advanced_active config active - | step reachable transition valid => - exact next_preserves_advanced_active valid transition - -theorem hasPhase_active - {config : Config} - {state : State} - {node : Location} - {phase : Phase} - (reachable : Reachable config state) - (hasPhase : HasPhase state node phase) - (advancedPhase : phase ≠ .gossiping) : - node ∈ state.active := by - rcases hasPhase with ⟨nodeState, found, phaseEq⟩ - rw [Global.nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have keyEq : entry.1 = node := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) findEq) - rw [←keyEq] - apply reachable_advanced_active reachable entry - (List.mem_of_find?_eq_some findEq) - rw [stateEq, phaseEq] - exact advancedPhase - -theorem fair_opener_witness - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - (activeNonempty : (execution.states start).active ≠ []) - (allPastGossip : - forall node, node ∈ (execution.states start).active -> - Not (HasPhase (execution.states start) node .gossiping)) : - EventuallyFrom start (fun n => - OpenerWitness (execution.states n)) := by - obtain ⟨voter, voterActive⟩ := - List.exists_mem_of_ne_nil _ activeNonempty - by_cases voting : - HasPhase (execution.states start) voter .voting - · rcases voting with ⟨voterState, foundVoter, voterVoting⟩ - have selectionProperty := - node_property_of_nodeState - (predicate := fun state => - state.phase = .voting -> NodeVotingSelection state) - (reachable_quorum_invariant - (execution_reachable execution initial start)).votingSelections - foundVoter - rcases selectionProperty voterVoting with - ⟨target, txid, chosen, maximum⟩ - have retryEnabled := - retry_voting_enabled (config := config) - voterActive foundVoter voterVoting chosen - rcases fair.retry start voter .voting voterActive - ⟨voterState, foundVoter, voterVoting⟩ - (Or.inr (Or.inl rfl)) retryEnabled with - ⟨retryAt, startRetry, leftVoting | retryAction⟩ - · exact - ⟨retryAt, startRetry, - openerWitness_after_leave_voting execution initial - startRetry allPastGossip - (by - rw [execution_active_eq execution retryAt] - rw [execution_active_eq execution start] at voterActive - exact voterActive) - leftVoting⟩ - · by_cases retryVoting : - HasPhase (execution.states retryAt) voter .voting - · rcases retryVoting with - ⟨retryState, foundRetry, votingRetry⟩ - have retrySelectionProperty := - node_property_of_nodeState - (predicate := fun state => - state.phase = .voting -> NodeVotingSelection state) - (reachable_quorum_invariant - (execution_reachable execution initial retryAt)).votingSelections - foundRetry - rcases retrySelectionProperty votingRetry with - ⟨retryTarget, retryTxID, retryChosen, retryMaximum⟩ - have retryStep : - next config (execution.states retryAt) (.retry voter) = - some (execution.states (retryAt + 1)) := by - simpa [retryAction] using execution.step_succ retryAt - rcases retry_vote_enqueued foundRetry votingRetry retryChosen - retryStep with - ⟨voteEnvelope, pending, voteSource, voteTarget, votePayload⟩ - rcases fair.delivery (retryAt + 1) voteEnvelope pending with - ⟨deliverAt, retryDeliver, deliverAction⟩ - have deliverStep : - next config (execution.states deliverAt) - (.deliver voteEnvelope) = - some (execution.states (deliverAt + 1)) := by - simpa [deliverAction] using execution.step_succ deliverAt - have deliverDetails := deliverStep - simp [next, Option.bind_eq_some_iff] at deliverDetails - have targetActive : voteEnvelope.target ∈ - (execution.states deliverAt).active := - deliverDetails.2.1 - by_cases targetVoting : - HasPhase (execution.states deliverAt) - voteEnvelope.target .voting - · rcases deliver_vote_progress - (reachable_well_formed - (execution_reachable execution initial deliverAt)) - votePayload targetVoting deliverStep with - leftAfter | hasVote - · have activeAfter : voteEnvelope.target ∈ - (execution.states (deliverAt + 1)).active := by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution deliverAt] at targetActive - exact targetActive - exact - ⟨deliverAt + 1, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip activeAfter leftAfter⟩ - · by_cases votingAfter : - HasPhase (execution.states (deliverAt + 1)) - voteEnvelope.target .voting - · have activeAfter : voteEnvelope.target ∈ - (execution.states (deliverAt + 1)).active := by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution deliverAt] at targetActive - exact targetActive - have timeoutEnabled := - voting_timeout_enabled (config := config) - activeAfter votingAfter - rcases fair.timeout (deliverAt + 1) - voteEnvelope.target .voting activeAfter votingAfter - (Or.inr (Or.inl rfl)) timeoutEnabled with - ⟨timeoutAt, deliverTimeout, - leftBeforeTimeout | timeoutAction⟩ - · exact - ⟨timeoutAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution timeoutAt] - rw [execution_active_eq execution - (deliverAt + 1)] at activeAfter - exact activeAfter) - leftBeforeTimeout⟩ - · by_cases votingAtTimeout : - HasPhase (execution.states timeoutAt) - voteEnvelope.target .voting - · have voteAtTimeout := - hasVote_mono execution initial deliverTimeout hasVote - have timeoutStep : - next config (execution.states timeoutAt) - (.timeout voteEnvelope.target) = - some (execution.states (timeoutAt + 1)) := by - simpa [timeoutAction] using - execution.step_succ timeoutAt - rcases timeout_voting_step - (reachable_well_formed - (execution_reachable execution initial timeoutAt)) - (reachable_lanes_valid - (execution_reachable execution initial timeoutAt)) - votingAtTimeout voteAtTimeout timeoutStep with - opened | - ⟨waitingState, foundWaiting, waitingPhase, - waitingLane, waitingVotes⟩ - · exact - ⟨timeoutAt + 1, by omega, - ⟨voteEnvelope.target, Or.inl opened⟩⟩ - · have activeWaiting : voteEnvelope.target ∈ - (execution.states (timeoutAt + 1)).active := by - rw [execution_active_eq execution (timeoutAt + 1)] - rw [execution_active_eq execution - (deliverAt + 1)] at activeAfter - exact activeAfter - have secondEnabled := - voting_timeout_enabled (config := config) - activeWaiting - ⟨waitingState, foundWaiting, waitingPhase⟩ - rcases fair.timeout (timeoutAt + 1) - voteEnvelope.target .voting activeWaiting - ⟨waitingState, foundWaiting, waitingPhase⟩ - (Or.inr (Or.inl rfl)) secondEnabled with - ⟨secondAt, firstSecond, - leftBeforeSecond | secondAction⟩ - · exact - ⟨secondAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution secondAt] - rw [execution_active_eq execution - (timeoutAt + 1)] at activeWaiting - exact activeWaiting) - leftBeforeSecond⟩ - · by_cases votingAtSecond : - HasPhase (execution.states secondAt) - voteEnvelope.target .voting - · rcases votingAtSecond with - ⟨secondState, foundSecond, secondPhase⟩ - have votesSecond := - hasVote_mono execution initial firstSecond - ⟨waitingState, foundWaiting, waitingVotes⟩ - rcases votesSecond with - ⟨voteState, foundVotes, secondVotes⟩ - rw [foundSecond] at foundVotes - injection foundVotes with voteStateEq - subst voteState - have advancedSecond := - advanced_lane_mono execution initial firstSecond - ⟨waitingState, foundWaiting, by simp [waitingLane]⟩ - rcases advancedSecond with - ⟨laneState, foundLane, advanced⟩ - rw [foundSecond] at foundLane - injection foundLane with laneStateEq - subst laneState - have laneValid : LaneValid secondState := by - apply node_property_of_nodeState - (predicate := LaneValid) - · exact reachable_lanes_valid - (execution_reachable execution initial secondAt) - · exact foundSecond - have secondLane : secondState.timeoutState = - .voting := by - rcases laneValid.2.1 secondPhase with - gossipLane | votingLane - · contradiction - · exact votingLane - have secondStep : - next config (execution.states secondAt) - (.timeout voteEnvelope.target) = - some (execution.states (secondAt + 1)) := by - simpa [secondAction] using - execution.step_succ secondAt - have opened := - aligned_timeout_voting_opens - (reachable_well_formed - (execution_reachable execution initial secondAt)) - foundSecond secondPhase secondLane secondVotes - secondStep - exact - ⟨secondAt + 1, by omega, - ⟨voteEnvelope.target, Or.inl opened⟩⟩ - · exact - ⟨secondAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution secondAt] - rw [execution_active_eq execution - (timeoutAt + 1)] at activeWaiting - exact activeWaiting) - votingAtSecond⟩ - · exact - ⟨timeoutAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution timeoutAt] - rw [execution_active_eq execution - (deliverAt + 1)] at activeAfter - exact activeAfter) - votingAtTimeout⟩ - · exact - ⟨deliverAt + 1, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution deliverAt] - at targetActive - exact targetActive) - votingAfter⟩ - · exact - ⟨deliverAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip targetActive targetVoting⟩ - · exact - ⟨retryAt, startRetry, - openerWitness_after_leave_voting execution initial - startRetry allPastGossip - (by - rw [execution_active_eq execution retryAt] - rw [execution_active_eq execution start] at voterActive - exact voterActive) - retryVoting⟩ - · exact - ⟨start, Nat.le_refl start, - openerWitness_after_leave_voting execution initial - (Nat.le_refl start) allPastGossip voterActive voting⟩ - -theorem openerWitness_eventually_completes - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - (witness : OpenerWitness (execution.states start)) : - EventuallyFrom start (fun n => - exists node, CompletedOpen (execution.states n) node) := by - rcases witness with ⟨node, opening | completed⟩ - · have active := - hasPhase_active (execution_reachable execution initial start) - opening (by simp) - rcases fair_opening_completes execution initial fair active opening with - ⟨completedAt, order, completed⟩ - exact ⟨completedAt, order, node, completed⟩ - · exact ⟨start, Nat.le_refl start, node, completed⟩ - -theorem fair_some_opener_completes - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (activeNonempty : (execution.states 0).active ≠ []) : - EventuallyFrom 0 (fun n => - exists node, CompletedOpen (execution.states n) node) := by - rcases fair_all_leave_gossip execution initial fair 0 with - ⟨pastGossipAt, _, allPastGossip⟩ - have nonemptyAt : - (execution.states pastGossipAt).active ≠ [] := by - rw [execution_active_eq execution pastGossipAt] - exact activeNonempty - have allPastAt : - forall node, node ∈ (execution.states pastGossipAt).active -> - Not (HasPhase (execution.states pastGossipAt) - node .gossiping) := by - intro node active - rw [execution_active_eq execution pastGossipAt] at active - exact allPastGossip node active - rcases fair_opener_witness execution initial fair nonemptyAt - allPastAt with - ⟨witnessAt, pastWitness, witness⟩ - rcases openerWitness_eventually_completes execution initial fair - witness with - ⟨completedAt, witnessCompleted, completed⟩ - exact ⟨completedAt, by omega, completed⟩ - -theorem fair_target_terminal_after_completion - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener target : Location} - (completed : CompletedOpen (execution.states start) opener) - (active : target ∈ (execution.states start).active) : - EventuallyFrom start (fun n => - Terminal (execution.states n) target) := by - by_cases same : target = opener - · subst target - exact ⟨start, Nat.le_refl start, Or.inr completed⟩ - · rcases broadcast start opener completed target active same with - ⟨envelope, sent, sourceEq, targetEq, payload⟩ - rcases reachable_announcements_resolved - (execution_reachable execution initial start) - envelope sent payload with - pending | terminal | opening - · rcases fair.delivery start envelope pending with - ⟨deliverAt, startDelivery, deliverAction⟩ - have deliverStep : - next config (execution.states deliverAt) (.deliver envelope) = - some (execution.states (deliverAt + 1)) := by - simpa [deliverAction] using execution.step_succ deliverAt - rcases deliver_iamopen_resolves - (reachable_well_formed - (execution_reachable execution initial deliverAt)) - (reachable_open_completed - (execution_reachable execution initial deliverAt)) - payload deliverStep with - terminal | targetOpening - · exact - ⟨deliverAt + 1, by omega, by simpa [targetEq] using terminal⟩ - · have openingActive := - hasPhase_active - (execution_reachable execution initial (deliverAt + 1)) - targetOpening (by simp) - rcases fair_opening_completes execution initial fair - openingActive targetOpening with - ⟨completedAt, deliveryCompleted, targetCompleted⟩ - exact - ⟨completedAt, by omega, - by simpa [targetEq] using (Or.inr targetCompleted)⟩ - · exact - ⟨start, Nat.le_refl start, by simpa [targetEq] using terminal⟩ - · have openingActive := - hasPhase_active - (execution_reachable execution initial start) - opening (by simp) - rcases fair_opening_completes execution initial fair - openingActive opening with - ⟨completedAt, startCompleted, targetCompleted⟩ - exact - ⟨completedAt, startCompleted, - by simpa [targetEq] using (Or.inr targetCompleted)⟩ - -theorem fair_all_terminal_after_completion - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener : Location} - (completed : CompletedOpen (execution.states start) opener) : - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - Terminal (execution.states n) node) := by - apply eventually_list (execution.states start).active - · intro node active - exact fair_target_terminal_after_completion - execution initial fair broadcast completed active - · intro node first second order terminal - exact terminal_mono execution order terminal - -theorem global_progress - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - (activeNonempty : (execution.states 0).active ≠ []) : - EventuallyFrom 0 (fun n => - exists node, CompletedOpen (execution.states n) node) /\ - EventuallyFrom 0 (fun n => - forall node, node ∈ (execution.states 0).active -> - Terminal (execution.states n) node) := by - have completed := - fair_some_opener_completes execution initial fair activeNonempty - constructor - · exact completed - · rcases completed with - ⟨completedAt, _, opener, openerCompleted⟩ - rcases fair_all_terminal_after_completion execution initial fair - broadcast openerCompleted with - ⟨terminalAt, completedTerminal, allTerminal⟩ - refine ⟨terminalAt, by omega, ?_⟩ - intro node active - apply allTerminal node - rw [execution_active_eq execution completedAt] - exact active - -theorem single_completion_path_joins_others - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener : Location} - (completed : CompletedOpen (execution.states start) opener) - (onlyOpener : OnlyOpenerCompletesFrom execution start opener) : - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - node = opener \/ node ∈ (execution.states n).restarts) := by - apply eventually_list (execution.states start).active - · intro node active - by_cases same : node = opener - · exact ⟨start, Nat.le_refl start, Or.inl same⟩ - · rcases fair_target_terminal_after_completion - execution initial fair broadcast completed active with - ⟨terminalAt, startTerminal, terminal⟩ - rcases terminal with restarted | targetCompleted - · exact ⟨terminalAt, startTerminal, Or.inr restarted⟩ - · exact False.elim - (same - (onlyOpener terminalAt node startTerminal targetCompleted)) - · intro node first second order joined - rcases joined with same | restarted - · exact Or.inl same - · exact Or.inr - (by - induction second, order using Nat.le_induction with - | base => exact restarted - | succ second order restarted => - exact next_restarts_monotonic - (execution.step_succ second) node restarted) - -theorem quorum_path_progress - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener : Location} - (opened : QuorumOpened (execution.states start) opener) - (completed : CompletedOpen (execution.states start) opener) - (quorumOnly : QuorumOnlyCompletions execution) : - QuorumOpened (execution.states start) opener /\ - CompletedOpen (execution.states start) opener /\ - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - node = opener \/ node ∈ (execution.states n).restarts) := by - have onlyOpener : - OnlyOpenerCompletesFrom execution start opener := by - intro n node startN nodeCompleted - exact quorum_opener_unique - (execution_reachable execution initial n) - (quorumOnly n node nodeCompleted) - (quorumOpened_mono execution startN opened) - exact - ⟨opened, completed, - single_completion_path_joins_others - execution initial fair broadcast completed onlyOpener⟩ - end DisasterRecovery.Protocol.Global diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean index dbe145561f17..d9a96580b85f 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean @@ -1,5 +1,6 @@ import DisasterRecovery.Protocol.Global -import Mathlib.Tactic + +/-! Human-reviewed reachability and message-provenance invariants. -/ namespace DisasterRecovery.Protocol.Global @@ -37,863 +38,4 @@ structure WellFormed (config : Config) (state : State) : Prop where envelope ∈ state.sent historiesActive : HistoriesActive state -theorem messageForEffect_source - {config : Config} - {source : Location} - {sourceState : NodeState} - {effect : Effect} - {envelope : Envelope} - (created : - messageForEffect config source sourceState effect = some envelope) : - envelope.source = source /\ - envelope.sourceState = sourceState := by - cases effect with - | sendGossip target => - cases found : recoveredTxID config source with - | none => - simp [messageForEffect, found] at created - | some txid => - simp [messageForEffect, found] at created - rw [←created] - exact ⟨rfl, rfl⟩ - | sendVote target => - simp [messageForEffect] at created - rw [←created] - exact ⟨rfl, rfl⟩ - | sendIAmOpen target => - simp [messageForEffect] at created - rw [←created] - exact ⟨rfl, rfl⟩ - | opening kind => - simp_all [messageForEffect] - | restart chosen => - simp_all [messageForEffect] - | completed => - simp_all [messageForEffect] - | rejected reason => - simp_all [messageForEffect] - -theorem retryMessages_source - {config : Config} - {source : Location} - {sourceState : NodeState} - {envelope : Envelope} - (created : - envelope ∈ retryMessages config source sourceState) : - envelope.source = source /\ - envelope.sourceState = sourceState := by - rw [retryMessages, List.mem_filterMap] at created - rcases created with ⟨effect, _, produced⟩ - exact messageForEffect_source produced - -theorem retryMessages_valid - (config : Config) - (source : Location) - (sourceState : NodeState) - (sourceLocation : sourceState.location = source) : - forall envelope, - envelope ∈ retryMessages config source sourceState -> - envelope.Valid config := by - intro envelope created - rcases retryMessages_source created with - ⟨sourceEq, stateEq⟩ - constructor - · rw [stateEq, sourceEq] - exact sourceLocation - · rw [sourceEq, stateEq] - exact created - -theorem valid_envelope_effect - {config : Config} - {envelope : Envelope} - (valid : envelope.Valid config) : - exists effect, - effect ∈ - (step config.protocol envelope.sourceState .retry).effects /\ - messageForEffect config envelope.source - envelope.sourceState effect = some envelope := by - rcases valid with ⟨_, created⟩ - rw [retryMessages, List.mem_filterMap] at created - exact created - -theorem valid_gossip_uses_recovered_txid - {config : Config} - {envelope : Envelope} - {txid : TxID} - (valid : envelope.Valid config) - (gossip : envelope.payload = .gossip txid) : - recoveredTxID config envelope.source = some txid := by - rcases valid_envelope_effect valid with - ⟨effect, _, created⟩ - cases effect with - | sendGossip target => - cases found : recoveredTxID config envelope.source with - | none => - simp [messageForEffect, found] at created - | some recovered => - simp [messageForEffect, found] at created - rw [←created] at gossip - injection gossip with same - subst recovered - rfl - | sendVote target => - simp [messageForEffect] at created - rw [←created] at gossip - contradiction - | sendIAmOpen target => - simp [messageForEffect] at created - rw [←created] at gossip - contradiction - | opening kind => - simp [messageForEffect] at created - | restart chosen => - simp [messageForEffect] at created - | completed => - simp [messageForEffect] at created - | rejected reason => - simp [messageForEffect] at created - -theorem step_preserves_location - (config : Protocol.Config) - (state : NodeState) - (event : Event) : - (step config state event).state.location = state.location := by - cases event <;> - simp [step, rejected, advance, advanceTimeoutLane] - all_goals repeat first | split | simp_all - -theorem nodeState_location - {state : State} - {node : Location} - {foundState : NodeState} - (locations : - forall entry, entry ∈ state.system.nodes -> - entry.2.location = entry.1) - (found : nodeState state node = some foundState) : - foundState.location = node := by - rw [nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have membership : entry ∈ state.system.nodes := - List.mem_of_find?_eq_some findEq - have condition : (entry.1 == node) = true := - List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) findEq - have keyEq : entry.1 = node := beq_iff_eq.mp condition - rw [←stateEq, locations entry membership, keyEq] - -theorem initial_well_formed - (config : Config) - (active : List Location) - (valid : config.Valid) - (activeNodup : active.Nodup) - (activeConfigured : - forall node, node ∈ active -> - node ∈ config.protocol.expectedLocations) : - WellFormed config (initial config active) := by - constructor - · simp [Global.initial, initialSystem, Function.comp_def] - · simpa [Global.initial, initialSystem, Function.comp_def] using valid.2.1 - · simp [Global.initial, initialSystem, initialNode] - · exact activeNodup - · exact activeConfigured - · simp [Global.initial] - · simp [Global.initial] - · simp [Global.initial] - · constructor <;> simp [Global.initial] - -@[simp] -theorem recordEffects_active - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : - (recordEffects node nodeState effects state).active = state.active := by - induction effects generalizing state with - | nil => rfl - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - change - (recordEffects node nodeState tail - (recordEffect node nodeState state effect)).active = - state.active - rw [ih] - cases effect <;> rfl - -@[simp] -theorem recordEffects_system - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : - (recordEffects node nodeState effects state).system = state.system := by - induction effects generalizing state with - | nil => rfl - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - change - (recordEffects node nodeState tail - (recordEffect node nodeState state effect)).system = - state.system - rw [ih] - cases effect <;> rfl - -@[simp] -theorem recordEffects_network - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : - (recordEffects node nodeState effects state).network = state.network := by - induction effects generalizing state with - | nil => rfl - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - change - (recordEffects node nodeState tail - (recordEffect node nodeState state effect)).network = - state.network - rw [ih] - cases effect <;> rfl - -@[simp] -theorem recordEffects_sent - (node : Location) - (nodeState : NodeState) - (effects : List Effect) - (state : State) : - (recordEffects node nodeState effects state).sent = state.sent := by - induction effects generalizing state with - | nil => rfl - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - change - (recordEffects node nodeState tail - (recordEffect node nodeState state effect)).sent = - state.sent - rw [ih] - cases effect <;> rfl - -theorem recordEffect_preserves_histories_active - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - (wellFormed : HistoriesActive state) - (nodeActive : node ∈ state.active) : - HistoriesActive (recordEffect node nodeState state effect) := by - rcases wellFormed with ⟨openings, restarts, completed⟩ - cases effect <;> - constructor <;> - simp_all [recordEffect] - -theorem recordEffects_preserves_histories_active - {node : Location} - {nodeState : NodeState} - {effects : List Effect} - {state : State} - (wellFormed : HistoriesActive state) - (nodeActive : node ∈ state.active) : - HistoriesActive (recordEffects node nodeState effects state) := by - induction effects generalizing state with - | nil => exact wellFormed - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - apply ih - · exact recordEffect_preserves_histories_active wellFormed nodeActive - · cases effect <;> simpa [recordEffect] using nodeActive - -theorem mem_of_mem_removeOne - [BEq α] - (value member : α) - (values : List α) : - member ∈ removeOne value values -> - member ∈ values := by - induction values with - | nil => simp [removeOne] - | cons head tail ih => - simp only [removeOne] - split - · exact List.mem_cons_of_mem head - · intro membership - rw [List.mem_cons] at membership ⊢ - exact membership.imp_right ih - -theorem mem_openings_recordEffect - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - {opening : Opening} - (membership : opening ∈ state.openings) : - opening ∈ (recordEffect node nodeState state effect).openings := by - cases effect <;> simp_all [recordEffect] - -theorem mem_restarts_recordEffect - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - {restart : Location} - (membership : restart ∈ state.restarts) : - restart ∈ (recordEffect node nodeState state effect).restarts := by - cases effect <;> simp_all [recordEffect] - -theorem mem_completed_recordEffect - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - {completed : Location} - (membership : completed ∈ state.completed) : - completed ∈ (recordEffect node nodeState state effect).completed := by - cases effect <;> simp_all [recordEffect] - -theorem mem_openings_recordEffects - {node : Location} - {nodeState : NodeState} - {state : State} - {effects : List Effect} - {opening : Opening} - (membership : opening ∈ state.openings) : - opening ∈ (recordEffects node nodeState effects state).openings := by - induction effects generalizing state with - | nil => exact membership - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - exact ih (mem_openings_recordEffect membership) - -theorem mem_restarts_recordEffects - {node : Location} - {nodeState : NodeState} - {state : State} - {effects : List Effect} - {restart : Location} - (membership : restart ∈ state.restarts) : - restart ∈ (recordEffects node nodeState effects state).restarts := by - induction effects generalizing state with - | nil => exact membership - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - exact ih (mem_restarts_recordEffect membership) - -theorem mem_completed_recordEffects - {node : Location} - {nodeState : NodeState} - {state : State} - {effects : List Effect} - {completed : Location} - (membership : completed ∈ state.completed) : - completed ∈ (recordEffects node nodeState effects state).completed := by - induction effects generalizing state with - | nil => exact membership - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - exact ih (mem_completed_recordEffect membership) - -theorem replaceNode_keys - (target : Location) - (nextState : NodeState) - (nodes : List (Prod Location NodeState)) : - (replaceNode target nextState nodes).map Prod.fst = - nodes.map Prod.fst := by - induction nodes with - | nil => rfl - | cons entry tail ih => - simp only [replaceNode, List.map_cons] - split - · - rename_i condition - have same : entry.1 = target := beq_iff_eq.mp condition - simp only [List.cons.injEq] - constructor - · exact same.symm - · simpa [replaceNode] using ih - · - simp only [List.cons.injEq, true_and] - simpa [replaceNode] using ih - -theorem replaceNode_locations - (target : Location) - (nextState : NodeState) - (nodes : List (Prod Location NodeState)) - (locations : - forall entry, entry ∈ nodes -> - entry.2.location = entry.1) - (nextLocation : nextState.location = target) : - forall entry, entry ∈ replaceNode target nextState nodes -> - entry.2.location = entry.1 := by - intro entry membership - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · exact nextLocation - · exact locations previous previousMember - -theorem findNode_replaceNode_ne - (target other : Location) - (nextState : NodeState) - (nodes : List (Prod Location NodeState)) - (different : other ≠ target) : - ((replaceNode target nextState nodes).find? - fun entry => entry.1 == other).map Prod.snd = - (nodes.find? fun entry => entry.1 == other).map Prod.snd := by - let replace : Prod Location NodeState -> Prod Location NodeState := - fun entry => - if entry.1 == target then (target, nextState) else entry - change - Option.map Prod.snd - (List.find? (fun entry => entry.1 == other) - (nodes.map replace)) = - Option.map Prod.snd - (List.find? (fun entry => entry.1 == other) nodes) - rw [List.find?_map] - have predicate : - ((fun entry : Prod Location NodeState => entry.1 == other) ∘ - replace) = - (fun entry => entry.1 == other) := by - funext entry - by_cases atTarget : entry.1 = target - · simp [replace, atTarget] - · simp [replace, atTarget] - rw [predicate] - cases found : - List.find? (fun entry : Prod Location NodeState => - entry.1 == other) nodes with - | none => simp - | some entry => - have condition : - (entry.1 == other) = true := - List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == other) found - have entryOther : entry.1 = other := - beq_iff_eq.mp condition - have notTarget : entry.1 ≠ target := by - simpa [entryOther] using different - simp [replace, notTarget] - -theorem systemStep_node_keys_eq - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (transition : - systemStep config before target event = some (after, output)) : - after.nodes.map Prod.fst = before.nodes.map Prod.fst := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with ⟨node, _, stateEq, _⟩ - rw [←stateEq] - exact replaceNode_keys target - (step config node event).state before.nodes - -theorem systemStep_preserves_node_locations - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (locations : - forall entry, entry ∈ before.nodes -> - entry.2.location = entry.1) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.location = entry.1 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, stateEq, _⟩ - rw [←stateEq] - apply replaceNode_locations - · exact locations - · calc - (step config node event).state.location = - node.location := step_preserves_location config node event - _ = key := - locations (key, node) (List.mem_of_find?_eq_some found) - _ = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - -theorem systemStep_other_node_eq - {config : Protocol.Config} - {before after : SystemState} - {target other : Location} - {event : Event} - {output : StepOutput} - (different : other ≠ target) - (transition : - systemStep config before target event = some (after, output)) : - (after.nodes.find? fun entry => entry.1 == other).map Prod.snd = - (before.nodes.find? fun entry => entry.1 == other).map Prod.snd := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with ⟨node, _, stateEq, _⟩ - rw [←stateEq] - exact findNode_replaceNode_ne target other - (step config node event).state before.nodes different - -theorem next_active_eq - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - after.active = before.active := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - rfl - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, _, system, output, _, rfl⟩ - simp - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, system, output, _, _, rfl⟩ - simp - -theorem next_node_keys_eq - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - after.system.nodes.map Prod.fst = - before.system.nodes.map Prod.fst := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - rfl - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, _, system, output, systemStep, rfl⟩ - simpa using systemStep_node_keys_eq systemStep - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, system, output, systemStep, _, rfl⟩ - simpa using systemStep_node_keys_eq systemStep - -theorem retry_system_eq - {config : Config} - {before after : State} - {source : Location} - (transition : next config before (.retry source) = some after) : - after.system = before.system := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - rfl - -theorem deliver_network_eq - {config : Config} - {before after : State} - {envelope : Envelope} - (transition : next config before (.deliver envelope) = some after) : - after.network = removeOne envelope before.network := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - simp - -theorem timeout_network_eq - {config : Config} - {before after : State} - {target : Location} - (transition : next config before (.timeout target) = some after) : - after.network = before.network := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - simp - -theorem deliver_other_node_eq - {config : Config} - {before after : State} - {envelope : Envelope} - {other : Location} - (different : other ≠ envelope.target) - (transition : next config before (.deliver envelope) = some after) : - nodeState after other = nodeState before other := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] - simp only [nodeState, recordEffects_system] - exact systemStep_other_node_eq different systemStep - -theorem timeout_other_node_eq - {config : Config} - {before after : State} - {target other : Location} - (different : other ≠ target) - (transition : next config before (.timeout target) = some after) : - nodeState after other = nodeState before other := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - simp only [nodeState, recordEffects_system] - exact systemStep_other_node_eq different systemStep - -theorem next_sent_extends - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - exists added, after.sent = before.sent ++ added := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact ⟨retryMessages config source sourceState, rfl⟩ - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - refine ⟨[], ?_⟩ - simp - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - refine ⟨[], ?_⟩ - simp - -theorem next_openings_monotonic - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - forall opening, opening ∈ before.openings -> - opening ∈ after.openings := by - intro opening membership - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact membership - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - apply mem_openings_recordEffects - simpa using membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - apply mem_openings_recordEffects - simpa using membership - -theorem next_restarts_monotonic - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - forall restart, restart ∈ before.restarts -> - restart ∈ after.restarts := by - intro restart membership - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact membership - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - apply mem_restarts_recordEffects - simpa using membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - apply mem_restarts_recordEffects - simpa using membership - -theorem next_completed_monotonic - {config : Config} - {before after : State} - {action : Action} - (transition : next config before action = some after) : - forall completed, completed ∈ before.completed -> - completed ∈ after.completed := by - intro completed membership - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact membership - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, rfl⟩ - apply mem_completed_recordEffects - simpa using membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, rfl⟩ - apply mem_completed_recordEffects - simpa using membership - -theorem retry_preserves_well_formed - {config : Config} - {before after : State} - {source : Location} - (wellFormed : WellFormed config before) - (transition : next config before (.retry source) = some after) : - WellFormed config after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨sourceActive, sourceState, found, _, stateEq⟩ - have sourceLocation : sourceState.location = source := - nodeState_location wellFormed.nodeLocations found - rw [←stateEq] - constructor - · exact wellFormed.nodeKeys - · exact wellFormed.nodeKeysNodup - · exact wellFormed.nodeLocations - · exact wellFormed.activeNodup - · exact wellFormed.activeConfigured - · intro envelope membership - rw [List.mem_append] at membership - rcases membership with membership | membership - · exact wellFormed.sentValid envelope membership - · exact retryMessages_valid config source sourceState - sourceLocation envelope membership - · intro envelope membership - rw [List.mem_append] at membership - rcases membership with membership | membership - · exact wellFormed.sentSourceActive envelope membership - · rw [(retryMessages_source membership).1] - exact sourceActive - · intro envelope membership - rw [List.mem_append] at membership ⊢ - rcases membership with membership | membership - · exact Or.inl (wellFormed.networkSent envelope membership) - · exact Or.inr membership - · constructor - · exact wellFormed.historiesActive.openings - · exact wellFormed.historiesActive.restarts - · exact wellFormed.historiesActive.completed - -theorem deliver_preserves_well_formed - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (transition : next config before (.deliver envelope) = some after) : - WellFormed config after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, targetActive, system, output, systemStep, stateEq⟩ - rw [←stateEq] - constructor - · simp only [recordEffects_system] - exact (systemStep_node_keys_eq systemStep).trans - wellFormed.nodeKeys - · rw [recordEffects_system, systemStep_node_keys_eq systemStep] - exact wellFormed.nodeKeysNodup - · simp only [recordEffects_system] - exact systemStep_preserves_node_locations - wellFormed.nodeLocations systemStep - · simpa using wellFormed.activeNodup - · simpa using wellFormed.activeConfigured - · intro sent membership - rw [recordEffects_sent] at membership - exact wellFormed.sentValid sent membership - · intro sent membership - rw [recordEffects_sent] at membership - rw [recordEffects_active] - exact wellFormed.sentSourceActive sent membership - · intro pending membership - rw [recordEffects_network] at membership - rw [recordEffects_sent] - exact wellFormed.networkSent pending - (mem_of_mem_removeOne envelope pending before.network membership) - · apply recordEffects_preserves_histories_active - · constructor - · simpa using wellFormed.historiesActive.openings - · simpa using wellFormed.historiesActive.restarts - · simpa using wellFormed.historiesActive.completed - · simpa using targetActive - -theorem timeout_preserves_well_formed - {config : Config} - {before after : State} - {target : Location} - (wellFormed : WellFormed config before) - (transition : next config before (.timeout target) = some after) : - WellFormed config after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨targetActive, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - constructor - · simp only [recordEffects_system] - exact (systemStep_node_keys_eq systemStep).trans - wellFormed.nodeKeys - · rw [recordEffects_system, systemStep_node_keys_eq systemStep] - exact wellFormed.nodeKeysNodup - · simp only [recordEffects_system] - exact systemStep_preserves_node_locations - wellFormed.nodeLocations systemStep - · simpa using wellFormed.activeNodup - · simpa using wellFormed.activeConfigured - · intro sent membership - rw [recordEffects_sent] at membership - exact wellFormed.sentValid sent membership - · intro sent membership - rw [recordEffects_sent] at membership - rw [recordEffects_active] - exact wellFormed.sentSourceActive sent membership - · intro pending membership - rw [recordEffects_network] at membership - rw [recordEffects_sent] - exact wellFormed.networkSent pending membership - · apply recordEffects_preserves_histories_active - · constructor - · simpa using wellFormed.historiesActive.openings - · simpa using wellFormed.historiesActive.restarts - · simpa using wellFormed.historiesActive.completed - · simpa using targetActive - -theorem next_preserves_well_formed - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (transition : next config before action = some after) : - WellFormed config after := by - cases action with - | retry source => - exact retry_preserves_well_formed wellFormed transition - | deliver envelope => - exact deliver_preserves_well_formed wellFormed transition - | timeout target => - exact timeout_preserves_well_formed wellFormed transition - -theorem reachable_well_formed - {config : Config} - {state : State} - (reachable : Reachable config state) : - WellFormed config state := by - induction reachable with - | initial active valid nodup configured => - exact initial_well_formed config active valid nodup configured - | step reachable transition wellFormed => - exact next_preserves_well_formed wellFormed transition - -theorem reachable_config_valid - {config : Config} - {state : State} - (reachable : Reachable config state) : - config.Valid := by - induction reachable with - | initial active valid nodup configured => exact valid - | step reachable transition valid => exact valid - end DisasterRecovery.Protocol.Global diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean index 7413f3f435ee..8dd4f36170df 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean @@ -1,5 +1,6 @@ import DisasterRecovery.Protocol.Invariants -import Mathlib.Tactic + +/-! Human-reviewed vote provenance, quorum and opening predicates. -/ namespace DisasterRecovery.Protocol.Global @@ -77,1391 +78,14 @@ structure QuorumInvariant (config : Config) (state : State) : Prop where sentVotesSelected : SentVotesSelected state openingsValid : OpeningsValid config state -theorem insertVote_nodup - (source : Location) - {votes : List Location} - (nodup : votes.Nodup) : - (insertVote source votes).Nodup := by - unfold insertVote - split - · exact nodup - · rename_i absent - apply (List.mergeSort_perm _ _).symm.nodup - rw [List.nodup_cons] - exact - ⟨fun member => absent (List.contains_iff_mem.mpr member), nodup⟩ - -theorem mem_insertVote - {member source : Location} - {votes : List Location} - (membership : member ∈ insertVote source votes) : - member ∈ votes \/ member = source := by - unfold insertVote at membership - split at membership - · exact Or.inl membership - · have unsorted := - (List.mergeSort_perm _ _).mem_iff.mp membership - rw [List.mem_cons] at unsorted - exact unsorted.symm - -theorem step_preserves_votes_nodup - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (nodup : state.votes.Nodup) : - (step config state event).state.votes.Nodup := by - cases event <;> - simp [step, rejected, advance, advanceTimeoutLane] - all_goals - repeat first | split | simp_all [insertVote_nodup] - def acceptedVoteSource : Event -> Option Location | .receiveVote source .accepted => some source | _ => none -theorem step_votes_shape - (config : Protocol.Config) - (state : NodeState) - (event : Event) : - (step config state event).state.votes = state.votes \/ - exists source, - acceptedVoteSource event = some source /\ - (step config state event).state.votes = - insertVote source state.votes := by - cases event - all_goals try cases_type Validation - all_goals - simp [acceptedVoteSource, step, rejected, advance, advanceTimeoutLane] - all_goals repeat first | split | simp_all - -theorem step_vote_origin - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (voter : Location) - (membership : voter ∈ (step config state event).state.votes) : - voter ∈ state.votes \/ - acceptedVoteSource event = some voter := by - rcases step_votes_shape config state event with - unchanged | ⟨source, sourceEq, changed⟩ - · rw [unchanged] at membership - exact Or.inl membership - · rw [changed] at membership - rcases mem_insertVote membership with old | added - · exact Or.inl old - · subst source - exact Or.inr sourceEq - -theorem step_preserves_non_gossiping - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (pastGossip : state.phase ≠ .gossiping) : - (step config state event).state.phase ≠ .gossiping := by - cases event <;> - simp [step, rejected, advance, advanceTimeoutLane] - all_goals repeat first | split | simp_all - -theorem voting_step_preserves_choice - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (pastGossip : state.phase ≠ .gossiping) - (stillVoting : (step config state event).state.phase = .voting) : - state.phase = .voting /\ - (step config state event).state.chosen = state.chosen := by - cases event <;> - simp [step, rejected, advance, advanceTimeoutLane] at stillVoting ⊢ - all_goals repeat first | split at stillVoting | split | simp_all - -theorem step_preserves_voting_selection - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (before : - state.phase = .voting -> - NodeVotingSelection state) - (voting : (step config state event).state.phase = .voting) : - NodeVotingSelection (step config state event).state := by - cases event - all_goals try cases_type Validation - all_goals - simp [NodeVotingSelection, step, rejected, advance, - advanceTimeoutLane, validTimeout] at before voting ⊢ - all_goals - repeat first | split at voting | split | simp_all | aesop - -theorem retry_vote_state - {config : Config} - {envelope : Envelope} - (valid : envelope.Valid config) - (vote : envelope.payload = .vote) : - envelope.sourceState.phase = .voting /\ - envelope.sourceState.chosen = some envelope.target := by - rcases valid_envelope_effect valid with - ⟨effect, member, created⟩ - cases effect with - | sendGossip target => - cases found : recoveredTxID config envelope.source with - | none => - simp [messageForEffect, found] at created - | some txid => - simp [messageForEffect, found] at created - rw [←created] at vote - contradiction - | sendVote target => - simp [messageForEffect] at created - rw [←created] at vote ⊢ - cases phase : envelope.sourceState.phase <;> - simp [step, phase] at member - next => - cases chosen : envelope.sourceState.chosen <;> - simp_all - | sendIAmOpen target => - simp [messageForEffect] at created - rw [←created] at vote - contradiction - | opening kind => - simp [messageForEffect] at created - | restart chosen => - simp [messageForEffect] at created - | completed => - simp [messageForEffect] at created - | rejected reason => - simp [messageForEffect] at created - -theorem opening_effect_state - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (kind : OpenKind) - (opening : .opening kind ∈ (step config state event).effects) : - (step config state event).state.phase = .opening /\ - (step config state event).state.openKind = some kind := by - cases event - all_goals try cases_type Validation - all_goals - simp [step, rejected, advance, advanceTimeoutLane, validTimeout] - at opening ⊢ - all_goals - repeat first | split at opening | split | simp_all | aesop - -theorem quorum_effect_has_threshold - (config : Protocol.Config) - (state : NodeState) - (event : Event) - (opening : - .opening .quorum ∈ (step config state event).effects) : - voteQuorum config <= - (step config state event).state.votes.length := by - cases event - all_goals try cases_type Validation - all_goals - simp [step, rejected, advance, advanceTimeoutLane, validTimeout] - at opening ⊢ - all_goals - repeat first | split at opening | split | simp_all | aesop - -theorem sentVote_mono - {before after : State} - {voter target : Location} - (sent : forall envelope, envelope ∈ before.sent -> - envelope ∈ after.sent) - (vote : SentVote before voter target) : - SentVote after voter target := by - rcases vote with - ⟨envelope, membership, source, destination, payload⟩ - exact - ⟨envelope, sent envelope membership, source, destination, payload⟩ - -theorem opening_valid_of_sent_eq - {config : Config} - {before after : State} - {opening : Opening} - (sentEq : after.sent = before.sent) - (valid : opening.Valid config before) : - opening.Valid config after := by - rcases valid with - ⟨location, phase, kind, nodup, quorum, votesSent⟩ - constructor - · exact location - · exact phase - · exact kind - · exact nodup - · exact quorum - · intro voter membership - apply sentVote_mono - · intro envelope sent - rw [sentEq] - exact sent - · exact votesSent voter membership - -theorem opening_valid_mono - {config : Config} - {before after : State} - {opening : Opening} - (sent : - forall envelope, envelope ∈ before.sent -> - envelope ∈ after.sent) - (valid : opening.Valid config before) : - opening.Valid config after := by - rcases valid with - ⟨location, phase, kind, nodup, quorum, votesSent⟩ - constructor - · exact location - · exact phase - · exact kind - · exact nodup - · exact quorum - · intro voter membership - exact sentVote_mono sent (votesSent voter membership) - -theorem recordEffect_preserves_openings_valid - {config : Config} - {node : Location} - {nodeState : NodeState} - {state : State} - {effect : Effect} - (valid : OpeningsValid config state) - (newValid : - forall kind, - effect = .opening kind -> - Opening.Valid config state - { node, kind, state := nodeState }) : - OpeningsValid config - (recordEffect node nodeState state effect) := by - intro opening membership - cases effect with - | opening kind => - simp [recordEffect] at membership - rcases membership with rfl | old - · apply opening_valid_of_sent_eq - (before := state) - (after := recordEffect node nodeState state (.opening kind)) - rfl - exact newValid kind rfl - · apply opening_valid_of_sent_eq - (before := state) - (after := recordEffect node nodeState state (.opening kind)) - rfl - exact valid opening old - | sendGossip target => - exact valid opening membership - | sendVote target => - exact valid opening membership - | sendIAmOpen target => - exact valid opening membership - | restart target => - apply opening_valid_of_sent_eq - (before := state) - (after := recordEffect node nodeState state (.restart target)) - rfl - exact valid opening membership - | completed => - apply opening_valid_of_sent_eq - (before := state) - (after := recordEffect node nodeState state .completed) - rfl - exact valid opening membership - | rejected reason => - exact valid opening membership - -theorem recordEffects_preserves_openings_valid - {config : Config} - {node : Location} - {nodeState : NodeState} - {state : State} - {effects : List Effect} - (valid : OpeningsValid config state) - (newValid : - forall kind, - .opening kind ∈ effects -> - Opening.Valid config state - { node, kind, state := nodeState }) : - OpeningsValid config - (recordEffects node nodeState effects state) := by - induction effects generalizing state with - | nil => exact valid - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - apply ih - · apply recordEffect_preserves_openings_valid valid - intro kind effectEq - subst effect - exact newValid kind (by simp) - · intro kind membership - apply opening_valid_of_sent_eq - (before := state) - (after := recordEffect node nodeState state effect) - (by cases effect <;> rfl) - exact newValid kind (by simp [membership]) - -theorem eventFor_vote_source - {envelope : Envelope} - {voter : Location} - (source : - acceptedVoteSource (eventFor envelope) = some voter) : - envelope.payload = .vote /\ - envelope.source = voter := by - cases payload : envelope.payload <;> - simp_all [eventFor, acceptedVoteSource] - -theorem systemStep_preserves_votes_nodup - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (nodup : - forall entry, entry ∈ before.nodes -> - entry.2.votes.Nodup) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.votes.Nodup := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, stateEq, _⟩ - rw [←stateEq] - intro entry membership - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · apply step_preserves_votes_nodup - exact nodup (key, node) (List.mem_of_find?_eq_some found) - · exact nodup previous previousMember - -theorem systemStep_preserves_voting_selections - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (valid : - forall entry, entry ∈ before.nodes -> - entry.2.phase = .voting -> - NodeVotingSelection entry.2) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.phase = .voting -> - NodeVotingSelection entry.2 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership voting - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · rename_i atTarget - apply step_preserves_voting_selection config node event - · exact valid (key, node) - (List.mem_of_find?_eq_some found) - · simpa [atTarget, outputEq] using voting - · rename_i notTarget - exact valid previous previousMember - (by simpa [notTarget] using voting) - -theorem systemStep_output_location - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (locations : - forall entry, entry ∈ before.nodes -> - entry.2.location = entry.1) - (transition : - systemStep config before target event = some (after, output)) : - output.state.location = target := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, _, outputEq⟩ - calc - output.state.location = - node.location := by - rw [←outputEq] - exact step_preserves_location config node event - _ = key := - locations (key, node) (List.mem_of_find?_eq_some found) - _ = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - -theorem systemStep_output_mem - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (transition : - systemStep config before target event = some (after, output)) : - (target, output.state) ∈ after.nodes := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq, replaceNode, List.mem_map] - refine ⟨(key, node), List.mem_of_find?_eq_some found, ?_⟩ - have keyEq : key = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - simp [keyEq, outputEq] - -theorem systemStep_opening_effect_state - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {kind : OpenKind} - (transition : - systemStep config before target event = some (after, output)) - (opening : .opening kind ∈ output.effects) : - output.state.phase = .opening /\ - output.state.openKind = some kind := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, _, _, outputEq⟩ - rw [←outputEq] at opening ⊢ - exact opening_effect_state config node event kind opening - -theorem systemStep_quorum_effect_has_threshold - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (transition : - systemStep config before target event = some (after, output)) - (opening : .opening .quorum ∈ output.effects) : - voteQuorum config <= output.state.votes.length := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, _, _, outputEq⟩ - rw [←outputEq] at opening ⊢ - exact quorum_effect_has_threshold config node event opening - -theorem initial_node_votes_nodup - (config : Config) - (active : List Location) : - NodeVotesNodup (initial config active) := by - simp [NodeVotesNodup, Global.initial, initialSystem, initialNode] - -theorem initial_node_votes_sent - (config : Config) - (active : List Location) : - NodeVotesSent (initial config active) := by - simp [NodeVotesSent, Global.initial, initialSystem, initialNode] - -theorem initial_sent_votes_functional - (config : Config) - (active : List Location) : - SentVotesFunctional (initial config active) := by - simp [SentVotesFunctional, SentVote, Global.initial] - -theorem initial_sent_vote_stable - (config : Config) - (active : List Location) : - SentVoteStable (initial config active) := by - simp [SentVoteStable, Global.initial] - -theorem initial_voting_selections - (config : Config) - (active : List Location) : - VotingSelectionsValid (initial config active) := by - simp [VotingSelectionsValid, Global.initial, initialSystem, initialNode] - -theorem initial_sent_votes_selected - (config : Config) - (active : List Location) : - SentVotesSelected (initial config active) := by - simp [SentVotesSelected, Global.initial] - -theorem initial_openings_valid - (config : Config) - (active : List Location) : - OpeningsValid config (initial config active) := by - simp [OpeningsValid, Global.initial] - -theorem systemStep_preserves_node_votes_sent - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {beforeState afterState : State} - (beforeSystem : beforeState.system = before) - (votesSent : NodeVotesSent beforeState) - (carry : - forall voter destination, - SentVote beforeState voter destination -> - SentVote afterState voter destination) - (introduced : - forall voter, - acceptedVoteSource event = some voter -> - SentVote afterState voter target) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - forall voter, voter ∈ entry.2.votes -> - SentVote afterState voter entry.1 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership voter vote - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · rename_i atTarget - have targetEq : previous.1 = target := - beq_iff_eq.mp atTarget - rcases step_vote_origin config node event voter - (by simpa [outputEq, atTarget] using vote) with - old | added - · have keyEq : key = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - apply carry - rw [←keyEq] - exact votesSent (key, node) - (by - rw [beforeSystem] - exact List.mem_of_find?_eq_some found) - voter old - · exact introduced voter added - · rename_i notTarget - apply carry - exact votesSent previous - (by - rw [beforeSystem] - exact previousMember) - voter (by simpa [notTarget] using vote) - -theorem eq_of_key_eq - {α : Type} - {nodes : List (Prod Location α)} - (nodup : (nodes.map Prod.fst).Nodup) - {first second : Prod Location α} - (firstMember : first ∈ nodes) - (secondMember : second ∈ nodes) - (keyEq : first.1 = second.1) : - first = second := by - induction nodes generalizing first second with - | nil => simp at firstMember - | cons head tail ih => - rw [List.map_cons, List.nodup_cons] at nodup - rcases nodup with ⟨headFresh, tailNodup⟩ - rw [List.mem_cons] at firstMember secondMember - rcases firstMember with rfl | firstTail - · rcases secondMember with rfl | secondTail - · rfl - · exfalso - apply headFresh - rw [List.mem_map] - exact ⟨second, secondTail, keyEq.symm⟩ - · rcases secondMember with rfl | secondTail - · exfalso - apply headFresh - rw [List.mem_map] - exact ⟨first, firstTail, keyEq⟩ - · exact ih tailNodup firstTail secondTail keyEq - -theorem systemStep_preserves_vote_stability - {config : Protocol.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {envelope : Envelope} - (stable : - forall entry, entry ∈ before.nodes -> - entry.1 = envelope.source -> - entry.2.phase ≠ .gossiping /\ - (entry.2.phase = .voting -> - entry.2.chosen = some envelope.target)) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.1 = envelope.source -> - entry.2.phase ≠ .gossiping /\ - (entry.2.phase = .voting -> - entry.2.chosen = some envelope.target) := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership sourceEq - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · rename_i atTarget - have targetEq : previous.1 = target := - beq_iff_eq.mp atTarget - have targetSource : target = envelope.source := by - simpa [atTarget] using sourceEq - have keyEq : key = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - have beforeStable := - stable (key, node) (List.mem_of_find?_eq_some found) - (keyEq.trans targetSource) - constructor - · exact step_preserves_non_gossiping config node event - beforeStable.1 - · intro voting - rcases voting_step_preserves_choice config node event - beforeStable.1 voting with ⟨beforeVoting, chosenEq⟩ - rw [chosenEq] - exact beforeStable.2 beforeVoting - · rename_i notTarget - exact stable previous previousMember - (by simpa [notTarget] using sourceEq) - -theorem next_preserves_node_votes_nodup - {config : Config} - {before after : State} - {action : Action} - (nodup : NodeVotesNodup before) - (transition : next config before action = some after) : - NodeVotesNodup after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact nodup - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, rfl⟩ - intro entry membership - rw [recordEffects_system] at membership - exact systemStep_preserves_votes_nodup nodup systemStep - entry membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, rfl⟩ - intro entry membership - rw [recordEffects_system] at membership - exact systemStep_preserves_votes_nodup nodup systemStep - entry membership - -theorem next_preserves_voting_selections - {config : Config} - {before after : State} - {action : Action} - (valid : VotingSelectionsValid before) - (transition : next config before action = some after) : - VotingSelectionsValid after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact valid - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, rfl⟩ - intro entry membership voting - rw [recordEffects_system] at membership - exact systemStep_preserves_voting_selections valid systemStep - entry membership voting - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, rfl⟩ - intro entry membership voting - rw [recordEffects_system] at membership - exact systemStep_preserves_voting_selections valid systemStep - entry membership voting - -theorem retry_preserves_sent_votes_selected - {config : Config} - {before after : State} - {source : Location} - (wellFormed : WellFormed config before) - (votingSelections : VotingSelectionsValid before) - (selected : SentVotesSelected before) - (transition : next config before (.retry source) = some after) : - SentVotesSelected after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, found, _, stateEq⟩ - have sourceLocation : sourceState.location = source := - nodeState_location wellFormed.nodeLocations found - rw [←stateEq] - intro envelope membership payload - rw [List.mem_append] at membership - rcases membership with old | added - · exact selected envelope old payload - · have valid : envelope.Valid config := - retryMessages_valid config source sourceState sourceLocation - envelope added - have voteState := retry_vote_state valid payload - have identity := retryMessages_source added - rw [identity.2] at voteState - rw [nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have sourceSelection := - votingSelections entry (List.mem_of_find?_eq_some findEq) - (by simpa [stateEq] using voteState.1) - simpa [identity.2, stateEq] using sourceSelection - -theorem deliver_preserves_sent_votes_selected - {config : Config} - {before after : State} - {envelope : Envelope} - (selected : SentVotesSelected before) - (transition : next config before (.deliver envelope) = some after) : - SentVotesSelected after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, stateEq⟩ - rw [←stateEq] - intro vote membership payload - rw [recordEffects_sent] at membership - exact selected vote membership payload - -theorem timeout_preserves_sent_votes_selected - {config : Config} - {before after : State} - {target : Location} - (selected : SentVotesSelected before) - (transition : next config before (.timeout target) = some after) : - SentVotesSelected after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, stateEq⟩ - rw [←stateEq] - intro vote membership payload - rw [recordEffects_sent] at membership - exact selected vote membership payload - -theorem retry_preserves_node_votes_sent - {config : Config} - {before after : State} - {source : Location} - (votesSent : NodeVotesSent before) - (transition : next config before (.retry source) = some after) : - NodeVotesSent after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - intro entry membership voter vote - apply sentVote_mono (before := before) - · intro envelope sent - exact List.mem_append_left _ sent - · exact votesSent entry membership voter vote - -theorem deliver_preserves_node_votes_sent - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (votesSent : NodeVotesSent before) - (transition : next config before (.deliver envelope) = some after) : - NodeVotesSent after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨inNetwork, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] - intro entry membership voter vote - rw [recordEffects_system] at membership - let afterState := - recordEffects envelope.target output.state output.effects - { - before with - system - network := removeOne envelope before.network - } - have carry : - forall oldVoter oldTarget, - SentVote before oldVoter oldTarget -> - SentVote afterState oldVoter oldTarget := by - intro oldVoter oldTarget oldVote - apply sentVote_mono (before := before) (after := afterState) - · intro sent sentMember - simpa [afterState] using sentMember - · exact oldVote - have introducedVote : - forall newVoter, - acceptedVoteSource (eventFor envelope) = some newVoter -> - SentVote afterState newVoter envelope.target := by - intro newVoter introduced - rcases eventFor_vote_source introduced with - ⟨payload, source⟩ - subst newVoter - refine ⟨envelope, ?_, rfl, rfl, payload⟩ - simp [afterState] - exact wellFormed.networkSent envelope - inNetwork - exact systemStep_preserves_node_votes_sent - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl votesSent carry introducedVote systemStep - entry membership voter vote - -theorem timeout_preserves_node_votes_sent - {config : Config} - {before after : State} - {target : Location} - (votesSent : NodeVotesSent before) - (transition : next config before (.timeout target) = some after) : - NodeVotesSent after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - intro entry membership voter vote - rw [recordEffects_system] at membership - let afterState := - recordEffects target output.state output.effects - { before with system } - have carry : - forall oldVoter oldTarget, - SentVote before oldVoter oldTarget -> - SentVote afterState oldVoter oldTarget := by - intro oldVoter oldTarget oldVote - apply sentVote_mono (before := before) (after := afterState) - · intro sent sentMember - simpa [afterState] using sentMember - · exact oldVote - have introducedVote : - forall newVoter, - acceptedVoteSource Event.timeout = some newVoter -> - SentVote afterState newVoter target := by - intro newVoter introduced - simp [acceptedVoteSource] at introduced - exact systemStep_preserves_node_votes_sent - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl votesSent carry introducedVote systemStep - entry membership voter vote - -theorem retry_preserves_openings_valid - {config : Config} - {before after : State} - {source : Location} - (valid : OpeningsValid config before) - (transition : next config before (.retry source) = some after) : - OpeningsValid config after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - intro opening membership - apply opening_valid_mono - · intro envelope sent - exact List.mem_append_left _ sent - · exact valid opening membership - -theorem deliver_preserves_openings_valid - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (votesNodup : NodeVotesNodup before) - (votesSent : NodeVotesSent before) - (valid : OpeningsValid config before) - (transition : next config before (.deliver envelope) = some after) : - OpeningsValid config after := by - have afterNodup := - next_preserves_node_votes_nodup votesNodup transition - have afterVotesSent := - deliver_preserves_node_votes_sent wellFormed votesSent transition - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] at afterNodup afterVotesSent ⊢ - let delivered : State := { - before with - system - network := removeOne envelope before.network - } - apply recordEffects_preserves_openings_valid - · intro opening membership - apply opening_valid_of_sent_eq - (before := before) (after := delivered) rfl - exact valid opening membership - · intro kind openingEffect - have effectState := - systemStep_opening_effect_state systemStep openingEffect - constructor - · exact systemStep_output_location - wellFormed.nodeLocations systemStep - · exact effectState.1 - · exact effectState.2 - · apply afterNodup (envelope.target, output.state) - rw [recordEffects_system] - exact systemStep_output_mem systemStep - · intro quorumKind - have kindEq : kind = .quorum := by simpa using quorumKind - rw [kindEq] at openingEffect - simpa using - systemStep_quorum_effect_has_threshold systemStep openingEffect - · intro voter vote - have sent := - afterVotesSent (envelope.target, output.state) - (by - rw [recordEffects_system] - exact systemStep_output_mem systemStep) - voter vote - simpa [SentVote, delivered] using sent - -theorem timeout_preserves_openings_valid - {config : Config} - {before after : State} - {target : Location} - (wellFormed : WellFormed config before) - (votesNodup : NodeVotesNodup before) - (votesSent : NodeVotesSent before) - (valid : OpeningsValid config before) - (transition : next config before (.timeout target) = some after) : - OpeningsValid config after := by - have afterNodup := - next_preserves_node_votes_nodup votesNodup transition - have afterVotesSent := - timeout_preserves_node_votes_sent votesSent transition - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] at afterNodup afterVotesSent ⊢ - let timedOut : State := { before with system } - apply recordEffects_preserves_openings_valid - · intro opening membership - apply opening_valid_of_sent_eq - (before := before) (after := timedOut) rfl - exact valid opening membership - · intro kind openingEffect - have effectState := - systemStep_opening_effect_state systemStep openingEffect - constructor - · exact systemStep_output_location - wellFormed.nodeLocations systemStep - · exact effectState.1 - · exact effectState.2 - · apply afterNodup (target, output.state) - rw [recordEffects_system] - exact systemStep_output_mem systemStep - · intro quorumKind - have kindEq : kind = .quorum := by simpa using quorumKind - rw [kindEq] at openingEffect - simpa using - systemStep_quorum_effect_has_threshold systemStep openingEffect - · intro voter vote - have sent := - afterVotesSent (target, output.state) - (by - rw [recordEffects_system] - exact systemStep_output_mem systemStep) - voter vote - simpa [SentVote, timedOut] using sent - -theorem retry_preserves_sent_vote_stable - {config : Config} - {before after : State} - {source : Location} - (wellFormed : WellFormed config before) - (stable : SentVoteStable before) - (transition : next config before (.retry source) = some after) : - SentVoteStable after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, found, _, stateEq⟩ - have sourceLocation : sourceState.location = source := - nodeState_location wellFormed.nodeLocations found - rw [←stateEq] - intro envelope membership payload entry entryMember keyEq - rw [List.mem_append] at membership - rcases membership with old | added - · exact stable envelope old payload entry entryMember keyEq - · have valid : envelope.Valid config := - retryMessages_valid config source sourceState sourceLocation - envelope added - have voteState := retry_vote_state valid payload - rcases retryMessages_source added with - ⟨sourceEq, stateEq⟩ - rw [nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨foundEntry, findEq, foundStateEq⟩ - have foundMember : foundEntry ∈ before.system.nodes := - List.mem_of_find?_eq_some findEq - have foundKey : foundEntry.1 = source := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == source) findEq) - have sameEntry : entry = foundEntry := - eq_of_key_eq wellFormed.nodeKeysNodup entryMember foundMember - ((keyEq.trans sourceEq).trans foundKey.symm) - subst entry - rw [foundStateEq, ←stateEq] - exact ⟨by simp [voteState.1], fun _ => voteState.2⟩ - -theorem deliver_preserves_sent_vote_stable - {config : Config} - {before after : State} - {delivered : Envelope} - (stable : SentVoteStable before) - (transition : next config before (.deliver delivered) = some after) : - SentVoteStable after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] - intro envelope membership payload entry entryMember keyEq - rw [recordEffects_sent] at membership - rw [recordEffects_system] at entryMember - exact systemStep_preserves_vote_stability - (fun previous previousMember source => - stable envelope membership payload previous previousMember source) - systemStep entry entryMember keyEq - -theorem timeout_preserves_sent_vote_stable - {config : Config} - {before after : State} - {target : Location} - (stable : SentVoteStable before) - (transition : next config before (.timeout target) = some after) : - SentVoteStable after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - intro envelope membership payload entry entryMember keyEq - rw [recordEffects_sent] at membership - rw [recordEffects_system] at entryMember - exact systemStep_preserves_vote_stability - (fun previous previousMember source => - stable envelope membership payload previous previousMember source) - systemStep entry entryMember keyEq - -theorem sentVote_stable_at_node - {state : State} - {voter target : Location} - {current : NodeState} - (stable : SentVoteStable state) - (vote : SentVote state voter target) - (found : nodeState state voter = some current) : - current.phase ≠ .gossiping /\ - (current.phase = .voting -> - current.chosen = some target) := by - rcases vote with - ⟨envelope, sent, sourceEq, targetEq, payload⟩ - rw [nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have entryMember : entry ∈ state.system.nodes := - List.mem_of_find?_eq_some findEq - have entryKey : entry.1 = voter := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == voter) findEq) - have result := - stable envelope sent payload entry entryMember - (entryKey.trans sourceEq.symm) - rw [stateEq] at result - simpa [targetEq] using result - -theorem retry_preserves_sent_votes_functional - {config : Config} - {before after : State} - {source : Location} - (wellFormed : WellFormed config before) - (functional : SentVotesFunctional before) - (stable : SentVoteStable before) - (transition : next config before (.retry source) = some after) : - SentVotesFunctional after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, found, _, stateEq⟩ - have sourceLocation : sourceState.location = source := - nodeState_location wellFormed.nodeLocations found - rw [←stateEq] - have classify : - forall voter target, - SentVote - { - before with - network := before.network ++ - retryMessages config source sourceState - sent := before.sent ++ - retryMessages config source sourceState - } - voter target -> - SentVote before voter target \/ - (voter = source /\ - sourceState.phase = .voting /\ - sourceState.chosen = some target) := by - intro voter target vote - rcases vote with - ⟨envelope, membership, sourceEq, targetEq, payload⟩ - rw [List.mem_append] at membership - rcases membership with old | added - · exact Or.inl - ⟨envelope, old, sourceEq, targetEq, payload⟩ - · have valid : envelope.Valid config := - retryMessages_valid config source sourceState sourceLocation - envelope added - have voteState := retry_vote_state valid payload - have retryIdentity := retryMessages_source added - rw [retryIdentity.2] at voteState - exact Or.inr - ⟨sourceEq.symm.trans retryIdentity.1, - voteState.1, - by simpa [targetEq] using voteState.2⟩ - intro voter first second firstVote secondVote - rcases classify voter first firstVote with - firstOld | ⟨firstSource, firstPhase, firstChoice⟩ - · rcases classify voter second secondVote with - secondOld | ⟨secondSource, secondPhase, secondChoice⟩ - · exact functional voter first second firstOld secondOld - · have oldState := - sentVote_stable_at_node stable firstOld - (by simpa [secondSource] using found) - have oldChoice := oldState.2 secondPhase - rw [oldChoice] at secondChoice - exact Option.some.inj secondChoice - · rcases classify voter second secondVote with - secondOld | ⟨secondSource, secondPhase, secondChoice⟩ - · have oldState := - sentVote_stable_at_node stable secondOld - (by simpa [firstSource] using found) - have oldChoice := oldState.2 firstPhase - rw [oldChoice] at firstChoice - exact (Option.some.inj firstChoice).symm - · rw [firstChoice] at secondChoice - exact Option.some.inj secondChoice - -theorem deliver_preserves_sent_votes_functional - {config : Config} - {before after : State} - {envelope : Envelope} - (functional : SentVotesFunctional before) - (transition : next config before (.deliver envelope) = some after) : - SentVotesFunctional after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, _, stateEq⟩ - rw [←stateEq] - intro voter first second firstVote secondVote - apply functional voter first second - · simpa [SentVote] using firstVote - · simpa [SentVote] using secondVote - -theorem timeout_preserves_sent_votes_functional - {config : Config} - {before after : State} - {target : Location} - (functional : SentVotesFunctional before) - (transition : next config before (.timeout target) = some after) : - SentVotesFunctional after := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, _, _, stateEq⟩ - rw [←stateEq] - intro voter first second firstVote secondVote - apply functional voter first second - · simpa [SentVote] using firstVote - · simpa [SentVote] using secondVote - -theorem initial_quorum_invariant - (config : Config) - (active : List Location) : - QuorumInvariant config (initial config active) := { - votesNodup := initial_node_votes_nodup config active - votesSent := initial_node_votes_sent config active - sentVoteStable := initial_sent_vote_stable config active - sentVotesFunctional := initial_sent_votes_functional config active - votingSelections := initial_voting_selections config active - sentVotesSelected := initial_sent_votes_selected config active - openingsValid := initial_openings_valid config active -} - -theorem next_preserves_quorum_invariant - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (invariant : QuorumInvariant config before) - (transition : next config before action = some after) : - QuorumInvariant config after := by - cases action with - | retry source => - constructor - · exact next_preserves_node_votes_nodup - invariant.votesNodup transition - · exact retry_preserves_node_votes_sent - invariant.votesSent transition - · exact retry_preserves_sent_vote_stable - wellFormed invariant.sentVoteStable transition - · exact retry_preserves_sent_votes_functional - wellFormed invariant.sentVotesFunctional - invariant.sentVoteStable transition - · exact next_preserves_voting_selections - invariant.votingSelections transition - · exact retry_preserves_sent_votes_selected - wellFormed invariant.votingSelections - invariant.sentVotesSelected transition - · exact retry_preserves_openings_valid - invariant.openingsValid transition - | deliver envelope => - constructor - · exact next_preserves_node_votes_nodup - invariant.votesNodup transition - · exact deliver_preserves_node_votes_sent - wellFormed invariant.votesSent transition - · exact deliver_preserves_sent_vote_stable - invariant.sentVoteStable transition - · exact deliver_preserves_sent_votes_functional - invariant.sentVotesFunctional transition - · exact next_preserves_voting_selections - invariant.votingSelections transition - · exact deliver_preserves_sent_votes_selected - invariant.sentVotesSelected transition - · exact deliver_preserves_openings_valid - wellFormed invariant.votesNodup invariant.votesSent - invariant.openingsValid transition - | timeout target => - constructor - · exact next_preserves_node_votes_nodup - invariant.votesNodup transition - · exact timeout_preserves_node_votes_sent - invariant.votesSent transition - · exact timeout_preserves_sent_vote_stable - invariant.sentVoteStable transition - · exact timeout_preserves_sent_votes_functional - invariant.sentVotesFunctional transition - · exact next_preserves_voting_selections - invariant.votingSelections transition - · exact timeout_preserves_sent_votes_selected - invariant.sentVotesSelected transition - · exact timeout_preserves_openings_valid - wellFormed invariant.votesNodup invariant.votesSent - invariant.openingsValid transition - -theorem reachable_quorum_invariant - {config : Config} - {state : State} - (reachable : Reachable config state) : - QuorumInvariant config state := by - induction reachable with - | initial active valid nodup configured => - exact initial_quorum_invariant config active - | step reachable transition invariant => - exact next_preserves_quorum_invariant - (reachable_well_formed reachable) invariant transition - -theorem quorum_lists_intersect - {α : Type} - [DecidableEq α] - (expected first second : List α) - (firstNodup : first.Nodup) - (secondNodup : second.Nodup) - (firstSubset : - forall value, value ∈ first -> value ∈ expected) - (secondSubset : - forall value, value ∈ second -> value ∈ expected) - (firstQuorum : - expected.length / 2 + 1 <= first.length) - (secondQuorum : - expected.length / 2 + 1 <= second.length) : - exists value, value ∈ first /\ value ∈ second := by - by_contra noShared - push_neg at noShared - have disjoint : Disjoint first.toFinset second.toFinset := - Finset.disjoint_left.mpr (by - intro value firstMember secondMember - exact noShared value - (List.mem_toFinset.mp firstMember) - (List.mem_toFinset.mp secondMember)) - have unionSubset : - first.toFinset ∪ second.toFinset ⊆ expected.toFinset := by - intro value membership - rw [Finset.mem_union] at membership - rw [List.mem_toFinset] - exact membership.elim - (fun member => - firstSubset value (List.mem_toFinset.mp member)) - (fun member => - secondSubset value (List.mem_toFinset.mp member)) - have unionCard := Finset.card_le_card unionSubset - rw [Finset.card_union_of_disjoint disjoint, - List.toFinset_card_of_nodup firstNodup, - List.toFinset_card_of_nodup secondNodup] at unionCard - have expectedCard := List.toFinset_card_le expected - omega - def QuorumOpened (state : State) (node : Location) : Prop := exists opening, opening ∈ state.openings /\ opening.node = node /\ opening.kind = .quorum -theorem opening_vote_configured - {config : Config} - {state : State} - {opening : Opening} - (wellFormed : WellFormed config state) - (valid : opening.Valid config state) - {voter : Location} - (vote : voter ∈ opening.state.votes) : - voter ∈ config.protocol.expectedLocations := by - rcases valid.votesSent voter vote with - ⟨envelope, sent, sourceEq, _, _⟩ - apply wellFormed.activeConfigured voter - simpa [sourceEq] using - wellFormed.sentSourceActive envelope sent - -theorem quorum_opener_unique - {config : Config} - {state : State} - {first second : Location} - (reachable : Reachable config state) - (firstOpened : QuorumOpened state first) - (secondOpened : QuorumOpened state second) : - first = second := by - have wellFormed := reachable_well_formed reachable - have invariant := reachable_quorum_invariant reachable - rcases firstOpened with - ⟨firstOpening, firstMember, firstNode, firstKind⟩ - rcases secondOpened with - ⟨secondOpening, secondMember, secondNode, secondKind⟩ - have firstValid := - invariant.openingsValid firstOpening firstMember - have secondValid := - invariant.openingsValid secondOpening secondMember - rcases quorum_lists_intersect - config.protocol.expectedLocations - firstOpening.state.votes - secondOpening.state.votes - firstValid.votesNodup - secondValid.votesNodup - (fun voter vote => - opening_vote_configured wellFormed firstValid vote) - (fun voter vote => - opening_vote_configured wellFormed secondValid vote) - (by - simpa [voteQuorum] using firstValid.quorum firstKind) - (by - simpa [voteQuorum] using secondValid.quorum secondKind) with - ⟨voter, firstVote, secondVote⟩ - have targetEq := - invariant.sentVotesFunctional voter - firstOpening.node secondOpening.node - (firstValid.votesSent voter firstVote) - (secondValid.votesSent voter secondVote) - exact firstNode.symm.trans (targetEq.trans secondNode) - end DisasterRecovery.Protocol.Global diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean index 72db88bcbc0b..ce028d217edd 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean @@ -1,5 +1,7 @@ import DisasterRecovery.Protocol.Model +/-! Human-reviewed local execution and fairness definitions. -/ + namespace DisasterRecovery.Protocol def EventuallyFrom (start : Nat) (predicate : Nat -> Prop) : Prop := @@ -42,190 +44,4 @@ def StrongFairness def AlignedOpening (state : NodeState) : Prop := state.phase = .opening /\ state.timeoutState = .opening -theorem valid_timeout_requires_alignment - (state : NodeState) - (h : validTimeout state true = true) : - state.phase = state.timeoutState := by - simpa [validTimeout] using h - -theorem gossip_freezes_after_choice - (config : Config) - (state : NodeState) - (source : Location) - (txid : TxID) - (h : state.chosen.isSome = true) : - let output := step config state (.receiveGossip source txid .accepted) - output.state = state /\ output.accepted = false := by - cases chosen : state.chosen <;> simp_all [step, rejected] - -theorem rejected_gossip_stutters - (config : Config) - (state : NodeState) - (source : Location) - (txid : TxID) : - let output := step config state (.receiveGossip source txid .rejected) - output.state = state /\ output.accepted = false := by - simp [step, rejected] - -theorem duplicate_vote_is_idempotent - (source : Location) - (votes : List Location) - (h : votes.contains source = true) : - insertVote source votes = votes := by - unfold insertVote - rw [h] - simp - -theorem opening_rejects_iamopen - (config : Config) - (state : NodeState) - (source : Location) : - let opening := { state with phase := .opening } - let output := step config opening (.receiveIAmOpen source .accepted) - output.state = opening /\ output.accepted = false := by - simp [step, rejected] - -theorem open_rejects_iamopen - (config : Config) - (state : NodeState) - (source : Location) : - let opened := { state with phase := .open } - let output := step config opened (.receiveIAmOpen source .accepted) - output.state = opened /\ output.accepted = false := by - simp [step, rejected] - -theorem aligned_voting_timeout_without_votes_stutters - (config : Config) - (state : NodeState) : - let waiting := { - state with - phase := .voting - timeoutState := .voting - votes := [] - } - step config waiting .timeout = { state := waiting } := by - simp [step, advance, validTimeout, voteQuorum] - -theorem aligned_opening_timeout_completes - (config : Config) - (state : NodeState) : - let opening := { - state with - phase := .opening - timeoutState := .opening - } - let output := step config opening .timeout - output.state.phase = .open /\ - output.state.timeoutState = .opening /\ - output.effects = [.completed] := by - simp [step, advance, validTimeout, advanceTimeoutLane, advanceTimeoutState] - -theorem quorum_advance_opens - (config : Config) - (state : NodeState) - (phase : state.phase = .voting) - (quorum : state.votes.length >= voteQuorum config) : - let output := (advance config state false).get! - output.state.phase = .opening /\ - output.state.openKind = some .quorum /\ - output.effects = [.opening .quorum] := by - simp [advance, phase, quorum, validTimeout, advanceTimeoutLane] - -theorem aligned_empty_gossip_timeout_aborts - (config : Config) - (state : NodeState) : - let waiting := { - state with - phase := .gossiping - timeoutState := .gossiping - gossips := [] - } - let output := step config waiting .timeout - output.state = waiting /\ output.accepted = false := by - simp [step, advance, validTimeout, rejected, maximumGossip] - -theorem non_timeout_step_preserves_aligned_opening - (config : Config) - (state : NodeState) - (event : Event) - (aligned : AlignedOpening state) - (notTimeout : Not (event = .timeout)) : - AlignedOpening (step config state event).state := by - have phase := aligned.1 - have timeoutState := aligned.2 - cases event with - | receiveGossip source txid validation => - cases validation <;> - simp_all [AlignedOpening, step, rejected, advance, validTimeout, - advanceTimeoutLane] - split <;> simp_all - | receiveVote source validation => - cases validation <;> - simp_all [AlignedOpening, step, rejected, advance, validTimeout, - advanceTimeoutLane] - | receiveIAmOpen source validation => - cases validation <;> - simp_all [AlignedOpening, step, rejected] - | timeout => - exact (notTimeout rfl).elim - | retry => - simp [AlignedOpening, step, phase, timeoutState] - -theorem aligned_timeout_transitions_to_open - (config : Config) - (state : NodeState) - (aligned : AlignedOpening state) : - (step config state .timeout).state.phase = .open := by - have phase := aligned.1 - have timeoutState := aligned.2 - simp [step, advance, validTimeout, phase, timeoutState, - advanceTimeoutLane, advanceTimeoutState] - -theorem fairness_supplies_firing - {config : Config} - (execution : Execution config) - (enabled : NodeState -> Prop) - (fired : NodeState -> Event -> Prop) - (fair : WeakFairness execution enabled fired) - (alwaysEnabled : forall n, enabled (execution.states n)) : - InfinitelyOften - (fun n => fired (execution.states n) (execution.events n)) := by - intro start - exact fair start (fun n _ => alwaysEnabled n) - -theorem fair_aligned_opening_progress - {config : Config} - (execution : Execution config) - (initial : AlignedOpening (execution.states 0)) - (fair : WeakFairness execution AlignedOpening - (fun _ event => event = .timeout)) : - EventuallyFrom 0 - (fun n => (execution.states n).phase = .open) := by - apply Classical.byContradiction - intro noOpen - have neverOpen : - forall n, Not ((execution.states n).phase = .open) := by - intro n opened - apply noOpen - exact Exists.intro n (And.intro (Nat.zero_le n) opened) - have alignedAlways : forall n, AlignedOpening (execution.states n) := by - intro n - induction n with - | zero => exact initial - | succ n aligned => - have notTimeout : Not (execution.events n = .timeout) := by - intro timeout - apply neverOpen (n + 1) - rw [execution.step_succ n, timeout] - exact aligned_timeout_transitions_to_open config _ aligned - rw [execution.step_succ n] - exact non_timeout_step_preserves_aligned_opening - config _ _ aligned notTimeout - have firing := fair 0 (fun n _ => alignedAlways n) - let n := firing.choose - have timeout := firing.choose_spec.2 - apply neverOpen (n + 1) - rw [execution.step_succ n, timeout] - exact aligned_timeout_transitions_to_open config _ (alignedAlways n) - -end DisasterRecovery.Protocol \ No newline at end of file +end DisasterRecovery.Protocol diff --git a/lean/disaster-recovery/README.md b/lean/disaster-recovery/README.md index 130468ca3862..d64dac46ca31 100644 --- a/lean/disaster-recovery/README.md +++ b/lean/disaster-recovery/README.md @@ -27,21 +27,44 @@ discrepancy remains explicit. model receives the result of C++ quote and certificate validation. The model does not formalize or prove the cryptography that produces that result. +## Review guide + +Start with `DisasterRecovery/Properties.lean`: it exposes 15 system-level +`theorem` statements, each with an explicit application of its checked proof. +Review those statements and every definition or assumption they use in +`DisasterRecovery/Protocol/`. Machine checking does not establish that the +model matches the C++ implementation or that its assumptions describe a real +deployment. + +The 233 supporting declarations are `lemma`s in +`DisasterRecovery/Proofs/`. Their implementations can normally be omitted from +line-by-line human review once the build and axiom audit pass. Mathlib's +`lemma` is a synonym for `theorem`, not a weaker form of checking. The existing +helper names are preserved, and the public statements remain explicitly linked +to them rather than being detached specifications. + +Only the Lean files under `DisasterRecovery/Proofs/` are marked +`linguist-generated` in the repository's `.gitattributes`, so GitHub can collapse +them without collapsing the review-required model and properties. Changes to imports, the review boundary, +the toolchain, dependencies, or checking machinery still require human review. +`DisasterRecovery.lean`, `CanonicalTests.lean`, the Lake configuration and lockfile, +and the CI workflow are part of that review surface. + ## Proof coverage and limits -`DisasterRecovery.Protocol.Temporal` proves local safety properties and +`DisasterRecovery.Proofs.Temporal` proves local safety properties and Opening-to-Open progress under weak timeout fairness. -`DisasterRecovery.Protocol.Invariants` proves global well-formedness, +`DisasterRecovery.Proofs.Invariants` proves global well-formedness, message provenance, locality of transitions, append-only send history, and monotonic terminal histories for reachable states. -`DisasterRecovery.Protocol.Quorum` proves that votes are unique and backed by +`DisasterRecovery.Proofs.Quorum` proves that votes are unique and backed by prior sends, strict-majority quorums intersect, and any two quorum openings in a reachable execution select the same opener. This safety result does not require fairness. -`DisasterRecovery.Protocol.Committed` proves TxID maximum properties and +`DisasterRecovery.Proofs.Committed` proves TxID maximum properties and committed-prefix preservation under two explicit premises: - `DurableCommit` requires at least one configured recovered ledger to cover @@ -53,7 +76,7 @@ A quorum opening alone does not imply `FullGossipSelection`, because voting may begin after a gossip timeout. The committed-prefix result deliberately does not derive or hide either durability or full-gossip evidence. -`DisasterRecovery.Protocol.GlobalTemporal` proves conditional global progress. +`DisasterRecovery.Proofs.GlobalTemporal` proves conditional global progress. Its theorems assume the relevant retry, message-delivery, and timeout fairness premises. Progress for every active node additionally requires `BroadcastBeforeCompletion`: an opener must send its `IAmOpen` announcement to @@ -62,19 +85,27 @@ order actions that are enabled only for a finite interval, so this broadcast ordering is a separate premise. The proofs do not construct a scheduler that satisfies the fairness and broadcast-before-completion premises. +The `global_progress` property also requires a reachable initial state and a +nonempty active set. Its terminal outcome means completion or a requested +joining restart. The stronger statements that all other nodes request a restart +retain their explicit `OnlyOpenerCompletesFrom` or `QuorumOnlyCompletions` +premises; they do not rule out failover completions without such a premise. + ## Files -| File | Purpose | -| ----------------------------------------------- | -------------------------------------- | -| `DisasterRecovery/Protocol/Model.lean` | C++-aligned local transition model | -| `DisasterRecovery/Protocol/Temporal.lean` | Local safety and liveness | -| `DisasterRecovery/Protocol/Global.lean` | Distributed transition semantics | -| `DisasterRecovery/Protocol/Invariants.lean` | Reachability invariants | -| `DisasterRecovery/Protocol/Quorum.lean` | Quorum uniqueness | -| `DisasterRecovery/Protocol/Committed.lean` | Committed-prefix safety | -| `DisasterRecovery/Protocol/GlobalTemporal.lean` | Global liveness | -| `CanonicalTests.lean` | Executable canonical behavior checks | -| `AxiomChecks.lean` | Transitive project `sorryAx` rejection | +| File | Review role | Purpose | +| ----------------------------------------------- | --------------- | ---------------------------------------------------- | +| `DisasterRecovery/Properties.lean` | Human | Selected system properties and checked proof links | +| `DisasterRecovery/Protocol/Model.lean` | Human | C++-aligned local transition model | +| `DisasterRecovery/Protocol/Global.lean` | Human | Distributed transitions and reachability | +| `DisasterRecovery/Protocol/Temporal.lean` | Human | Local execution and fairness definitions | +| `DisasterRecovery/Protocol/Invariants.lean` | Human | Well-formedness and message-provenance predicates | +| `DisasterRecovery/Protocol/Quorum.lean` | Human | Vote and quorum-opening predicates | +| `DisasterRecovery/Protocol/Committed.lean` | Human | Prefix ordering, durability and full-gossip premises | +| `DisasterRecovery/Protocol/GlobalTemporal.lean` | Human | Global execution, fairness and termination premises | +| `DisasterRecovery/Proofs/*.lean` | Machine-checked | Supporting lemmas and proof implementations | +| `DisasterRecovery.lean` | Human | Complete library import and audit root | +| `CanonicalTests.lean` | Human | Executable canonical behavior checks | ## Validation @@ -82,7 +113,26 @@ Run from this directory: ```console lake exe cache get -lake build -lake env lean -DwarningAsError=true AxiomChecks.lean +lake exe mk_all --check --lib DisasterRecovery +lake build --wfail +lake lint lake exe canonical-checks ``` + +`lake build --wfail` treats build warnings, including uses of `sorry` and +`admit`, as errors. `lake lint` runs +[`axiom-audit`](https://github.com/leanprover-community/axiom-audit) over the +`DisasterRecovery` library's transitive axiom dependencies. Only `propext`, +`Classical.choice`, and `Quot.sound` are allowed, so `sorryAx`, user-defined +axioms, and `native_decide` dependencies are rejected. + +The build compiles the reviewed statements and their proof implementations; +`lake exe canonical-checks` separately exercises the transition model. +`mk_all --check` verifies that `DisasterRecovery.lean` imports every library +module, preventing newly added proofs from being silently omitted from the +build and audit. Run `lake exe mk_all --lib DisasterRecovery` to refresh the +import root when adding a module. + +When refreshing the auditor dependency, use +`lake --keep-toolchain update axiomAudit` to retain the package's pinned +Lean and Mathlib versions. diff --git a/lean/disaster-recovery/lake-manifest.json b/lean/disaster-recovery/lake-manifest.json index 4df3dace4b34..7eefb7f0600e 100644 --- a/lean/disaster-recovery/lake-manifest.json +++ b/lean/disaster-recovery/lake-manifest.json @@ -2,6 +2,18 @@ "version": "1.1.0", "packagesDir": ".lake/packages", "packages": [ + { + "url": "https://github.com/leanprover-community/axiom-audit.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "46024e005996495c65ef609368e11ab39c4222e3", + "name": "axiomAudit", + "manifestFile": "lake-manifest.json", + "inputRev": "46024e005996495c65ef609368e11ab39c4222e3", + "inherited": false, + "configFile": "lakefile.toml" + }, { "url": "https://github.com/leanprover-community/mathlib4.git", "type": "git", diff --git a/lean/disaster-recovery/lakefile.toml b/lean/disaster-recovery/lakefile.toml index ac7b91709c40..b983e17c6dc8 100644 --- a/lean/disaster-recovery/lakefile.toml +++ b/lean/disaster-recovery/lakefile.toml @@ -1,6 +1,9 @@ name = "disaster_recovery" version = "0.1.0" moreLeanArgs = ["-DwarningAsError=true"] +# Quote the hyphenated executable name for Lean's name parser. +lintDriver = "axiomAudit/\u00abaxiom-audit\u00bb" +lintDriverArgs = ["--root", "DisasterRecovery"] defaultTargets = [ "DisasterRecovery", "canonical-checks", @@ -11,6 +14,11 @@ name = "mathlib" git = "https://github.com/leanprover-community/mathlib4.git" rev = "v4.28.0" +[[require]] +name = "axiomAudit" +git = "https://github.com/leanprover-community/axiom-audit.git" +rev = "46024e005996495c65ef609368e11ab39c4222e3" # v0.1.2 + [[lean_lib]] name = "DisasterRecovery" From 5c8daa7aea8a355b413314cde87e7d70128c79e1 Mon Sep 17 00:00:00 2001 From: achamayou Date: Mon, 7 Sep 2026 19:43:15 +0100 Subject: [PATCH 10/35] Consolidate Lean verification workflow Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> Copilot-Session: ed9f1e31-297c-4592-a089-2d37c49c2434 --- .github/workflows/README.md | 9 ++++++--- .../workflows/{lean-disaster-recovery.yml => lean.yml} | 10 +++++----- 2 files changed, 11 insertions(+), 8 deletions(-) rename .github/workflows/{lean-disaster-recovery.yml => lean.yml} (85%) diff --git a/.github/workflows/README.md b/.github/workflows/README.md index fa2bf87b8674..bf65dc78162a 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -101,9 +101,12 @@ Runs on pull requests that change `tla/` or `src/consensus/aft/raft.h`. File: `tla-shallow.yml` 3rd party dependencies: None -# Lean Disaster Recovery +# Lean -Builds the canonical Lean disaster recovery model with `lake build --wfail`, +Runs all Lean verification for the repository. Future Lean checks should be +added as jobs to this workflow. + +The disaster recovery job builds the canonical model with `lake build --wfail`, audits its transitive axiom dependencies with `lake lint`, and runs its executable canonical behavior checks on relevant pull requests. The build and audit include both the human-reviewed model and system properties @@ -111,7 +114,7 @@ and the proof implementation files marked as generated for review purposes. The standard `mk_all --check` command ensures that the audit root imports every library module, so newly added proofs cannot silently escape the checks. -File: `lean-disaster-recovery.yml` +File: `lean.yml` 3rd party dependencies: None # Vendored Dependency Verification diff --git a/.github/workflows/lean-disaster-recovery.yml b/.github/workflows/lean.yml similarity index 85% rename from .github/workflows/lean-disaster-recovery.yml rename to .github/workflows/lean.yml index 31085ba5efaa..081a8fc0604b 100644 --- a/.github/workflows/lean-disaster-recovery.yml +++ b/.github/workflows/lean.yml @@ -1,10 +1,10 @@ -name: "Lean Disaster Recovery" +name: "Lean" on: pull_request: paths: - - "lean/disaster-recovery/**" - - ".github/workflows/lean-disaster-recovery.yml" + - "lean/**" + - ".github/workflows/lean.yml" concurrency: group: ${{ github.workflow }}-${{ github.ref }} @@ -13,8 +13,8 @@ concurrency: permissions: read-all jobs: - canonical-model: - name: Canonical model and proofs + disaster-recovery: + name: Disaster recovery model and proofs runs-on: ubuntu-latest timeout-minutes: 30 From 059dc03aa38f59ee3ed3decc2e781a229a1c2e7c Mon Sep 17 00:00:00 2001 From: achamayou Date: Mon, 7 Sep 2026 19:51:53 +0100 Subject: [PATCH 11/35] Share Lean build ignore rule Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> Copilot-Session: ed9f1e31-297c-4592-a089-2d37c49c2434 --- lean/.gitignore | 1 + lean/disaster-recovery/.gitignore | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) create mode 100644 lean/.gitignore delete mode 100644 lean/disaster-recovery/.gitignore diff --git a/lean/.gitignore b/lean/.gitignore new file mode 100644 index 000000000000..01f8cdb637da --- /dev/null +++ b/lean/.gitignore @@ -0,0 +1 @@ +.lake/ diff --git a/lean/disaster-recovery/.gitignore b/lean/disaster-recovery/.gitignore deleted file mode 100644 index 4080d07dfc31..000000000000 --- a/lean/disaster-recovery/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/.lake/ From b2f393262fd6b16142227f4778beb851b30883a0 Mon Sep 17 00:00:00 2001 From: achamayou Date: Mon, 7 Sep 2026 20:18:11 +0100 Subject: [PATCH 12/35] Upgrade Lean disaster recovery to 4.33.1 Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> Copilot-Session: ed9f1e31-297c-4592-a089-2d37c49c2434 --- .../Proofs/GlobalTemporal.lean | 10 +++---- .../DisasterRecovery/Proofs/Quorum.lean | 2 +- lean/disaster-recovery/README.md | 2 +- lean/disaster-recovery/lake-manifest.json | 29 ++++++++++--------- lean/disaster-recovery/lakefile.toml | 2 +- lean/disaster-recovery/lean-toolchain | 2 +- 6 files changed, 24 insertions(+), 23 deletions(-) diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean index 79c9db807a0d..1d48f8e043a1 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean @@ -1856,7 +1856,7 @@ lemma next_preserves_announcements_live rw [identity.2] at opening exact Or.inl ⟨sourceState, - by simpa [identity.1] using found, + by simpa [identity.1, Global.nodeState] using found, opening⟩ | deliver delivered => intro envelope membership payload @@ -2873,9 +2873,9 @@ lemma fair_target_terminal_after_completion rcases fair_opening_completes execution initial fair openingActive targetOpening with ⟨completedAt, deliveryCompleted, targetCompleted⟩ + rw [targetEq] at targetCompleted exact - ⟨completedAt, by omega, - by simpa [targetEq] using (Or.inr targetCompleted)⟩ + ⟨completedAt, by omega, Or.inr targetCompleted⟩ · exact ⟨start, Nat.le_refl start, by simpa [targetEq] using terminal⟩ · have openingActive := @@ -2885,9 +2885,9 @@ lemma fair_target_terminal_after_completion rcases fair_opening_completes execution initial fair openingActive opening with ⟨completedAt, startCompleted, targetCompleted⟩ + rw [targetEq] at targetCompleted exact - ⟨completedAt, startCompleted, - by simpa [targetEq] using (Or.inr targetCompleted)⟩ + ⟨completedAt, startCompleted, Or.inr targetCompleted⟩ lemma fair_all_terminal_after_completion {config : Config} diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean index 48bde6e6e2a3..ad568a25707f 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean @@ -1307,7 +1307,7 @@ lemma quorum_lists_intersect expected.length / 2 + 1 <= second.length) : exists value, value ∈ first /\ value ∈ second := by by_contra noShared - push_neg at noShared + push Not at noShared have disjoint : Disjoint first.toFinset second.toFinset := Finset.disjoint_left.mpr (by intro value firstMember secondMember diff --git a/lean/disaster-recovery/README.md b/lean/disaster-recovery/README.md index d64dac46ca31..c7808aa8dab7 100644 --- a/lean/disaster-recovery/README.md +++ b/lean/disaster-recovery/README.md @@ -2,7 +2,7 @@ This package contains the canonical Lean model of CCF's C++ recovery decision protocol and its permanent safety and liveness proofs. It is pinned to Lean -4.28.0 and Mathlib `v4.28.0`. +4.33.1 and Mathlib `v4.33.1`. ## Model diff --git a/lean/disaster-recovery/lake-manifest.json b/lean/disaster-recovery/lake-manifest.json index 7eefb7f0600e..6c10c12ab941 100644 --- a/lean/disaster-recovery/lake-manifest.json +++ b/lean/disaster-recovery/lake-manifest.json @@ -1,5 +1,5 @@ { - "version": "1.1.0", + "version": "1.2.0", "packagesDir": ".lake/packages", "packages": [ { @@ -19,10 +19,10 @@ "type": "git", "subDir": null, "scope": "", - "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", + "rev": "0df444a360eaa60ab8c11dca51a86af692955474", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", + "inputRev": "v4.33.1", "inherited": false, "configFile": "lakefile.lean" }, @@ -31,7 +31,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", + "rev": "b7eb3304aeae834b12dda98993a37f6a41f6f0bb", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -43,7 +43,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "rev": "5f4d51b81cbd3f6b32b156bfad9056621a040404", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -55,7 +55,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", + "rev": "16f02aa7642864af59f1ff0e384a015994db9118", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -67,10 +67,10 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", + "rev": "4be2e3d5087eeb272cf5a8853b8f9dd025ef5957", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.87", + "inputRev": "main", "inherited": true, "configFile": "lakefile.lean" }, @@ -79,7 +79,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", + "rev": "3448c0bcc5ce01b2d1546e483ec3620e32df3d0e", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -91,7 +91,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", + "rev": "92c15be17b7caf78c2ad767ec40f89052d908d81", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -103,7 +103,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", + "rev": "4488d40d070b9700d4d5a6aa342f0d40c31b2a2d", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -115,14 +115,15 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", + "rev": "6130a47896ce867c6a4a55373441e59e565bad0f", "name": "Cli", "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", + "inputRev": "v4.33.0", "inherited": true, "configFile": "lakefile.toml" } ], "name": "disaster_recovery", - "lakeDir": ".lake" + "lakeDir": ".lake", + "fixedToolchain": false } diff --git a/lean/disaster-recovery/lakefile.toml b/lean/disaster-recovery/lakefile.toml index b983e17c6dc8..83c7c7e13827 100644 --- a/lean/disaster-recovery/lakefile.toml +++ b/lean/disaster-recovery/lakefile.toml @@ -12,7 +12,7 @@ defaultTargets = [ [[require]] name = "mathlib" git = "https://github.com/leanprover-community/mathlib4.git" -rev = "v4.28.0" +rev = "v4.33.1" [[require]] name = "axiomAudit" diff --git a/lean/disaster-recovery/lean-toolchain b/lean/disaster-recovery/lean-toolchain index 4c685fa085fa..a8afa7d1b02d 100644 --- a/lean/disaster-recovery/lean-toolchain +++ b/lean/disaster-recovery/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.28.0 +leanprover/lean4:v4.33.1 From 0e89572082e5fae2eb9decc44b248980da7e0a20 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Tue, 8 Sep 2026 10:38:37 +0100 Subject: [PATCH 13/35] Align disaster recovery Lean namespaces with module paths Use file-aligned Protocol and Proofs namespaces, expose the reviewed theorems under DisasterRecovery.Properties, and update dependent names and documentation. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery/CanonicalTests.lean | 2 +- .../DisasterRecovery/Proofs/Committed.lean | 39 ++++++------- .../Proofs/GlobalTemporal.lean | 55 +++++++++++-------- .../DisasterRecovery/Proofs/Invariants.lean | 16 ++++-- .../DisasterRecovery/Proofs/Quorum.lean | 51 +++++++++-------- .../DisasterRecovery/Proofs/Temporal.lean | 6 +- .../DisasterRecovery/Properties.lean | 48 +++++++++------- .../DisasterRecovery/Protocol/Committed.lean | 11 ++-- .../DisasterRecovery/Protocol/Global.lean | 4 +- .../Protocol/GlobalTemporal.lean | 8 ++- .../DisasterRecovery/Protocol/Invariants.lean | 7 ++- .../DisasterRecovery/Protocol/Model.lean | 4 +- .../DisasterRecovery/Protocol/Quorum.lean | 9 ++- .../DisasterRecovery/Protocol/Temporal.lean | 6 +- lean/disaster-recovery/README.md | 16 +++++- 15 files changed, 165 insertions(+), 117 deletions(-) diff --git a/lean/disaster-recovery/CanonicalTests.lean b/lean/disaster-recovery/CanonicalTests.lean index 426f5a1ea432..c7362fc45ae5 100644 --- a/lean/disaster-recovery/CanonicalTests.lean +++ b/lean/disaster-recovery/CanonicalTests.lean @@ -1,6 +1,6 @@ import DisasterRecovery.Protocol.Temporal -open DisasterRecovery.Protocol +open DisasterRecovery.Protocol.Model private def expect (condition : Bool) (message : String) : IO Unit := unless condition do throw (IO.userError message) diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean index a4df56469242..bbfb9d005d56 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean @@ -7,25 +7,24 @@ Machine-checked proof implementations. Review the system-level statements in `DisasterRecovery.Properties` and assumptions in `DisasterRecovery.Protocol.Committed`. -/ -namespace DisasterRecovery.Protocol +namespace DisasterRecovery.Proofs.Committed -namespace TxID +open Protocol +open Model hiding Config +open Global Protocol.Invariants Protocol.Quorum Protocol.Committed +open DisasterRecovery.Proofs.Invariants DisasterRecovery.Proofs.Quorum -lemma prefix_refl (txid : TxID) : PrefixOf txid txid := by - simp [PrefixOf] +lemma prefix_refl (txid : TxID) : TxID.PrefixOf txid txid := by + simp [TxID.PrefixOf] lemma prefix_trans {first second third : TxID} - (firstSecond : PrefixOf first second) - (secondThird : PrefixOf second third) : - PrefixOf first third := by - simp [PrefixOf] at firstSecond secondThird ⊢ + (firstSecond : TxID.PrefixOf first second) + (secondThird : TxID.PrefixOf second third) : + TxID.PrefixOf first third := by + simp [TxID.PrefixOf] at firstSecond secondThird ⊢ omega -end TxID - -namespace Global - lemma prefix_of_score_true (leftName rightName : Location) (left right : TxID) @@ -55,7 +54,7 @@ lemma current_prefix_selectMaximum · rename_i score exact prefix_of_score_true candidate.1 current.1 candidate.2 current.2 score - · exact TxID.prefix_refl current.2 + · exact prefix_refl current.2 lemma candidate_prefix_selectMaximum (current candidate : Prod Location TxID) : @@ -63,7 +62,7 @@ lemma candidate_prefix_selectMaximum (selectMaximum current candidate).2 := by unfold selectMaximum split - · exact TxID.prefix_refl candidate.2 + · exact prefix_refl candidate.2 · rename_i score exact prefix_of_score_false candidate.1 current.1 candidate.2 current.2 @@ -79,19 +78,19 @@ lemma foldl_selectMaximum_upper_bound | nil => simp at membership subst member - exact TxID.prefix_refl current.2 + exact prefix_refl current.2 | cons candidate rest ih => simp only [List.foldl_cons] rcases membership with currentMember | tailMember · subst member - exact TxID.prefix_trans + exact prefix_trans (current_prefix_selectMaximum current candidate) (ih (selectMaximum current candidate) (selectMaximum current candidate) (Or.inl rfl)) · rw [List.mem_cons] at tailMember rcases tailMember with candidateMember | restMember · subst member - exact TxID.prefix_trans + exact prefix_trans (candidate_prefix_selectMaximum current candidate) (ih (selectMaximum current candidate) (selectMaximum current candidate) (Or.inl rfl)) @@ -216,7 +215,7 @@ lemma full_gossip_selection_preserves_commit exact ⟨selectedTxID, recoveredTxID_of_mem configValid selectedRecovered, - TxID.prefix_trans committedDurable durableMaximum⟩ + prefix_trans committedDurable durableMaximum⟩ /-- Quorum opening scopes the result to an actual decision, while the separate @@ -238,6 +237,4 @@ lemma quorum_open_preserves_commit TxID.PrefixOf committed recovered := full_gossip_selection_preserves_commit reachable full durable -end Global - -end DisasterRecovery.Protocol +end DisasterRecovery.Proofs.Committed diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean index 1d48f8e043a1..8d8d01835035 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean @@ -8,7 +8,14 @@ Machine-checked proof implementations. Review the system-level statements in `DisasterRecovery.Properties` and assumptions in `DisasterRecovery.Protocol.GlobalTemporal`. -/ -namespace DisasterRecovery.Protocol.Global +namespace DisasterRecovery.Proofs.GlobalTemporal + +open Protocol +open Model hiding Config +open Global Protocol.Invariants Protocol.Quorum Protocol.Committed Protocol.GlobalTemporal +open Protocol.Temporal (EventuallyFrom) +open DisasterRecovery.Proofs.Invariants DisasterRecovery.Proofs.Quorum +open DisasterRecovery.Proofs.Committed DisasterRecovery.Proofs.Temporal lemma hasPhase_unique {state : State} @@ -25,7 +32,7 @@ lemma hasPhase_unique exact firstEq.symm.trans secondEq lemma step_preserves_lane - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (valid : LaneValid state) : @@ -38,7 +45,7 @@ lemma step_preserves_lane all_goals repeat first | split | simp_all | aesop lemma step_preserves_advanced_lane - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (advanced : state.timeoutState ≠ .gossiping) : @@ -51,7 +58,7 @@ lemma step_preserves_advanced_lane all_goals repeat first | split | simp_all lemma systemStep_preserves_lanes - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -209,7 +216,7 @@ lemma timeout_target_state · simpa using systemStep lemma systemStep_output_eq - {config : Protocol.Config} + {config : Model.Config} {global : State} {after : SystemState} {target : Location} @@ -423,7 +430,7 @@ lemma retry_iamopen_state | rejected reason => simp [messageForEffect] at created lemma step_joining_origin - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (joining : (step config state event).state.phase = .joining) : @@ -438,7 +445,7 @@ lemma step_joining_origin repeat first | split at joining | split | simp_all | aesop lemma step_open_origin - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (opened : (step config state event).state.phase = .open) : @@ -453,7 +460,7 @@ lemma step_open_origin repeat first | split at opened | split | simp_all | aesop lemma iamopen_delivery_outcome - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (source : Location) : let output := step config state (.receiveIAmOpen source .accepted) @@ -464,7 +471,7 @@ lemma iamopen_delivery_outcome simp [step, phase, rejected, advance, advanceTimeoutLane] lemma iamopen_open_predecessor - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (source : Location) (opened : @@ -699,7 +706,7 @@ lemma maximumGossip_some exact ⟨tail.foldl selectMaximum head, rfl⟩ lemma gossip_receive_progress - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (source : Location) (txid : TxID) @@ -717,7 +724,7 @@ lemma gossip_receive_progress repeat first | split | simp_all lemma gossip_timeout_progress - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (valid : LaneValid state) (phase : state.phase = .gossiping) @@ -729,7 +736,7 @@ lemma gossip_timeout_progress repeat first | split at accepted | split | simp_all lemma gossip_timeout_enabled_local - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (valid : LaneValid state) (phase : state.phase = .gossiping) @@ -760,7 +767,7 @@ lemma gossip_timeout_enabled gossiping nonempty lemma opening_timeout_local - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (valid : LaneValid state) (phase : state.phase = .opening) : @@ -778,7 +785,7 @@ lemma opening_timeout_local advanceTimeoutState, openingDistance] lemma opening_step_distance_le - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (valid : LaneValid state) @@ -807,7 +814,7 @@ lemma opening_step_distance_le | retry => simp [step] lemma opening_step_or_completed - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (phase : state.phase = .opening) : @@ -833,7 +840,7 @@ lemma opening_step_or_completed | retry => simp [step, phase] lemma opening_non_timeout - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (phase : state.phase = .opening) @@ -1001,7 +1008,7 @@ lemma insertVote_nonempty simp at lengths lemma step_preserves_nonempty_votes - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (nonempty : state.votes ≠ []) : @@ -1246,7 +1253,7 @@ lemma timeout_gossip_progress ⟨output.state, foundAfter, by simpa [outputEq] using voting⟩ lemma vote_receive_progress - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (source : Location) (phase : state.phase = .voting) : @@ -1258,7 +1265,7 @@ lemma vote_receive_progress repeat first | split | simp_all lemma voting_timeout_local - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (valid : LaneValid state) (phase : state.phase = .voting) @@ -1275,7 +1282,7 @@ lemma voting_timeout_local advanceTimeoutLane, advanceTimeoutState] lemma aligned_voting_timeout_opens - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (phase : state.phase = .voting) (lane : state.timeoutState = .voting) @@ -1989,7 +1996,7 @@ lemma next_preserves_announcements_resolved ⟨afterState, foundAfter, phaseAfter⟩) lemma systemStep_preserves_joining_announcements - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -2156,7 +2163,7 @@ lemma reachable_joining_announcements (reachable_well_formed reachable) valid transition lemma systemStep_preserves_open_completed - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -2417,7 +2424,7 @@ lemma openerWitness_after_leave_voting active notGossip notVoting lemma systemStep_preserves_advanced_active - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -2999,4 +3006,4 @@ lemma quorum_path_progress single_completion_path_joins_others execution initial fair broadcast completed onlyOpener⟩ -end DisasterRecovery.Protocol.Global +end DisasterRecovery.Proofs.GlobalTemporal diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Invariants.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Invariants.lean index 9be993296dcc..935ebc646ac4 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Invariants.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Invariants.lean @@ -6,7 +6,11 @@ Machine-checked proof implementations. Review the system-level statements in `DisasterRecovery.Properties` and definitions in `DisasterRecovery.Protocol.Invariants`. -/ -namespace DisasterRecovery.Protocol.Global +namespace DisasterRecovery.Proofs.Invariants + +open Protocol +open Model hiding Config +open Global Protocol.Invariants lemma messageForEffect_source {config : Config} @@ -125,7 +129,7 @@ lemma valid_gossip_uses_recovered_txid simp [messageForEffect] at created lemma step_preserves_location - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) : (step config state event).state.location = state.location := by @@ -445,7 +449,7 @@ lemma findNode_replaceNode_ne simp [replace, notTarget] lemma systemStep_node_keys_eq - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -460,7 +464,7 @@ lemma systemStep_node_keys_eq (step config node event).state before.nodes lemma systemStep_preserves_node_locations - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -490,7 +494,7 @@ lemma systemStep_preserves_node_locations entry.1 == target) found) lemma systemStep_other_node_eq - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target other : Location} {event : Event} @@ -867,4 +871,4 @@ lemma reachable_config_valid | initial active valid nodup configured => exact valid | step reachable transition valid => exact valid -end DisasterRecovery.Protocol.Global +end DisasterRecovery.Proofs.Invariants diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean index ad568a25707f..6f39a4e87c00 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Quorum.lean @@ -7,7 +7,12 @@ Machine-checked proof implementations. Review the system-level statements in `DisasterRecovery.Properties` and definitions in `DisasterRecovery.Protocol.Quorum`. -/ -namespace DisasterRecovery.Protocol.Global +namespace DisasterRecovery.Proofs.Quorum + +open Protocol +open Model hiding Config +open Global Protocol.Invariants Protocol.Quorum +open DisasterRecovery.Proofs.Invariants lemma insertVote_nodup (source : Location) @@ -37,7 +42,7 @@ lemma mem_insertVote exact unsorted.symm lemma step_preserves_votes_nodup - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (nodup : state.votes.Nodup) : @@ -48,7 +53,7 @@ lemma step_preserves_votes_nodup repeat first | split | simp_all [insertVote_nodup] lemma step_votes_shape - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) : (step config state event).state.votes = state.votes \/ @@ -63,7 +68,7 @@ lemma step_votes_shape all_goals repeat first | split | simp_all lemma step_vote_origin - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (voter : Location) @@ -81,7 +86,7 @@ lemma step_vote_origin exact Or.inr sourceEq lemma step_preserves_non_gossiping - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (pastGossip : state.phase ≠ .gossiping) : @@ -91,7 +96,7 @@ lemma step_preserves_non_gossiping all_goals repeat first | split | simp_all lemma voting_step_preserves_choice - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (pastGossip : state.phase ≠ .gossiping) @@ -103,7 +108,7 @@ lemma voting_step_preserves_choice all_goals repeat first | split at stillVoting | split | simp_all lemma step_preserves_voting_selection - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (before : @@ -159,7 +164,7 @@ lemma retry_vote_state simp [messageForEffect] at created lemma opening_effect_state - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (kind : OpenKind) @@ -175,7 +180,7 @@ lemma opening_effect_state repeat first | split at opening | split | simp_all | aesop lemma quorum_effect_has_threshold - (config : Protocol.Config) + (config : Model.Config) (state : NodeState) (event : Event) (opening : @@ -207,8 +212,8 @@ lemma opening_valid_of_sent_eq {before after : State} {opening : Opening} (sentEq : after.sent = before.sent) - (valid : opening.Valid config before) : - opening.Valid config after := by + (valid : Opening.Valid config before opening) : + Opening.Valid config after opening := by rcases valid with ⟨location, phase, kind, nodup, quorum, votesSent⟩ constructor @@ -231,8 +236,8 @@ lemma opening_valid_mono (sent : forall envelope, envelope ∈ before.sent -> envelope ∈ after.sent) - (valid : opening.Valid config before) : - opening.Valid config after := by + (valid : Opening.Valid config before opening) : + Opening.Valid config after opening := by rcases valid with ⟨location, phase, kind, nodup, quorum, votesSent⟩ constructor @@ -335,7 +340,7 @@ lemma eventFor_vote_source simp_all [eventFor, acceptedVoteSource] lemma systemStep_preserves_votes_nodup - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -360,7 +365,7 @@ lemma systemStep_preserves_votes_nodup · exact nodup previous previousMember lemma systemStep_preserves_voting_selections - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -392,7 +397,7 @@ lemma systemStep_preserves_voting_selections (by simpa [notTarget] using voting) lemma systemStep_output_location - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -420,7 +425,7 @@ lemma systemStep_output_location entry.1 == target) found) lemma systemStep_output_mem - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -441,7 +446,7 @@ lemma systemStep_output_mem simp [keyEq, outputEq] lemma systemStep_opening_effect_state - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -459,7 +464,7 @@ lemma systemStep_opening_effect_state exact opening_effect_state config node event kind opening lemma systemStep_quorum_effect_has_threshold - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -517,7 +522,7 @@ lemma initial_openings_valid simp [OpeningsValid, Global.initial] lemma systemStep_preserves_node_votes_sent - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -603,7 +608,7 @@ lemma eq_of_key_eq · exact ih tailNodup firstTail secondTail keyEq lemma systemStep_preserves_vote_stability - {config : Protocol.Config} + {config : Model.Config} {before after : SystemState} {target : Location} {event : Event} @@ -1336,7 +1341,7 @@ lemma opening_vote_configured {state : State} {opening : Opening} (wellFormed : WellFormed config state) - (valid : opening.Valid config state) + (valid : Opening.Valid config state opening) {voter : Location} (vote : voter ∈ opening.state.votes) : voter ∈ config.protocol.expectedLocations := by @@ -1386,4 +1391,4 @@ lemma quorum_opener_unique (secondValid.votesSent voter secondVote) exact firstNode.symm.trans (targetEq.trans secondNode) -end DisasterRecovery.Protocol.Global +end DisasterRecovery.Proofs.Quorum diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean index cb1a9cab53ce..c61cd5153de1 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean @@ -6,7 +6,9 @@ Machine-checked proof implementations. Review the system-level statements in `DisasterRecovery.Properties` and definitions in `DisasterRecovery.Protocol.Temporal`. -/ -namespace DisasterRecovery.Protocol +namespace DisasterRecovery.Proofs.Temporal + +open Protocol.Model Protocol.Temporal lemma valid_timeout_requires_alignment (state : NodeState) @@ -194,4 +196,4 @@ lemma fair_aligned_opening_progress rw [execution.step_succ n, timeout] exact aligned_timeout_transitions_to_open config _ (alignedAlways n) -end DisasterRecovery.Protocol \ No newline at end of file +end DisasterRecovery.Proofs.Temporal \ No newline at end of file diff --git a/lean/disaster-recovery/DisasterRecovery/Properties.lean b/lean/disaster-recovery/DisasterRecovery/Properties.lean index 17854b30611a..e83ad5803454 100644 --- a/lean/disaster-recovery/DisasterRecovery/Properties.lean +++ b/lean/disaster-recovery/DisasterRecovery/Properties.lean @@ -9,7 +9,11 @@ lemma from `DisasterRecovery.Proofs`; changing a statement must preserve that checked connection. Intermediate facts remain lemmas in the proof modules. -/ -namespace DisasterRecovery.Protocol.Properties +namespace DisasterRecovery.Properties + +section Local + +open Protocol.Model Protocol.Temporal /-! ## Local safety and progress -/ @@ -21,7 +25,7 @@ theorem gossip_freezes_after_choice (chosen : state.chosen.isSome = true) : let output := step config state (.receiveGossip source txid .accepted) output.state = state /\ output.accepted = false := - DisasterRecovery.Protocol.gossip_freezes_after_choice config state source txid chosen + Proofs.Temporal.gossip_freezes_after_choice config state source txid chosen theorem rejected_gossip_stutters (config : Config) @@ -30,7 +34,7 @@ theorem rejected_gossip_stutters (txid : TxID) : let output := step config state (.receiveGossip source txid .rejected) output.state = state /\ output.accepted = false := - DisasterRecovery.Protocol.rejected_gossip_stutters config state source txid + Proofs.Temporal.rejected_gossip_stutters config state source txid theorem quorum_advance_opens (config : Config) @@ -41,7 +45,7 @@ theorem quorum_advance_opens output.state.phase = .opening /\ output.state.openKind = some .quorum /\ output.effects = [.opening .quorum] := - DisasterRecovery.Protocol.quorum_advance_opens config state phase quorum + Proofs.Temporal.quorum_advance_opens config state phase quorum theorem aligned_opening_timeout_completes (config : Config) @@ -55,7 +59,7 @@ theorem aligned_opening_timeout_completes output.state.phase = .open /\ output.state.timeoutState = .opening /\ output.effects = [.completed] := - DisasterRecovery.Protocol.aligned_opening_timeout_completes config state + Proofs.Temporal.aligned_opening_timeout_completes config state theorem fair_aligned_opening_progress {config : Config} @@ -65,11 +69,15 @@ theorem fair_aligned_opening_progress (fun _ event => event = .timeout)) : EventuallyFrom 0 (fun n => (execution.states n).phase = .open) := - DisasterRecovery.Protocol.fair_aligned_opening_progress execution initial fair + Proofs.Temporal.fair_aligned_opening_progress execution initial fair -end DisasterRecovery.Protocol.Properties +end Local -namespace DisasterRecovery.Protocol.Global.Properties +section Global + +open Protocol.Model hiding Config +open Protocol.Global Protocol.Invariants Protocol.Quorum Protocol.Committed Protocol.GlobalTemporal +open Protocol.Temporal (EventuallyFrom) /-! ## Reachability and quorum safety -/ @@ -78,14 +86,14 @@ theorem reachable_well_formed {state : State} (reachable : Reachable config state) : WellFormed config state := - DisasterRecovery.Protocol.Global.reachable_well_formed reachable + Proofs.Invariants.reachable_well_formed reachable theorem reachable_quorum_invariant {config : Config} {state : State} (reachable : Reachable config state) : QuorumInvariant config state := - DisasterRecovery.Protocol.Global.reachable_quorum_invariant reachable + Proofs.Quorum.reachable_quorum_invariant reachable theorem quorum_opener_unique {config : Config} @@ -95,7 +103,7 @@ theorem quorum_opener_unique (firstOpened : QuorumOpened state first) (secondOpened : QuorumOpened state second) : first = second := - DisasterRecovery.Protocol.Global.quorum_opener_unique + Proofs.Quorum.quorum_opener_unique reachable firstOpened secondOpened /-! ## Committed-prefix safety -/ @@ -111,7 +119,7 @@ theorem full_gossip_selection_preserves_commit exists recovered, recoveredTxID config opener = some recovered /\ TxID.PrefixOf committed recovered := - DisasterRecovery.Protocol.Global.full_gossip_selection_preserves_commit + Proofs.Committed.full_gossip_selection_preserves_commit reachable full durable theorem quorum_open_preserves_commit @@ -126,7 +134,7 @@ theorem quorum_open_preserves_commit exists recovered, recoveredTxID config opener = some recovered /\ TxID.PrefixOf committed recovered := - DisasterRecovery.Protocol.Global.quorum_open_preserves_commit + Proofs.Committed.quorum_open_preserves_commit reachable opened full durable /-! ## Conditional global progress -/ @@ -142,7 +150,7 @@ theorem fair_opening_completes (phase : HasPhase (execution.states start) node .opening) : EventuallyFrom start (fun n => CompletedOpen (execution.states n) node) := - DisasterRecovery.Protocol.Global.fair_opening_completes + Proofs.GlobalTemporal.fair_opening_completes execution initial fair active phase theorem fair_some_opener_completes @@ -153,7 +161,7 @@ theorem fair_some_opener_completes (activeNonempty : (execution.states 0).active ≠ []) : EventuallyFrom 0 (fun n => exists node, CompletedOpen (execution.states n) node) := - DisasterRecovery.Protocol.Global.fair_some_opener_completes + Proofs.GlobalTemporal.fair_some_opener_completes execution initial fair activeNonempty theorem global_progress @@ -168,7 +176,7 @@ theorem global_progress EventuallyFrom 0 (fun n => forall node, node ∈ (execution.states 0).active -> Terminal (execution.states n) node) := - DisasterRecovery.Protocol.Global.global_progress + Proofs.GlobalTemporal.global_progress execution initial fair broadcast activeNonempty theorem single_completion_path_joins_others @@ -184,7 +192,7 @@ theorem single_completion_path_joins_others EventuallyFrom start (fun n => forall node, node ∈ (execution.states start).active -> node = opener \/ node ∈ (execution.states n).restarts) := - DisasterRecovery.Protocol.Global.single_completion_path_joins_others + Proofs.GlobalTemporal.single_completion_path_joins_others execution initial fair broadcast completed onlyOpener theorem quorum_path_progress @@ -203,7 +211,9 @@ theorem quorum_path_progress EventuallyFrom start (fun n => forall node, node ∈ (execution.states start).active -> node = opener \/ node ∈ (execution.states n).restarts) := - DisasterRecovery.Protocol.Global.quorum_path_progress + Proofs.GlobalTemporal.quorum_path_progress execution initial fair broadcast opened completed quorumOnly -end DisasterRecovery.Protocol.Global.Properties +end Global + +end DisasterRecovery.Properties diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean index 142d2a0735e8..c44e559ef6b4 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean @@ -2,7 +2,10 @@ import DisasterRecovery.Protocol.Quorum /-! Human-reviewed committed-prefix ordering and completeness assumptions. -/ -namespace DisasterRecovery.Protocol +namespace DisasterRecovery.Protocol.Committed + +open Model hiding Config +open Global namespace TxID @@ -12,8 +15,6 @@ def PrefixOf (left right : TxID) : Prop := end TxID -namespace Global - def FullGossipSelection (config : Config) (state : State) @@ -31,6 +32,4 @@ def DurableCommit (config : Config) (committed : TxID) : Prop := (location, txid) ∈ config.recovered /\ TxID.PrefixOf committed txid -end Global - -end DisasterRecovery.Protocol +end DisasterRecovery.Protocol.Committed diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean index 80e395678134..0dd29c4ae4f3 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Global.lean @@ -2,8 +2,10 @@ import DisasterRecovery.Protocol.Model namespace DisasterRecovery.Protocol.Global +open Model + structure Config where - protocol : Protocol.Config + protocol : Model.Config recovered : List (Prod Location TxID) deriving Repr, BEq diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean index de535ee12fd7..6977d6833d53 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean @@ -3,7 +3,11 @@ import DisasterRecovery.Protocol.Temporal /-! Human-reviewed global execution, termination and fairness assumptions. -/ -namespace DisasterRecovery.Protocol.Global +namespace DisasterRecovery.Protocol.GlobalTemporal + +open Model hiding Config +open Global Quorum +open Temporal (EventuallyFrom) structure Execution (config : Config) where states : Nat -> State @@ -177,4 +181,4 @@ def openingDistance : Phase -> Nat | .opening => 1 | .joining | .open => 0 -end DisasterRecovery.Protocol.Global +end DisasterRecovery.Protocol.GlobalTemporal diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean index d9a96580b85f..977084ed4e9a 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Invariants.lean @@ -2,7 +2,10 @@ import DisasterRecovery.Protocol.Global /-! Human-reviewed reachability and message-provenance invariants. -/ -namespace DisasterRecovery.Protocol.Global +namespace DisasterRecovery.Protocol.Invariants + +open Model hiding Config +open Global structure HistoriesActive (state : State) : Prop where openings : @@ -38,4 +41,4 @@ structure WellFormed (config : Config) (state : State) : Prop where envelope ∈ state.sent historiesActive : HistoriesActive state -end DisasterRecovery.Protocol.Global +end DisasterRecovery.Protocol.Invariants diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Model.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Model.lean index 323e79f08c10..0565be759d16 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Model.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Model.lean @@ -1,6 +1,6 @@ import Std -namespace DisasterRecovery.Protocol +namespace DisasterRecovery.Protocol.Model abbrev Location := String @@ -287,4 +287,4 @@ def stateKey (state : NodeState) : String := let kind := state.openKind.map openKindName |>.getD "-" s!"{state.location}|{phaseName state.phase}|{phaseName state.timeoutState}|g={gossips}|v={votes}|c={chosen}|k={kind}|r={state.restartRequested}" -end DisasterRecovery.Protocol +end DisasterRecovery.Protocol.Model diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean index 8dd4f36170df..80683f4e858f 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Quorum.lean @@ -2,7 +2,10 @@ import DisasterRecovery.Protocol.Invariants /-! Human-reviewed vote provenance, quorum and opening predicates. -/ -namespace DisasterRecovery.Protocol.Global +namespace DisasterRecovery.Protocol.Quorum + +open Model hiding Config +open Global def SentVote (state : State) (voter target : Location) : Prop := exists envelope, @@ -67,7 +70,7 @@ structure Opening.Valid def OpeningsValid (config : Config) (state : State) : Prop := forall opening, opening ∈ state.openings -> - opening.Valid config state + Opening.Valid config state opening structure QuorumInvariant (config : Config) (state : State) : Prop where votesNodup : NodeVotesNodup state @@ -88,4 +91,4 @@ def QuorumOpened (state : State) (node : Location) : Prop := opening.node = node /\ opening.kind = .quorum -end DisasterRecovery.Protocol.Global +end DisasterRecovery.Protocol.Quorum diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean index ce028d217edd..b1bcf5e7d4b0 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean @@ -2,7 +2,9 @@ import DisasterRecovery.Protocol.Model /-! Human-reviewed local execution and fairness definitions. -/ -namespace DisasterRecovery.Protocol +namespace DisasterRecovery.Protocol.Temporal + +open Model def EventuallyFrom (start : Nat) (predicate : Nat -> Prop) : Prop := exists n, start <= n /\ predicate n @@ -44,4 +46,4 @@ def StrongFairness def AlignedOpening (state : NodeState) : Prop := state.phase = .opening /\ state.timeoutState = .opening -end DisasterRecovery.Protocol +end DisasterRecovery.Protocol.Temporal diff --git a/lean/disaster-recovery/README.md b/lean/disaster-recovery/README.md index c7808aa8dab7..e62124a0c584 100644 --- a/lean/disaster-recovery/README.md +++ b/lean/disaster-recovery/README.md @@ -39,9 +39,19 @@ deployment. The 233 supporting declarations are `lemma`s in `DisasterRecovery/Proofs/`. Their implementations can normally be omitted from line-by-line human review once the build and axiom audit pass. Mathlib's -`lemma` is a synonym for `theorem`, not a weaker form of checking. The existing -helper names are preserved, and the public statements remain explicitly linked -to them rather than being detached specifications. +`lemma` is a synonym for `theorem`, not a weaker form of checking. The public +statements remain explicitly linked to these lemmas rather than being detached +specifications. + +Declaration namespaces follow the module paths. Model definitions live under +`DisasterRecovery.Protocol.`, supporting lemmas under +`DisasterRecovery.Proofs.`, and the 15 reviewed theorems under +`DisasterRecovery.Properties`. For example, +`DisasterRecovery.Properties.gossip_freezes_after_choice` explicitly applies +`DisasterRecovery.Proofs.Temporal.gossip_freezes_after_choice` from +`DisasterRecovery/Proofs/Temporal.lean`. Local and global properties share the +`DisasterRecovery.Properties` namespace; their `Config` and `Execution` types +come from the corresponding protocol modules. Only the Lean files under `DisasterRecovery/Proofs/` are marked `linguist-generated` in the repository's `.gitattributes`, so GitHub can collapse From 8cc52f8138b5cf945a9e5bcba3eba198a642c789 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Wed, 9 Sep 2026 14:58:18 +0100 Subject: [PATCH 14/35] Limit disaster recovery proofs to safety Remove temporal and liveness definitions and proofs, retain local transition safety under Proofs.Model, and rename TxID.PrefixOf to TxID.EarlierThan. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery/CanonicalTests.lean | 2 +- lean/disaster-recovery/DisasterRecovery.lean | 5 +- .../DisasterRecovery/Proofs/Committed.lean | 32 +- .../Proofs/GlobalTemporal.lean | 3009 ----------------- .../Proofs/{Temporal.lean => Model.lean} | 94 +- .../DisasterRecovery/Properties.lean | 111 +- .../DisasterRecovery/Protocol/Committed.lean | 4 +- .../Protocol/GlobalTemporal.lean | 184 - .../DisasterRecovery/Protocol/Temporal.lean | 49 - lean/disaster-recovery/README.md | 65 +- 10 files changed, 63 insertions(+), 3492 deletions(-) delete mode 100644 lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean rename lean/disaster-recovery/DisasterRecovery/Proofs/{Temporal.lean => Model.lean} (51%) delete mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean delete mode 100644 lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean diff --git a/lean/disaster-recovery/CanonicalTests.lean b/lean/disaster-recovery/CanonicalTests.lean index c7362fc45ae5..db28b2921e4d 100644 --- a/lean/disaster-recovery/CanonicalTests.lean +++ b/lean/disaster-recovery/CanonicalTests.lean @@ -1,4 +1,4 @@ -import DisasterRecovery.Protocol.Temporal +import DisasterRecovery.Protocol.Model open DisasterRecovery.Protocol.Model diff --git a/lean/disaster-recovery/DisasterRecovery.lean b/lean/disaster-recovery/DisasterRecovery.lean index 5c3139abf786..e65fc0ebad9b 100644 --- a/lean/disaster-recovery/DisasterRecovery.lean +++ b/lean/disaster-recovery/DisasterRecovery.lean @@ -1,13 +1,10 @@ import DisasterRecovery.Proofs.Committed -import DisasterRecovery.Proofs.GlobalTemporal import DisasterRecovery.Proofs.Invariants +import DisasterRecovery.Proofs.Model import DisasterRecovery.Proofs.Quorum -import DisasterRecovery.Proofs.Temporal import DisasterRecovery.Properties import DisasterRecovery.Protocol.Committed import DisasterRecovery.Protocol.Global -import DisasterRecovery.Protocol.GlobalTemporal import DisasterRecovery.Protocol.Invariants import DisasterRecovery.Protocol.Model import DisasterRecovery.Protocol.Quorum -import DisasterRecovery.Protocol.Temporal diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean index bbfb9d005d56..d5a926a7a046 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Committed.lean @@ -14,15 +14,15 @@ open Model hiding Config open Global Protocol.Invariants Protocol.Quorum Protocol.Committed open DisasterRecovery.Proofs.Invariants DisasterRecovery.Proofs.Quorum -lemma prefix_refl (txid : TxID) : TxID.PrefixOf txid txid := by - simp [TxID.PrefixOf] +lemma prefix_refl (txid : TxID) : TxID.EarlierThan txid txid := by + simp [TxID.EarlierThan] lemma prefix_trans {first second third : TxID} - (firstSecond : TxID.PrefixOf first second) - (secondThird : TxID.PrefixOf second third) : - TxID.PrefixOf first third := by - simp [TxID.PrefixOf] at firstSecond secondThird ⊢ + (firstSecond : TxID.EarlierThan first second) + (secondThird : TxID.EarlierThan second third) : + TxID.EarlierThan first third := by + simp [TxID.EarlierThan] at firstSecond secondThird ⊢ omega lemma prefix_of_score_true @@ -30,9 +30,9 @@ lemma prefix_of_score_true (left right : TxID) (score : txScoreGreater leftName left rightName right = true) : - TxID.PrefixOf right left := by + TxID.EarlierThan right left := by simp [txScoreGreater] at score - simp [TxID.PrefixOf] + simp [TxID.EarlierThan] omega lemma prefix_of_score_false @@ -40,14 +40,14 @@ lemma prefix_of_score_false (left right : TxID) (score : txScoreGreater leftName left rightName right = false) : - TxID.PrefixOf left right := by + TxID.EarlierThan left right := by simp [txScoreGreater] at score - simp [TxID.PrefixOf] + simp [TxID.EarlierThan] omega lemma current_prefix_selectMaximum (current candidate : Prod Location TxID) : - TxID.PrefixOf current.2 + TxID.EarlierThan current.2 (selectMaximum current candidate).2 := by unfold selectMaximum split @@ -58,7 +58,7 @@ lemma current_prefix_selectMaximum lemma candidate_prefix_selectMaximum (current candidate : Prod Location TxID) : - TxID.PrefixOf candidate.2 + TxID.EarlierThan candidate.2 (selectMaximum current candidate).2 := by unfold selectMaximum split @@ -72,7 +72,7 @@ lemma foldl_selectMaximum_upper_bound (current member : Prod Location TxID) (tail : List (Prod Location TxID)) (membership : member = current \/ member ∈ tail) : - TxID.PrefixOf member.2 + TxID.EarlierThan member.2 (tail.foldl selectMaximum current).2 := by induction tail generalizing current member with | nil => @@ -102,7 +102,7 @@ lemma maximumGossip_upper_bound {selected member : Prod Location TxID} (maximum : maximumGossip gossips = some selected) (membership : member ∈ gossips) : - TxID.PrefixOf member.2 selected.2 := by + TxID.EarlierThan member.2 selected.2 := by cases gossips with | nil => simp at membership | cons head tail => @@ -186,7 +186,7 @@ lemma full_gossip_selection_preserves_commit (durable : DurableCommit config committed) : exists recovered, recoveredTxID config opener = some recovered /\ - TxID.PrefixOf committed recovered := by + TxID.EarlierThan committed recovered := by have configValid := reachable_config_valid reachable have wellFormed := reachable_well_formed reachable have invariant := reachable_quorum_invariant reachable @@ -234,7 +234,7 @@ lemma quorum_open_preserves_commit (durable : DurableCommit config committed) : exists recovered, recoveredTxID config opener = some recovered /\ - TxID.PrefixOf committed recovered := + TxID.EarlierThan committed recovered := full_gossip_selection_preserves_commit reachable full durable end DisasterRecovery.Proofs.Committed diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean deleted file mode 100644 index 8d8d01835035..000000000000 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalTemporal.lean +++ /dev/null @@ -1,3009 +0,0 @@ -import DisasterRecovery.Protocol.GlobalTemporal -import DisasterRecovery.Proofs.Committed -import DisasterRecovery.Proofs.Temporal -import Mathlib.Tactic - -/-! -Machine-checked proof implementations. Review the system-level statements in -`DisasterRecovery.Properties` and assumptions in `DisasterRecovery.Protocol.GlobalTemporal`. --/ - -namespace DisasterRecovery.Proofs.GlobalTemporal - -open Protocol -open Model hiding Config -open Global Protocol.Invariants Protocol.Quorum Protocol.Committed Protocol.GlobalTemporal -open Protocol.Temporal (EventuallyFrom) -open DisasterRecovery.Proofs.Invariants DisasterRecovery.Proofs.Quorum -open DisasterRecovery.Proofs.Committed DisasterRecovery.Proofs.Temporal - -lemma hasPhase_unique - {state : State} - {node : Location} - {first second : Phase} - (firstPhase : HasPhase state node first) - (secondPhase : HasPhase state node second) : - first = second := by - rcases firstPhase with ⟨firstState, firstFound, firstEq⟩ - rcases secondPhase with ⟨secondState, secondFound, secondEq⟩ - rw [firstFound] at secondFound - injection secondFound with stateEq - subst secondState - exact firstEq.symm.trans secondEq - -lemma step_preserves_lane - (config : Model.Config) - (state : NodeState) - (event : Event) - (valid : LaneValid state) : - LaneValid (step config state event).state := by - cases event - all_goals try cases_type Validation - all_goals - simp [LaneValid, step, rejected, advance, advanceTimeoutLane, - advanceTimeoutState, validTimeout] at valid ⊢ - all_goals repeat first | split | simp_all | aesop - -lemma step_preserves_advanced_lane - (config : Model.Config) - (state : NodeState) - (event : Event) - (advanced : state.timeoutState ≠ .gossiping) : - (step config state event).state.timeoutState ≠ .gossiping := by - cases event - all_goals try cases_type Validation - all_goals - simp [step, rejected, advance, validTimeout, advanceTimeoutLane, - advanceTimeoutState] at advanced ⊢ - all_goals repeat first | split | simp_all - -lemma systemStep_preserves_lanes - {config : Model.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - (valid : - forall entry, entry ∈ before.nodes -> - LaneValid entry.2) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - LaneValid entry.2 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · apply step_preserves_lane config node event - exact valid (key, node) (List.mem_of_find?_eq_some found) - · exact valid previous previousMember - -lemma initial_lanes_valid - (config : Config) - (active : List Location) : - NodeLanesValid (initial config active) := by - simp [NodeLanesValid, LaneValid, Global.initial, initialSystem, - initialNode] - -lemma next_preserves_lanes - {config : Config} - {before after : State} - {action : Action} - (valid : NodeLanesValid before) - (transition : next config before action = some after) : - NodeLanesValid after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, rfl⟩ - exact valid - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, rfl⟩ - intro entry membership - rw [recordEffects_system] at membership - exact systemStep_preserves_lanes valid systemStep - entry membership - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, rfl⟩ - intro entry membership - rw [recordEffects_system] at membership - exact systemStep_preserves_lanes valid systemStep - entry membership - -lemma reachable_lanes_valid - {config : Config} - {state : State} - (reachable : Reachable config state) : - NodeLanesValid state := by - induction reachable with - | initial active valid nodup configured => - exact initial_lanes_valid config active - | step reachable transition valid => - exact next_preserves_lanes valid transition - -lemma nodeState_eq_of_mem - {state : State} - {node : Location} - {foundState : NodeState} - (keysNodup : (state.system.nodes.map Prod.fst).Nodup) - (membership : (node, foundState) ∈ state.system.nodes) : - Global.nodeState state node = some foundState := by - unfold Global.nodeState - cases found : - state.system.nodes.find? fun entry => entry.1 == node with - | none => - rw [List.find?_eq_none] at found - exact False.elim - (found (node, foundState) membership (by simp)) - | some entry => - have foundMember : entry ∈ state.system.nodes := - List.mem_of_find?_eq_some found - have foundKey : entry.1 = node := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) found) - have same : entry = (node, foundState) := - eq_of_key_eq keysNodup foundMember membership foundKey - simp [same] - -lemma node_property_of_nodeState - {state : State} - {node : Location} - {foundState : NodeState} - {predicate : NodeState -> Prop} - (property : - forall entry, entry ∈ state.system.nodes -> - predicate entry.2) - (found : Global.nodeState state node = some foundState) : - predicate foundState := by - rw [Global.nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - rw [←stateEq] - exact property entry (List.mem_of_find?_eq_some findEq) - -lemma deliver_target_state - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (transition : next config before (.deliver envelope) = some after) : - exists output, - Global.nodeState after envelope.target = some output.state /\ - systemStep config.protocol before.system envelope.target - (eventFor envelope) = some (after.system, output) := by - have afterWellFormed := - next_preserves_well_formed wellFormed transition - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] at afterWellFormed ⊢ - refine ⟨output, ?_, ?_⟩ - · apply nodeState_eq_of_mem afterWellFormed.nodeKeysNodup - rw [recordEffects_system] - exact systemStep_output_mem systemStep - · simpa using systemStep - -lemma timeout_target_state - {config : Config} - {before after : State} - {target : Location} - (wellFormed : WellFormed config before) - (transition : next config before (.timeout target) = some after) : - exists output, - Global.nodeState after target = some output.state /\ - output.accepted = true /\ - systemStep config.protocol before.system target .timeout = - some (after.system, output) := by - have afterWellFormed := - next_preserves_well_formed wellFormed transition - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, accepted, stateEq⟩ - rw [←stateEq] at afterWellFormed ⊢ - refine ⟨output, ?_, accepted, ?_⟩ - · apply nodeState_eq_of_mem afterWellFormed.nodeKeysNodup - rw [recordEffects_system] - exact systemStep_output_mem systemStep - · simpa using systemStep - -lemma systemStep_output_eq - {config : Model.Config} - {global : State} - {after : SystemState} - {target : Location} - {event : Event} - {state : NodeState} - {output : StepOutput} - (found : Global.nodeState global target = some state) - (transition : - systemStep config global.system target event = some (after, output)) : - output = step config state event := by - change - (do - let node <- Global.nodeState global target - let result := step config node event - pure ({ - nodes := replaceNode target result.state global.system.nodes - }, result)) = some (after, output) at transition - rw [found] at transition - simp at transition - exact transition.2.symm - -lemma completed_effect_recorded - {node : Location} - {nodeState : NodeState} - {effects : List Effect} - {state : State} - (completed : .completed ∈ effects) : - node ∈ (recordEffects node nodeState effects state).completed := by - induction effects generalizing state with - | nil => simp at completed - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - rw [List.mem_cons] at completed - rcases completed with rfl | inTail - · apply mem_completed_recordEffects - simp [recordEffect] - · exact ih inTail - -lemma restart_effect_recorded - {node chosen : Location} - {nodeState : NodeState} - {effects : List Effect} - {state : State} - (restart : .restart chosen ∈ effects) : - node ∈ (recordEffects node nodeState effects state).restarts := by - induction effects generalizing state with - | nil => simp at restart - | cons effect tail ih => - simp only [recordEffects, List.foldl_cons] - rw [List.mem_cons] at restart - rcases restart with rfl | inTail - · apply mem_restarts_recordEffects - simp [recordEffect] - · exact ih inTail - -lemma mem_removeOne_or_eq - [BEq α] - [LawfulBEq α] - {member removed : α} - {values : List α} - (membership : member ∈ values) : - member ∈ removeOne removed values \/ member = removed := by - induction values with - | nil => simp at membership - | cons head tail ih => - rw [List.mem_cons] at membership - rcases membership with rfl | inTail - · by_cases equal : member = removed - · exact Or.inr equal - · exact Or.inl (by simp [removeOne, equal]) - · simp only [removeOne] - split - · exact Or.inl inTail - · rcases ih inTail with still | equal - · exact Or.inl (by simp [still]) - · exact Or.inr equal - -lemma execution_reachable - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) : - forall n, Reachable config (execution.states n) := by - intro n - induction n with - | zero => exact initial - | succ n reachable => - exact Reachable.step reachable (execution.step_succ n) - -lemma execution_active_eq - {config : Config} - (execution : Execution config) : - forall n, (execution.states n).active = (execution.states 0).active := by - intro n - induction n with - | zero => rfl - | succ n activeEq => - exact (next_active_eq (execution.step_succ n)).trans activeEq - -lemma active_at - {config : Config} - (execution : Execution config) - {node : Location} - (active : node ∈ (execution.states 0).active) : - forall n, node ∈ (execution.states n).active := by - intro n - rw [execution_active_eq execution n] - exact active - -lemma recovered_for_configured - {config : Config} - (valid : config.Valid) - {node : Location} - (configured : node ∈ config.protocol.expectedLocations) : - exists txid, recoveredTxID config node = some txid := by - rw [←valid.2.2] at configured - rcases List.mem_map.mp configured with - ⟨entry, membership, keyEq⟩ - rcases entry with ⟨location, txid⟩ - simp at keyEq - subst location - refine ⟨txid, ?_⟩ - apply recoveredTxID_of_mem valid - exact membership - -lemma active_nodeState - {config : Config} - {state : State} - (wellFormed : WellFormed config state) - {node : Location} - (active : node ∈ state.active) : - exists nodeState, - Global.nodeState state node = some nodeState := by - have configured := wellFormed.activeConfigured node active - rw [←wellFormed.nodeKeys] at configured - rcases List.mem_map.mp configured with - ⟨entry, membership, keyEq⟩ - refine ⟨entry.2, ?_⟩ - apply nodeState_eq_of_mem wellFormed.nodeKeysNodup - rcases entry with ⟨location, nodeState⟩ - simp at keyEq - subst location - exact membership - -lemma retryMessages_self_gossip - {config : Config} - {node : Location} - {state : NodeState} - {txid : TxID} - (phase : state.phase = .gossiping) - (configured : node ∈ config.protocol.expectedLocations) - (recovered : recoveredTxID config node = some txid) : - { - source := node - target := node - payload := Payload.gossip txid - sourceState := state - } ∈ retryMessages config node state := by - rw [retryMessages, List.mem_filterMap] - refine ⟨.sendGossip node, ?_, ?_⟩ - · simpa [step, phase] using configured - · simp [messageForEffect, recovered] - -lemma retryMessages_vote - {config : Config} - {node target : Location} - {state : NodeState} - (phase : state.phase = .voting) - (chosen : state.chosen = some target) : - { - source := node - target - payload := Payload.vote - sourceState := state - } ∈ retryMessages config node state := by - rw [retryMessages, List.mem_filterMap] - refine ⟨.sendVote target, ?_, rfl⟩ - simp [step, phase, chosen] - -lemma retry_iamopen_state - {config : Config} - {envelope : Envelope} - (valid : envelope.Valid config) - (announcement : envelope.payload = .iAmOpen) : - envelope.sourceState.phase = .opening := by - rcases valid_envelope_effect valid with - ⟨effect, member, created⟩ - cases effect with - | sendGossip target => - cases found : recoveredTxID config envelope.source with - | none => simp [messageForEffect, found] at created - | some txid => - simp [messageForEffect, found] at created - rw [←created] at announcement - contradiction - | sendVote target => - simp [messageForEffect] at created - rw [←created] at announcement - contradiction - | sendIAmOpen target => - simp [messageForEffect] at created - rw [←created] at announcement ⊢ - cases phase : envelope.sourceState.phase - case opening => rfl - case voting => - cases chosen : envelope.sourceState.chosen <;> - simp [step, phase, chosen] at member - all_goals simp [step, phase] at member - | opening kind => simp [messageForEffect] at created - | restart chosen => simp [messageForEffect] at created - | completed => simp [messageForEffect] at created - | rejected reason => simp [messageForEffect] at created - -lemma step_joining_origin - (config : Model.Config) - (state : NodeState) - (event : Event) - (joining : (step config state event).state.phase = .joining) : - state.phase = .joining \/ - exists source, acceptedIAmOpenSource event = some source := by - cases event - all_goals try cases_type Validation - all_goals - simp [acceptedIAmOpenSource, step, rejected, advance, - advanceTimeoutLane] at joining ⊢ - all_goals - repeat first | split at joining | split | simp_all | aesop - -lemma step_open_origin - (config : Model.Config) - (state : NodeState) - (event : Event) - (opened : (step config state event).state.phase = .open) : - state.phase = .open \/ - .completed ∈ (step config state event).effects := by - cases event - all_goals try cases_type Validation - all_goals - simp [step, rejected, advance, advanceTimeoutLane, validTimeout] - at opened ⊢ - all_goals - repeat first | split at opened | split | simp_all | aesop - -lemma iamopen_delivery_outcome - (config : Model.Config) - (state : NodeState) - (source : Location) : - let output := step config state (.receiveIAmOpen source .accepted) - output.state.phase = .opening \/ - output.state.phase = .open \/ - exists chosen, .restart chosen ∈ output.effects := by - cases phase : state.phase <;> - simp [step, phase, rejected, advance, advanceTimeoutLane] - -lemma iamopen_open_predecessor - (config : Model.Config) - (state : NodeState) - (source : Location) - (opened : - (step config state (.receiveIAmOpen source .accepted)).state.phase = - .open) : - state.phase = .open := by - cases phase : state.phase <;> - simp [step, phase, rejected, advance, advanceTimeoutLane] at opened - rfl - -lemma eventFor_iamopen_source - {envelope : Envelope} - {source : Location} - (accepted : - acceptedIAmOpenSource (eventFor envelope) = some source) : - envelope.payload = .iAmOpen /\ - envelope.source = source := by - cases payload : envelope.payload <;> - simp_all [eventFor, acceptedIAmOpenSource] - -lemma retry_gossip_enabled - {config : Config} - {state : State} - {node : Location} - (valid : config.Valid) - (wellFormed : WellFormed config state) - (active : node ∈ state.active) - (phase : HasPhase state node .gossiping) : - Enabled config state (.retry node) := by - rcases phase with ⟨nodeState, found, gossiping⟩ - have configured := wellFormed.activeConfigured node active - rcases recovered_for_configured valid configured with - ⟨txid, recovered⟩ - have message := - retryMessages_self_gossip gossiping configured recovered - have messagesNonempty : - retryMessages config node nodeState ≠ [] := by - intro empty - rw [empty] at message - simp at message - refine ⟨{ - state with - network := state.network ++ retryMessages config node nodeState - sent := state.sent ++ retryMessages config node nodeState - }, ?_⟩ - simp [next, active, found, messagesNonempty] - -lemma retry_voting_enabled - {config : Config} - {state : State} - {node target : Location} - {nodeState : NodeState} - (active : node ∈ state.active) - (found : Global.nodeState state node = some nodeState) - (phase : nodeState.phase = .voting) - (chosen : nodeState.chosen = some target) : - Enabled config state (.retry node) := by - have message := retryMessages_vote (config := config) - (node := node) phase chosen - have messagesNonempty : - retryMessages config node nodeState ≠ [] := by - intro empty - rw [empty] at message - simp at message - refine ⟨{ - state with - network := state.network ++ retryMessages config node nodeState - sent := state.sent ++ retryMessages config node nodeState - }, ?_⟩ - simp [next, active, found, messagesNonempty] - -lemma delivery_enabled - {config : Config} - {state : State} - {envelope : Envelope} - (wellFormed : WellFormed config state) - (network : envelope ∈ state.network) - (targetActive : envelope.target ∈ state.active) : - Enabled config state (.deliver envelope) := by - rcases active_nodeState wellFormed targetActive with - ⟨targetState, found⟩ - let output := step config.protocol targetState (eventFor envelope) - let system : SystemState := { - nodes := replaceNode envelope.target output.state state.system.nodes - } - let delivered : State := { - state with - system - network := removeOne envelope state.network - } - have stepResult : - systemStep config.protocol state.system envelope.target - (eventFor envelope) = some (system, output) := by - change - (do - let node <- Global.nodeState state envelope.target - let result := step config.protocol node (eventFor envelope) - pure ({ - nodes := - replaceNode envelope.target result.state state.system.nodes - }, result)) = some (system, output) - rw [found] - rfl - refine - ⟨recordEffects envelope.target output.state output.effects delivered, ?_⟩ - simp [next, network, targetActive, stepResult, output, system, - delivered] - -lemma timeout_enabled_of_accepted - {config : Config} - {state : State} - {node : Location} - {nodeState : NodeState} - (active : node ∈ state.active) - (found : Global.nodeState state node = some nodeState) - (accepted : (step config.protocol nodeState .timeout).accepted = true) : - Enabled config state (.timeout node) := by - let output := step config.protocol nodeState .timeout - let system : SystemState := { - nodes := replaceNode node output.state state.system.nodes - } - have stepResult : - systemStep config.protocol state.system node .timeout = - some (system, output) := by - change - (do - let current <- Global.nodeState state node - let result := step config.protocol current .timeout - pure ({ - nodes := replaceNode node result.state state.system.nodes - }, result)) = some (system, output) - rw [found] - rfl - refine - ⟨recordEffects node output.state output.effects - { state with system }, ?_⟩ - simp [next, active, stepResult, accepted, output, system] - -lemma retry_gossip_enqueued - {config : Config} - {before after : State} - {node : Location} - (valid : config.Valid) - (wellFormed : WellFormed config before) - (phase : HasPhase before node .gossiping) - (transition : next config before (.retry node) = some after) : - exists envelope, - envelope ∈ after.network /\ - envelope.source = node /\ - envelope.target = node /\ - exists txid, envelope.payload = .gossip txid := by - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨active, sourceState, found, _, stateEq⟩ - rcases phase with ⟨phaseState, foundPhase, gossiping⟩ - have configured := - wellFormed.activeConfigured node active - rcases recovered_for_configured valid configured with - ⟨txid, recovered⟩ - rw [found] at foundPhase - injection foundPhase with stateEq' - subst phaseState - let envelope : Envelope := { - source := node - target := node - payload := .gossip txid - sourceState - } - have message : envelope ∈ retryMessages config node sourceState := - retryMessages_self_gossip gossiping configured recovered - rw [←stateEq] - exact - ⟨envelope, List.mem_append_right _ message, rfl, rfl, txid, rfl⟩ - -lemma retry_vote_enqueued - {config : Config} - {before after : State} - {node target : Location} - {nodeState : NodeState} - (found : Global.nodeState before node = some nodeState) - (phase : nodeState.phase = .voting) - (chosen : nodeState.chosen = some target) - (transition : next config before (.retry node) = some after) : - exists envelope, - envelope ∈ after.network /\ - envelope.source = node /\ - envelope.target = target /\ - envelope.payload = .vote := by - have message := retryMessages_vote (config := config) - (node := node) phase chosen - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, actualState, actualFound, _, stateEq⟩ - rw [found] at actualFound - injection actualFound with actualEq - subst actualState - let envelope : Envelope := { - source := node - target - payload := .vote - sourceState := nodeState - } - rw [←stateEq] - exact - ⟨envelope, List.mem_append_right _ message, rfl, rfl, rfl⟩ - -lemma insertGossip_nonempty - (source : Location) - (txid : TxID) - (gossips : List (Prod Location TxID)) : - insertGossip source txid gossips ≠ [] := by - unfold insertGossip - split - · rename_i present - intro empty - subst gossips - simp at present - · intro empty - have lengths := - (List.mergeSort_perm ((source, txid) :: gossips) - (fun left right => left.1 <= right.1)).length_eq - rw [empty] at lengths - simp at lengths - -lemma maximumGossip_some - {gossips : List (Prod Location TxID)} - (nonempty : gossips ≠ []) : - exists selected, maximumGossip gossips = some selected := by - cases gossips with - | nil => contradiction - | cons head tail => - exact ⟨tail.foldl selectMaximum head, rfl⟩ - -lemma gossip_receive_progress - (config : Model.Config) - (state : NodeState) - (source : Location) - (txid : TxID) - (valid : LaneValid state) - (phase : state.phase = .gossiping) : - let output := - step config state (.receiveGossip source txid .accepted) - output.state.phase ≠ .gossiping \/ - output.state.gossips ≠ [] := by - have chosen := valid.2.2.2 phase - have nonempty := insertGossip_nonempty source txid state.gossips - obtain ⟨selected, maximum⟩ := maximumGossip_some nonempty - simp [step, phase, chosen, rejected, advance, advanceTimeoutLane, - validTimeout] - repeat first | split | simp_all - -lemma gossip_timeout_progress - (config : Model.Config) - (state : NodeState) - (valid : LaneValid state) - (phase : state.phase = .gossiping) - (accepted : (step config state .timeout).accepted = true) : - (step config state .timeout).state.phase = .voting := by - have lane := valid.1 phase - simp [step, phase, lane, rejected, advance, advanceTimeoutLane, - validTimeout] at accepted ⊢ - repeat first | split at accepted | split | simp_all - -lemma gossip_timeout_enabled_local - (config : Model.Config) - (state : NodeState) - (valid : LaneValid state) - (phase : state.phase = .gossiping) - (nonempty : state.gossips ≠ []) : - (step config state .timeout).accepted = true := by - have lane := valid.1 phase - obtain ⟨selected, maximum⟩ := maximumGossip_some nonempty - simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, - maximum] - -lemma gossip_timeout_enabled - {config : Config} - {state : State} - {node : Location} - (active : node ∈ state.active) - (lanes : NodeLanesValid state) - (phase : HasPhase state node .gossiping) - (gossip : HasGossip state node) : - Enabled config state (.timeout node) := by - rcases phase with ⟨phaseState, foundPhase, gossiping⟩ - rcases gossip with ⟨gossipState, foundGossip, nonempty⟩ - rw [foundPhase] at foundGossip - injection foundGossip with stateEq - subst gossipState - have lane := node_property_of_nodeState lanes foundPhase - apply timeout_enabled_of_accepted active foundPhase - exact gossip_timeout_enabled_local config.protocol phaseState lane - gossiping nonempty - -lemma opening_timeout_local - (config : Model.Config) - (state : NodeState) - (valid : LaneValid state) - (phase : state.phase = .opening) : - let output := step config state .timeout - (output.effects = [.completed] /\ output.state.phase = .open) \/ - (output.state.phase = .opening /\ - openingDistance output.state.timeoutState < - openingDistance state.timeoutState) := by - rcases valid.2.2.1 phase with lane | lane | lane - · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, - advanceTimeoutState, openingDistance] - · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, - advanceTimeoutState, openingDistance] - · simp [step, phase, lane, advance, validTimeout, advanceTimeoutLane, - advanceTimeoutState, openingDistance] - -lemma opening_step_distance_le - (config : Model.Config) - (state : NodeState) - (event : Event) - (valid : LaneValid state) - (phase : state.phase = .opening) - (after : (step config state event).state.phase = .opening) : - openingDistance (step config state event).state.timeoutState <= - openingDistance state.timeoutState := by - cases event with - | receiveGossip source txid validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - repeat first | split | simp_all - | receiveVote source validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - | receiveIAmOpen source validation => - cases validation <;> simp [step, phase, rejected] - | timeout => - rcases opening_timeout_local config state valid phase with - done | progress - · rw [done.2] at after - contradiction - · exact Nat.le_of_lt progress.2 - | retry => simp [step] - -lemma opening_step_or_completed - (config : Model.Config) - (state : NodeState) - (event : Event) - (phase : state.phase = .opening) : - (step config state event).state.phase = .opening \/ - ((step config state event).state.phase = .open /\ - .completed ∈ (step config state event).effects) := by - cases event with - | receiveGossip source txid validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - repeat first | split | simp_all - | receiveVote source validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - | receiveIAmOpen source validation => - cases validation <;> simp [step, phase, rejected] - | timeout => - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - split <;> simp_all - | retry => simp [step, phase] - -lemma opening_non_timeout - (config : Model.Config) - (state : NodeState) - (event : Event) - (phase : state.phase = .opening) - (notTimeout : event ≠ .timeout) : - (step config state event).state.phase = .opening /\ - (step config state event).state.timeoutState = - state.timeoutState := by - cases event with - | receiveGossip source txid validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - repeat first | split | simp_all - | receiveVote source validation => - cases validation <;> - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - | receiveIAmOpen source validation => - cases validation <;> simp [step, phase, rejected] - | timeout => contradiction - | retry => exact ⟨phase, rfl⟩ - -lemma opening_timeout_enabled - {config : Config} - {state : State} - {node : Location} - (active : node ∈ state.active) - (phase : HasPhase state node .opening) : - Enabled config state (.timeout node) := by - rcases phase with ⟨nodeState, found, opening⟩ - apply timeout_enabled_of_accepted active found - simp [step, opening, advance, rejected] - repeat first | split | simp_all - -lemma timeout_opening_step - {config : Config} - {before after : State} - {node : Location} - {beforeState : NodeState} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (foundBefore : - Global.nodeState before node = some beforeState) - (opening : beforeState.phase = .opening) - (transition : next config before (.timeout node) = some after) : - CompletedOpen after node \/ - (exists nextState : NodeState, - Global.nodeState after node = some nextState /\ - nextState.phase = .opening /\ - openingDistance nextState.timeoutState < - openingDistance beforeState.timeoutState) := by - have lane : LaneValid beforeState := by - apply node_property_of_nodeState (predicate := LaneValid) - · exact lanes - · exact foundBefore - have timeoutResult : - ((step config.protocol beforeState .timeout).effects = - [.completed] /\ - (step config.protocol beforeState .timeout).state.phase = .open) \/ - ((step config.protocol beforeState .timeout).state.phase = - .opening /\ - openingDistance - (step config.protocol beforeState .timeout).state.timeoutState < - openingDistance beforeState.timeoutState) := - opening_timeout_local config.protocol beforeState lane opening - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - have outputEq := systemStep_output_eq foundBefore systemStep - rw [←outputEq] at timeoutResult - rw [←stateEq] - rcases timeoutResult with completed | progress - · exact Or.inl (by - rcases completed with ⟨effects, _⟩ - rw [effects] - simp [CompletedOpen, recordEffects, recordEffect]) - · exact Or.inr - ⟨output.state, - (by - apply nodeState_eq_of_mem - · rw [recordEffects_system, - systemStep_node_keys_eq systemStep] - exact wellFormed.nodeKeysNodup - · rw [recordEffects_system] - exact systemStep_output_mem systemStep), - progress.1, - by simpa using progress.2⟩ - -lemma next_opening_progress - {config : Config} - {before after : State} - {node : Location} - {beforeState : NodeState} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (foundBefore : - Global.nodeState before node = some beforeState) - (opening : beforeState.phase = .opening) - (transition : next config before action = some after) : - CompletedOpen after node \/ - (exists afterState : NodeState, - Global.nodeState after node = some afterState /\ - afterState.phase = .opening /\ - openingDistance afterState.timeoutState <= - openingDistance beforeState.timeoutState) := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact Or.inr - ⟨beforeState, foundBefore, opening, Nat.le_refl _⟩ - | deliver envelope => - by_cases target : node = envelope.target - · subst node - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - have preserved := - opening_non_timeout config.protocol beforeState - (eventFor envelope) opening - (by - cases payloadEq : envelope.payload <;> - simp [eventFor, payloadEq]) - rw [←outputEq] at preserved - exact Or.inr - ⟨output.state, foundAfter, preserved.1, - by rw [preserved.2]⟩ - · have unchanged := deliver_other_node_eq target transition - rw [foundBefore] at unchanged - exact Or.inr - ⟨beforeState, by simp [unchanged], opening, Nat.le_refl _⟩ - | timeout target => - by_cases same : node = target - · subst node - rcases timeout_opening_step wellFormed lanes foundBefore - opening transition with - completed | ⟨nextState, foundAfter, nextOpening, distance⟩ - · exact Or.inl completed - · exact Or.inr - ⟨nextState, foundAfter, nextOpening, - Nat.le_of_lt distance⟩ - · have unchanged := timeout_other_node_eq same transition - rw [foundBefore] at unchanged - exact Or.inr - ⟨beforeState, by simp [unchanged], opening, Nat.le_refl _⟩ - -lemma insertVote_nonempty - (source : Location) - (votes : List Location) : - insertVote source votes ≠ [] := by - unfold insertVote - split - · rename_i present - intro empty - subst votes - simp at present - · intro empty - have lengths := - (List.mergeSort_perm (source :: votes) - (fun left right => left <= right)).length_eq - rw [empty] at lengths - simp at lengths - -lemma step_preserves_nonempty_votes - (config : Model.Config) - (state : NodeState) - (event : Event) - (nonempty : state.votes ≠ []) : - (step config state event).state.votes ≠ [] := by - rcases step_votes_shape config state event with - unchanged | ⟨source, _, changed⟩ - · rw [unchanged] - exact nonempty - · rw [changed] - exact insertVote_nonempty source state.votes - -lemma next_preserves_hasVote - {config : Config} - {before after : State} - {action : Action} - {node : Location} - (wellFormed : WellFormed config before) - (vote : HasVote before node) - (transition : next config before action = some after) : - HasVote after node := by - rcases vote with ⟨beforeState, foundBefore, nonempty⟩ - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact ⟨beforeState, foundBefore, nonempty⟩ - | deliver envelope => - by_cases target : node = envelope.target - · subst node - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact step_preserves_nonempty_votes - config.protocol beforeState (eventFor envelope) nonempty⟩ - · have unchanged := deliver_other_node_eq target transition - rw [foundBefore] at unchanged - exact ⟨beforeState, by simp [unchanged], nonempty⟩ - | timeout target => - by_cases same : node = target - · subst node - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact step_preserves_nonempty_votes - config.protocol beforeState .timeout nonempty⟩ - · have unchanged := timeout_other_node_eq same transition - rw [foundBefore] at unchanged - exact ⟨beforeState, by simp [unchanged], nonempty⟩ - -lemma hasVote_mono - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (vote : HasVote (execution.states start) node) : - HasVote (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact vote - | succ finish order vote => - exact next_preserves_hasVote - (reachable_well_formed - (execution_reachable execution initial finish)) - vote (execution.step_succ finish) - -lemma next_preserves_advanced_lane - {config : Config} - {before after : State} - {action : Action} - {node : Location} - (wellFormed : WellFormed config before) - (advanced : LaneAdvanced before node) - (transition : next config before action = some after) : - LaneAdvanced after node := by - rcases advanced with ⟨beforeState, foundBefore, lane⟩ - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact ⟨beforeState, foundBefore, lane⟩ - | deliver envelope => - by_cases target : node = envelope.target - · subst node - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact step_preserves_advanced_lane - config.protocol beforeState (eventFor envelope) lane⟩ - · have unchanged := deliver_other_node_eq target transition - rw [foundBefore] at unchanged - exact ⟨beforeState, by simp [unchanged], lane⟩ - | timeout target => - by_cases same : node = target - · subst node - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact step_preserves_advanced_lane - config.protocol beforeState .timeout lane⟩ - · have unchanged := timeout_other_node_eq same transition - rw [foundBefore] at unchanged - exact ⟨beforeState, by simp [unchanged], lane⟩ - -lemma advanced_lane_mono - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (advanced : LaneAdvanced (execution.states start) node) : - LaneAdvanced (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact advanced - | succ finish order advanced => - exact next_preserves_advanced_lane - (reachable_well_formed - (execution_reachable execution initial finish)) - advanced (execution.step_succ finish) - -lemma opening_progress_between - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start finish : Nat} - {node : Location} - {startState : NodeState} - (order : start <= finish) - (foundStart : - Global.nodeState (execution.states start) node = some startState) - (openingStart : startState.phase = .opening) - (notCompleted : - Not (CompletedOpen (execution.states finish) node)) : - exists finishState : NodeState, - Global.nodeState (execution.states finish) node = some finishState /\ - finishState.phase = .opening /\ - openingDistance finishState.timeoutState <= - openingDistance startState.timeoutState := by - induction finish, order using Nat.le_induction with - | base => - exact - ⟨startState, foundStart, openingStart, Nat.le_refl _⟩ - | succ finish order ih => - have notCompletedBefore : - Not (CompletedOpen (execution.states finish) node) := by - intro completed - exact notCompleted - (next_completed_monotonic - (execution.step_succ finish) node completed) - rcases ih notCompletedBefore with - ⟨beforeState, foundBefore, openingBefore, distanceBefore⟩ - rcases next_opening_progress - (reachable_well_formed - (execution_reachable execution initial finish)) - (reachable_lanes_valid - (execution_reachable execution initial finish)) - foundBefore openingBefore (execution.step_succ finish) with - completed | - ⟨afterState, foundAfter, openingAfter, distanceAfter⟩ - · contradiction - · exact - ⟨afterState, foundAfter, openingAfter, - Nat.le_trans distanceAfter distanceBefore⟩ - -lemma deliver_gossip_progress - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (payload : exists txid, envelope.payload = .gossip txid) - (phase : HasPhase before envelope.target .gossiping) - (transition : next config before (.deliver envelope) = some after) : - Not (HasPhase after envelope.target .gossiping) \/ - HasGossip after envelope.target := by - rcases phase with ⟨beforeState, foundBefore, gossiping⟩ - rcases payload with ⟨txid, payload⟩ - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - have lane := - node_property_of_nodeState lanes foundBefore - simp [eventFor, payload] at outputEq - have progress := - gossip_receive_progress config.protocol beforeState - envelope.source txid lane gossiping - rw [←outputEq] at progress - rcases progress with left | right - · exact Or.inl (by - intro stillGossiping - rcases stillGossiping with ⟨state, found, phase⟩ - rw [foundAfter] at found - injection found with stateEq - subst state - exact left phase) - · exact Or.inr ⟨output.state, foundAfter, right⟩ - -lemma timeout_gossip_progress - {config : Config} - {before after : State} - {node : Location} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (phase : HasPhase before node .gossiping) - (transition : next config before (.timeout node) = some after) : - HasPhase after node .voting := by - rcases phase with ⟨beforeState, foundBefore, gossiping⟩ - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, accepted, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - have lane := - node_property_of_nodeState lanes foundBefore - have voting := - gossip_timeout_progress config.protocol beforeState lane - gossiping (by simpa [outputEq] using accepted) - exact - ⟨output.state, foundAfter, by simpa [outputEq] using voting⟩ - -lemma vote_receive_progress - (config : Model.Config) - (state : NodeState) - (source : Location) - (phase : state.phase = .voting) : - let output := step config state (.receiveVote source .accepted) - output.state.phase ≠ .voting \/ output.state.votes ≠ [] := by - have nonempty := insertVote_nonempty source state.votes - simp [step, phase, rejected, advance, validTimeout, - advanceTimeoutLane] - repeat first | split | simp_all - -lemma voting_timeout_local - (config : Model.Config) - (state : NodeState) - (valid : LaneValid state) - (phase : state.phase = .voting) - (nonempty : state.votes ≠ []) : - let output := step config state .timeout - output.state.phase = .opening \/ - (output.state.phase = .voting /\ - output.state.timeoutState = .voting) := by - rcases valid.2.1 phase with lane | lane - · simp [step, phase, lane, rejected, advance, validTimeout, - advanceTimeoutLane, advanceTimeoutState] - repeat first | split | simp_all - · simp [step, phase, lane, nonempty, rejected, advance, validTimeout, - advanceTimeoutLane, advanceTimeoutState] - -lemma aligned_voting_timeout_opens - (config : Model.Config) - (state : NodeState) - (phase : state.phase = .voting) - (lane : state.timeoutState = .voting) - (nonempty : state.votes ≠ []) : - (step config state .timeout).state.phase = .opening := by - simp [step, phase, lane, nonempty, rejected, advance, validTimeout, - advanceTimeoutLane] - -lemma deliver_vote_progress - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (payload : envelope.payload = .vote) - (phase : HasPhase before envelope.target .voting) - (transition : next config before (.deliver envelope) = some after) : - Not (HasPhase after envelope.target .voting) \/ - HasVote after envelope.target := by - rcases phase with ⟨beforeState, foundBefore, voting⟩ - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - have outputEq := - systemStep_output_eq foundBefore systemStep - simp [eventFor, payload] at outputEq - have progress := - vote_receive_progress config.protocol beforeState - envelope.source voting - rw [←outputEq] at progress - rcases progress with left | right - · exact Or.inl (by - intro stillVoting - rcases stillVoting with ⟨state, found, phase⟩ - rw [foundAfter] at found - injection found with stateEq - subst state - exact left phase) - · exact Or.inr ⟨output.state, foundAfter, right⟩ - -lemma deliver_iamopen_resolves - {config : Config} - {before after : State} - {envelope : Envelope} - (wellFormed : WellFormed config before) - (openCompleted : OpenCompleted before) - (payload : envelope.payload = .iAmOpen) - (transition : next config before (.deliver envelope) = some after) : - Terminal after envelope.target \/ - HasPhase after envelope.target .opening := by - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, targetActive, system, output, systemStep, stateEq⟩ - rcases active_nodeState wellFormed targetActive with - ⟨beforeState, foundBefore⟩ - have outputEq := systemStep_output_eq foundBefore systemStep - simp [eventFor, payload] at outputEq - have outcome := - iamopen_delivery_outcome config.protocol beforeState envelope.source - rw [←outputEq] at outcome - rw [←stateEq] - rcases outcome with opening | opened | ⟨chosen, restarted⟩ - · exact Or.inr - ⟨output.state, - by - apply nodeState_eq_of_mem - · rw [recordEffects_system, - systemStep_node_keys_eq systemStep] - exact wellFormed.nodeKeysNodup - · rw [recordEffects_system] - exact systemStep_output_mem systemStep, - opening⟩ - · have beforeOpen := - iamopen_open_predecessor config.protocol beforeState - envelope.source (by simpa [outputEq] using opened) - have completedBefore : CompletedOpen before envelope.target := by - rw [Global.nodeState, Option.map_eq_some_iff] at foundBefore - rcases foundBefore with ⟨entry, findEq, stateEq⟩ - have keyEq : entry.1 = envelope.target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == envelope.target) findEq) - rw [←keyEq] - apply openCompleted entry (List.mem_of_find?_eq_some findEq) - simpa [stateEq] using beforeOpen - exact Or.inl (Or.inr - (mem_completed_recordEffects completedBefore)) - · exact Or.inl (Or.inl - (restart_effect_recorded restarted)) - -lemma voting_timeout_enabled - {config : Config} - {state : State} - {node : Location} - (active : node ∈ state.active) - (phase : HasPhase state node .voting) : - Enabled config state (.timeout node) := by - rcases phase with ⟨nodeState, found, voting⟩ - apply timeout_enabled_of_accepted active found - simp [step, voting, advance, rejected] - repeat first | split | simp_all - -lemma timeout_voting_step - {config : Config} - {before after : State} - {node : Location} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (phase : HasPhase before node .voting) - (vote : HasVote before node) - (transition : next config before (.timeout node) = some after) : - HasPhase after node .opening \/ - (exists nextState : NodeState, - Global.nodeState after node = some nextState /\ - nextState.phase = .voting /\ - nextState.timeoutState = .voting /\ - nextState.votes ≠ []) := by - rcases phase with ⟨beforeState, foundBefore, voting⟩ - rcases vote with ⟨voteState, foundVote, nonempty⟩ - rw [foundBefore] at foundVote - injection foundVote with stateEq - subst voteState - have lane : LaneValid beforeState := by - apply node_property_of_nodeState (predicate := LaneValid) - · exact lanes - · exact foundBefore - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - have outputEq := systemStep_output_eq foundBefore systemStep - have progress := - voting_timeout_local config.protocol beforeState lane voting nonempty - rw [←outputEq] at progress - rcases progress with opening | waiting - · exact Or.inl ⟨output.state, foundAfter, opening⟩ - · exact Or.inr - ⟨output.state, foundAfter, waiting.1, waiting.2, - by - rw [outputEq] - exact step_preserves_nonempty_votes - config.protocol beforeState .timeout nonempty⟩ - -lemma aligned_timeout_voting_opens - {config : Config} - {before after : State} - {node : Location} - {nodeState : NodeState} - (wellFormed : WellFormed config before) - (found : Global.nodeState before node = some nodeState) - (phase : nodeState.phase = .voting) - (lane : nodeState.timeoutState = .voting) - (nonempty : nodeState.votes ≠ []) - (transition : next config before (.timeout node) = some after) : - HasPhase after node .opening := by - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - have outputEq := systemStep_output_eq found systemStep - exact - ⟨output.state, foundAfter, - by - rw [outputEq] - exact aligned_voting_timeout_opens config.protocol nodeState - phase lane nonempty⟩ - -lemma fair_gossip_progress - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - {node : Location} - (active : node ∈ (execution.states start).active) - (phase : HasPhase (execution.states start) node .gossiping) : - EventuallyFrom start (fun n => - Not (HasPhase (execution.states n) node .gossiping)) := by - have reachable (n : Nat) := - execution_reachable execution initial n - have configValid := reachable_config_valid (reachable start) - have retryEnabled := - retry_gossip_enabled configValid - (reachable_well_formed (reachable start)) active phase - rcases fair.retry start node .gossiping active phase - (Or.inl rfl) retryEnabled with - ⟨retryAt, startRetry, leftGossip | retryAction⟩ - · exact ⟨retryAt, startRetry, leftGossip⟩ - · by_cases retryPhase : - HasPhase (execution.states retryAt) node .gossiping - · have retryStep : - next config (execution.states retryAt) (.retry node) = - some (execution.states (retryAt + 1)) := by - simpa [retryAction] using execution.step_succ retryAt - rcases retry_gossip_enqueued configValid - (reachable_well_formed (reachable retryAt)) - retryPhase retryStep with - ⟨envelope, pending, sourceEq, targetEq, txid, payload⟩ - rcases fair.delivery (retryAt + 1) envelope pending with - ⟨deliverAt, retryDeliver, deliverAction⟩ - by_cases deliverPhase : - HasPhase (execution.states deliverAt) node .gossiping - · have deliverStep : - next config (execution.states deliverAt) - (.deliver envelope) = - some (execution.states (deliverAt + 1)) := by - simpa [deliverAction] using execution.step_succ deliverAt - have delivered := - deliver_gossip_progress - (reachable_well_formed (reachable deliverAt)) - (reachable_lanes_valid (reachable deliverAt)) - ⟨txid, payload⟩ - (by simpa [targetEq] using deliverPhase) - deliverStep - rcases delivered with leftAfter | hasGossip - · exact - ⟨deliverAt + 1, by omega, by simpa [targetEq] using leftAfter⟩ - · by_cases afterPhase : - HasPhase (execution.states (deliverAt + 1)) node .gossiping - · have timeoutEnabled := - gossip_timeout_enabled - (config := config) - (by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution start] at active - exact active) - (reachable_lanes_valid (reachable (deliverAt + 1))) - afterPhase - (by simpa [targetEq] using hasGossip) - rcases fair.timeout (deliverAt + 1) node .gossiping - (by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution start] at active - exact active) - afterPhase (Or.inl rfl) timeoutEnabled with - ⟨timeoutAt, deliverTimeout, leftBeforeTimeout | timeoutAction⟩ - · exact ⟨timeoutAt, by omega, leftBeforeTimeout⟩ - · by_cases timeoutPhase : - HasPhase (execution.states timeoutAt) node .gossiping - · have timeoutStep : - next config (execution.states timeoutAt) - (.timeout node) = - some (execution.states (timeoutAt + 1)) := by - simpa [timeoutAction] using - execution.step_succ timeoutAt - have voting := - timeout_gossip_progress - (reachable_well_formed (reachable timeoutAt)) - (reachable_lanes_valid (reachable timeoutAt)) - timeoutPhase timeoutStep - refine ⟨timeoutAt + 1, by omega, ?_⟩ - intro impossible - have phases := hasPhase_unique voting impossible - contradiction - · exact ⟨timeoutAt, by omega, timeoutPhase⟩ - · exact ⟨deliverAt + 1, by omega, afterPhase⟩ - · exact ⟨deliverAt, by omega, deliverPhase⟩ - · exact ⟨retryAt, startRetry, retryPhase⟩ - -lemma next_gossiping_predecessor - {config : Config} - {before after : State} - {action : Action} - {node : Location} - (wellFormed : WellFormed config before) - (transition : next config before action = some after) - (afterGossip : HasPhase after node .gossiping) : - HasPhase before node .gossiping := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] at afterGossip - exact afterGossip - | deliver envelope => - by_cases target : node = envelope.target - · subst node - have details := transition - simp [next, Option.bind_eq_some_iff] at details - have targetActive := details.2.1 - rcases active_nodeState wellFormed targetActive with - ⟨beforeState, foundBefore⟩ - rcases deliver_target_state wellFormed transition with - ⟨output, foundAfter, systemStep⟩ - rcases afterGossip with ⟨afterState, found, phase⟩ - rw [foundAfter] at found - injection found with stateEq - subst afterState - have outputEq := - systemStep_output_eq foundBefore systemStep - have beforePhase : beforeState.phase = .gossiping := by - by_contra notGossip - have notAfter := - step_preserves_non_gossiping config.protocol beforeState - (eventFor envelope) notGossip - rw [←outputEq] at notAfter - exact notAfter phase - exact ⟨beforeState, foundBefore, beforePhase⟩ - · rcases afterGossip with ⟨afterState, foundAfter, phase⟩ - have unchanged := - deliver_other_node_eq target transition - rw [foundAfter] at unchanged - cases foundBefore : - Global.nodeState before node with - | none => simp [foundBefore] at unchanged - | some beforeState => - rw [foundBefore] at unchanged - injection unchanged with stateEq - subst beforeState - exact ⟨afterState, foundBefore, phase⟩ - | timeout target => - by_cases same : node = target - · subst node - have details := transition - simp [next, Option.bind_eq_some_iff] at details - have targetActive := details.1 - rcases active_nodeState wellFormed targetActive with - ⟨beforeState, foundBefore⟩ - rcases timeout_target_state wellFormed transition with - ⟨output, foundAfter, _, systemStep⟩ - rcases afterGossip with ⟨afterState, found, phase⟩ - rw [foundAfter] at found - injection found with stateEq - subst afterState - have outputEq := - systemStep_output_eq foundBefore systemStep - have beforePhase : beforeState.phase = .gossiping := by - by_contra notGossip - have notAfter := - step_preserves_non_gossiping config.protocol beforeState - .timeout notGossip - rw [←outputEq] at notAfter - exact notAfter phase - exact ⟨beforeState, foundBefore, beforePhase⟩ - · rcases afterGossip with ⟨afterState, foundAfter, phase⟩ - have unchanged := - timeout_other_node_eq same transition - rw [foundAfter] at unchanged - cases foundBefore : - Global.nodeState before node with - | none => simp [foundBefore] at unchanged - | some beforeState => - rw [foundBefore] at unchanged - injection unchanged with stateEq - subst beforeState - exact ⟨afterState, foundBefore, phase⟩ - -lemma not_gossiping_mono - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (notGossip : - Not (HasPhase (execution.states start) node .gossiping)) : - Not (HasPhase (execution.states finish) node .gossiping) := by - induction finish, order using Nat.le_induction with - | base => exact notGossip - | succ finish order notGossip => - intro gossip - exact notGossip - (next_gossiping_predecessor - (reachable_well_formed - (execution_reachable execution initial finish)) - (execution.step_succ finish) gossip) - -lemma eventually_list - {predicate : Nat -> Location -> Prop} - {start : Nat} - (nodes : List Location) - (eventual : - forall node, node ∈ nodes -> - EventuallyFrom start (fun n => predicate n node)) - (monotonic : - forall node first second, - first <= second -> - predicate first node -> - predicate second node) : - EventuallyFrom start (fun n => - forall node, node ∈ nodes -> predicate n node) := by - revert eventual - induction nodes with - | nil => - intro eventual - exact ⟨start, Nat.le_refl start, by simp⟩ - | cons head tail ih => - intro eventual - rcases eventual head (by simp) with - ⟨headAt, startHead, headHolds⟩ - rcases ih - (fun node membership => eventual node (by simp [membership])) with - ⟨tailAt, startTail, tailHolds⟩ - refine - ⟨max headAt tailAt, by omega, ?_⟩ - intro node membership - rw [List.mem_cons] at membership - rcases membership with rfl | inTail - · exact monotonic _ headAt (max headAt tailAt) - (Nat.le_max_left _ _) headHolds - · exact monotonic node tailAt (max headAt tailAt) - (Nat.le_max_right _ _) (tailHolds node inTail) - -lemma fair_all_leave_gossip - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (start : Nat) : - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - Not (HasPhase (execution.states n) node .gossiping)) := by - apply eventually_list (execution.states start).active - · intro node active - by_cases phase : - HasPhase (execution.states start) node .gossiping - · exact fair_gossip_progress execution initial fair active phase - · exact ⟨start, Nat.le_refl start, phase⟩ - · intro node first second order notGossip - exact not_gossiping_mono execution initial order notGossip - -lemma terminal_mono_step - {config : Config} - {before after : State} - {action : Action} - {node : Location} - (transition : next config before action = some after) - (terminal : Terminal before node) : - Terminal after node := by - rcases terminal with restarted | completed - · exact Or.inl (next_restarts_monotonic transition node restarted) - · exact Or.inr (next_completed_monotonic transition node completed) - -lemma terminal_mono - {config : Config} - (execution : Execution config) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (terminal : Terminal (execution.states start) node) : - Terminal (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact terminal - | succ finish order terminal => - exact terminal_mono_step (execution.step_succ finish) terminal - -lemma completed_mono - {config : Config} - (execution : Execution config) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (completed : CompletedOpen (execution.states start) node) : - CompletedOpen (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact completed - | succ finish order completed => - exact next_completed_monotonic - (execution.step_succ finish) node completed - -lemma quorumOpened_mono - {config : Config} - (execution : Execution config) - {start finish : Nat} - {node : Location} - (order : start <= finish) - (opened : QuorumOpened (execution.states start) node) : - QuorumOpened (execution.states finish) node := by - induction finish, order using Nat.le_induction with - | base => exact opened - | succ finish order opened => - rcases opened with - ⟨opening, membership, openingNode, kind⟩ - exact - ⟨opening, - next_openings_monotonic - (execution.step_succ finish) opening membership, - openingNode, - kind⟩ - -lemma fair_opening_completes - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - {node : Location} - (active : node ∈ (execution.states start).active) - (phase : HasPhase (execution.states start) node .opening) : - EventuallyFrom start (fun n => - CompletedOpen (execution.states n) node) := by - rcases phase with ⟨startState, foundStart, openingStart⟩ - have auxiliary : - forall distance start state, - openingDistance state.timeoutState = distance -> - node ∈ (execution.states start).active -> - Global.nodeState (execution.states start) node = some state -> - state.phase = .opening -> - EventuallyFrom start (fun n => - CompletedOpen (execution.states n) node) := by - intro distance - induction distance using Nat.strong_induction_on with - | h distance ih => - intro start state distanceEq active found opening - have enabled := - opening_timeout_enabled (config := config) - active ⟨state, found, opening⟩ - rcases fair.openingTimeout start node active - ⟨state, found, opening⟩ enabled with - ⟨timeoutAt, startTimeout, - completed | ⟨stillOpening, timeoutAction⟩⟩ - · exact ⟨timeoutAt, startTimeout, completed⟩ - · by_cases completedBefore : - CompletedOpen (execution.states timeoutAt) node - · exact ⟨timeoutAt, startTimeout, completedBefore⟩ - · rcases opening_progress_between execution initial startTimeout - found opening completedBefore with - ⟨timeoutState, foundTimeout, openingTimeout, - distanceTimeout⟩ - have timeoutStep : - next config (execution.states timeoutAt) - (.timeout node) = - some (execution.states (timeoutAt + 1)) := by - simpa [timeoutAction] using execution.step_succ timeoutAt - rcases timeout_opening_step - (reachable_well_formed - (execution_reachable execution initial timeoutAt)) - (reachable_lanes_valid - (execution_reachable execution initial timeoutAt)) - foundTimeout openingTimeout timeoutStep with - completedAfter | - ⟨nextState, foundNext, openingNext, distanceNext⟩ - · exact ⟨timeoutAt + 1, by omega, completedAfter⟩ - · have nextLess : openingDistance nextState.timeoutState < - distance := by - rw [←distanceEq] - exact Nat.lt_of_lt_of_le distanceNext distanceTimeout - rcases ih (openingDistance nextState.timeoutState) - nextLess (timeoutAt + 1) nextState rfl - (by - rw [execution_active_eq execution (timeoutAt + 1)] - rw [execution_active_eq execution start] at active - exact active) - foundNext openingNext with - ⟨completedAt, nextCompleted, completed⟩ - exact ⟨completedAt, by omega, completed⟩ - exact auxiliary (openingDistance startState.timeoutState) - start startState rfl active foundStart openingStart - -lemma initial_announcements_live - (config : Config) - (active : List Location) : - AnnouncementsLive (initial config active) := by - simp [AnnouncementsLive, Global.initial] - -lemma next_preserves_announcements_live - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (live : AnnouncementsLive before) - (transition : next config before action = some after) : - AnnouncementsLive after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, found, _, stateEq⟩ - have sourceLocation := - nodeState_location wellFormed.nodeLocations found - rw [←stateEq] - intro envelope membership payload - rw [List.mem_append] at membership - rcases membership with old | added - · exact live envelope old payload - · have valid : envelope.Valid config := - retryMessages_valid config source sourceState sourceLocation - envelope added - have opening := retry_iamopen_state valid payload - have identity := retryMessages_source added - rw [identity.2] at opening - exact Or.inl - ⟨sourceState, - by simpa [identity.1, Global.nodeState] using found, - opening⟩ - | deliver delivered => - intro envelope membership payload - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq, recordEffects_sent] at membership - rcases live envelope membership payload with - opening | completed - · rcases opening with ⟨sourceState, found, phase⟩ - rcases next_opening_progress wellFormed lanes found phase - transition with - completed | ⟨afterState, foundAfter, phaseAfter, _⟩ - · exact Or.inr completed - · exact Or.inl ⟨afterState, foundAfter, phaseAfter⟩ - · exact Or.inr - (next_completed_monotonic transition envelope.source completed) - | timeout target => - intro envelope membership payload - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq, recordEffects_sent] at membership - rcases live envelope membership payload with - opening | completed - · rcases opening with ⟨sourceState, found, phase⟩ - rcases next_opening_progress wellFormed lanes found phase - transition with - completed | ⟨afterState, foundAfter, phaseAfter, _⟩ - · exact Or.inr completed - · exact Or.inl ⟨afterState, foundAfter, phaseAfter⟩ - · exact Or.inr - (next_completed_monotonic transition envelope.source completed) - -lemma reachable_announcements_live - {config : Config} - {state : State} - (reachable : Reachable config state) : - AnnouncementsLive state := by - induction reachable with - | initial active valid nodup configured => - exact initial_announcements_live config active - | step reachable transition live => - exact next_preserves_announcements_live - (reachable_well_formed reachable) - (reachable_lanes_valid reachable) - live transition - -lemma initial_announcements_resolved - (config : Config) - (active : List Location) : - AnnouncementsResolved (initial config active) := by - simp [AnnouncementsResolved, Global.initial] - -lemma next_preserves_announcements_resolved - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (lanes : NodeLanesValid before) - (openCompleted : OpenCompleted before) - (resolved : AnnouncementsResolved before) - (transition : next config before action = some after) : - AnnouncementsResolved after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - intro envelope membership payload - rw [List.mem_append] at membership - rcases membership with old | added - · rcases resolved envelope old payload with - pending | terminal | opening - · exact Or.inl (List.mem_append_left _ pending) - · exact Or.inr (Or.inl terminal) - · exact Or.inr (Or.inr opening) - · exact Or.inl (List.mem_append_right _ added) - | deliver delivered => - intro envelope membership payload - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq, recordEffects_sent] at membership - rcases resolved envelope membership payload with - pending | terminal | opening - · rcases mem_removeOne_or_eq pending with remains | equal - · exact Or.inl (by - rw [←stateEq, recordEffects_network] - exact remains) - · subst envelope - rcases deliver_iamopen_resolves wellFormed openCompleted payload - transition with - terminal | opening - · exact Or.inr (Or.inl terminal) - · exact Or.inr (Or.inr opening) - · exact Or.inr (Or.inl - (terminal_mono_step transition terminal)) - · rcases opening with ⟨sourceState, found, phase⟩ - rcases next_opening_progress wellFormed lanes found phase - transition with - completed | ⟨afterState, foundAfter, phaseAfter, _⟩ - · exact Or.inr (Or.inl (Or.inr completed)) - · exact Or.inr (Or.inr - ⟨afterState, foundAfter, phaseAfter⟩) - | timeout target => - intro envelope membership payload - have details := transition - simp [next, Option.bind_eq_some_iff] at details - rcases details with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq, recordEffects_sent] at membership - rcases resolved envelope membership payload with - pending | terminal | opening - · exact Or.inl (by - rw [←stateEq, recordEffects_network] - exact pending) - · exact Or.inr (Or.inl - (terminal_mono_step transition terminal)) - · rcases opening with ⟨sourceState, found, phase⟩ - rcases next_opening_progress wellFormed lanes found phase - transition with - completed | ⟨afterState, foundAfter, phaseAfter, _⟩ - · exact Or.inr (Or.inl (Or.inr completed)) - · exact Or.inr (Or.inr - ⟨afterState, foundAfter, phaseAfter⟩) - -lemma systemStep_preserves_joining_announcements - {config : Model.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {beforeState afterState : State} - (beforeSystem : beforeState.system = before) - (valid : JoiningAnnouncements beforeState) - (carry : - forall destination, - SentAnnouncementTo beforeState destination -> - SentAnnouncementTo afterState destination) - (introduced : - (exists source, acceptedIAmOpenSource event = some source) -> - SentAnnouncementTo afterState target) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.phase = .joining -> - SentAnnouncementTo afterState entry.1 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership joining - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · rename_i atTarget - rcases step_joining_origin config node event - (by simpa [atTarget, outputEq] using joining) with - old | received - · have keyEq : key = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - rw [←keyEq] - apply carry - apply valid (key, node) - · rw [beforeSystem] - exact List.mem_of_find?_eq_some found - · exact old - · exact introduced received - · rename_i notTarget - apply carry - apply valid previous - · rw [beforeSystem] - exact previousMember - · simpa [notTarget] using joining - -lemma initial_joining_announcements - (config : Config) - (active : List Location) : - JoiningAnnouncements (initial config active) := by - simp [JoiningAnnouncements, Global.initial, initialSystem, initialNode] - -lemma next_preserves_joining_announcements - {config : Config} - {before after : State} - {action : Action} - (wellFormed : WellFormed config before) - (valid : JoiningAnnouncements before) - (transition : next config before action = some after) : - JoiningAnnouncements after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - intro entry membership joining - rcases valid entry membership joining with - ⟨envelope, sent, target, payload⟩ - exact - ⟨envelope, List.mem_append_left _ sent, target, payload⟩ - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨inNetwork, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] - intro entry membership joining - rw [recordEffects_system] at membership - let afterState := - recordEffects envelope.target output.state output.effects - { - before with - system - network := removeOne envelope before.network - } - have carry : - forall destination, - SentAnnouncementTo before destination -> - SentAnnouncementTo afterState destination := by - intro destination announcement - rcases announcement with - ⟨sentEnvelope, sent, target, payload⟩ - exact - ⟨sentEnvelope, by simpa [afterState] using sent, - target, payload⟩ - have introduced : - (exists source, - acceptedIAmOpenSource (eventFor envelope) = some source) -> - SentAnnouncementTo afterState envelope.target := by - rintro ⟨source, accepted⟩ - rcases eventFor_iamopen_source accepted with - ⟨payload, _⟩ - exact - ⟨envelope, - by - simp [afterState] - exact wellFormed.networkSent envelope inNetwork, - rfl, payload⟩ - exact systemStep_preserves_joining_announcements - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl valid carry introduced systemStep - entry membership joining - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - intro entry membership joining - rw [recordEffects_system] at membership - let afterState := - recordEffects target output.state output.effects - { before with system } - have carry : - forall destination, - SentAnnouncementTo before destination -> - SentAnnouncementTo afterState destination := by - intro destination announcement - rcases announcement with - ⟨sentEnvelope, sent, target, payload⟩ - exact - ⟨sentEnvelope, by simpa [afterState] using sent, - target, payload⟩ - have introduced : - (exists source, - acceptedIAmOpenSource Event.timeout = some source) -> - SentAnnouncementTo afterState target := by - rintro ⟨source, accepted⟩ - simp [acceptedIAmOpenSource] at accepted - exact systemStep_preserves_joining_announcements - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl valid carry introduced systemStep - entry membership joining - -lemma reachable_joining_announcements - {config : Config} - {state : State} - (reachable : Reachable config state) : - JoiningAnnouncements state := by - induction reachable with - | initial active valid nodup configured => - exact initial_joining_announcements config active - | step reachable transition valid => - exact next_preserves_joining_announcements - (reachable_well_formed reachable) valid transition - -lemma systemStep_preserves_open_completed - {config : Model.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {beforeState afterState : State} - (beforeSystem : beforeState.system = before) - (valid : OpenCompleted beforeState) - (carry : - forall node, - CompletedOpen beforeState node -> - CompletedOpen afterState node) - (introduced : - .completed ∈ output.effects -> - CompletedOpen afterState target) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.phase = .open -> - CompletedOpen afterState entry.1 := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership opened - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · rename_i atTarget - rcases step_open_origin config node event - (by simpa [atTarget, outputEq] using opened) with - old | completed - · have keyEq : key = target := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == target) found) - rw [←keyEq] - apply carry - apply valid (key, node) - · rw [beforeSystem] - exact List.mem_of_find?_eq_some found - · exact old - · rw [outputEq] at completed - exact introduced completed - · rename_i notTarget - apply carry - apply valid previous - · rw [beforeSystem] - exact previousMember - · simpa [notTarget] using opened - -lemma initial_open_completed - (config : Config) - (active : List Location) : - OpenCompleted (initial config active) := by - simp [OpenCompleted, Global.initial, initialSystem, initialNode] - -lemma next_preserves_open_completed - {config : Config} - {before after : State} - {action : Action} - (valid : OpenCompleted before) - (transition : next config before action = some after) : - OpenCompleted after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact valid - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, _, system, output, systemStep, stateEq⟩ - rw [←stateEq] - intro entry membership opened - rw [recordEffects_system] at membership - let afterState := - recordEffects envelope.target output.state output.effects - { - before with - system - network := removeOne envelope before.network - } - have carry : - forall node, - CompletedOpen before node -> - CompletedOpen afterState node := by - intro node completed - apply mem_completed_recordEffects - exact completed - have introduced : - .completed ∈ output.effects -> - CompletedOpen afterState envelope.target := by - intro completed - exact completed_effect_recorded completed - exact systemStep_preserves_open_completed - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl valid carry introduced systemStep entry membership opened - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - intro entry membership opened - rw [recordEffects_system] at membership - let afterState := - recordEffects target output.state output.effects - { before with system } - have carry : - forall node, - CompletedOpen before node -> - CompletedOpen afterState node := by - intro node completed - apply mem_completed_recordEffects - exact completed - have introduced : - .completed ∈ output.effects -> - CompletedOpen afterState target := by - intro completed - exact completed_effect_recorded completed - exact systemStep_preserves_open_completed - (before := before.system) - (after := system) - (beforeState := before) - (afterState := afterState) - rfl valid carry introduced systemStep entry membership opened - -lemma reachable_open_completed - {config : Config} - {state : State} - (reachable : Reachable config state) : - OpenCompleted state := by - induction reachable with - | initial active valid nodup configured => - exact initial_open_completed config active - | step reachable transition valid => - exact next_preserves_open_completed valid transition - -lemma reachable_announcements_resolved - {config : Config} - {state : State} - (reachable : Reachable config state) : - AnnouncementsResolved state := by - induction reachable with - | initial active valid nodup configured => - exact initial_announcements_resolved config active - | step reachable transition resolved => - exact next_preserves_announcements_resolved - (reachable_well_formed reachable) - (reachable_lanes_valid reachable) - (reachable_open_completed reachable) - resolved transition - -lemma open_node_completed - {state : State} - {node : Location} - {nodeState : NodeState} - (valid : OpenCompleted state) - (found : Global.nodeState state node = some nodeState) - (opened : nodeState.phase = .open) : - CompletedOpen state node := by - rw [Global.nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have keyEq : entry.1 = node := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) findEq) - rw [←keyEq] - apply valid entry (List.mem_of_find?_eq_some findEq) - simpa [stateEq] using opened - -lemma joining_node_announcement - {state : State} - {node : Location} - {nodeState : NodeState} - (valid : JoiningAnnouncements state) - (found : Global.nodeState state node = some nodeState) - (joining : nodeState.phase = .joining) : - SentAnnouncementTo state node := by - rw [Global.nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have keyEq : entry.1 = node := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) findEq) - rw [←keyEq] - apply valid entry (List.mem_of_find?_eq_some findEq) - simpa [stateEq] using joining - -lemma openerWitness_of_later_phase - {config : Config} - {state : State} - {node : Location} - (reachable : Reachable config state) - (active : node ∈ state.active) - (notGossip : Not (HasPhase state node .gossiping)) - (notVoting : Not (HasPhase state node .voting)) : - OpenerWitness state := by - rcases active_nodeState (reachable_well_formed reachable) active with - ⟨nodeState, found⟩ - cases phase : nodeState.phase with - | gossiping => - exact False.elim - (notGossip ⟨nodeState, found, phase⟩) - | voting => - exact False.elim - (notVoting ⟨nodeState, found, phase⟩) - | opening => - exact ⟨node, Or.inl ⟨nodeState, found, phase⟩⟩ - | joining => - rcases joining_node_announcement - (reachable_joining_announcements reachable) - found phase with - ⟨envelope, sent, target, payload⟩ - rcases reachable_announcements_live reachable - envelope sent payload with - opening | completed - · exact ⟨envelope.source, Or.inl opening⟩ - · exact ⟨envelope.source, Or.inr completed⟩ - | «open» => - exact - ⟨node, Or.inr - (open_node_completed - (reachable_open_completed reachable) found phase)⟩ - -lemma openerWitness_after_leave_voting - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - {start later : Nat} - {node : Location} - (order : start <= later) - (allPastGossip : - forall activeNode, - activeNode ∈ (execution.states start).active -> - Not (HasPhase (execution.states start) - activeNode .gossiping)) - (active : node ∈ (execution.states later).active) - (notVoting : - Not (HasPhase (execution.states later) node .voting)) : - OpenerWitness (execution.states later) := by - have activeStart : node ∈ (execution.states start).active := by - rw [execution_active_eq execution later] at active - rw [execution_active_eq execution start] - exact active - have notGossip := - not_gossiping_mono execution initial order - (allPastGossip node activeStart) - exact openerWitness_of_later_phase - (execution_reachable execution initial later) - active notGossip notVoting - -lemma systemStep_preserves_advanced_active - {config : Model.Config} - {before after : SystemState} - {target : Location} - {event : Event} - {output : StepOutput} - {active : List Location} - (valid : - forall entry, entry ∈ before.nodes -> - entry.2.phase ≠ .gossiping -> - entry.1 ∈ active) - (targetActive : target ∈ active) - (transition : - systemStep config before target event = some (after, output)) : - forall entry, entry ∈ after.nodes -> - entry.2.phase ≠ .gossiping -> - entry.1 ∈ active := by - simp [systemStep, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨node, ⟨key, found⟩, systemEq, outputEq⟩ - rw [←systemEq] - intro entry membership advanced - rw [replaceNode, List.mem_map] at membership - rcases membership with ⟨previous, previousMember, rfl⟩ - split - · exact targetActive - · rename_i notTarget - exact valid previous previousMember - (by simpa [notTarget] using advanced) - -lemma initial_advanced_active - (config : Config) - (active : List Location) : - AdvancedNodesActive (initial config active) := by - simp [AdvancedNodesActive, Global.initial, initialSystem, initialNode] - -lemma next_preserves_advanced_active - {config : Config} - {before after : State} - {action : Action} - (valid : AdvancedNodesActive before) - (transition : next config before action = some after) : - AdvancedNodesActive after := by - cases action with - | retry source => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, sourceState, _, _, stateEq⟩ - rw [←stateEq] - exact valid - | deliver envelope => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨_, targetActive, system, output, systemStep, stateEq⟩ - rw [←stateEq] - intro entry membership advanced - rw [recordEffects_system] at membership - simpa using - systemStep_preserves_advanced_active - valid targetActive systemStep entry membership advanced - | timeout target => - simp [next, Option.bind_eq_some_iff] at transition - rcases transition with - ⟨targetActive, system, output, systemStep, _, stateEq⟩ - rw [←stateEq] - intro entry membership advanced - rw [recordEffects_system] at membership - simpa using - systemStep_preserves_advanced_active - valid targetActive systemStep entry membership advanced - -lemma reachable_advanced_active - {config : Config} - {state : State} - (reachable : Reachable config state) : - AdvancedNodesActive state := by - induction reachable with - | initial active valid nodup configured => - exact initial_advanced_active config active - | step reachable transition valid => - exact next_preserves_advanced_active valid transition - -lemma hasPhase_active - {config : Config} - {state : State} - {node : Location} - {phase : Phase} - (reachable : Reachable config state) - (hasPhase : HasPhase state node phase) - (advancedPhase : phase ≠ .gossiping) : - node ∈ state.active := by - rcases hasPhase with ⟨nodeState, found, phaseEq⟩ - rw [Global.nodeState, Option.map_eq_some_iff] at found - rcases found with ⟨entry, findEq, stateEq⟩ - have keyEq : entry.1 = node := - beq_iff_eq.mp - (List.find?_some - (p := fun entry : Prod Location NodeState => - entry.1 == node) findEq) - rw [←keyEq] - apply reachable_advanced_active reachable entry - (List.mem_of_find?_eq_some findEq) - rw [stateEq, phaseEq] - exact advancedPhase - -lemma fair_opener_witness - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - (activeNonempty : (execution.states start).active ≠ []) - (allPastGossip : - forall node, node ∈ (execution.states start).active -> - Not (HasPhase (execution.states start) node .gossiping)) : - EventuallyFrom start (fun n => - OpenerWitness (execution.states n)) := by - obtain ⟨voter, voterActive⟩ := - List.exists_mem_of_ne_nil _ activeNonempty - by_cases voting : - HasPhase (execution.states start) voter .voting - · rcases voting with ⟨voterState, foundVoter, voterVoting⟩ - have selectionProperty := - node_property_of_nodeState - (predicate := fun state => - state.phase = .voting -> NodeVotingSelection state) - (reachable_quorum_invariant - (execution_reachable execution initial start)).votingSelections - foundVoter - rcases selectionProperty voterVoting with - ⟨target, txid, chosen, maximum⟩ - have retryEnabled := - retry_voting_enabled (config := config) - voterActive foundVoter voterVoting chosen - rcases fair.retry start voter .voting voterActive - ⟨voterState, foundVoter, voterVoting⟩ - (Or.inr (Or.inl rfl)) retryEnabled with - ⟨retryAt, startRetry, leftVoting | retryAction⟩ - · exact - ⟨retryAt, startRetry, - openerWitness_after_leave_voting execution initial - startRetry allPastGossip - (by - rw [execution_active_eq execution retryAt] - rw [execution_active_eq execution start] at voterActive - exact voterActive) - leftVoting⟩ - · by_cases retryVoting : - HasPhase (execution.states retryAt) voter .voting - · rcases retryVoting with - ⟨retryState, foundRetry, votingRetry⟩ - have retrySelectionProperty := - node_property_of_nodeState - (predicate := fun state => - state.phase = .voting -> NodeVotingSelection state) - (reachable_quorum_invariant - (execution_reachable execution initial retryAt)).votingSelections - foundRetry - rcases retrySelectionProperty votingRetry with - ⟨retryTarget, retryTxID, retryChosen, retryMaximum⟩ - have retryStep : - next config (execution.states retryAt) (.retry voter) = - some (execution.states (retryAt + 1)) := by - simpa [retryAction] using execution.step_succ retryAt - rcases retry_vote_enqueued foundRetry votingRetry retryChosen - retryStep with - ⟨voteEnvelope, pending, voteSource, voteTarget, votePayload⟩ - rcases fair.delivery (retryAt + 1) voteEnvelope pending with - ⟨deliverAt, retryDeliver, deliverAction⟩ - have deliverStep : - next config (execution.states deliverAt) - (.deliver voteEnvelope) = - some (execution.states (deliverAt + 1)) := by - simpa [deliverAction] using execution.step_succ deliverAt - have deliverDetails := deliverStep - simp [next, Option.bind_eq_some_iff] at deliverDetails - have targetActive : voteEnvelope.target ∈ - (execution.states deliverAt).active := - deliverDetails.2.1 - by_cases targetVoting : - HasPhase (execution.states deliverAt) - voteEnvelope.target .voting - · rcases deliver_vote_progress - (reachable_well_formed - (execution_reachable execution initial deliverAt)) - votePayload targetVoting deliverStep with - leftAfter | hasVote - · have activeAfter : voteEnvelope.target ∈ - (execution.states (deliverAt + 1)).active := by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution deliverAt] at targetActive - exact targetActive - exact - ⟨deliverAt + 1, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip activeAfter leftAfter⟩ - · by_cases votingAfter : - HasPhase (execution.states (deliverAt + 1)) - voteEnvelope.target .voting - · have activeAfter : voteEnvelope.target ∈ - (execution.states (deliverAt + 1)).active := by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution deliverAt] at targetActive - exact targetActive - have timeoutEnabled := - voting_timeout_enabled (config := config) - activeAfter votingAfter - rcases fair.timeout (deliverAt + 1) - voteEnvelope.target .voting activeAfter votingAfter - (Or.inr (Or.inl rfl)) timeoutEnabled with - ⟨timeoutAt, deliverTimeout, - leftBeforeTimeout | timeoutAction⟩ - · exact - ⟨timeoutAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution timeoutAt] - rw [execution_active_eq execution - (deliverAt + 1)] at activeAfter - exact activeAfter) - leftBeforeTimeout⟩ - · by_cases votingAtTimeout : - HasPhase (execution.states timeoutAt) - voteEnvelope.target .voting - · have voteAtTimeout := - hasVote_mono execution initial deliverTimeout hasVote - have timeoutStep : - next config (execution.states timeoutAt) - (.timeout voteEnvelope.target) = - some (execution.states (timeoutAt + 1)) := by - simpa [timeoutAction] using - execution.step_succ timeoutAt - rcases timeout_voting_step - (reachable_well_formed - (execution_reachable execution initial timeoutAt)) - (reachable_lanes_valid - (execution_reachable execution initial timeoutAt)) - votingAtTimeout voteAtTimeout timeoutStep with - opened | - ⟨waitingState, foundWaiting, waitingPhase, - waitingLane, waitingVotes⟩ - · exact - ⟨timeoutAt + 1, by omega, - ⟨voteEnvelope.target, Or.inl opened⟩⟩ - · have activeWaiting : voteEnvelope.target ∈ - (execution.states (timeoutAt + 1)).active := by - rw [execution_active_eq execution (timeoutAt + 1)] - rw [execution_active_eq execution - (deliverAt + 1)] at activeAfter - exact activeAfter - have secondEnabled := - voting_timeout_enabled (config := config) - activeWaiting - ⟨waitingState, foundWaiting, waitingPhase⟩ - rcases fair.timeout (timeoutAt + 1) - voteEnvelope.target .voting activeWaiting - ⟨waitingState, foundWaiting, waitingPhase⟩ - (Or.inr (Or.inl rfl)) secondEnabled with - ⟨secondAt, firstSecond, - leftBeforeSecond | secondAction⟩ - · exact - ⟨secondAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution secondAt] - rw [execution_active_eq execution - (timeoutAt + 1)] at activeWaiting - exact activeWaiting) - leftBeforeSecond⟩ - · by_cases votingAtSecond : - HasPhase (execution.states secondAt) - voteEnvelope.target .voting - · rcases votingAtSecond with - ⟨secondState, foundSecond, secondPhase⟩ - have votesSecond := - hasVote_mono execution initial firstSecond - ⟨waitingState, foundWaiting, waitingVotes⟩ - rcases votesSecond with - ⟨voteState, foundVotes, secondVotes⟩ - rw [foundSecond] at foundVotes - injection foundVotes with voteStateEq - subst voteState - have advancedSecond := - advanced_lane_mono execution initial firstSecond - ⟨waitingState, foundWaiting, by simp [waitingLane]⟩ - rcases advancedSecond with - ⟨laneState, foundLane, advanced⟩ - rw [foundSecond] at foundLane - injection foundLane with laneStateEq - subst laneState - have laneValid : LaneValid secondState := by - apply node_property_of_nodeState - (predicate := LaneValid) - · exact reachable_lanes_valid - (execution_reachable execution initial secondAt) - · exact foundSecond - have secondLane : secondState.timeoutState = - .voting := by - rcases laneValid.2.1 secondPhase with - gossipLane | votingLane - · contradiction - · exact votingLane - have secondStep : - next config (execution.states secondAt) - (.timeout voteEnvelope.target) = - some (execution.states (secondAt + 1)) := by - simpa [secondAction] using - execution.step_succ secondAt - have opened := - aligned_timeout_voting_opens - (reachable_well_formed - (execution_reachable execution initial secondAt)) - foundSecond secondPhase secondLane secondVotes - secondStep - exact - ⟨secondAt + 1, by omega, - ⟨voteEnvelope.target, Or.inl opened⟩⟩ - · exact - ⟨secondAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution secondAt] - rw [execution_active_eq execution - (timeoutAt + 1)] at activeWaiting - exact activeWaiting) - votingAtSecond⟩ - · exact - ⟨timeoutAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution timeoutAt] - rw [execution_active_eq execution - (deliverAt + 1)] at activeAfter - exact activeAfter) - votingAtTimeout⟩ - · exact - ⟨deliverAt + 1, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip - (by - rw [execution_active_eq execution (deliverAt + 1)] - rw [execution_active_eq execution deliverAt] - at targetActive - exact targetActive) - votingAfter⟩ - · exact - ⟨deliverAt, by omega, - openerWitness_after_leave_voting execution initial - (by omega) allPastGossip targetActive targetVoting⟩ - · exact - ⟨retryAt, startRetry, - openerWitness_after_leave_voting execution initial - startRetry allPastGossip - (by - rw [execution_active_eq execution retryAt] - rw [execution_active_eq execution start] at voterActive - exact voterActive) - retryVoting⟩ - · exact - ⟨start, Nat.le_refl start, - openerWitness_after_leave_voting execution initial - (Nat.le_refl start) allPastGossip voterActive voting⟩ - -lemma openerWitness_eventually_completes - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - (witness : OpenerWitness (execution.states start)) : - EventuallyFrom start (fun n => - exists node, CompletedOpen (execution.states n) node) := by - rcases witness with ⟨node, opening | completed⟩ - · have active := - hasPhase_active (execution_reachable execution initial start) - opening (by simp) - rcases fair_opening_completes execution initial fair active opening with - ⟨completedAt, order, completed⟩ - exact ⟨completedAt, order, node, completed⟩ - · exact ⟨start, Nat.le_refl start, node, completed⟩ - -lemma fair_some_opener_completes - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (activeNonempty : (execution.states 0).active ≠ []) : - EventuallyFrom 0 (fun n => - exists node, CompletedOpen (execution.states n) node) := by - rcases fair_all_leave_gossip execution initial fair 0 with - ⟨pastGossipAt, _, allPastGossip⟩ - have nonemptyAt : - (execution.states pastGossipAt).active ≠ [] := by - rw [execution_active_eq execution pastGossipAt] - exact activeNonempty - have allPastAt : - forall node, node ∈ (execution.states pastGossipAt).active -> - Not (HasPhase (execution.states pastGossipAt) - node .gossiping) := by - intro node active - rw [execution_active_eq execution pastGossipAt] at active - exact allPastGossip node active - rcases fair_opener_witness execution initial fair nonemptyAt - allPastAt with - ⟨witnessAt, pastWitness, witness⟩ - rcases openerWitness_eventually_completes execution initial fair - witness with - ⟨completedAt, witnessCompleted, completed⟩ - exact ⟨completedAt, by omega, completed⟩ - -lemma fair_target_terminal_after_completion - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener target : Location} - (completed : CompletedOpen (execution.states start) opener) - (active : target ∈ (execution.states start).active) : - EventuallyFrom start (fun n => - Terminal (execution.states n) target) := by - by_cases same : target = opener - · subst target - exact ⟨start, Nat.le_refl start, Or.inr completed⟩ - · rcases broadcast start opener completed target active same with - ⟨envelope, sent, sourceEq, targetEq, payload⟩ - rcases reachable_announcements_resolved - (execution_reachable execution initial start) - envelope sent payload with - pending | terminal | opening - · rcases fair.delivery start envelope pending with - ⟨deliverAt, startDelivery, deliverAction⟩ - have deliverStep : - next config (execution.states deliverAt) (.deliver envelope) = - some (execution.states (deliverAt + 1)) := by - simpa [deliverAction] using execution.step_succ deliverAt - rcases deliver_iamopen_resolves - (reachable_well_formed - (execution_reachable execution initial deliverAt)) - (reachable_open_completed - (execution_reachable execution initial deliverAt)) - payload deliverStep with - terminal | targetOpening - · exact - ⟨deliverAt + 1, by omega, by simpa [targetEq] using terminal⟩ - · have openingActive := - hasPhase_active - (execution_reachable execution initial (deliverAt + 1)) - targetOpening (by simp) - rcases fair_opening_completes execution initial fair - openingActive targetOpening with - ⟨completedAt, deliveryCompleted, targetCompleted⟩ - rw [targetEq] at targetCompleted - exact - ⟨completedAt, by omega, Or.inr targetCompleted⟩ - · exact - ⟨start, Nat.le_refl start, by simpa [targetEq] using terminal⟩ - · have openingActive := - hasPhase_active - (execution_reachable execution initial start) - opening (by simp) - rcases fair_opening_completes execution initial fair - openingActive opening with - ⟨completedAt, startCompleted, targetCompleted⟩ - rw [targetEq] at targetCompleted - exact - ⟨completedAt, startCompleted, Or.inr targetCompleted⟩ - -lemma fair_all_terminal_after_completion - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener : Location} - (completed : CompletedOpen (execution.states start) opener) : - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - Terminal (execution.states n) node) := by - apply eventually_list (execution.states start).active - · intro node active - exact fair_target_terminal_after_completion - execution initial fair broadcast completed active - · intro node first second order terminal - exact terminal_mono execution order terminal - -lemma global_progress - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - (activeNonempty : (execution.states 0).active ≠ []) : - EventuallyFrom 0 (fun n => - exists node, CompletedOpen (execution.states n) node) /\ - EventuallyFrom 0 (fun n => - forall node, node ∈ (execution.states 0).active -> - Terminal (execution.states n) node) := by - have completed := - fair_some_opener_completes execution initial fair activeNonempty - constructor - · exact completed - · rcases completed with - ⟨completedAt, _, opener, openerCompleted⟩ - rcases fair_all_terminal_after_completion execution initial fair - broadcast openerCompleted with - ⟨terminalAt, completedTerminal, allTerminal⟩ - refine ⟨terminalAt, by omega, ?_⟩ - intro node active - apply allTerminal node - rw [execution_active_eq execution completedAt] - exact active - -lemma single_completion_path_joins_others - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener : Location} - (completed : CompletedOpen (execution.states start) opener) - (onlyOpener : OnlyOpenerCompletesFrom execution start opener) : - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - node = opener \/ node ∈ (execution.states n).restarts) := by - apply eventually_list (execution.states start).active - · intro node active - by_cases same : node = opener - · exact ⟨start, Nat.le_refl start, Or.inl same⟩ - · rcases fair_target_terminal_after_completion - execution initial fair broadcast completed active with - ⟨terminalAt, startTerminal, terminal⟩ - rcases terminal with restarted | targetCompleted - · exact ⟨terminalAt, startTerminal, Or.inr restarted⟩ - · exact False.elim - (same - (onlyOpener terminalAt node startTerminal targetCompleted)) - · intro node first second order joined - rcases joined with same | restarted - · exact Or.inl same - · exact Or.inr - (by - induction second, order using Nat.le_induction with - | base => exact restarted - | succ second order restarted => - exact next_restarts_monotonic - (execution.step_succ second) node restarted) - -lemma quorum_path_progress - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener : Location} - (opened : QuorumOpened (execution.states start) opener) - (completed : CompletedOpen (execution.states start) opener) - (quorumOnly : QuorumOnlyCompletions execution) : - QuorumOpened (execution.states start) opener /\ - CompletedOpen (execution.states start) opener /\ - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - node = opener \/ node ∈ (execution.states n).restarts) := by - have onlyOpener : - OnlyOpenerCompletesFrom execution start opener := by - intro n node startN nodeCompleted - exact quorum_opener_unique - (execution_reachable execution initial n) - (quorumOnly n node nodeCompleted) - (quorumOpened_mono execution startN opened) - exact - ⟨opened, completed, - single_completion_path_joins_others - execution initial fair broadcast completed onlyOpener⟩ - -end DisasterRecovery.Proofs.GlobalTemporal diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Model.lean similarity index 51% rename from lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean rename to lean/disaster-recovery/DisasterRecovery/Proofs/Model.lean index c61cd5153de1..03ddc38e6c0a 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Temporal.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Model.lean @@ -1,14 +1,14 @@ -import DisasterRecovery.Protocol.Temporal +import DisasterRecovery.Protocol.Model import Mathlib.Tactic.Lemma /-! Machine-checked proof implementations. Review the system-level statements in -`DisasterRecovery.Properties` and definitions in `DisasterRecovery.Protocol.Temporal`. +`DisasterRecovery.Properties` and definitions in `DisasterRecovery.Protocol.Model`. -/ -namespace DisasterRecovery.Proofs.Temporal +namespace DisasterRecovery.Proofs.Model -open Protocol.Model Protocol.Temporal +open Protocol.Model lemma valid_timeout_requires_alignment (state : NodeState) @@ -112,88 +112,4 @@ lemma aligned_empty_gossip_timeout_aborts output.state = waiting /\ output.accepted = false := by simp [step, advance, validTimeout, rejected, maximumGossip] -lemma non_timeout_step_preserves_aligned_opening - (config : Config) - (state : NodeState) - (event : Event) - (aligned : AlignedOpening state) - (notTimeout : Not (event = .timeout)) : - AlignedOpening (step config state event).state := by - have phase := aligned.1 - have timeoutState := aligned.2 - cases event with - | receiveGossip source txid validation => - cases validation <;> - simp_all [AlignedOpening, step, rejected, advance, validTimeout, - advanceTimeoutLane] - split <;> simp_all - | receiveVote source validation => - cases validation <;> - simp_all [AlignedOpening, step, rejected, advance, validTimeout, - advanceTimeoutLane] - | receiveIAmOpen source validation => - cases validation <;> - simp_all [AlignedOpening, step, rejected] - | timeout => - exact (notTimeout rfl).elim - | retry => - simp [AlignedOpening, step, phase, timeoutState] - -lemma aligned_timeout_transitions_to_open - (config : Config) - (state : NodeState) - (aligned : AlignedOpening state) : - (step config state .timeout).state.phase = .open := by - have phase := aligned.1 - have timeoutState := aligned.2 - simp [step, advance, validTimeout, phase, timeoutState, - advanceTimeoutLane, advanceTimeoutState] - -lemma fairness_supplies_firing - {config : Config} - (execution : Execution config) - (enabled : NodeState -> Prop) - (fired : NodeState -> Event -> Prop) - (fair : WeakFairness execution enabled fired) - (alwaysEnabled : forall n, enabled (execution.states n)) : - InfinitelyOften - (fun n => fired (execution.states n) (execution.events n)) := by - intro start - exact fair start (fun n _ => alwaysEnabled n) - -lemma fair_aligned_opening_progress - {config : Config} - (execution : Execution config) - (initial : AlignedOpening (execution.states 0)) - (fair : WeakFairness execution AlignedOpening - (fun _ event => event = .timeout)) : - EventuallyFrom 0 - (fun n => (execution.states n).phase = .open) := by - apply Classical.byContradiction - intro noOpen - have neverOpen : - forall n, Not ((execution.states n).phase = .open) := by - intro n opened - apply noOpen - exact Exists.intro n (And.intro (Nat.zero_le n) opened) - have alignedAlways : forall n, AlignedOpening (execution.states n) := by - intro n - induction n with - | zero => exact initial - | succ n aligned => - have notTimeout : Not (execution.events n = .timeout) := by - intro timeout - apply neverOpen (n + 1) - rw [execution.step_succ n, timeout] - exact aligned_timeout_transitions_to_open config _ aligned - rw [execution.step_succ n] - exact non_timeout_step_preserves_aligned_opening - config _ _ aligned notTimeout - have firing := fair 0 (fun n _ => alignedAlways n) - let n := firing.choose - have timeout := firing.choose_spec.2 - apply neverOpen (n + 1) - rw [execution.step_succ n, timeout] - exact aligned_timeout_transitions_to_open config _ (alignedAlways n) - -end DisasterRecovery.Proofs.Temporal \ No newline at end of file +end DisasterRecovery.Proofs.Model \ No newline at end of file diff --git a/lean/disaster-recovery/DisasterRecovery/Properties.lean b/lean/disaster-recovery/DisasterRecovery/Properties.lean index e83ad5803454..90fc5c171970 100644 --- a/lean/disaster-recovery/DisasterRecovery/Properties.lean +++ b/lean/disaster-recovery/DisasterRecovery/Properties.lean @@ -1,4 +1,7 @@ -import DisasterRecovery.Proofs.GlobalTemporal +import DisasterRecovery.Proofs.Committed +import DisasterRecovery.Proofs.Invariants +import DisasterRecovery.Proofs.Model +import DisasterRecovery.Proofs.Quorum /-! # Human-reviewed system properties @@ -13,9 +16,9 @@ namespace DisasterRecovery.Properties section Local -open Protocol.Model Protocol.Temporal +open Protocol.Model -/-! ## Local safety and progress -/ +/-! ## Local safety -/ theorem gossip_freezes_after_choice (config : Config) @@ -25,7 +28,7 @@ theorem gossip_freezes_after_choice (chosen : state.chosen.isSome = true) : let output := step config state (.receiveGossip source txid .accepted) output.state = state /\ output.accepted = false := - Proofs.Temporal.gossip_freezes_after_choice config state source txid chosen + Proofs.Model.gossip_freezes_after_choice config state source txid chosen theorem rejected_gossip_stutters (config : Config) @@ -34,7 +37,7 @@ theorem rejected_gossip_stutters (txid : TxID) : let output := step config state (.receiveGossip source txid .rejected) output.state = state /\ output.accepted = false := - Proofs.Temporal.rejected_gossip_stutters config state source txid + Proofs.Model.rejected_gossip_stutters config state source txid theorem quorum_advance_opens (config : Config) @@ -45,7 +48,7 @@ theorem quorum_advance_opens output.state.phase = .opening /\ output.state.openKind = some .quorum /\ output.effects = [.opening .quorum] := - Proofs.Temporal.quorum_advance_opens config state phase quorum + Proofs.Model.quorum_advance_opens config state phase quorum theorem aligned_opening_timeout_completes (config : Config) @@ -59,25 +62,14 @@ theorem aligned_opening_timeout_completes output.state.phase = .open /\ output.state.timeoutState = .opening /\ output.effects = [.completed] := - Proofs.Temporal.aligned_opening_timeout_completes config state - -theorem fair_aligned_opening_progress - {config : Config} - (execution : Execution config) - (initial : AlignedOpening (execution.states 0)) - (fair : WeakFairness execution AlignedOpening - (fun _ event => event = .timeout)) : - EventuallyFrom 0 - (fun n => (execution.states n).phase = .open) := - Proofs.Temporal.fair_aligned_opening_progress execution initial fair + Proofs.Model.aligned_opening_timeout_completes config state end Local section Global open Protocol.Model hiding Config -open Protocol.Global Protocol.Invariants Protocol.Quorum Protocol.Committed Protocol.GlobalTemporal -open Protocol.Temporal (EventuallyFrom) +open Protocol.Global Protocol.Invariants Protocol.Quorum Protocol.Committed /-! ## Reachability and quorum safety -/ @@ -118,7 +110,7 @@ theorem full_gossip_selection_preserves_commit (durable : DurableCommit config committed) : exists recovered, recoveredTxID config opener = some recovered /\ - TxID.PrefixOf committed recovered := + TxID.EarlierThan committed recovered := Proofs.Committed.full_gossip_selection_preserves_commit reachable full durable @@ -133,87 +125,10 @@ theorem quorum_open_preserves_commit (durable : DurableCommit config committed) : exists recovered, recoveredTxID config opener = some recovered /\ - TxID.PrefixOf committed recovered := + TxID.EarlierThan committed recovered := Proofs.Committed.quorum_open_preserves_commit reachable opened full durable -/-! ## Conditional global progress -/ - -theorem fair_opening_completes - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - {start : Nat} - {node : Location} - (active : node ∈ (execution.states start).active) - (phase : HasPhase (execution.states start) node .opening) : - EventuallyFrom start (fun n => - CompletedOpen (execution.states n) node) := - Proofs.GlobalTemporal.fair_opening_completes - execution initial fair active phase - -theorem fair_some_opener_completes - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (activeNonempty : (execution.states 0).active ≠ []) : - EventuallyFrom 0 (fun n => - exists node, CompletedOpen (execution.states n) node) := - Proofs.GlobalTemporal.fair_some_opener_completes - execution initial fair activeNonempty - -theorem global_progress - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - (activeNonempty : (execution.states 0).active ≠ []) : - EventuallyFrom 0 (fun n => - exists node, CompletedOpen (execution.states n) node) /\ - EventuallyFrom 0 (fun n => - forall node, node ∈ (execution.states 0).active -> - Terminal (execution.states n) node) := - Proofs.GlobalTemporal.global_progress - execution initial fair broadcast activeNonempty - -theorem single_completion_path_joins_others - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener : Location} - (completed : CompletedOpen (execution.states start) opener) - (onlyOpener : OnlyOpenerCompletesFrom execution start opener) : - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - node = opener \/ node ∈ (execution.states n).restarts) := - Proofs.GlobalTemporal.single_completion_path_joins_others - execution initial fair broadcast completed onlyOpener - -theorem quorum_path_progress - {config : Config} - (execution : Execution config) - (initial : Reachable config (execution.states 0)) - (fair : Fair execution) - (broadcast : BroadcastBeforeCompletion execution) - {start : Nat} - {opener : Location} - (opened : QuorumOpened (execution.states start) opener) - (completed : CompletedOpen (execution.states start) opener) - (quorumOnly : QuorumOnlyCompletions execution) : - QuorumOpened (execution.states start) opener /\ - CompletedOpen (execution.states start) opener /\ - EventuallyFrom start (fun n => - forall node, node ∈ (execution.states start).active -> - node = opener \/ node ∈ (execution.states n).restarts) := - Proofs.GlobalTemporal.quorum_path_progress - execution initial fair broadcast opened completed quorumOnly - end Global end DisasterRecovery.Properties diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean index c44e559ef6b4..11ce44bd732b 100644 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean +++ b/lean/disaster-recovery/DisasterRecovery/Protocol/Committed.lean @@ -9,7 +9,7 @@ open Global namespace TxID -def PrefixOf (left right : TxID) : Prop := +def EarlierThan (left right : TxID) : Prop := left.view < right.view \/ (left.view = right.view /\ left.seqno <= right.seqno) @@ -30,6 +30,6 @@ def FullGossipSelection def DurableCommit (config : Config) (committed : TxID) : Prop := exists location txid, (location, txid) ∈ config.recovered /\ - TxID.PrefixOf committed txid + TxID.EarlierThan committed txid end DisasterRecovery.Protocol.Committed diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean deleted file mode 100644 index 6977d6833d53..000000000000 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/GlobalTemporal.lean +++ /dev/null @@ -1,184 +0,0 @@ -import DisasterRecovery.Protocol.Committed -import DisasterRecovery.Protocol.Temporal - -/-! Human-reviewed global execution, termination and fairness assumptions. -/ - -namespace DisasterRecovery.Protocol.GlobalTemporal - -open Model hiding Config -open Global Quorum -open Temporal (EventuallyFrom) - -structure Execution (config : Config) where - states : Nat -> State - actions : Nat -> Action - step_succ : forall n, - next config (states n) (actions n) = some (states (n + 1)) - -def HasPhase (state : State) (node : Location) (phase : Phase) : Prop := - exists nodeState, - Global.nodeState state node = some nodeState /\ - nodeState.phase = phase - -def HasGossip (state : State) (node : Location) : Prop := - exists nodeState, - Global.nodeState state node = some nodeState /\ - nodeState.gossips ≠ [] - -def HasVote (state : State) (node : Location) : Prop := - exists nodeState, - Global.nodeState state node = some nodeState /\ - nodeState.votes ≠ [] - -def LaneAdvanced (state : State) (node : Location) : Prop := - exists nodeState, - Global.nodeState state node = some nodeState /\ - nodeState.timeoutState ≠ .gossiping - -def Terminal (state : State) (node : Location) : Prop := - node ∈ state.restarts \/ node ∈ state.completed - -def CompletedOpen (state : State) (node : Location) : Prop := - node ∈ state.completed - -def AnnouncementsLive (state : State) : Prop := - forall envelope, envelope ∈ state.sent -> - envelope.payload = .iAmOpen -> - HasPhase state envelope.source .opening \/ - CompletedOpen state envelope.source - -def SentAnnouncementTo (state : State) (target : Location) : Prop := - exists envelope, - envelope ∈ state.sent /\ - envelope.target = target /\ - envelope.payload = .iAmOpen - -def JoiningAnnouncements (state : State) : Prop := - forall entry, entry ∈ state.system.nodes -> - entry.2.phase = .joining -> - SentAnnouncementTo state entry.1 - -def OpenCompleted (state : State) : Prop := - forall entry, entry ∈ state.system.nodes -> - entry.2.phase = .open -> - CompletedOpen state entry.1 - -def AdvancedNodesActive (state : State) : Prop := - forall entry, entry ∈ state.system.nodes -> - entry.2.phase ≠ .gossiping -> - entry.1 ∈ state.active - -def OpenerWitness (state : State) : Prop := - exists node, - HasPhase state node .opening \/ - CompletedOpen state node - -def OnlyOpenerCompletesFrom - {config : Config} - (execution : Execution config) - (start : Nat) - (opener : Location) : Prop := - forall n node, - start <= n -> - CompletedOpen (execution.states n) node -> - node = opener - -def QuorumOnlyCompletions - {config : Config} - (execution : Execution config) : Prop := - forall n node, - CompletedOpen (execution.states n) node -> - QuorumOpened (execution.states n) node - -def SentAnnouncement - (state : State) - (source target : Location) : Prop := - exists envelope, - envelope ∈ state.sent /\ - envelope.source = source /\ - envelope.target = target /\ - envelope.payload = .iAmOpen - -def BroadcastBeforeCompletion - {config : Config} - (execution : Execution config) : Prop := - forall n opener, - CompletedOpen (execution.states n) opener -> - forall target, target ∈ (execution.states n).active -> - target ≠ opener -> - SentAnnouncement (execution.states n) opener target - -def AnnouncementsResolved (state : State) : Prop := - forall envelope, envelope ∈ state.sent -> - envelope.payload = .iAmOpen -> - envelope ∈ state.network \/ - Terminal state envelope.target \/ - HasPhase state envelope.target .opening - -def Enabled (config : Config) (state : State) (action : Action) : Prop := - exists nextState, next config state action = some nextState - -def LaneValid (state : NodeState) : Prop := - (state.phase = .gossiping -> - state.timeoutState = .gossiping) /\ - (state.phase = .voting -> - state.timeoutState = .gossiping \/ - state.timeoutState = .voting) /\ - (state.phase = .opening -> - state.timeoutState = .gossiping \/ - state.timeoutState = .voting \/ - state.timeoutState = .opening) /\ - (state.phase = .gossiping -> - state.chosen = none) - -def NodeLanesValid (state : State) : Prop := - forall entry, entry ∈ state.system.nodes -> - LaneValid entry.2 - -structure Fair - {config : Config} - (execution : Execution config) : Prop where - retry : - forall start node phase, - node ∈ (execution.states start).active -> - HasPhase (execution.states start) node phase -> - (phase = .gossiping \/ phase = .voting \/ phase = .opening) -> - Enabled config (execution.states start) (.retry node) -> - EventuallyFrom start (fun n => - Not (HasPhase (execution.states n) node phase) \/ - execution.actions n = .retry node) - delivery : - forall start envelope, - envelope ∈ (execution.states start).network -> - EventuallyFrom start (fun n => - execution.actions n = .deliver envelope) - timeout : - forall start node phase, - node ∈ (execution.states start).active -> - HasPhase (execution.states start) node phase -> - (phase = .gossiping \/ phase = .voting \/ phase = .opening) -> - Enabled config (execution.states start) (.timeout node) -> - EventuallyFrom start (fun n => - Not (HasPhase (execution.states n) node phase) \/ - execution.actions n = .timeout node) - openingTimeout : - forall start node, - node ∈ (execution.states start).active -> - HasPhase (execution.states start) node .opening -> - Enabled config (execution.states start) (.timeout node) -> - EventuallyFrom start (fun n => - CompletedOpen (execution.states n) node \/ - (HasPhase (execution.states n) node .opening /\ - execution.actions n = .timeout node)) - -def acceptedIAmOpenSource : Event -> Option Location - | .receiveIAmOpen source .accepted => some source - | _ => none - -def openingDistance : Phase -> Nat - | .gossiping => 3 - | .voting => 2 - | .opening => 1 - | .joining | .open => 0 - -end DisasterRecovery.Protocol.GlobalTemporal diff --git a/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean b/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean deleted file mode 100644 index b1bcf5e7d4b0..000000000000 --- a/lean/disaster-recovery/DisasterRecovery/Protocol/Temporal.lean +++ /dev/null @@ -1,49 +0,0 @@ -import DisasterRecovery.Protocol.Model - -/-! Human-reviewed local execution and fairness definitions. -/ - -namespace DisasterRecovery.Protocol.Temporal - -open Model - -def EventuallyFrom (start : Nat) (predicate : Nat -> Prop) : Prop := - exists n, start <= n /\ predicate n - -def AlwaysFrom (start : Nat) (predicate : Nat -> Prop) : Prop := - forall n, start <= n -> predicate n - -def InfinitelyOften (predicate : Nat -> Prop) : Prop := - forall start, EventuallyFrom start predicate - -def EventuallyAlways (predicate : Nat -> Prop) : Prop := - exists start, AlwaysFrom start predicate - -structure Execution (config : Config) where - states : Nat -> NodeState - events : Nat -> Event - step_succ : forall n, - states (n + 1) = (step config (states n) (events n)).state - -def WeakFairness - {config : Config} - (execution : Execution config) - (enabled : NodeState -> Prop) - (fired : NodeState -> Event -> Prop) : Prop := - forall start, - AlwaysFrom start (fun n => enabled (execution.states n)) -> - EventuallyFrom start - (fun n => fired (execution.states n) (execution.events n)) - -def StrongFairness - {config : Config} - (execution : Execution config) - (enabled : NodeState -> Prop) - (fired : NodeState -> Event -> Prop) : Prop := - InfinitelyOften (fun n => enabled (execution.states n)) -> - InfinitelyOften - (fun n => fired (execution.states n) (execution.events n)) - -def AlignedOpening (state : NodeState) : Prop := - state.phase = .opening /\ state.timeoutState = .opening - -end DisasterRecovery.Protocol.Temporal diff --git a/lean/disaster-recovery/README.md b/lean/disaster-recovery/README.md index e62124a0c584..c6dc5b382d25 100644 --- a/lean/disaster-recovery/README.md +++ b/lean/disaster-recovery/README.md @@ -1,8 +1,8 @@ # Lean disaster recovery model This package contains the canonical Lean model of CCF's C++ recovery decision -protocol and its permanent safety and liveness proofs. It is pinned to Lean -4.33.1 and Mathlib `v4.33.1`. +protocol and its permanent safety proofs. It is pinned to Lean 4.33.1 and +Mathlib `v4.33.1`. ## Model @@ -29,14 +29,14 @@ does not formalize or prove the cryptography that produces that result. ## Review guide -Start with `DisasterRecovery/Properties.lean`: it exposes 15 system-level +Start with `DisasterRecovery/Properties.lean`: it exposes 9 system-level `theorem` statements, each with an explicit application of its checked proof. Review those statements and every definition or assumption they use in `DisasterRecovery/Protocol/`. Machine checking does not establish that the model matches the C++ implementation or that its assumptions describe a real deployment. -The 233 supporting declarations are `lemma`s in +The 124 supporting declarations are `lemma`s in `DisasterRecovery/Proofs/`. Their implementations can normally be omitted from line-by-line human review once the build and axiom audit pass. Mathlib's `lemma` is a synonym for `theorem`, not a weaker form of checking. The public @@ -45,13 +45,13 @@ specifications. Declaration namespaces follow the module paths. Model definitions live under `DisasterRecovery.Protocol.`, supporting lemmas under -`DisasterRecovery.Proofs.`, and the 15 reviewed theorems under +`DisasterRecovery.Proofs.`, and the 9 reviewed theorems under `DisasterRecovery.Properties`. For example, `DisasterRecovery.Properties.gossip_freezes_after_choice` explicitly applies -`DisasterRecovery.Proofs.Temporal.gossip_freezes_after_choice` from -`DisasterRecovery/Proofs/Temporal.lean`. Local and global properties share the -`DisasterRecovery.Properties` namespace; their `Config` and `Execution` types -come from the corresponding protocol modules. +`DisasterRecovery.Proofs.Model.gossip_freezes_after_choice` from +`DisasterRecovery/Proofs/Model.lean`. Local and global properties share the +`DisasterRecovery.Properties` namespace; their `Config` types come from the +corresponding protocol modules. Only the Lean files under `DisasterRecovery/Proofs/` are marked `linguist-generated` in the repository's `.gitattributes`, so GitHub can collapse @@ -62,8 +62,7 @@ and the CI workflow are part of that review surface. ## Proof coverage and limits -`DisasterRecovery.Proofs.Temporal` proves local safety properties and -Opening-to-Open progress under weak timeout fairness. +`DisasterRecovery.Proofs.Model` proves local transition-safety properties. `DisasterRecovery.Proofs.Invariants` proves global well-formedness, message provenance, locality of transitions, append-only send history, and @@ -71,8 +70,8 @@ monotonic terminal histories for reachable states. `DisasterRecovery.Proofs.Quorum` proves that votes are unique and backed by prior sends, strict-majority quorums intersect, and any two quorum openings in -a reachable execution select the same opener. This safety result does not -require fairness. +a reachable execution select the same opener. This safety result is independent +of scheduling assumptions. `DisasterRecovery.Proofs.Committed` proves TxID maximum properties and committed-prefix preservation under two explicit premises: @@ -86,36 +85,22 @@ A quorum opening alone does not imply `FullGossipSelection`, because voting may begin after a gossip timeout. The committed-prefix result deliberately does not derive or hide either durability or full-gossip evidence. -`DisasterRecovery.Proofs.GlobalTemporal` proves conditional global progress. -Its theorems assume the relevant retry, message-delivery, and timeout fairness -premises. Progress for every active node additionally requires -`BroadcastBeforeCompletion`: an opener must send its `IAmOpen` announcement to -every other active node before it completes. Ordinary weak fairness does not -order actions that are enabled only for a finite interval, so this broadcast -ordering is a separate premise. The proofs do not construct a scheduler that -satisfies the fairness and broadcast-before-completion premises. - -The `global_progress` property also requires a reachable initial state and a -nonempty active set. Its terminal outcome means completion or a requested -joining restart. The stronger statements that all other nodes request a restart -retain their explicit `OnlyOpenerCompletesFrom` or `QuorumOnlyCompletions` -premises; they do not rule out failover completions without such a premise. +Liveness, fairness, progress, and termination properties are out of scope at +this stage. ## Files -| File | Review role | Purpose | -| ----------------------------------------------- | --------------- | ---------------------------------------------------- | -| `DisasterRecovery/Properties.lean` | Human | Selected system properties and checked proof links | -| `DisasterRecovery/Protocol/Model.lean` | Human | C++-aligned local transition model | -| `DisasterRecovery/Protocol/Global.lean` | Human | Distributed transitions and reachability | -| `DisasterRecovery/Protocol/Temporal.lean` | Human | Local execution and fairness definitions | -| `DisasterRecovery/Protocol/Invariants.lean` | Human | Well-formedness and message-provenance predicates | -| `DisasterRecovery/Protocol/Quorum.lean` | Human | Vote and quorum-opening predicates | -| `DisasterRecovery/Protocol/Committed.lean` | Human | Prefix ordering, durability and full-gossip premises | -| `DisasterRecovery/Protocol/GlobalTemporal.lean` | Human | Global execution, fairness and termination premises | -| `DisasterRecovery/Proofs/*.lean` | Machine-checked | Supporting lemmas and proof implementations | -| `DisasterRecovery.lean` | Human | Complete library import and audit root | -| `CanonicalTests.lean` | Human | Executable canonical behavior checks | +| File | Review role | Purpose | +| ------------------------------------------- | --------------- | ---------------------------------------------------- | +| `DisasterRecovery/Properties.lean` | Human | Selected system properties and checked proof links | +| `DisasterRecovery/Protocol/Model.lean` | Human | C++-aligned local transition model | +| `DisasterRecovery/Protocol/Global.lean` | Human | Distributed transitions and reachability | +| `DisasterRecovery/Protocol/Invariants.lean` | Human | Well-formedness and message-provenance predicates | +| `DisasterRecovery/Protocol/Quorum.lean` | Human | Vote and quorum-opening predicates | +| `DisasterRecovery/Protocol/Committed.lean` | Human | Prefix ordering, durability and full-gossip premises | +| `DisasterRecovery/Proofs/*.lean` | Machine-checked | Supporting lemmas and proof implementations | +| `DisasterRecovery.lean` | Human | Complete library import and audit root | +| `CanonicalTests.lean` | Human | Executable canonical behavior checks | ## Validation From 971644a3688c2739deb639c782f09ea09ce87e2b Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:56:08 +0100 Subject: [PATCH 15/35] Add temporary legacy Lean migration package Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- lean/disaster-recovery-migration/.gitignore | 2 + .../AxiomChecks.lean | 24 ++ .../DisasterRecoveryMigration.lean | 3 + .../Legacy/Checker.lean | 152 +++++++ .../Legacy/Model.lean | 392 ++++++++++++++++++ lean/disaster-recovery-migration/Main.lean | 23 + lean/disaster-recovery-migration/Tests.lean | 72 ++++ .../lake-manifest.json | 102 +++++ .../disaster-recovery-migration/lakefile.toml | 24 ++ .../lean-toolchain | 2 + 10 files changed, 796 insertions(+) create mode 100644 lean/disaster-recovery-migration/.gitignore create mode 100644 lean/disaster-recovery-migration/AxiomChecks.lean create mode 100644 lean/disaster-recovery-migration/DisasterRecoveryMigration.lean create mode 100644 lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Checker.lean create mode 100644 lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Model.lean create mode 100644 lean/disaster-recovery-migration/Main.lean create mode 100644 lean/disaster-recovery-migration/Tests.lean create mode 100644 lean/disaster-recovery-migration/lake-manifest.json create mode 100644 lean/disaster-recovery-migration/lakefile.toml create mode 100644 lean/disaster-recovery-migration/lean-toolchain diff --git a/lean/disaster-recovery-migration/.gitignore b/lean/disaster-recovery-migration/.gitignore new file mode 100644 index 000000000000..6726f2f29a8f --- /dev/null +++ b/lean/disaster-recovery-migration/.gitignore @@ -0,0 +1,2 @@ +/.lake/ + diff --git a/lean/disaster-recovery-migration/AxiomChecks.lean b/lean/disaster-recovery-migration/AxiomChecks.lean new file mode 100644 index 000000000000..43c60eb3dc9b --- /dev/null +++ b/lean/disaster-recovery-migration/AxiomChecks.lean @@ -0,0 +1,24 @@ +import DisasterRecovery +import DisasterRecoveryMigration +import Lean.Elab.Command +import Lean.Util.CollectAxioms + +open Lean Elab Command + +elab "#assert_no_migration_sorries" : command => do + let env <- getEnv + let mut offenders : Array Name := #[] + for (name, _) in env.constants.toList do + if name.toString.startsWith "DisasterRecoveryMigration" || + name.toString.startsWith "DisasterRecovery" then + let axioms <- liftCoreM <| Lean.collectAxioms name + if axioms.contains (Name.mkSimple "sorryAx") then + offenders := offenders.push name + unless offenders.isEmpty do + throwError "declarations contain sorryAx: {offenders}" + +#assert_no_migration_sorries + +def main : IO Unit := + pure () + diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean new file mode 100644 index 000000000000..53c5d03c3733 --- /dev/null +++ b/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean @@ -0,0 +1,3 @@ +import DisasterRecoveryMigration.Legacy.Model +import DisasterRecoveryMigration.Legacy.Checker + diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Checker.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Checker.lean new file mode 100644 index 000000000000..659daef03546 --- /dev/null +++ b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Checker.lean @@ -0,0 +1,152 @@ +import DisasterRecoveryMigration.Legacy.Model + +namespace DisasterRecoveryMigration.Legacy + +structure Edge where + src : Nat + action : Action + dst : Nat +deriving Repr, BEq + +structure Graph where + states : Array GlobalState + edges : Array Edge + parents : Array (Option (Prod Nat Action)) + +def enumerate (n : Nat) : IO Graph := do + let initial := initialState n + let mut states := #[initial] + let mut edges := #[] + let mut parents : Array (Option (Prod Nat Action)) := #[none] + let mut seen : Std.HashMap String Nat := {} + seen := seen.insert (stateKey initial) 0 + let mut cursor := 0 + while cursor < states.size do + let state := states[cursor]! + for action in actions state do + match nextState n state action with + | none => pure () + | some next => + let key := stateKey next + let (dst, discovered) := + match seen[key]? with + | some index => (index, false) + | none => (states.size, true) + if discovered then + seen := seen.insert key dst + states := states.push next + parents := parents.push (some (cursor, action)) + edges := edges.push { src := cursor, action, dst } + cursor := cursor + 1 + pure { states, edges, parents } + +def valuationBits (values : Array Bool) : String := + String.ofList (values.toList.map fun value => if value then '1' else '0') + +private structure ExportEdge where + src : Nat + action : String + dst : Nat + +private def exportEdgeLE (left right : ExportEdge) : Bool := + left.src < right.src || + (left.src == right.src && + (left.action < right.action || + (left.action == right.action && left.dst <= right.dst))) + +private def traceTo (graph : Graph) (target : Nat) : List Action := + let rec collect (index : Nat) (fuel : Nat) (suffix : List Action) : List Action := + match fuel with + | 0 => suffix + | fuel + 1 => + match graph.parents[index]? |>.bind id with + | none => suffix + | some (parent, action) => collect parent fuel (action :: suffix) + collect target graph.states.size [] + +private def printTrace (graph : Graph) (target : Nat) : IO Unit := do + let trace := traceTo graph target + if trace.isEmpty then + IO.eprintln " trace: " + else + for (action, step) in trace.zipIdx do + IO.eprintln s!" {step + 1}. {actionKey action}" + +private def eventuallyGood (graph : Graph) (property : Nat) : Array Bool := + Id.run do + let mut good := + graph.states.map fun state => (legacyValuations state.actors.size state)[property]! + let mut remaining := Array.replicate graph.states.size 0 + let mut predecessors : Array (List Nat) := Array.replicate graph.states.size [] + for edge in graph.edges do + remaining := remaining.modify edge.src (fun count => count + 1) + predecessors := predecessors.modify edge.dst (fun values => edge.src :: values) + let mut queue := #[] + for index in List.range good.size do + if good[index]! then queue := queue.push index + let mut cursor := 0 + while cursor < queue.size do + let resolved := queue[cursor]! + for predecessor in predecessors[resolved]! do + if !good[predecessor]! then + remaining := remaining.modify predecessor (fun count => count - 1) + if remaining[predecessor]! == 0 then + good := good.set! predecessor true + queue := queue.push predecessor + cursor := cursor + 1 + return good + +def checkGraph (n : Nat) (graph : Graph) : IO Bool := do + IO.eprintln s!"reachable states: {graph.states.size}, transitions: {graph.edges.size}" + let mut passed := true + for property in List.range legacyPropertyNames.size do + let name := legacyPropertyNames[property]! + let expectation := legacyExpectations[property]! + let values := graph.states.map fun state => (legacyValuations n state)[property]! + let eventual := if expectation == "eventually" then eventuallyGood graph property else #[] + let result := + if expectation == "always" then values.all id + else if expectation == "sometimes" then values.any id + else eventual[0]! + IO.eprintln s!"{if result then "PASS" else "FAIL"} [{expectation}] {name}" + if result && expectation == "sometimes" then + match (List.range values.size).find? (fun index => values[index]!) with + | none => pure () + | some index => + IO.eprintln " shortest example:" + printTrace graph index + else if !result then + passed := false + let witness := + if expectation == "always" then + (List.range values.size).find? fun index => !values[index]! + else if expectation == "sometimes" then + some 0 + else + (List.range values.size).find? fun index => + !eventual[index]! + match witness with + | none => IO.eprintln " no reachable example" + | some index => printTrace graph index + pure passed + +def exportGraph (n : Nat) (graph : Graph) : IO Unit := do + let canonical := (graph.states.toList.zipIdx.map fun (state, bfsId) => + (stateKey state, bfsId)).mergeSort (fun left right => left.1 <= right.1) + let mut ids := Array.replicate graph.states.size 0 + for ((_, bfsId), canonicalId) in canonical.zipIdx do + ids := ids.set! bfsId canonicalId + IO.println "format\tccf-legacy-dr-graph-v1" + IO.println s!"nodes\t{n}" + IO.println s!"init\t{ids[0]!}" + for ((key, bfsId), canonicalId) in canonical.zipIdx do + IO.println s!"state\t{canonicalId}\t{key}\t{valuationBits (legacyValuations n graph.states[bfsId]!)}" + let canonicalEdges := (graph.edges.toList.map fun edge => { + src := ids[edge.src]! + action := actionKey edge.action + dst := ids[edge.dst]! + }).mergeSort exportEdgeLE + for edge in canonicalEdges do + IO.println s!"edge\t{edge.src}\t{edge.action}\t{edge.dst}" + +end DisasterRecoveryMigration.Legacy diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Model.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Model.lean new file mode 100644 index 000000000000..91000ae2f1b5 --- /dev/null +++ b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Model.lean @@ -0,0 +1,392 @@ +import Std + +namespace DisasterRecoveryMigration.Legacy + +abbrev Id := Nat +abbrev Txid := Nat + +structure Gossip where + src : Id + txid : Txid +deriving Repr, BEq, Hashable + +structure Vote where + src : Id + recv : List Gossip +deriving Repr, BEq, Hashable + +inductive Msg where + | gossip (value : Gossip) + | vote (value : Vote) + | iAmOpen (src : Id) +deriving Repr, BEq, Hashable + +inductive Phase where + | vote + | openJoin + | open (timeout : Bool) + | join +deriving Repr, BEq, Hashable, Inhabited + +structure ActorState where + nextStep : Phase + gossips : List Gossip + votes : List Vote + submittedVote : Option (Prod Id Vote) + txid : Txid +deriving Repr, BEq, Hashable, Inhabited + +structure Envelope where + src : Id + dst : Id + msg : Msg +deriving Repr, BEq, Hashable + +structure GlobalState where + actors : Array ActorState + timers : Array Bool + network : List Envelope +deriving Repr, BEq, Hashable, Inhabited + +inductive Action where + | deliver (envelope : Envelope) + | timeout (id : Id) +deriving Repr, BEq, Hashable + +structure Output where + sent : List (Prod Id Msg) := [] + setTimer : Bool := false +deriving Repr, BEq + +private def comma (values : List String) : String := + String.intercalate "," values + +def gossipKey (gossip : Gossip) : String := + s!"g({gossip.src},{gossip.txid})" + +def voteKey (vote : Vote) : String := + s!"v({vote.src},[{comma (vote.recv.map gossipKey)}])" + +def msgKey : Msg -> String + | .gossip gossip => gossipKey gossip + | .vote vote => voteKey vote + | .iAmOpen src => s!"o({src})" + +def envelopeKey (envelope : Envelope) : String := + s!"e({envelope.src},{envelope.dst},{msgKey envelope.msg})" + +def phaseKey : Phase -> String + | .vote => "vote" + | .openJoin => "openjoin" + | .open false => "open0" + | .open true => "open1" + | .join => "join" + +def submittedKey : Option (Prod Id Vote) -> String + | none => "none" + | some (dst, vote) => s!"some({dst},{voteKey vote})" + +def actorKey (actor : ActorState) : String := + s!"s({phaseKey actor.nextStep},[{comma (actor.gossips.map gossipKey)}],[{comma (actor.votes.map voteKey)}],{submittedKey actor.submittedVote},{actor.txid})" + +private def networkRunsFrom (current : Envelope) (count : Nat) : + List Envelope -> List (Prod Envelope Nat) + | [] => [(current, count)] + | head :: tail => + if head == current then + networkRunsFrom current (count + 1) tail + else + (current, count) :: networkRunsFrom head 1 tail + +private def networkRuns : List Envelope -> List (Prod Envelope Nat) + | [] => [] + | head :: tail => networkRunsFrom head 1 tail + +def stateKey (state : GlobalState) : String := + let actors := String.intercalate ";" (state.actors.toList.map actorKey) + let timers := comma (((List.range state.timers.size).filter + (fun id => state.timers[id]!)).map toString) + let network := comma ((networkRuns state.network).map fun (env, count) => + s!"{envelopeKey env}#{count}") + s!"S([{actors}],[{timers}],[{network}])" + +def actionKey : Action -> String + | .deliver env => s!"deliver({env.src},{env.dst},{msgKey env.msg})" + | .timeout id => s!"timeout({id},election)" + +private def insertSorted (before : a -> a -> Bool) (value : a) : List a -> List a + | [] => [value] + | head :: tail => + if before value head then + value :: head :: tail + else + head :: insertSorted before value tail + +private def insertUniqueSorted [BEq a] (before : a -> a -> Bool) (value : a) (values : List a) : + List a := + if values.contains value then values else insertSorted before value values + +private def removeOne [BEq a] (value : a) : List a -> List a + | [] => [] + | head :: tail => if head == value then tail else head :: removeOne value tail + +private def gossipGreater (left right : Gossip) : Bool := + right.txid < left.txid || (right.txid == left.txid && right.src < left.src) + +private def gossipBefore (left right : Gossip) : Bool := + left.src < right.src || (left.src == right.src && left.txid < right.txid) + +private def gossipListBefore : List Gossip -> List Gossip -> Bool + | [], [] => false + | [], _ :: _ => true + | _ :: _, [] => false + | left :: leftTail, right :: rightTail => + if left == right then gossipListBefore leftTail rightTail + else gossipBefore left right + +private def voteBefore (left right : Vote) : Bool := + left.src < right.src || (left.src == right.src && gossipListBefore left.recv right.recv) + +private def msgBefore : Msg -> Msg -> Bool + | .gossip left, .gossip right => gossipBefore left right + | .gossip _, _ => true + | .vote _, .gossip _ => false + | .vote left, .vote right => voteBefore left right + | .vote _, .iAmOpen _ => true + | .iAmOpen _, .gossip _ => false + | .iAmOpen _, .vote _ => false + | .iAmOpen left, .iAmOpen right => left < right + +private def envelopeBefore (left right : Envelope) : Bool := + left.src < right.src || + (left.src == right.src && + (left.dst < right.dst || (left.dst == right.dst && msgBefore left.msg right.msg))) + +private def maximumGossip : List Gossip -> Option Gossip + | [] => none + | head :: tail => + some (tail.foldl (fun current candidate => + if gossipGreater candidate current then candidate else current) head) + +private def voteForMax (gossips : List Gossip) (id : Id) : Option (Prod Id Vote) := do + let maximum <- maximumGossip gossips + pure (maximum.src, { src := id, recv := gossips }) + +private def otherPeers (n id : Nat) : List Id := + (List.range n).filter (fun peer => peer != id) + +private def advanceStep (n id : Nat) (timeout : Bool) (state : ActorState) : + Prod ActorState (Prod Output Bool) := + match state.nextStep with + | .vote => + if state.gossips.length == n || timeout then + match voteForMax state.gossips id with + | none => (state, {}, false) + | some (dst, vote) => + let next := { + state with + nextStep := .openJoin + submittedVote := some (dst, vote) + votes := if dst == id then insertUniqueSorted voteBefore vote state.votes else state.votes + } + let sent := if dst == id then [] else [(dst, Msg.vote vote)] + (next, { sent }, true) + else + (state, {}, false) + | .openJoin => + if state.votes.length >= (n + 1) / 2 || timeout then + let sent := (otherPeers n id).map (fun peer => (peer, Msg.iAmOpen id)) + ({ state with nextStep := .open timeout }, { sent }, true) + else + (state, {}, false) + | _ => (state, {}, false) + +def advanceSeveral (n id : Nat) (timeout : Bool) (state : ActorState) : + Prod ActorState Output := + let (state1, output1, advanced1) := advanceStep n id timeout state + if advanced1 then + let (state2, output2, _) := advanceStep n id timeout state1 + (state2, { sent := output1.sent ++ output2.sent }) + else + (state, {}) + +def onMessage (n id : Nat) (state : ActorState) (msg : Msg) : + Option (Prod ActorState Output) := + let received := + match msg with + | .gossip gossip => + if !state.gossips.contains gossip && state.submittedVote.isNone then + { state with gossips := insertUniqueSorted gossipBefore gossip state.gossips } + else + state + | .vote vote => + { state with votes := insertUniqueSorted voteBefore vote state.votes } + | .iAmOpen _ => + match state.nextStep with + | .open _ => state + | _ => { state with nextStep := .join } + let (next, output) := advanceSeveral n id false received + some (next, output) + +def onTimeout (n id : Nat) (state : ActorState) : Option (Prod ActorState Output) := + match state.nextStep with + | .vote => + if state.gossips.isEmpty then none + else + let (next, output) := advanceSeveral n id true state + some (next, { output with setTimer := true }) + | .openJoin => + if state.votes.isEmpty then none + else some (advanceSeveral n id true state) + | _ => none + +private def applyOutput (src : Id) (output : Output) (state : GlobalState) : GlobalState := + let network := output.sent.foldl + (fun current (dst, msg) => insertSorted envelopeBefore { src, dst, msg } current) + state.network + let timers := if output.setTimer then state.timers.set! src true else state.timers + { state with network, timers } + +private def startActor (n id : Nat) : Prod ActorState Output := + let gossip := { src := id, txid := id } + let initial : ActorState := { + nextStep := .vote + gossips := [gossip] + votes := [] + submittedVote := none + txid := id + } + let output : Output := { + sent := (otherPeers n id).map (fun peer => (peer, Msg.gossip gossip)) + setTimer := true + } + let (state, advanced) := advanceSeveral n id false initial + (state, { sent := output.sent ++ advanced.sent, setTimer := true }) + +def initialState (n : Nat) : GlobalState := + (List.range n).foldl (fun global id => + let (actor, output) := startActor n id + let withActor := { + global with + actors := global.actors.push actor + timers := global.timers.push false + } + applyOutput id output withActor) + { actors := #[], timers := #[], network := [] } + +private def distinctNetworkFrom (previous : Envelope) : List Envelope -> List Envelope + | [] => [] + | head :: tail => + if head == previous then + distinctNetworkFrom previous tail + else + head :: distinctNetworkFrom head tail + +private def distinctNetwork : List Envelope -> List Envelope + | [] => [] + | head :: tail => head :: distinctNetworkFrom head tail + +def actions (state : GlobalState) : List Action := + (distinctNetwork state.network).map Action.deliver ++ + ((List.range state.timers.size).filter + (fun id => state.timers[id]!)).map Action.timeout + +def nextState (n : Nat) (state : GlobalState) : Action -> Option GlobalState + | .deliver envelope => do + let actor <- state.actors[envelope.dst]? + let (nextActor, output) <- onMessage n envelope.dst actor envelope.msg + let delivered := { + state with + actors := state.actors.set! envelope.dst nextActor + network := removeOne envelope state.network + } + pure (applyOutput envelope.dst output delivered) + | .timeout id => do + guard (state.timers[id]?.getD false) + let actor <- state.actors[id]? + let (nextActor, output) <- onTimeout n id actor + let expired := { + state with + actors := state.actors.set! id nextActor + timers := state.timers.set! id false + } + pure (applyOutput id output expired) + +def reachedOpen (state : GlobalState) : Bool := + state.actors.any fun actor => + match actor.nextStep with + | .open _ => true + | _ => false + +def reachedOpenTimeout (state : GlobalState) (expected : Bool) : Bool := + state.actors.any fun actor => actor.nextStep == .open expected + +def unanimousVotes (n : Nat) (state : GlobalState) : Bool := + state.actors.all fun actor => + match actor.submittedVote with + | none => false + | some (_, vote) => + (List.range n).all fun peer => vote.recv.any (fun gossip => gossip.src == peer) + +def majorityHaveSameMaximum (state : GlobalState) : Bool := + let chosen := state.actors.toList.filterMap fun actor => do + let (_, vote) <- actor.submittedVote + let maximum <- maximumGossip vote.recv + pure maximum.src + let chosen := chosen.foldl (fun values id => + insertSorted (fun left right => left < right) id values) [] + let majorityIndex := state.actors.size / 2 + match chosen[majorityIndex]? with + | none => false + | some majority => (chosen.take majorityIndex).all (fun chosen => chosen == majority) + +private def implies (left right : Bool) : Bool := + !left || right + +def legacyValuations (n : Nat) (state : GlobalState) : Array Bool := + let openCount := state.actors.countP fun actor => + match actor.nextStep with + | .open _ => true + | _ => false + let allOpenJoin := state.actors.all (fun actor => actor.nextStep == .openJoin) + let allVotesDelivered := !state.network.any fun envelope => + match envelope.msg with + | .vote _ => true + | _ => false + let majorityIndex := state.actors.size / 2 + let commitTxid := (state.actors[majorityIndex]!).txid + let persisted := state.actors.all fun actor => + match actor.nextStep with + | .open _ => actor.txid >= commitTxid + | _ => true + #[ + implies (unanimousVotes n state) (reachedOpenTimeout state false), + reachedOpen state, + implies (majorityHaveSameMaximum state) (reachedOpenTimeout state false), + implies (!reachedOpenTimeout state true) (openCount <= 1), + !(allOpenJoin && allVotesDelivered), + implies (!reachedOpenTimeout state true) persisted, + implies (state.actors.size > 1) (reachedOpen state), + reachedOpenTimeout state true, + majorityHaveSameMaximum state && reachedOpenTimeout state false + ] + +def legacyPropertyNames : Array String := #[ + "Unanimous votes => no chance of a fork", + "Open", + "Majority votes => no fork", + "No open with timeout, no fork", + "Deadlock", + "Persist committed txs", + "Open is possible", + "Unsafe open with timeout", + "Majority vote still opens without timeout" +] + +def legacyExpectations : Array String := #[ + "eventually", "eventually", "eventually", + "always", "always", "always", + "sometimes", "sometimes", "sometimes" +] + +end DisasterRecoveryMigration.Legacy diff --git a/lean/disaster-recovery-migration/Main.lean b/lean/disaster-recovery-migration/Main.lean new file mode 100644 index 000000000000..c943598da3bc --- /dev/null +++ b/lean/disaster-recovery-migration/Main.lean @@ -0,0 +1,23 @@ +import DisasterRecoveryMigration.Legacy.Checker + +open DisasterRecoveryMigration.Legacy + +private def usage : String := + "usage: migration-model-checker [--nodes N]" + +private def parseNodes : List String -> Except String Nat + | [] => pure 3 + | ["--nodes", value] => + match value.toNat? with + | some n => if n > 0 then pure n else throw "--nodes must be positive" + | none => throw s!"invalid node count: {value}" + | _ => throw usage + +def main (args : List String) : IO UInt32 := do + match parseNodes args with + | .error message => + IO.eprintln message + pure 2 + | .ok n => + let graph <- enumerate n + if <- checkGraph n graph then pure 0 else pure 1 diff --git a/lean/disaster-recovery-migration/Tests.lean b/lean/disaster-recovery-migration/Tests.lean new file mode 100644 index 000000000000..1555b42e0972 --- /dev/null +++ b/lean/disaster-recovery-migration/Tests.lean @@ -0,0 +1,72 @@ +import DisasterRecoveryMigration.Legacy.Model + +open DisasterRecoveryMigration.Legacy + +private def expect (condition : Bool) (message : String) : IO Unit := + unless condition do throw (IO.userError message) + +private def deliverByKey (n : Nat) (state : GlobalState) (key : String) : Option GlobalState := do + let action <- (actions state).find? (fun action => actionKey action == key) + nextState n state action + +def main : IO UInt32 := do + let single := initialState 1 + expect (single.actors[0]!.nextStep == .open false) + "single node did not open immediately without timeout" + + let initial3 := initialState 3 + let timed <- match nextState 3 initial3 (.timeout 0) with + | some state => pure state + | none => throw (IO.userError "node 0 timeout was suppressed") + expect (timed.actors[0]!.nextStep == .open true) + "timeout did not drive vote and open-join closure to timeout-open" + + let opened := timed.actors[0]! + let lateGossip : Gossip := { src := 2, txid := 2 } + let frozen <- match onMessage 3 0 opened (.gossip lateGossip) with + | some result => pure result + | none => throw (IO.userError "message callback was unexpectedly suppressed") + expect (frozen.1.gossips == opened.gossips) + "gossip collection changed after the vote was submitted" + + let joinActor : ActorState := { + nextStep := .openJoin + gossips := [{ src := 1, txid := 1 }] + votes := [] + submittedVote := none + txid := 1 + } + let joined <- match onMessage 3 1 joinActor (.iAmOpen 0) with + | some result => pure result + | none => throw (IO.userError "IAmOpen was suppressed") + expect (joined.1.nextStep == .join) "IAmOpen did not cause Join" + + let firstOrder <- match deliverByKey 3 initial3 "deliver(1,0,g(1,1))" with + | some state => pure state + | none => throw (IO.userError "first unordered delivery failed") + let firstOrder <- match deliverByKey 3 firstOrder "deliver(2,0,g(2,2))" with + | some state => pure state + | none => throw (IO.userError "second unordered delivery failed") + let secondOrder <- match deliverByKey 3 initial3 "deliver(2,0,g(2,2))" with + | some state => pure state + | none => throw (IO.userError "reverse first unordered delivery failed") + let secondOrder <- match deliverByKey 3 secondOrder "deliver(1,0,g(1,1))" with + | some state => pure state + | none => throw (IO.userError "reverse second unordered delivery failed") + expect (firstOrder == secondOrder) "unordered deliveries produced different states" + + let duplicate : Envelope := { src := 1, dst := 0, msg := .gossip { src := 1, txid := 1 } } + let duplicated := { initial3 with network := duplicate :: duplicate :: initial3.network } + let once <- match nextState 3 duplicated (.deliver duplicate) with + | some state => pure state + | none => throw (IO.userError "first duplicate delivery was suppressed") + expect (once.network.count duplicate + 1 == duplicated.network.count duplicate) + "delivery did not remove exactly one duplicate" + let twice <- match nextState 3 once (.deliver duplicate) with + | some state => pure state + | none => throw (IO.userError "second duplicate delivery was suppressed") + expect (twice.network.count duplicate + 1 == once.network.count duplicate) + "second delivery did not remove exactly one duplicate" + + IO.println "all Lean semantic checks passed" + pure 0 diff --git a/lean/disaster-recovery-migration/lake-manifest.json b/lean/disaster-recovery-migration/lake-manifest.json new file mode 100644 index 000000000000..a1e9e3c4b3ea --- /dev/null +++ b/lean/disaster-recovery-migration/lake-manifest.json @@ -0,0 +1,102 @@ +{"version": "1.1.0", + "packagesDir": ".lake/packages", + "packages": + [{"type": "path", + "scope": "", + "name": "disaster_recovery", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "../disaster-recovery", + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/mathlib4.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", + "name": "mathlib", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/LeanSearchClient", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "name": "LeanSearchClient", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/import-graph", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", + "name": "importGraph", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/ProofWidgets4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", + "name": "proofwidgets", + "manifestFile": "lake-manifest.json", + "inputRev": "v0.0.87", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/aesop", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", + "name": "aesop", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/quote4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", + "name": "Qq", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/batteries", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", + "name": "batteries", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover/lean4-cli", + "type": "git", + "subDir": null, + "scope": "leanprover", + "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.toml"}], + "name": "disaster_recovery_migration", + "lakeDir": ".lake"} diff --git a/lean/disaster-recovery-migration/lakefile.toml b/lean/disaster-recovery-migration/lakefile.toml new file mode 100644 index 000000000000..17d6dade6e82 --- /dev/null +++ b/lean/disaster-recovery-migration/lakefile.toml @@ -0,0 +1,24 @@ +name = "disaster_recovery_migration" +version = "0.1.0" +moreLeanArgs = ["-DwarningAsError=true"] +defaultTargets = [ + "DisasterRecoveryMigration", + "migration-model-checker", + "migration-semantic-checks", +] + +[[require]] +name = "disaster_recovery" +path = "../disaster-recovery" + +[[lean_lib]] +name = "DisasterRecoveryMigration" + +[[lean_exe]] +name = "migration-model-checker" +root = "Main" + +[[lean_exe]] +name = "migration-semantic-checks" +root = "Tests" + diff --git a/lean/disaster-recovery-migration/lean-toolchain b/lean/disaster-recovery-migration/lean-toolchain new file mode 100644 index 000000000000..c631e159c6fc --- /dev/null +++ b/lean/disaster-recovery-migration/lean-toolchain @@ -0,0 +1,2 @@ +leanprover/lean4:v4.28.0 + From 5e6d9c88bf8e151e898ba38c3af655e7bf312cb6 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:57:48 +0100 Subject: [PATCH 16/35] Add Rust exporter and legacy graph comparator Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../ExportMain.lean | 25 ++ lean/disaster-recovery-migration/compare.py | 358 +++++++++++++++++ .../disaster-recovery-migration/lakefile.toml | 5 + tla/disaster-recovery/src/export.rs | 370 ++++++++++++++++++ tla/disaster-recovery/src/main.rs | 32 +- 5 files changed, 789 insertions(+), 1 deletion(-) create mode 100644 lean/disaster-recovery-migration/ExportMain.lean create mode 100755 lean/disaster-recovery-migration/compare.py create mode 100644 tla/disaster-recovery/src/export.rs diff --git a/lean/disaster-recovery-migration/ExportMain.lean b/lean/disaster-recovery-migration/ExportMain.lean new file mode 100644 index 000000000000..f09bdf5e608e --- /dev/null +++ b/lean/disaster-recovery-migration/ExportMain.lean @@ -0,0 +1,25 @@ +import DisasterRecoveryMigration.Legacy.Checker + +open DisasterRecoveryMigration.Legacy + +private def usage : String := + "usage: migration-exporter [--nodes N]" + +private def parseNodes : List String -> Except String Nat + | [] => pure 3 + | ["--nodes", value] => + match value.toNat? with + | some n => if n > 0 then pure n else throw "--nodes must be positive" + | none => throw s!"invalid node count: {value}" + | _ => throw usage + +def main (args : List String) : IO UInt32 := do + match parseNodes args with + | .error message => + IO.eprintln message + pure 2 + | .ok n => + let graph <- enumerate n + exportGraph n graph + pure 0 + diff --git a/lean/disaster-recovery-migration/compare.py b/lean/disaster-recovery-migration/compare.py new file mode 100755 index 000000000000..005d09c1df5a --- /dev/null +++ b/lean/disaster-recovery-migration/compare.py @@ -0,0 +1,358 @@ +#!/usr/bin/env python3 +# Copyright (c) Microsoft Corporation. All rights reserved. +# Licensed under the Apache 2.0 License. + +import argparse +import filecmp +import subprocess +import sys +import tempfile +from collections import defaultdict, deque +from dataclasses import dataclass +from pathlib import Path + +FORMAT = "ccf-legacy-dr-graph-v1" +PROPERTY_NAMES = ( + "Unanimous votes => no chance of a fork", + "Open", + "Majority votes => no fork", + "No open with timeout, no fork", + "Deadlock", + "Persist committed txs", + "Open is possible", + "Unsafe open with timeout", + "Majority vote still opens without timeout", +) +EXPECTED_COUNTS = { + 1: (1, 0), + 2: (54, 95), + 3: (105558, 552282), +} + + +@dataclass(frozen=True) +class Summary: + initial_key: str + states: int + edges: int + + +@dataclass +class Graph: + initial: str + valuations: dict[str, str] + edges: set[tuple[str, str, str]] + + +def run(command: list[str], cwd: Path, output: Path | None = None) -> None: + print(f"+ (cd {cwd} && {' '.join(command)})", flush=True) + if output is None: + result = subprocess.run( + command, cwd=cwd, text=True, capture_output=True, check=False + ) + else: + with output.open("w", encoding="ascii", newline="") as stream: + result = subprocess.run( + command, + cwd=cwd, + text=True, + stdout=stream, + stderr=subprocess.PIPE, + check=False, + ) + if result.returncode != 0: + if result.stderr: + print(result.stderr, file=sys.stderr, end="") + raise RuntimeError(f"command exited with status {result.returncode}") + + +def validate(path: Path, expected_nodes: int) -> Summary: + ids_to_keys: list[str] = [] + initial_id: int | None = None + edge_count = 0 + previous_edge: tuple[int, str, int] | None = None + section = "header" + + with path.open(encoding="ascii") as stream: + for line_number, raw_line in enumerate(stream, 1): + fields = raw_line.rstrip("\n").split("\t") + if fields == ["format", FORMAT] and line_number == 1: + continue + if fields == ["nodes", str(expected_nodes)] and line_number == 2: + continue + if len(fields) == 2 and fields[0] == "init" and line_number == 3: + initial_id = int(fields[1]) + section = "states" + continue + if len(fields) == 4 and fields[0] == "state" and section == "states": + state_id = int(fields[1]) + if state_id != len(ids_to_keys): + raise ValueError( + f"{path}:{line_number}: expected dense state id " + f"{len(ids_to_keys)}, found {state_id}" + ) + if ids_to_keys and fields[2] <= ids_to_keys[-1]: + raise ValueError( + f"{path}:{line_number}: state keys are unsorted or duplicated" + ) + bits = fields[3] + if len(bits) != len(PROPERTY_NAMES) or set(bits) - {"0", "1"}: + raise ValueError( + f"{path}:{line_number}: invalid property bitstring" + ) + ids_to_keys.append(fields[2]) + continue + if len(fields) == 4 and fields[0] == "edge": + section = "edges" + edge = (int(fields[1]), fields[2], int(fields[3])) + if edge[0] >= len(ids_to_keys) or edge[2] >= len(ids_to_keys): + raise ValueError( + f"{path}:{line_number}: edge references unknown state" + ) + if previous_edge is not None and edge <= previous_edge: + raise ValueError( + f"{path}:{line_number}: edges are unsorted or duplicated" + ) + previous_edge = edge + edge_count += 1 + continue + raise ValueError( + f"{path}:{line_number}: invalid record: {raw_line.rstrip()}" + ) + + if initial_id is None or initial_id >= len(ids_to_keys): + raise ValueError(f"{path}: invalid or missing initial state") + return Summary(ids_to_keys[initial_id], len(ids_to_keys), edge_count) + + +def load(path: Path) -> Graph: + ids_to_keys: list[str] = [] + valuations: dict[str, str] = {} + raw_edges: list[tuple[int, str, int]] = [] + initial_id = -1 + with path.open(encoding="ascii") as stream: + for raw_line in stream: + fields = raw_line.rstrip("\n").split("\t") + if fields[0] == "init": + initial_id = int(fields[1]) + elif fields[0] == "state": + state_id = int(fields[1]) + key = fields[2] + if state_id != len(ids_to_keys): + raise ValueError(f"{path}: non-dense state IDs") + ids_to_keys.append(key) + valuations[key] = fields[3] + elif fields[0] == "edge": + raw_edges.append((int(fields[1]), fields[2], int(fields[3]))) + edges = { + (ids_to_keys[src], action, ids_to_keys[dst]) for src, action, dst in raw_edges + } + return Graph(ids_to_keys[initial_id], valuations, edges) + + +def shortest_paths(graph: Graph) -> tuple[dict[str, int], dict[str, tuple[str, str]]]: + adjacency: dict[str, list[tuple[str, str]]] = defaultdict(list) + for src, action, dst in graph.edges: + adjacency[src].append((action, dst)) + for outgoing in adjacency.values(): + outgoing.sort() + + distance = {graph.initial: 0} + parent: dict[str, tuple[str, str]] = {} + pending = deque([graph.initial]) + while pending: + src = pending.popleft() + for action, dst in adjacency[src]: + if dst not in distance: + distance[dst] = distance[src] + 1 + parent[dst] = (src, action) + pending.append(dst) + return distance, parent + + +def describe_path( + graph: Graph, target: str, cached: tuple[dict[str, int], dict[str, tuple[str, str]]] +) -> str: + distance, parent = cached + if target not in distance: + return f"unreachable target key {target}" + actions: list[str] = [] + cursor = target + while cursor != graph.initial: + cursor, action = parent[cursor] + actions.append(action) + actions.reverse() + rendered = "\n".join( + f" {index}. {action}" for index, action in enumerate(actions, 1) + ) + return f"target: {target}\n{rendered or ' '}" + + +def mismatch(rust: Graph, lean: Graph) -> str: + if rust.initial != lean.initial: + return f"initial state mismatch\nRust: {rust.initial}\nLean: {lean.initial}" + + rust_paths = lean_paths = None + rust_states = set(rust.valuations) + lean_states = set(lean.valuations) + if rust_states != lean_states: + rust_only = rust_states - lean_states + lean_only = lean_states - rust_states + candidates: list[tuple[int, str, str, Graph]] = [] + if rust_only: + rust_paths = shortest_paths(rust) + state = min( + rust_only, key=lambda key: (rust_paths[0].get(key, sys.maxsize), key) + ) + candidates.append( + (rust_paths[0].get(state, sys.maxsize), "Rust-only", state, rust) + ) + if lean_only: + lean_paths = shortest_paths(lean) + state = min( + lean_only, key=lambda key: (lean_paths[0].get(key, sys.maxsize), key) + ) + candidates.append( + (lean_paths[0].get(state, sys.maxsize), "Lean-only", state, lean) + ) + _, side, state, graph = min(candidates) + paths = rust_paths if graph is rust else lean_paths + return ( + f"reachable state mismatch ({len(rust_only)} Rust-only, " + f"{len(lean_only)} Lean-only); shortest is {side}\n" + f"{describe_path(graph, state, paths)}" + ) + + rust_only_edges = rust.edges - lean.edges + lean_only_edges = lean.edges - rust.edges + if rust_only_edges or lean_only_edges: + candidates = [] + if rust_only_edges: + rust_paths = shortest_paths(rust) + edge = min( + rust_only_edges, + key=lambda value: (rust_paths[0].get(value[0], sys.maxsize), value), + ) + candidates.append( + ( + rust_paths[0].get(edge[0], sys.maxsize), + "Rust-only", + edge, + rust, + ) + ) + if lean_only_edges: + lean_paths = shortest_paths(lean) + edge = min( + lean_only_edges, + key=lambda value: (lean_paths[0].get(value[0], sys.maxsize), value), + ) + candidates.append( + ( + lean_paths[0].get(edge[0], sys.maxsize), + "Lean-only", + edge, + lean, + ) + ) + _, side, (src, action, dst), graph = min(candidates) + paths = rust_paths if graph is rust else lean_paths + return ( + f"labeled edge mismatch ({len(rust_only_edges)} Rust-only, " + f"{len(lean_only_edges)} Lean-only); shortest source is {side}\n" + f"{describe_path(graph, src, paths)}\n" + f"missing edge action: {action}\ndestination: {dst}" + ) + + differing = { + key for key in rust_states if rust.valuations[key] != lean.valuations[key] + } + if differing: + rust_paths = shortest_paths(rust) + state = min( + differing, key=lambda key: (rust_paths[0].get(key, sys.maxsize), key) + ) + rust_bits = rust.valuations[state] + lean_bits = lean.valuations[state] + details = [ + f" {index + 1}. {name}: Rust={rust_bits[index]} Lean={lean_bits[index]}" + for index, name in enumerate(PROPERTY_NAMES) + if rust_bits[index] != lean_bits[index] + ] + return ( + f"property valuation mismatch in {len(differing)} states\n" + f"{describe_path(rust, state, rust_paths)}\n" + "\n".join(details) + ) + + return "canonical files differ despite identical graph content" + + +def compare(nodes: int, lean_dir: Path, rust_dir: Path, temporary: Path) -> Summary: + rust_path = temporary / f"rust-{nodes}.tsv" + lean_path = temporary / f"lean-{nodes}.tsv" + run( + [ + "cargo", + "run", + "--quiet", + "--", + "export", + "--nodes", + str(nodes), + "-o", + str(rust_path), + ], + rust_dir, + ) + run( + ["lake", "exe", "migration-exporter", "--nodes", str(nodes)], + lean_dir, + lean_path, + ) + rust_summary = validate(rust_path, nodes) + lean_summary = validate(lean_path, nodes) + if rust_summary != lean_summary or not filecmp.cmp( + rust_path, lean_path, shallow=False + ): + raise AssertionError(mismatch(load(rust_path), load(lean_path))) + expected = EXPECTED_COUNTS.get(nodes) + if expected is not None and (rust_summary.states, rust_summary.edges) != expected: + raise AssertionError( + f"n={nodes}: expected {expected[0]} states/{expected[1]} edges, " + f"found {rust_summary.states}/{rust_summary.edges}" + ) + return rust_summary + + +def main() -> int: + parser = argparse.ArgumentParser( + description="Exhaustively compare Rust/Stateright and Lean legacy DR graphs" + ) + parser.add_argument("--nodes", type=int, nargs="+", default=[1, 2, 3]) + args = parser.parse_args() + if any(nodes < 1 for nodes in args.nodes): + parser.error("node counts must be positive") + + lean_dir = Path(__file__).resolve().parent + rust_dir = lean_dir.parents[1] / "tla" / "disaster-recovery" + try: + scratch = lean_dir / ".lake" + scratch.mkdir(exist_ok=True) + with tempfile.TemporaryDirectory( + prefix="ccf-legacy-dr-", dir=scratch + ) as directory: + for nodes in args.nodes: + summary = compare(nodes, lean_dir, rust_dir, Path(directory)) + print( + f"n={nodes}: equivalent initial state, {summary.states} states, " + f"{summary.edges} labeled edges compared in both directions, " + f"{len(PROPERTY_NAMES)} valuations/state" + ) + except (AssertionError, OSError, RuntimeError, ValueError) as error: + print(f"equivalence failed: {error}", file=sys.stderr) + return 1 + return 0 + + +if __name__ == "__main__": + raise SystemExit(main()) diff --git a/lean/disaster-recovery-migration/lakefile.toml b/lean/disaster-recovery-migration/lakefile.toml index 17d6dade6e82..5748abbe6fbb 100644 --- a/lean/disaster-recovery-migration/lakefile.toml +++ b/lean/disaster-recovery-migration/lakefile.toml @@ -5,6 +5,7 @@ defaultTargets = [ "DisasterRecoveryMigration", "migration-model-checker", "migration-semantic-checks", + "migration-exporter", ] [[require]] @@ -22,3 +23,7 @@ root = "Main" name = "migration-semantic-checks" root = "Tests" +[[lean_exe]] +name = "migration-exporter" +root = "ExportMain" + diff --git a/tla/disaster-recovery/src/export.rs b/tla/disaster-recovery/src/export.rs new file mode 100644 index 000000000000..f9988717b9ee --- /dev/null +++ b/tla/disaster-recovery/src/export.rs @@ -0,0 +1,370 @@ +//! Dependency-free canonical export of the reachable state graph. +//! +//! Implements the shared `ccf-legacy-dr-graph-v1` TSV contract: the model is +//! enumerated exhaustively using only the public `stateright::Model` +//! interface (`init_states`, `next_steps`, `within_boundary`), and every +//! state/action is serialized with an explicit hand-written grammar (never +//! `Debug`), so the output is stable across compiler/library versions and +//! diffable byte-for-byte against an independent re-implementation (e.g. +//! Python, Lean) of the same state machine. +//! +//! No new dependencies are introduced: only `stateright` (already a direct +//! dependency) and `std` are used. +//! +//! # Format +//! +//! ```text +//! format\tccf-legacy-dr-graph-v1 +//! nodes\t +//! init\t +//! state\t\t\t (one per reachable state) +//! edge\t\t\t (one per reachable transition) +//! ``` +//! +//! `` is a canonical, dense integer id (`0..N_STATES`) assigned by +//! sorting every reachable state's `` (see below) lexicographically +//! and numbering them in that order -- *not* BFS/discovery order -- so ids are +//! reproducible independent of traversal strategy. `state` records are +//! emitted in ascending `` order (equivalently, ascending `` +//! order). `edge` records are emitted sorted by the tuple +//! `(, text, )` (numeric on the ids, lexicographic on +//! the action text), and de-duplicated. Repeating the full `` in +//! every edge does not scale (e.g. `n=3` already has 105,558 states / 552,282 +//! edges), so edges reference states only by ``; a reader reconstructs the +//! `` for any `` via the `state` block. +//! +//! `` is exactly 9 characters of `1`/`0`, one per predicate +//! currently registered on the model via `ActorModel::property` +//! (`model.properties`), in registration order (liveness, then invariant, +//! then reachable properties -- *not* alphabetical). Each bit is the exact +//! existing `Property::condition` closure evaluated on that state, so the +//! export can never drift from `check`/`serve` behaviour, and preserves each +//! predicate's existing (sometimes misleadingly worded) name/meaning even +//! though names themselves are not repeated in the TSV output. +//! +//! Grammar for ``/`` tokens (no token contains whitespace): +//! +//! - gossip: `g(src,txid)` +//! - vote: `v(src,[GOSSIPS])` where `GOSSIPS` is a comma-separated gossip list +//! - msg: a gossip, a vote, or `o(id)` (`IAmOpen`) +//! - envelope: `e(src,dst,msg)` +//! - submitted vote: `none` or `some(dst,vote)` +//! - actor: `s(PHASE,[GOSSIPS],[VOTES],SUBMITTED,txid)` where `PHASE` is one +//! of `vote`, `openjoin`, `open0` (`Open { timeout: false }`), `open1` +//! (`Open { timeout: true }`), `join` +//! - global state: `S([ACTORS],[TIMERS],[ENVELOPES])` where `ACTORS` is +//! semicolon-separated (positional, by actor index), `TIMERS` is a +//! comma-separated list of actor ids with an active election timeout, and +//! `ENVELOPES` is a comma-separated list of `envelope#count` (count being +//! the in-flight multiplicity of that exact envelope) +//! - action: `deliver(src,dst,msg)` or `timeout(id,election)` +//! +//! `history` (`H = ()`), `random_choices` (`Node::Random = ()`), +//! `actor_storages` (`Node::Storage = ()`), and `crashed` (always all-`false`, +//! since `max_crashes` is never configured above `0`) are all omitted from +//! `S(...)`: for this model they are always constant/empty and carry no +//! information. +//! +//! Set elements (`GOSSIPS`, `VOTES`) are ordered using the actual Rust +//! `#[derive(Ord)]` implementation of `GossipStruct`/`VoteStruct` (not a +//! string sort), and `ENVELOPES` are ordered using `Envelope`'s derived +//! `Ord`. Per `Model::next_state`'s documented contract ("`None` indicates +//! the action does not change state"), only actions for which `next_state` +//! returns `Some` produce an edge; this is preserved by using +//! `Model::next_steps`, whose default implementation already filters out +//! `None` results. + +use crate::model::{GossipStruct, ModelCfg, Msg, NextStep, Node, State, Timer, VoteStruct}; +use stateright::actor::{ + ActorModel, ActorModelAction, ActorModelState, Envelope, Id, Network, Timers, +}; +use stateright::Model; +use std::collections::{HashMap, VecDeque}; +use std::io::{self, Write}; + +fn fmt_id(id: Id) -> String { + usize::from(id).to_string() +} + +fn fmt_gossip(g: &GossipStruct) -> String { + format!("g({},{})", fmt_id(g.src), g.txid) +} + +/// Clones and sorts a gossip set using `GossipStruct`'s derived `Ord` +/// (compares `src` then `txid`), per the shared contract's "sort set +/// elements by Rust derived Ord". +fn sorted_gossips(set: &stateright::util::HashableHashSet) -> Vec { + let mut v: Vec = set.iter().cloned().collect(); + v.sort(); + v +} + +fn fmt_gossip_list(set: &stateright::util::HashableHashSet) -> String { + let items: Vec = sorted_gossips(set).iter().map(fmt_gossip).collect(); + format!("[{}]", items.join(",")) +} + +fn fmt_vote(v: &VoteStruct) -> String { + format!("v({},{})", fmt_id(v.src), fmt_gossip_list(&v.recv)) +} + +/// Clones and sorts a vote set using `VoteStruct`'s derived `Ord` (compares +/// `src` then `recv`). +fn sorted_votes(set: &stateright::util::HashableHashSet) -> Vec { + let mut v: Vec = set.iter().cloned().collect(); + v.sort(); + v +} + +fn fmt_vote_list(set: &stateright::util::HashableHashSet) -> String { + let items: Vec = sorted_votes(set).iter().map(fmt_vote).collect(); + format!("[{}]", items.join(",")) +} + +fn fmt_submitted(sv: &Option<(Id, VoteStruct)>) -> String { + match sv { + None => "none".to_string(), + Some((dst, vote)) => format!("some({},{})", fmt_id(*dst), fmt_vote(vote)), + } +} + +fn fmt_phase(n: &NextStep) -> &'static str { + match n { + NextStep::Vote => "vote", + NextStep::OpenJoin => "openjoin", + NextStep::Open { timeout: false } => "open0", + NextStep::Open { timeout: true } => "open1", + NextStep::Join => "join", + } +} + +fn fmt_actor(s: &State) -> String { + format!( + "s({},{},{},{},{})", + fmt_phase(&s.next_step), + fmt_gossip_list(&s.gossips), + fmt_vote_list(&s.votes), + fmt_submitted(&s.submitted_vote), + s.txid, + ) +} + +fn fmt_msg(m: &Msg) -> String { + match m { + Msg::Gossip(g) => fmt_gossip(g), + Msg::Vote(v) => fmt_vote(v), + Msg::IAmOpen(id) => format!("o({})", fmt_id(*id)), + } +} + +fn fmt_envelope(env: &Envelope) -> String { + format!( + "e({},{},{})", + fmt_id(env.src), + fmt_id(env.dst), + fmt_msg(&env.msg) + ) +} + +/// Tallies in-flight multiplicity per distinct envelope. `Network::iter_all` +/// yields one item per unit of multiplicity regardless of the underlying +/// `Network` variant (this model only ever uses +/// `new_unordered_nonduplicating`, whose internal representation already +/// tracks a count directly), so tallying via `iter_all` is variant-agnostic +/// and stays correct if the network configuration ever changes. +fn network_counts(network: &Network) -> Vec<(Envelope, usize)> { + let mut counts: HashMap, usize> = HashMap::new(); + for env in network.iter_all() { + *counts.entry(env.to_cloned_msg()).or_insert(0) += 1; + } + let mut v: Vec<(Envelope, usize)> = counts.into_iter().collect(); + // Envelope's derived Ord (src, dst, msg), per the shared contract. + v.sort_by(|a, b| a.0.cmp(&b.0)); + v +} + +fn fmt_network(network: &Network) -> String { + let items: Vec = network_counts(network) + .iter() + .map(|(env, count)| format!("{}#{}", fmt_envelope(env), count)) + .collect(); + format!("[{}]", items.join(",")) +} + +/// Comma-separated, ascending list of actor ids with an active election +/// timeout. `Timer` currently has a single variant, so presence alone is +/// significant (no timer-kind tag is emitted). +fn fmt_timers(timers_set: &[Timers]) -> String { + let mut ids: Vec = timers_set + .iter() + .enumerate() + .filter(|(_, t)| t.iter().next().is_some()) + .map(|(i, _)| i) + .collect(); + ids.sort_unstable(); + let items: Vec = ids.iter().map(|i| i.to_string()).collect(); + format!("[{}]", items.join(",")) +} + +/// Canonical `S(...)` encoding of a full `ActorModelState`. Used both +/// as the state field in `state` records and as the basis of the canonical +/// state id, so two independent implementations that compute the same +/// reachable state always produce the same key, regardless of traversal order. +pub fn fmt_state(state: &ActorModelState) -> String { + let actors: Vec = state.actor_states.iter().map(|s| fmt_actor(s)).collect(); + format!( + "S([{}],{},{})", + actors.join(";"), + fmt_timers(&state.timers_set), + fmt_network(&state.network), + ) +} + +/// Canonical encoding of an `ActorModelAction`. Only `Deliver` and `Timeout` +/// are part of the `ccf-legacy-dr-graph-v1` contract: this model never +/// produces `Drop` (`LossyNetwork::No`), `Crash`/`Recover` (`max_crashes == +/// 0`), or `SelectRandom` (no `Actor` ever issues a `ChooseRandom` command), +/// so encountering one is a bug (e.g. a future model config change) rather +/// than a case the contract needs to define. +pub fn fmt_action(action: &ActorModelAction) -> String { + match action { + ActorModelAction::Deliver { src, dst, msg } => { + format!( + "deliver({},{},{})", + fmt_id(*src), + fmt_id(*dst), + fmt_msg(msg) + ) + } + ActorModelAction::Timeout(id, Timer::ElectionTimeout) => { + format!("timeout({},election)", fmt_id(*id)) + } + other => unreachable!( + "action variant {:?} is outside the ccf-legacy-dr-graph-v1 contract \ + (only Deliver/Timeout are ever produced by this model's configuration)", + other + ), + } +} + +/// The 9-character `1`/`0` bitstring for `state`, one bit per predicate +/// currently registered on `model` (`model.properties`) in registration +/// order -- i.e. exactly the same `fn` pointers used by `check`/`serve`, so +/// this can never drift from their semantics. +fn predicate_bitstring( + model: &ActorModel, + state: &ActorModelState, +) -> String { + model + .properties + .iter() + .map(|p| { + if (p.condition)(model, state) { + '1' + } else { + '0' + } + }) + .collect() +} + +/// Exhaustively enumerates the reachable state graph of `model` via the +/// public `stateright::Model` interface (`init_states`, `next_steps`, +/// `within_boundary`) and writes it to `out` as `ccf-legacy-dr-graph-v1`. +/// +/// States are discovered by BFS (for traversal only), but ``s are +/// assigned afterwards by sorting all discovered ``s +/// lexicographically -- so the numbering is a pure function of the reachable +/// state set, independent of traversal order. Edges reference states by +/// `` only, keeping output size linear in (states + edges) rather than +/// (edges * average state size). +pub fn export_graph( + model: &ActorModel, + out: &mut W, +) -> io::Result<()> { + // Indexed by BFS discovery order (a "discovery id"); remapped to the + // canonical sorted-key id only once the full state set is known. + let mut visited: HashMap, usize> = HashMap::new(); + let mut keys: Vec = Vec::new(); + let mut bits: Vec = Vec::new(); + let mut frontier: VecDeque> = VecDeque::new(); + // (discovery src id, action text, discovery dst id) + let mut edges: Vec<(usize, String, usize)> = Vec::new(); + + let mut init_states = model.init_states(); + assert_eq!( + init_states.len(), + 1, + "ccf-legacy-dr-graph-v1 assumes a single deterministic init state" + ); + let init_state = init_states.remove(0); + assert!( + model.within_boundary(&init_state), + "ccf-legacy-dr-graph-v1 assumes the init state is within the model boundary" + ); + let init_discovery_id = keys.len(); + keys.push(fmt_state(&init_state)); + bits.push(predicate_bitstring(model, &init_state)); + visited.insert(init_state.clone(), init_discovery_id); + frontier.push_back(init_state); + + while let Some(s) = frontier.pop_front() { + let src_discovery_id = *visited + .get(&s) + .expect("every frontier state was inserted into `visited` before being queued"); + // `next_steps` (default `Model` trait method) already filters out + // actions for which `next_state` returns `None`, preserving the + // documented no-op-suppression contract. + for (action, ns) in model.next_steps(&s) { + if !model.within_boundary(&ns) { + continue; + } + let action_key = fmt_action(&action); + let dst_discovery_id = if let Some(&id) = visited.get(&ns) { + id + } else { + let id = keys.len(); + keys.push(fmt_state(&ns)); + bits.push(predicate_bitstring(model, &ns)); + visited.insert(ns.clone(), id); + frontier.push_back(ns); + id + }; + edges.push((src_discovery_id, action_key, dst_discovery_id)); + } + } + + // Canonical id assignment: number every discovered state by the + // lexicographic order of its ``, not by discovery order. + let mut order: Vec = (0..keys.len()).collect(); + order.sort_by(|&a, &b| keys[a].cmp(&keys[b])); + let mut canonical_id: Vec = vec![0; keys.len()]; + for (id, &discovery_id) in order.iter().enumerate() { + canonical_id[discovery_id] = id; + } + + // Remap edges to canonical ids, then sort by (SRC_ID, ACTION, DST_ID) -- + // numeric on the ids (real `usize` comparison, not string comparison), + // lexicographic on the action text -- and de-duplicate. + let mut canonical_edges: Vec<(usize, String, usize)> = edges + .into_iter() + .map(|(src, action, dst)| (canonical_id[src], action, canonical_id[dst])) + .collect(); + canonical_edges.sort(); + canonical_edges.dedup(); + + writeln!(out, "format\tccf-legacy-dr-graph-v1")?; + writeln!(out, "nodes\t{}", model.actors.len())?; + writeln!(out, "init\t{}", canonical_id[init_discovery_id])?; + for (id, &discovery_id) in order.iter().enumerate() { + writeln!( + out, + "state\t{}\t{}\t{}", + id, keys[discovery_id], bits[discovery_id] + )?; + } + for (src, action, dst) in &canonical_edges { + writeln!(out, "edge\t{src}\t{action}\t{dst}")?; + } + Ok(()) +} diff --git a/tla/disaster-recovery/src/main.rs b/tla/disaster-recovery/src/main.rs index d92767d1a0f0..15bcef28f7ad 100644 --- a/tla/disaster-recovery/src/main.rs +++ b/tla/disaster-recovery/src/main.rs @@ -1,7 +1,9 @@ extern crate clap; extern crate stateright; use clap::Parser; +mod export; mod model; +use export::export_graph; use model::{ModelCfg, Msg, NextStep, Node, State}; use stateright::{actor::*, report::WriteReporter, util::HashableHashSet, Checker, Model}; use std::sync::Arc; @@ -198,7 +200,11 @@ fn properties(model: ActorModel) -> ActorModel, + }, } fn check(model: ActorModel) { @@ -227,6 +241,21 @@ fn serve(model: ActorModel) { checker.serve("localhost:8080"); } +fn export(model: ActorModel, out: Option) { + match out { + Some(path) => { + let mut file = std::fs::File::create(&path) + .unwrap_or_else(|e| panic!("failed to create '{}': {}", path, e)); + export_graph(&model, &mut file).expect("failed to write model export"); + } + None => { + let stdout = std::io::stdout(); + let mut handle = stdout.lock(); + export_graph(&model, &mut handle).expect("failed to write model export"); + } + } +} + fn main() { let args = CliArgs::parse(); @@ -240,5 +269,6 @@ fn main() { match args.command { Commands::Check => check(model), Commands::Serve => serve(model), + Commands::Export { out } => export(model, out), } } From 66e7932fc06e3fb33a9bd38e6b040ea4d060730c Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 10:59:14 +0100 Subject: [PATCH 17/35] Prove temporary canonical phase refinement Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../DisasterRecoveryMigration.lean | 2 +- .../DisasterRecoveryMigration/Refinement.lean | 335 ++++++++++++++++++ 2 files changed, 336 insertions(+), 1 deletion(-) create mode 100644 lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean index 53c5d03c3733..c1479820c03e 100644 --- a/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean +++ b/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean @@ -1,3 +1,3 @@ import DisasterRecoveryMigration.Legacy.Model import DisasterRecoveryMigration.Legacy.Checker - +import DisasterRecoveryMigration.Refinement diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean new file mode 100644 index 000000000000..b339e8d17aa1 --- /dev/null +++ b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean @@ -0,0 +1,335 @@ +import DisasterRecoveryMigration.Legacy.Model +import DisasterRecovery.Protocol.Model +import Mathlib.Logic.Relation + +namespace DisasterRecoveryMigration.Refinement + +open DisasterRecovery.Protocol + +def projectPhase (state : NodeState) : DisasterRecoveryMigration.Legacy.Phase := + match state.phase with + | .gossiping => .vote + | .voting => .openJoin + | .opening | .open => + match state.openKind with + | some .failover => .open true + | _ => .open false + | .joining => .join + +inductive LegacyAtomic : + DisasterRecoveryMigration.Legacy.Phase -> DisasterRecoveryMigration.Legacy.Phase -> Prop where + | gossipToVoting : LegacyAtomic .vote .openJoin + | quorumOpen : LegacyAtomic .openJoin (.open false) + | failoverOpen : LegacyAtomic .openJoin (.open true) + | gossipToJoin : LegacyAtomic .vote .join + | votingToJoin : LegacyAtomic .openJoin .join + +abbrev LegacyWeakStep := + Relation.ReflTransGen LegacyAtomic + +def embeddedTxID + (config : Config) + (source : Location) + (txid : TxID) : Prop := + txid.view = 0 /\ config.expectedLocations[txid.seqno]? = some source + +structure LegacyDataAssumptions + (config : Config) + (event : Event) + (after : NodeState) : Prop where + /-- Recorded for a future data refinement; phase simulation does not assume it. -/ + oddNodeCount : + exists half, config.expectedLocations.length = 2 * half + 1 + acceptedExpectedInput : + match event with + | .receiveGossip source txid validation => + validation = .accepted /\ + expectedSource config source = true /\ + embeddedTxID config source txid + | .receiveVote source validation => + validation = .accepted /\ expectedSource config source = true + | .receiveIAmOpen source validation => + validation = .accepted /\ expectedSource config source = true + | .timeout | .retry => True + quorumOnly : + after.openKind != some .failover + +structure CompatibilityStep + (config : Config) + (before : NodeState) + (event : Event) + (after : NodeState) : Prop where + canonical : + after = (step config before event).state + +private theorem advance_simulates + (config : Config) + (state : NodeState) + (timeout : Bool) + (output : StepOutput) + (advanced : advance config state timeout = some output) : + LegacyWeakStep (projectPhase state) (projectPhase output.state) := by + cases timeout <;> cases phase : state.phase <;> + simp [advance, phase] at advanced <;> + repeat' split at advanced <;> + simp_all [projectPhase, advanceTimeoutLane, advanceTimeoutState] + all_goals subst output + all_goals simp_all [projectPhase, advanceTimeoutLane] + all_goals + first + | (split <;> simp_all) + | skip + all_goals + first + | exact .refl + | exact .single .gossipToVoting + | exact .single .quorumOpen + | exact .single .failoverOpen + +private theorem receive_gossip_simulates + (config : Config) + (before : NodeState) + (source : Location) + (txid : TxID) + (validation : Validation) : + LegacyWeakStep + (projectPhase before) + (projectPhase + (step config before (.receiveGossip source txid validation)).state) := by + cases validation with + | rejected => + simp [step, rejected] + exact .refl + | accepted => + by_cases frozen : before.chosen != none + case pos => + simp [step, frozen, rejected] + exact .refl + case neg => + let received := { + before with gossips := insertGossip source txid before.gossips } + have same : projectPhase received = projectPhase before := by + simp [received, projectPhase] + cases advanced : advance config received false with + | none => + simp [step, frozen, received, advanced, rejected] + exact .refl + | some output => + simp [step, frozen, received, advanced] + have simulation := + advance_simulates config received false output advanced + rw [same] at simulation + exact simulation + +private theorem receive_vote_simulates + (config : Config) + (before : NodeState) + (source : Location) + (validation : Validation) : + LegacyWeakStep + (projectPhase before) + (projectPhase + (step config before (.receiveVote source validation)).state) := by + cases validation with + | rejected => + simp [step, rejected] + exact .refl + | accepted => + let received := { before with votes := insertVote source before.votes } + have same : projectPhase received = projectPhase before := by + simp [received, projectPhase] + cases advanced : advance config received false with + | none => + simp [step, received, advanced, rejected] + exact .refl + | some output => + simp [step, received, advanced] + have simulation := + advance_simulates config received false output advanced + rw [same] at simulation + exact simulation + +private theorem receive_iamopen_simulates + (config : Config) + (before : NodeState) + (source : Location) + (validation : Validation) : + LegacyWeakStep + (projectPhase before) + (projectPhase + (step config before (.receiveIAmOpen source validation)).state) := by + cases validation with + | rejected => + simp [step, rejected] + exact .refl + | accepted => + cases phase : before.phase <;> + simp [step, phase, advance, rejected, projectPhase, + advanceTimeoutLane] + all_goals + first + | exact .single .gossipToJoin + | exact .single .votingToJoin + | exact .refl + +theorem canonical_step_simulates + (config : Config) + (before : NodeState) + (event : Event) : + LegacyWeakStep + (projectPhase before) + (projectPhase (step config before event).state) := by + cases event with + | receiveGossip source txid validation => + exact receive_gossip_simulates config before source txid validation + | receiveVote source validation => + exact receive_vote_simulates config before source validation + | receiveIAmOpen source validation => + exact receive_iamopen_simulates config before source validation + | timeout => + cases advanced : advance config before true with + | none => + simp [step, advanced, rejected] + exact .refl + | some output => + simp [step, advanced] + exact advance_simulates config before true output advanced + | retry => + exact .refl + +theorem compatibility_step_simulates + {config : Config} + {before after : NodeState} + {event : Event} + (compatible : CompatibilityStep config before event after) : + LegacyWeakStep (projectPhase before) (projectPhase after) := by + rw [compatible.canonical] + exact canonical_step_simulates config before event + +def retryCompatibility + (config : Config) + (state : NodeState) : + CompatibilityStep config state .retry state := { + canonical := rfl +} + +def voteQuorumCompatibility + (config : Config) + (before : NodeState) + (source : Location) : + CompatibilityStep config before + (.receiveVote source .accepted) + (step config before (.receiveVote source .accepted)).state := { + canonical := rfl +} + +theorem quorum_phase_step_is_weak + (before after : NodeState) + (beforePhase : before.phase = .voting) + (afterPhase : after.phase = .opening) + (kind : after.openKind = some .quorum) : + LegacyWeakStep (projectPhase before) (projectPhase after) := by + simp [projectPhase, beforePhase, afterPhase, kind] + exact .single .quorumOpen + +theorem opening_to_open_is_stuttering + (before after : NodeState) + (beforePhase : before.phase = .opening) + (afterPhase : after.phase = .open) + (kind : after.openKind = before.openKind) : + LegacyWeakStep (projectPhase before) (projectPhase after) := by + simp [projectPhase, beforePhase, afterPhase, kind] + exact .refl + +inductive CompatibilityTrace + (config : Config) : + NodeState -> + List Event -> + NodeState -> + Prop where + | nil (state) : CompatibilityTrace config state [] state + | cons + (first middle last event rest) + (head : CompatibilityStep config first event middle) + (tail : CompatibilityTrace config middle rest last) : + CompatibilityTrace config first (event :: rest) last + +theorem compatibility_trace_simulates + {config : Config} + {first last : NodeState} + {events : List Event} + (compatible : CompatibilityTrace config first events last) : + LegacyWeakStep (projectPhase first) (projectPhase last) := by + induction compatible with + | nil state => exact .refl + | cons first middle last event rest head tail induction => + exact Relation.ReflTransGen.trans + (compatibility_step_simulates head) induction + +theorem initial_phase_correspondence : + projectPhase (initialNode "node0") = DisasterRecoveryMigration.Legacy.Phase.vote := by + rfl + +theorem three_node_initial_correspondence : + let config : Config := { + instanceId := "compat" + expectedLocations := ["0", "1", "2"] + } + ((initialSystem config).nodes.map + (fun entry => projectPhase entry.2) == + (DisasterRecoveryMigration.Legacy.initialState 3).actors.toList.map + (fun actor => actor.nextStep)) = true := by + rfl + +theorem odd_quorum_matches_legacy + (nodes half : Nat) + (odd : nodes = 2 * half + 1) : + nodes / 2 + 1 = (nodes + 1) / 2 := by + subst nodes + simp [Nat.add_div] + +theorem even_quorum_exceeds_legacy_by_one + (nodes half : Nat) + (even : nodes = 2 * half) : + nodes / 2 + 1 = (nodes + 1) / 2 + 1 := by + subst nodes + simp [Nat.add_div] + +def canonicalReachedOpen (state : NodeState) : Prop := + state.phase = .opening \/ state.phase = .open + +def projectedReachedOpen (state : NodeState) : Prop := + match projectPhase state with + | .open _ => True + | _ => False + +theorem reached_open_is_preserved + (state : NodeState) : + canonicalReachedOpen state <-> projectedReachedOpen state := by + cases phase : state.phase <;> + cases kind : state.openKind <;> + simp [canonicalReachedOpen, projectedReachedOpen, projectPhase, phase, kind] + all_goals + rename_i value + cases value <;> + simp + +theorem quorum_kind_projects_to_non_timeout_open + (state : NodeState) + (phase : state.phase = .opening \/ state.phase = .open) + (kind : state.openKind = some .quorum) : + projectPhase state = .open false := by + cases phase with + | inl opening => + cases state + simp_all [projectPhase] + | inr opened => + cases state + simp_all [projectPhase] + +theorem single_node_full_initial_models_differ : + projectPhase (initialNode "0") != + (DisasterRecoveryMigration.Legacy.initialState 1).actors[0]!.nextStep := by + decide + +end DisasterRecoveryMigration.Refinement \ No newline at end of file From 5ebeda9db3b47c603756588f2ff4b98201ad6b84 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 11:00:59 +0100 Subject: [PATCH 18/35] Add temporary migration CI and documentation Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../lean-disaster-recovery-migration.yml | 70 +++++++++++ lean/disaster-recovery-migration/.gitignore | 1 - .../AxiomChecks.lean | 1 - .../ExportMain.lean | 1 - lean/disaster-recovery-migration/README.md | 111 ++++++++++++++++++ .../disaster-recovery-migration/lakefile.toml | 1 - .../lean-toolchain | 1 - tla/disaster-recovery/Readme.md | 48 ++++++++ 8 files changed, 229 insertions(+), 5 deletions(-) create mode 100644 .github/workflows/lean-disaster-recovery-migration.yml create mode 100644 lean/disaster-recovery-migration/README.md diff --git a/.github/workflows/lean-disaster-recovery-migration.yml b/.github/workflows/lean-disaster-recovery-migration.yml new file mode 100644 index 000000000000..d286201f058e --- /dev/null +++ b/.github/workflows/lean-disaster-recovery-migration.yml @@ -0,0 +1,70 @@ +name: "Lean Disaster Recovery Migration Evidence" + +on: + pull_request: + paths: + - "lean/disaster-recovery-migration/**" + - "tla/disaster-recovery/**" + - ".github/workflows/lean-disaster-recovery-migration.yml" + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +permissions: read-all + +jobs: + migration-evidence: + name: Temporary migration evidence + runs-on: ubuntu-latest + timeout-minutes: 90 + + steps: + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Lean and Rust + shell: bash + run: | + set -euo pipefail + sudo apt-get update + sudo apt-get install -y elan + elan toolchain install "$(cat lean/disaster-recovery-migration/lean-toolchain)" + rustup toolchain install stable --profile minimal + rustup default stable + + - name: Build and check Rust model + working-directory: tla/disaster-recovery + shell: bash + run: | + set -euo pipefail + cargo check --locked + cargo build --locked + cargo run --quiet --locked -- --nodes 2 check + + - name: Check canonical Lean package + working-directory: lean/disaster-recovery + shell: bash + run: | + set -euo pipefail + lake exe cache get + lake build + lake env lean -DwarningAsError=true AxiomChecks.lean + lake exe canonical-checks + + - name: Build and check migration Lean package + working-directory: lean/disaster-recovery-migration + shell: bash + run: | + set -euo pipefail + lake exe cache get + lake build + lake env lean -DwarningAsError=true AxiomChecks.lean + lake exe migration-semantic-checks + lake exe migration-model-checker --nodes 3 + + - name: Compare complete Rust and Lean graphs + working-directory: lean/disaster-recovery-migration + shell: bash + run: | + set -euo pipefail + python3 compare.py --nodes 1 2 3 diff --git a/lean/disaster-recovery-migration/.gitignore b/lean/disaster-recovery-migration/.gitignore index 6726f2f29a8f..4080d07dfc31 100644 --- a/lean/disaster-recovery-migration/.gitignore +++ b/lean/disaster-recovery-migration/.gitignore @@ -1,2 +1 @@ /.lake/ - diff --git a/lean/disaster-recovery-migration/AxiomChecks.lean b/lean/disaster-recovery-migration/AxiomChecks.lean index 43c60eb3dc9b..7d35521df0e3 100644 --- a/lean/disaster-recovery-migration/AxiomChecks.lean +++ b/lean/disaster-recovery-migration/AxiomChecks.lean @@ -21,4 +21,3 @@ elab "#assert_no_migration_sorries" : command => do def main : IO Unit := pure () - diff --git a/lean/disaster-recovery-migration/ExportMain.lean b/lean/disaster-recovery-migration/ExportMain.lean index f09bdf5e608e..f7500f6a967c 100644 --- a/lean/disaster-recovery-migration/ExportMain.lean +++ b/lean/disaster-recovery-migration/ExportMain.lean @@ -22,4 +22,3 @@ def main (args : List String) : IO UInt32 := do let graph <- enumerate n exportGraph n graph pure 0 - diff --git a/lean/disaster-recovery-migration/README.md b/lean/disaster-recovery-migration/README.md new file mode 100644 index 000000000000..25976e5a701f --- /dev/null +++ b/lean/disaster-recovery-migration/README.md @@ -0,0 +1,111 @@ +# Temporary disaster recovery migration evidence + +This package is the temporary PR 2 evidence layer for migrating the legacy +Rust/Stateright disaster recovery model to Lean. It depends locally on the +canonical package in `../disaster-recovery`; it does not modify or duplicate +that package. This directory and its dedicated workflow are intended to be +deleted wholesale by PR 3 once the migration evidence has served its purpose. + +## Scope + +There are two distinct and deliberately weaker claims: + +1. The executable model in `DisasterRecoveryMigration.Legacy` is an exact + Lean mirror of the Rust/Stateright model in `tla/disaster-recovery`. + `compare.py` establishes exhaustive bounded equivalence for one, two, and + three nodes. +2. `DisasterRecoveryMigration.Refinement` relates the canonical C++-aligned + Lean model to the legacy Lean mirror only at the protocol-phase level. + +The bounded comparison is not a theorem about arbitrary node counts or a +formal semantics for Rust or Stateright. The phase refinement is not a full +bisimulation, data refinement, or proof that the canonical model is identical +to the Rust model. + +## Exact bounded equivalence + +Both exporters emit the stable `ccf-legacy-dr-graph-v1` format. State IDs are +assigned after sorting normalized state keys, independently of traversal +order. For each requested node count, `compare.py` checks: + +- the normalized initial state; +- every normalized reachable state in both directions; +- every labeled edge, including source and destination, in both directions; +- all nine registered predicate valuations for every reachable state; and +- the expected complete state and edge counts below. + +| Nodes | Reachable states | Labeled edges | Predicate values per state | +| ----: | ---------------: | ------------: | -------------------------: | +| 1 | 1 | 0 | 9 | +| 2 | 54 | 95 | 9 | +| 3 | 105,558 | 552,282 | 9 | + +The comparator fails on a difference from either exporter and reports a +shortest path to a representative state or edge mismatch. + +The mirror intentionally retains the legacy semantics, including message +multiplicity, unordered delivery, timer behavior, no-op suppression, immediate +multi-phase advancement, and the existing predicate definitions and names. +Differences in the canonical model are not backported into this oracle. + +## Canonical phase refinement and limitations + +`DisasterRecoveryMigration.Refinement` imports the canonical +`DisasterRecovery.Protocol.Model` through the local Lake dependency and +projects canonical phases as follows: + +- Gossiping maps to legacy Vote. +- Voting maps to legacy OpenJoin. +- canonical Opening and Open collapse to legacy Open, retaining quorum versus + failover as the legacy timeout flag. +- Joining maps to legacy Join. + +`canonical_step_simulates` proves that each canonical local step projects to a +reflexive-transitive legacy phase step. The file also proves finite compatible +trace simulation, collapsed-Open preservation, quorum-kind projection, and +Opening-to-Open stuttering. + +This phase-only result does not relate gossip sets, votes, timeout-lane state, +network state, transaction persistence, or all nine legacy predicates. It +does not establish a global scheduler correspondence or preserve the legacy +liveness expectations. + +Two intentional model differences are explicit: + +- The canonical quorum is the strict majority `n / 2 + 1`; the legacy quorum + is `(n + 1) / 2`. They agree for odd node counts, while for even node counts + the canonical threshold is one larger. +- With one node, the legacy full initial state opens immediately without a + timeout. The canonical initial node remains in Gossiping, whose projected + phase is Vote. `single_node_full_initial_models_differ` proves this mismatch. + +## Files + +| File | Purpose | +| ----------------------------------------------- | ------------------------------------------------------------------- | +| `DisasterRecoveryMigration/Legacy/Model.lean` | Exact executable legacy semantics | +| `DisasterRecoveryMigration/Legacy/Checker.lean` | BFS model checker and canonical graph encoder | +| `Main.lean` | Legacy model-checker CLI | +| `ExportMain.lean` | Separate Lean graph-exporter CLI | +| `Tests.lean` | Focused legacy semantic checks | +| `DisasterRecoveryMigration/Refinement.lean` | Canonical-to-legacy phase refinement | +| `AxiomChecks.lean` | `sorryAx` rejection for loaded migration and canonical declarations | +| `compare.py` | Bidirectional exhaustive Rust/Lean comparison | + +## Validation + +Run from this directory: + +```console +lake exe cache get +lake build +lake exe migration-semantic-checks +lake exe migration-model-checker --nodes 3 +lake env lean -DwarningAsError=true AxiomChecks.lean +python3 compare.py --nodes 1 2 3 +``` + +The canonical package's own `AxiomChecks.lean` remains authoritative for all +canonical declarations and is also run by the dedicated migration workflow. +The migration Lake package pins the same Lean toolchain, transitively resolves +the same Mathlib revision, and treats warnings as errors. diff --git a/lean/disaster-recovery-migration/lakefile.toml b/lean/disaster-recovery-migration/lakefile.toml index 5748abbe6fbb..d9c53898bb48 100644 --- a/lean/disaster-recovery-migration/lakefile.toml +++ b/lean/disaster-recovery-migration/lakefile.toml @@ -26,4 +26,3 @@ root = "Tests" [[lean_exe]] name = "migration-exporter" root = "ExportMain" - diff --git a/lean/disaster-recovery-migration/lean-toolchain b/lean/disaster-recovery-migration/lean-toolchain index c631e159c6fc..4c685fa085fa 100644 --- a/lean/disaster-recovery-migration/lean-toolchain +++ b/lean/disaster-recovery-migration/lean-toolchain @@ -1,2 +1 @@ leanprover/lean4:v4.28.0 - diff --git a/tla/disaster-recovery/Readme.md b/tla/disaster-recovery/Readme.md index e337787e0027..d13a98b9ac84 100644 --- a/tla/disaster-recovery/Readme.md +++ b/tla/disaster-recovery/Readme.md @@ -9,3 +9,51 @@ The specification can be checked from the command line via `cargo run check`. However, a more useful UX is via the web-view which is hosted locally via `cargo run serve`. This allows you to explore the specification actions interactively, and the checker can be exhaustively run using the `Run to completion` button, which should find several useful examples of states where the network is opened, and where a deadlock is reached. + +## Exporting the state graph + +`cargo run --quiet -- export --nodes [-o ]` exhaustively enumerates the reachable +state graph (via the public `stateright::Model` interface, i.e. `init_states`/`next_steps`) +and writes it to `` (or stdout) in the shared `ccf-legacy-dr-graph-v1` TSV contract, so +it can be diffed against an independent re-implementation of the same model (e.g. in Python +or Lean). The encoder (`src/export.rs`) never uses `Debug` formatting, so output is insulated +from field order, hash-set iteration order, and library-version changes. Full grammar and +design notes are documented in the module doc comment at the top of `src/export.rs`; summary: + +```text +format ccf-legacy-dr-graph-v1 +nodes +init +state (one per reachable state, ascending ) +edge (one per reachable transition, sorted) +``` + +- `` is a dense integer (`0..N_STATES`) assigned by sorting every reachable state's + `` lexicographically -- _not_ BFS/discovery order -- so numbering is a pure + function of the reachable state set. Edges reference states only by `` (not by + repeating ``), since e.g. `n=3` already has 105,558 states / 552,282 edges and + repeating full state keys per edge does not scale. `edge` records are sorted by the tuple + `(, text, )` -- numeric on the ids, lexicographic on the action -- + and de-duplicated. +- `` is 9 chars of `1`/`0`, one per predicate registered via + `ActorModel::property` (`model.properties`), in registration order -- the exact same `fn` + pointers used by `check`/`serve`, so the export can never drift from their semantics. +- `` is `S([ACTORS],[TIMERS],[ENVELOPES])`: `ACTORS` are semicolon-separated + `s(PHASE,[GOSSIPS],[VOTES],SUBMITTED,txid)` records (`PHASE` in `vote`/`openjoin`/`open0`/ + `open1`/`join`), `TIMERS` are the ids of actors with an active election timeout, and + `ENVELOPES` are `e(src,dst,msg)#count` in flight. `history`/`random_choices`/ + `actor_storages` (always the unit value `()` for this model) and `crashed` (always all + `false`, since `max_crashes` is never set above `0`) are omitted, as they carry no + information here. +- `` is `deliver(src,dst,msg)` or `timeout(id,election)`. +- Set elements (`GOSSIPS`, `VOTES`) and `ENVELOPES` are ordered using the real Rust + `#[derive(Ord)]` implementations of `GossipStruct`/`VoteStruct`/`Envelope` (not a + string sort). +- Per `Model::next_state`'s "`None` = no-op" contract, only actions where `next_state` + returns `Some` produce an `edge` line (`Model::next_steps`'s default implementation + already filters these out). + +`--nodes` is an alias for the existing `--n-nodes`/`-n` flag, and (being a global clap +argument) is accepted either before or after the subcommand, so existing invocations +(`cargo run -- --n-nodes 3 check`, `cargo run check`, `cargo run -- --n-nodes 3 serve`) keep +working unchanged alongside `cargo run --quiet -- export --nodes `. From bcf707173cccd7f643d47b1630cd55ddc1d7c593 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 11:33:35 +0100 Subject: [PATCH 19/35] Tighten temporary migration checks Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../lean-disaster-recovery-migration.yml | 1 + .../AxiomChecks.lean | 8 +- .../lake-manifest.json | 227 ++++++++++-------- 3 files changed, 132 insertions(+), 104 deletions(-) diff --git a/.github/workflows/lean-disaster-recovery-migration.yml b/.github/workflows/lean-disaster-recovery-migration.yml index d286201f058e..f559e52bb22c 100644 --- a/.github/workflows/lean-disaster-recovery-migration.yml +++ b/.github/workflows/lean-disaster-recovery-migration.yml @@ -3,6 +3,7 @@ name: "Lean Disaster Recovery Migration Evidence" on: pull_request: paths: + - "lean/disaster-recovery/**" - "lean/disaster-recovery-migration/**" - "tla/disaster-recovery/**" - ".github/workflows/lean-disaster-recovery-migration.yml" diff --git a/lean/disaster-recovery-migration/AxiomChecks.lean b/lean/disaster-recovery-migration/AxiomChecks.lean index 7d35521df0e3..689bd7be3431 100644 --- a/lean/disaster-recovery-migration/AxiomChecks.lean +++ b/lean/disaster-recovery-migration/AxiomChecks.lean @@ -9,8 +9,12 @@ elab "#assert_no_migration_sorries" : command => do let env <- getEnv let mut offenders : Array Name := #[] for (name, _) in env.constants.toList do - if name.toString.startsWith "DisasterRecoveryMigration" || - name.toString.startsWith "DisasterRecovery" then + let projectDeclaration := + match env.getModuleIdxFor? name with + | none => false + | some index => + env.header.moduleNames[index.toNat]!.toString.startsWith "DisasterRecovery" + if projectDeclaration then let axioms <- liftCoreM <| Lean.collectAxioms name if axioms.contains (Name.mkSimple "sorryAx") then offenders := offenders.push name diff --git a/lean/disaster-recovery-migration/lake-manifest.json b/lean/disaster-recovery-migration/lake-manifest.json index a1e9e3c4b3ea..b3664513dd68 100644 --- a/lean/disaster-recovery-migration/lake-manifest.json +++ b/lean/disaster-recovery-migration/lake-manifest.json @@ -1,102 +1,125 @@ -{"version": "1.1.0", - "packagesDir": ".lake/packages", - "packages": - [{"type": "path", - "scope": "", - "name": "disaster_recovery", - "manifestFile": "lake-manifest.json", - "inherited": false, - "dir": "../disaster-recovery", - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/mathlib4.git", - "type": "git", - "subDir": null, - "scope": "", - "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", - "name": "mathlib", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", - "inherited": true, - "configFile": "lakefile.lean"}, - {"url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/LeanSearchClient", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", - "name": "LeanSearchClient", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/import-graph", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", - "name": "importGraph", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/ProofWidgets4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", - "name": "proofwidgets", - "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.87", - "inherited": true, - "configFile": "lakefile.lean"}, - {"url": "https://github.com/leanprover-community/aesop", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", - "name": "aesop", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/quote4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", - "name": "Qq", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/batteries", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", - "name": "batteries", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover/lean4-cli", - "type": "git", - "subDir": null, - "scope": "leanprover", - "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", - "name": "Cli", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", - "inherited": true, - "configFile": "lakefile.toml"}], - "name": "disaster_recovery_migration", - "lakeDir": ".lake"} +{ + "version": "1.1.0", + "packagesDir": ".lake/packages", + "packages": [ + { + "type": "path", + "scope": "", + "name": "disaster_recovery", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "../disaster-recovery", + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/mathlib4.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", + "name": "mathlib", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.lean" + }, + { + "url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/LeanSearchClient", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "name": "LeanSearchClient", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/import-graph", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", + "name": "importGraph", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/ProofWidgets4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", + "name": "proofwidgets", + "manifestFile": "lake-manifest.json", + "inputRev": "v0.0.87", + "inherited": true, + "configFile": "lakefile.lean" + }, + { + "url": "https://github.com/leanprover-community/aesop", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", + "name": "aesop", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/quote4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", + "name": "Qq", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/batteries", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", + "name": "batteries", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover/lean4-cli", + "type": "git", + "subDir": null, + "scope": "leanprover", + "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.toml" + } + ], + "name": "disaster_recovery_migration", + "lakeDir": ".lake" +} From 02c1548ab5c150cfd2c205d8b3f754963c94940d Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 22:24:47 +0100 Subject: [PATCH 20/35] Enforce disaster recovery export invariants Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- tla/disaster-recovery/src/export.rs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/tla/disaster-recovery/src/export.rs b/tla/disaster-recovery/src/export.rs index f9988717b9ee..e62e4702c8dc 100644 --- a/tla/disaster-recovery/src/export.rs +++ b/tla/disaster-recovery/src/export.rs @@ -82,6 +82,8 @@ use stateright::Model; use std::collections::{HashMap, VecDeque}; use std::io::{self, Write}; +const PREDICATE_COUNT: usize = 9; + fn fmt_id(id: Id) -> String { usize::from(id).to_string() } @@ -239,10 +241,9 @@ pub fn fmt_action(action: &ActorModelAction) -> String { ActorModelAction::Timeout(id, Timer::ElectionTimeout) => { format!("timeout({},election)", fmt_id(*id)) } - other => unreachable!( - "action variant {:?} is outside the ccf-legacy-dr-graph-v1 contract \ - (only Deliver/Timeout are ever produced by this model's configuration)", - other + _ => unreachable!( + "action variant is outside the ccf-legacy-dr-graph-v1 contract \ + (only Deliver/Timeout are ever produced by this model's configuration)" ), } } @@ -282,6 +283,12 @@ pub fn export_graph( model: &ActorModel, out: &mut W, ) -> io::Result<()> { + assert_eq!( + model.properties.len(), + PREDICATE_COUNT, + "ccf-legacy-dr-graph-v1 requires exactly {PREDICATE_COUNT} registered model properties" + ); + // Indexed by BFS discovery order (a "discovery id"); remapped to the // canonical sorted-key id only once the full state set is known. let mut visited: HashMap, usize> = HashMap::new(); From 252377ddf88904625544792b94741c909e327c4d Mon Sep 17 00:00:00 2001 From: achamayou Date: Mon, 7 Sep 2026 20:50:01 +0100 Subject: [PATCH 21/35] Update migration evidence for Lean 4.33 Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- .github/workflows/README.md | 4 ++ .../lean-disaster-recovery-migration.yml | 71 ------------------- .github/workflows/lean.yml | 53 ++++++++++++++ lean/disaster-recovery-migration/.gitignore | 1 - .../AxiomChecks.lean | 27 ------- .../DisasterRecoveryMigration.lean | 2 +- .../DisasterRecoveryMigration/Refinement.lean | 4 +- lean/disaster-recovery-migration/README.md | 38 +++++----- .../lake-manifest.json | 41 +++++++---- .../disaster-recovery-migration/lakefile.toml | 3 + .../lean-toolchain | 2 +- 11 files changed, 111 insertions(+), 135 deletions(-) delete mode 100644 .github/workflows/lean-disaster-recovery-migration.yml delete mode 100644 lean/disaster-recovery-migration/.gitignore delete mode 100644 lean/disaster-recovery-migration/AxiomChecks.lean diff --git a/.github/workflows/README.md b/.github/workflows/README.md index bf65dc78162a..07e6d9404580 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -114,6 +114,10 @@ and the proof implementation files marked as generated for review purposes. The standard `mk_all --check` command ensures that the audit root imports every library module, so newly added proofs cannot silently escape the checks. +The temporary migration-evidence job builds and audits the Lean mirror of the +legacy Rust/Stateright disaster recovery model, exercises both implementations, +and exhaustively compares their complete graphs for up to three nodes. + File: `lean.yml` 3rd party dependencies: None diff --git a/.github/workflows/lean-disaster-recovery-migration.yml b/.github/workflows/lean-disaster-recovery-migration.yml deleted file mode 100644 index f559e52bb22c..000000000000 --- a/.github/workflows/lean-disaster-recovery-migration.yml +++ /dev/null @@ -1,71 +0,0 @@ -name: "Lean Disaster Recovery Migration Evidence" - -on: - pull_request: - paths: - - "lean/disaster-recovery/**" - - "lean/disaster-recovery-migration/**" - - "tla/disaster-recovery/**" - - ".github/workflows/lean-disaster-recovery-migration.yml" - -concurrency: - group: ${{ github.workflow }}-${{ github.ref }} - cancel-in-progress: true - -permissions: read-all - -jobs: - migration-evidence: - name: Temporary migration evidence - runs-on: ubuntu-latest - timeout-minutes: 90 - - steps: - - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 - - - name: Install Lean and Rust - shell: bash - run: | - set -euo pipefail - sudo apt-get update - sudo apt-get install -y elan - elan toolchain install "$(cat lean/disaster-recovery-migration/lean-toolchain)" - rustup toolchain install stable --profile minimal - rustup default stable - - - name: Build and check Rust model - working-directory: tla/disaster-recovery - shell: bash - run: | - set -euo pipefail - cargo check --locked - cargo build --locked - cargo run --quiet --locked -- --nodes 2 check - - - name: Check canonical Lean package - working-directory: lean/disaster-recovery - shell: bash - run: | - set -euo pipefail - lake exe cache get - lake build - lake env lean -DwarningAsError=true AxiomChecks.lean - lake exe canonical-checks - - - name: Build and check migration Lean package - working-directory: lean/disaster-recovery-migration - shell: bash - run: | - set -euo pipefail - lake exe cache get - lake build - lake env lean -DwarningAsError=true AxiomChecks.lean - lake exe migration-semantic-checks - lake exe migration-model-checker --nodes 3 - - - name: Compare complete Rust and Lean graphs - working-directory: lean/disaster-recovery-migration - shell: bash - run: | - set -euo pipefail - python3 compare.py --nodes 1 2 3 diff --git a/.github/workflows/lean.yml b/.github/workflows/lean.yml index 081a8fc0604b..cb1f134a392a 100644 --- a/.github/workflows/lean.yml +++ b/.github/workflows/lean.yml @@ -4,6 +4,7 @@ on: pull_request: paths: - "lean/**" + - "tla/disaster-recovery/**" - ".github/workflows/lean.yml" concurrency: @@ -45,3 +46,55 @@ jobs: lake build --wfail lake lint lake exe canonical-checks + + migration-evidence: + name: Temporary migration evidence + runs-on: ubuntu-latest + timeout-minutes: 90 + + steps: + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Lean and Rust + shell: bash + run: | + set -euo pipefail + sudo apt-get update + sudo apt-get install -y elan + elan toolchain install "$(cat lean/disaster-recovery-migration/lean-toolchain)" + rustup toolchain install stable --profile minimal + rustup default stable + + - name: Build and check Rust model + working-directory: tla/disaster-recovery + shell: bash + run: | + set -euo pipefail + cargo check --locked + cargo build --locked + cargo run --quiet --locked -- --nodes 2 check + + - name: Restore Mathlib cache + working-directory: lean/disaster-recovery-migration + shell: bash + run: | + set -euo pipefail + lake exe cache get + + - name: Build and check migration model + working-directory: lean/disaster-recovery-migration + shell: bash + run: | + set -euo pipefail + lake exe mk_all --check --lib DisasterRecoveryMigration + lake build --wfail + lake lint + lake exe migration-semantic-checks + lake exe migration-model-checker --nodes 3 + + - name: Compare complete Rust and Lean graphs + working-directory: lean/disaster-recovery-migration + shell: bash + run: | + set -euo pipefail + python3 compare.py --nodes 1 2 3 diff --git a/lean/disaster-recovery-migration/.gitignore b/lean/disaster-recovery-migration/.gitignore deleted file mode 100644 index 4080d07dfc31..000000000000 --- a/lean/disaster-recovery-migration/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/.lake/ diff --git a/lean/disaster-recovery-migration/AxiomChecks.lean b/lean/disaster-recovery-migration/AxiomChecks.lean deleted file mode 100644 index 689bd7be3431..000000000000 --- a/lean/disaster-recovery-migration/AxiomChecks.lean +++ /dev/null @@ -1,27 +0,0 @@ -import DisasterRecovery -import DisasterRecoveryMigration -import Lean.Elab.Command -import Lean.Util.CollectAxioms - -open Lean Elab Command - -elab "#assert_no_migration_sorries" : command => do - let env <- getEnv - let mut offenders : Array Name := #[] - for (name, _) in env.constants.toList do - let projectDeclaration := - match env.getModuleIdxFor? name with - | none => false - | some index => - env.header.moduleNames[index.toNat]!.toString.startsWith "DisasterRecovery" - if projectDeclaration then - let axioms <- liftCoreM <| Lean.collectAxioms name - if axioms.contains (Name.mkSimple "sorryAx") then - offenders := offenders.push name - unless offenders.isEmpty do - throwError "declarations contain sorryAx: {offenders}" - -#assert_no_migration_sorries - -def main : IO Unit := - pure () diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean index c1479820c03e..f17bd8ffc407 100644 --- a/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean +++ b/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean @@ -1,3 +1,3 @@ -import DisasterRecoveryMigration.Legacy.Model import DisasterRecoveryMigration.Legacy.Checker +import DisasterRecoveryMigration.Legacy.Model import DisasterRecoveryMigration.Refinement diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean index b339e8d17aa1..722e5d2229e1 100644 --- a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean +++ b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean @@ -206,14 +206,14 @@ theorem compatibility_step_simulates rw [compatible.canonical] exact canonical_step_simulates config before event -def retryCompatibility +theorem retryCompatibility (config : Config) (state : NodeState) : CompatibilityStep config state .retry state := { canonical := rfl } -def voteQuorumCompatibility +theorem voteQuorumCompatibility (config : Config) (before : NodeState) (source : Location) : diff --git a/lean/disaster-recovery-migration/README.md b/lean/disaster-recovery-migration/README.md index 25976e5a701f..3ea813d5400b 100644 --- a/lean/disaster-recovery-migration/README.md +++ b/lean/disaster-recovery-migration/README.md @@ -3,8 +3,9 @@ This package is the temporary PR 2 evidence layer for migrating the legacy Rust/Stateright disaster recovery model to Lean. It depends locally on the canonical package in `../disaster-recovery`; it does not modify or duplicate -that package. This directory and its dedicated workflow are intended to be -deleted wholesale by PR 3 once the migration evidence has served its purpose. +that package. This directory and the shared Lean workflow's migration-evidence +job are intended to be deleted by PR 3 once the evidence has served its +purpose. ## Scope @@ -81,16 +82,15 @@ Two intentional model differences are explicit: ## Files -| File | Purpose | -| ----------------------------------------------- | ------------------------------------------------------------------- | -| `DisasterRecoveryMigration/Legacy/Model.lean` | Exact executable legacy semantics | -| `DisasterRecoveryMigration/Legacy/Checker.lean` | BFS model checker and canonical graph encoder | -| `Main.lean` | Legacy model-checker CLI | -| `ExportMain.lean` | Separate Lean graph-exporter CLI | -| `Tests.lean` | Focused legacy semantic checks | -| `DisasterRecoveryMigration/Refinement.lean` | Canonical-to-legacy phase refinement | -| `AxiomChecks.lean` | `sorryAx` rejection for loaded migration and canonical declarations | -| `compare.py` | Bidirectional exhaustive Rust/Lean comparison | +| File | Purpose | +| ----------------------------------------------- | --------------------------------------------- | +| `DisasterRecoveryMigration/Legacy/Model.lean` | Exact executable legacy semantics | +| `DisasterRecoveryMigration/Legacy/Checker.lean` | BFS model checker and canonical graph encoder | +| `Main.lean` | Legacy model-checker CLI | +| `ExportMain.lean` | Separate Lean graph-exporter CLI | +| `Tests.lean` | Focused legacy semantic checks | +| `DisasterRecoveryMigration/Refinement.lean` | Canonical-to-legacy phase refinement | +| `compare.py` | Bidirectional exhaustive Rust/Lean comparison | ## Validation @@ -98,14 +98,16 @@ Run from this directory: ```console lake exe cache get -lake build +lake exe mk_all --check --lib DisasterRecoveryMigration +lake build --wfail +lake lint lake exe migration-semantic-checks lake exe migration-model-checker --nodes 3 -lake env lean -DwarningAsError=true AxiomChecks.lean python3 compare.py --nodes 1 2 3 ``` -The canonical package's own `AxiomChecks.lean` remains authoritative for all -canonical declarations and is also run by the dedicated migration workflow. -The migration Lake package pins the same Lean toolchain, transitively resolves -the same Mathlib revision, and treats warnings as errors. +The canonical package's own axiom-audit configuration remains authoritative +for all canonical declarations and is run by the canonical job in the shared +Lean workflow. The migration Lake package pins Lean 4.33.1, transitively +resolves Mathlib v4.33.1, treats warnings as errors, verifies complete library +coverage with `mk_all --check`, and audits transitive axioms with `lake lint`. diff --git a/lean/disaster-recovery-migration/lake-manifest.json b/lean/disaster-recovery-migration/lake-manifest.json index b3664513dd68..2fcc2ce77743 100644 --- a/lean/disaster-recovery-migration/lake-manifest.json +++ b/lean/disaster-recovery-migration/lake-manifest.json @@ -1,5 +1,5 @@ { - "version": "1.1.0", + "version": "1.2.0", "packagesDir": ".lake/packages", "packages": [ { @@ -11,15 +11,27 @@ "dir": "../disaster-recovery", "configFile": "lakefile.toml" }, + { + "url": "https://github.com/leanprover-community/axiom-audit.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "46024e005996495c65ef609368e11ab39c4222e3", + "name": "axiomAudit", + "manifestFile": "lake-manifest.json", + "inputRev": "46024e005996495c65ef609368e11ab39c4222e3", + "inherited": true, + "configFile": "lakefile.toml" + }, { "url": "https://github.com/leanprover-community/mathlib4.git", "type": "git", "subDir": null, "scope": "", - "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", + "rev": "0df444a360eaa60ab8c11dca51a86af692955474", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", + "inputRev": "v4.33.1", "inherited": true, "configFile": "lakefile.lean" }, @@ -28,7 +40,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", + "rev": "b7eb3304aeae834b12dda98993a37f6a41f6f0bb", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -40,7 +52,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "rev": "5f4d51b81cbd3f6b32b156bfad9056621a040404", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -52,7 +64,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", + "rev": "16f02aa7642864af59f1ff0e384a015994db9118", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -64,10 +76,10 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", + "rev": "4be2e3d5087eeb272cf5a8853b8f9dd025ef5957", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.87", + "inputRev": "main", "inherited": true, "configFile": "lakefile.lean" }, @@ -76,7 +88,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", + "rev": "3448c0bcc5ce01b2d1546e483ec3620e32df3d0e", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -88,7 +100,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", + "rev": "92c15be17b7caf78c2ad767ec40f89052d908d81", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -100,7 +112,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", + "rev": "4488d40d070b9700d4d5a6aa342f0d40c31b2a2d", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -112,14 +124,15 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", + "rev": "6130a47896ce867c6a4a55373441e59e565bad0f", "name": "Cli", "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", + "inputRev": "v4.33.0", "inherited": true, "configFile": "lakefile.toml" } ], "name": "disaster_recovery_migration", - "lakeDir": ".lake" + "lakeDir": ".lake", + "fixedToolchain": false } diff --git a/lean/disaster-recovery-migration/lakefile.toml b/lean/disaster-recovery-migration/lakefile.toml index d9c53898bb48..2096426c753f 100644 --- a/lean/disaster-recovery-migration/lakefile.toml +++ b/lean/disaster-recovery-migration/lakefile.toml @@ -1,6 +1,9 @@ name = "disaster_recovery_migration" version = "0.1.0" moreLeanArgs = ["-DwarningAsError=true"] +# Quote the hyphenated executable name for Lean's name parser. +lintDriver = "axiomAudit/\u00abaxiom-audit\u00bb" +lintDriverArgs = ["--root", "DisasterRecoveryMigration"] defaultTargets = [ "DisasterRecoveryMigration", "migration-model-checker", diff --git a/lean/disaster-recovery-migration/lean-toolchain b/lean/disaster-recovery-migration/lean-toolchain index 4c685fa085fa..a8afa7d1b02d 100644 --- a/lean/disaster-recovery-migration/lean-toolchain +++ b/lean/disaster-recovery-migration/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.28.0 +leanprover/lean4:v4.33.1 From 0e75abecb43e0d5f915edfb5b01c0a8e93e28662 Mon Sep 17 00:00:00 2001 From: achamayou Date: Wed, 9 Sep 2026 00:02:39 +0100 Subject: [PATCH 22/35] Fix migration refinement namespace Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- .../DisasterRecoveryMigration/Refinement.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean index 722e5d2229e1..6a3a74ccb613 100644 --- a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean +++ b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean @@ -4,7 +4,7 @@ import Mathlib.Logic.Relation namespace DisasterRecoveryMigration.Refinement -open DisasterRecovery.Protocol +open DisasterRecovery.Protocol.Model def projectPhase (state : NodeState) : DisasterRecoveryMigration.Legacy.Phase := match state.phase with From f5ab02bf516dbba730573d83242fc499ca2078f4 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 11:57:06 +0100 Subject: [PATCH 23/35] Remove superseded disaster recovery models Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .github/workflows/README.md | 4 - .github/workflows/ci-verification.yml | 38 +- .github/workflows/lean.yml | 53 -- .../DisasterRecoveryMigration.lean | 3 - .../Legacy/Checker.lean | 152 ----- .../Legacy/Model.lean | 392 ------------ .../DisasterRecoveryMigration/Refinement.lean | 335 ---------- .../ExportMain.lean | 24 - lean/disaster-recovery-migration/Main.lean | 23 - lean/disaster-recovery-migration/README.md | 113 ---- lean/disaster-recovery-migration/Tests.lean | 72 --- lean/disaster-recovery-migration/compare.py | 358 ----------- .../lake-manifest.json | 138 ---- .../disaster-recovery-migration/lakefile.toml | 31 - .../lean-toolchain | 1 - tla/disaster-recovery/.gitignore | 1 - tla/disaster-recovery/Cargo.lock | 592 ------------------ tla/disaster-recovery/Cargo.toml | 7 - tla/disaster-recovery/Readme.md | 59 -- tla/disaster-recovery/src/export.rs | 377 ----------- tla/disaster-recovery/src/main.rs | 274 -------- tla/disaster-recovery/src/model.rs | 193 ------ 22 files changed, 24 insertions(+), 3216 deletions(-) delete mode 100644 lean/disaster-recovery-migration/DisasterRecoveryMigration.lean delete mode 100644 lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Checker.lean delete mode 100644 lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Model.lean delete mode 100644 lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean delete mode 100644 lean/disaster-recovery-migration/ExportMain.lean delete mode 100644 lean/disaster-recovery-migration/Main.lean delete mode 100644 lean/disaster-recovery-migration/README.md delete mode 100644 lean/disaster-recovery-migration/Tests.lean delete mode 100755 lean/disaster-recovery-migration/compare.py delete mode 100644 lean/disaster-recovery-migration/lake-manifest.json delete mode 100644 lean/disaster-recovery-migration/lakefile.toml delete mode 100644 lean/disaster-recovery-migration/lean-toolchain delete mode 100644 tla/disaster-recovery/.gitignore delete mode 100644 tla/disaster-recovery/Cargo.lock delete mode 100644 tla/disaster-recovery/Cargo.toml delete mode 100644 tla/disaster-recovery/Readme.md delete mode 100644 tla/disaster-recovery/src/export.rs delete mode 100644 tla/disaster-recovery/src/main.rs delete mode 100644 tla/disaster-recovery/src/model.rs diff --git a/.github/workflows/README.md b/.github/workflows/README.md index 07e6d9404580..bf65dc78162a 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -114,10 +114,6 @@ and the proof implementation files marked as generated for review purposes. The standard `mk_all --check` command ensures that the audit root imports every library module, so newly added proofs cannot silently escape the checks. -The temporary migration-evidence job builds and audits the Lean mirror of the -legacy Rust/Stateright disaster recovery model, exercises both implementations, -and exhaustively compares their complete graphs for up to three nodes. - File: `lean.yml` 3rd party dependencies: None diff --git a/.github/workflows/ci-verification.yml b/.github/workflows/ci-verification.yml index 1a72ca4feb95..71bf6fa49b82 100644 --- a/.github/workflows/ci-verification.yml +++ b/.github/workflows/ci-verification.yml @@ -243,24 +243,34 @@ jobs: path: | tla/traces/* - model-checking-self-healing-open: - name: Model Checking - Self-Healing Open - runs-on: [self-hosted, 1ES.Pool=gha-vmss-d16av6-ci] - container: - image: mcr.microsoft.com/azurelinux/base/core:3.0 - options: --user root --publish-all --cap-add NET_ADMIN --cap-add NET_RAW --cap-add SYS_PTRACE + lean-disaster-recovery: + name: Lean Disaster Recovery - Canonical Model + runs-on: ubuntu-latest + timeout-minutes: 30 steps: - - name: "Checkout dependencies" + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Lean shell: bash run: | - gpg --import /etc/pki/rpm-gpg/MICROSOFT-RPM-GPG-KEY - tdnf -y update - tdnf -y install ca-certificates git + set -euo pipefail + sudo apt-get update + sudo apt-get install -y elan + elan toolchain install "$(cat lean/disaster-recovery/lean-toolchain)" - - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 - - name: Install Stateright dependencies + - name: Restore Mathlib cache + working-directory: lean/disaster-recovery + shell: bash run: | - tdnf install -y cargo + set -euo pipefail + lake exe cache get - - run: cd tla/disaster-recovery && cargo run check + - name: Build and check canonical model + working-directory: lean/disaster-recovery + shell: bash + run: | + set -euo pipefail + lake build + lake env lean -DwarningAsError=true AxiomChecks.lean + lake exe canonical-checks diff --git a/.github/workflows/lean.yml b/.github/workflows/lean.yml index cb1f134a392a..081a8fc0604b 100644 --- a/.github/workflows/lean.yml +++ b/.github/workflows/lean.yml @@ -4,7 +4,6 @@ on: pull_request: paths: - "lean/**" - - "tla/disaster-recovery/**" - ".github/workflows/lean.yml" concurrency: @@ -46,55 +45,3 @@ jobs: lake build --wfail lake lint lake exe canonical-checks - - migration-evidence: - name: Temporary migration evidence - runs-on: ubuntu-latest - timeout-minutes: 90 - - steps: - - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 - - - name: Install Lean and Rust - shell: bash - run: | - set -euo pipefail - sudo apt-get update - sudo apt-get install -y elan - elan toolchain install "$(cat lean/disaster-recovery-migration/lean-toolchain)" - rustup toolchain install stable --profile minimal - rustup default stable - - - name: Build and check Rust model - working-directory: tla/disaster-recovery - shell: bash - run: | - set -euo pipefail - cargo check --locked - cargo build --locked - cargo run --quiet --locked -- --nodes 2 check - - - name: Restore Mathlib cache - working-directory: lean/disaster-recovery-migration - shell: bash - run: | - set -euo pipefail - lake exe cache get - - - name: Build and check migration model - working-directory: lean/disaster-recovery-migration - shell: bash - run: | - set -euo pipefail - lake exe mk_all --check --lib DisasterRecoveryMigration - lake build --wfail - lake lint - lake exe migration-semantic-checks - lake exe migration-model-checker --nodes 3 - - - name: Compare complete Rust and Lean graphs - working-directory: lean/disaster-recovery-migration - shell: bash - run: | - set -euo pipefail - python3 compare.py --nodes 1 2 3 diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean deleted file mode 100644 index f17bd8ffc407..000000000000 --- a/lean/disaster-recovery-migration/DisasterRecoveryMigration.lean +++ /dev/null @@ -1,3 +0,0 @@ -import DisasterRecoveryMigration.Legacy.Checker -import DisasterRecoveryMigration.Legacy.Model -import DisasterRecoveryMigration.Refinement diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Checker.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Checker.lean deleted file mode 100644 index 659daef03546..000000000000 --- a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Checker.lean +++ /dev/null @@ -1,152 +0,0 @@ -import DisasterRecoveryMigration.Legacy.Model - -namespace DisasterRecoveryMigration.Legacy - -structure Edge where - src : Nat - action : Action - dst : Nat -deriving Repr, BEq - -structure Graph where - states : Array GlobalState - edges : Array Edge - parents : Array (Option (Prod Nat Action)) - -def enumerate (n : Nat) : IO Graph := do - let initial := initialState n - let mut states := #[initial] - let mut edges := #[] - let mut parents : Array (Option (Prod Nat Action)) := #[none] - let mut seen : Std.HashMap String Nat := {} - seen := seen.insert (stateKey initial) 0 - let mut cursor := 0 - while cursor < states.size do - let state := states[cursor]! - for action in actions state do - match nextState n state action with - | none => pure () - | some next => - let key := stateKey next - let (dst, discovered) := - match seen[key]? with - | some index => (index, false) - | none => (states.size, true) - if discovered then - seen := seen.insert key dst - states := states.push next - parents := parents.push (some (cursor, action)) - edges := edges.push { src := cursor, action, dst } - cursor := cursor + 1 - pure { states, edges, parents } - -def valuationBits (values : Array Bool) : String := - String.ofList (values.toList.map fun value => if value then '1' else '0') - -private structure ExportEdge where - src : Nat - action : String - dst : Nat - -private def exportEdgeLE (left right : ExportEdge) : Bool := - left.src < right.src || - (left.src == right.src && - (left.action < right.action || - (left.action == right.action && left.dst <= right.dst))) - -private def traceTo (graph : Graph) (target : Nat) : List Action := - let rec collect (index : Nat) (fuel : Nat) (suffix : List Action) : List Action := - match fuel with - | 0 => suffix - | fuel + 1 => - match graph.parents[index]? |>.bind id with - | none => suffix - | some (parent, action) => collect parent fuel (action :: suffix) - collect target graph.states.size [] - -private def printTrace (graph : Graph) (target : Nat) : IO Unit := do - let trace := traceTo graph target - if trace.isEmpty then - IO.eprintln " trace: " - else - for (action, step) in trace.zipIdx do - IO.eprintln s!" {step + 1}. {actionKey action}" - -private def eventuallyGood (graph : Graph) (property : Nat) : Array Bool := - Id.run do - let mut good := - graph.states.map fun state => (legacyValuations state.actors.size state)[property]! - let mut remaining := Array.replicate graph.states.size 0 - let mut predecessors : Array (List Nat) := Array.replicate graph.states.size [] - for edge in graph.edges do - remaining := remaining.modify edge.src (fun count => count + 1) - predecessors := predecessors.modify edge.dst (fun values => edge.src :: values) - let mut queue := #[] - for index in List.range good.size do - if good[index]! then queue := queue.push index - let mut cursor := 0 - while cursor < queue.size do - let resolved := queue[cursor]! - for predecessor in predecessors[resolved]! do - if !good[predecessor]! then - remaining := remaining.modify predecessor (fun count => count - 1) - if remaining[predecessor]! == 0 then - good := good.set! predecessor true - queue := queue.push predecessor - cursor := cursor + 1 - return good - -def checkGraph (n : Nat) (graph : Graph) : IO Bool := do - IO.eprintln s!"reachable states: {graph.states.size}, transitions: {graph.edges.size}" - let mut passed := true - for property in List.range legacyPropertyNames.size do - let name := legacyPropertyNames[property]! - let expectation := legacyExpectations[property]! - let values := graph.states.map fun state => (legacyValuations n state)[property]! - let eventual := if expectation == "eventually" then eventuallyGood graph property else #[] - let result := - if expectation == "always" then values.all id - else if expectation == "sometimes" then values.any id - else eventual[0]! - IO.eprintln s!"{if result then "PASS" else "FAIL"} [{expectation}] {name}" - if result && expectation == "sometimes" then - match (List.range values.size).find? (fun index => values[index]!) with - | none => pure () - | some index => - IO.eprintln " shortest example:" - printTrace graph index - else if !result then - passed := false - let witness := - if expectation == "always" then - (List.range values.size).find? fun index => !values[index]! - else if expectation == "sometimes" then - some 0 - else - (List.range values.size).find? fun index => - !eventual[index]! - match witness with - | none => IO.eprintln " no reachable example" - | some index => printTrace graph index - pure passed - -def exportGraph (n : Nat) (graph : Graph) : IO Unit := do - let canonical := (graph.states.toList.zipIdx.map fun (state, bfsId) => - (stateKey state, bfsId)).mergeSort (fun left right => left.1 <= right.1) - let mut ids := Array.replicate graph.states.size 0 - for ((_, bfsId), canonicalId) in canonical.zipIdx do - ids := ids.set! bfsId canonicalId - IO.println "format\tccf-legacy-dr-graph-v1" - IO.println s!"nodes\t{n}" - IO.println s!"init\t{ids[0]!}" - for ((key, bfsId), canonicalId) in canonical.zipIdx do - IO.println s!"state\t{canonicalId}\t{key}\t{valuationBits (legacyValuations n graph.states[bfsId]!)}" - let canonicalEdges := (graph.edges.toList.map fun edge => { - src := ids[edge.src]! - action := actionKey edge.action - dst := ids[edge.dst]! - }).mergeSort exportEdgeLE - for edge in canonicalEdges do - IO.println s!"edge\t{edge.src}\t{edge.action}\t{edge.dst}" - -end DisasterRecoveryMigration.Legacy diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Model.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Model.lean deleted file mode 100644 index 91000ae2f1b5..000000000000 --- a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Legacy/Model.lean +++ /dev/null @@ -1,392 +0,0 @@ -import Std - -namespace DisasterRecoveryMigration.Legacy - -abbrev Id := Nat -abbrev Txid := Nat - -structure Gossip where - src : Id - txid : Txid -deriving Repr, BEq, Hashable - -structure Vote where - src : Id - recv : List Gossip -deriving Repr, BEq, Hashable - -inductive Msg where - | gossip (value : Gossip) - | vote (value : Vote) - | iAmOpen (src : Id) -deriving Repr, BEq, Hashable - -inductive Phase where - | vote - | openJoin - | open (timeout : Bool) - | join -deriving Repr, BEq, Hashable, Inhabited - -structure ActorState where - nextStep : Phase - gossips : List Gossip - votes : List Vote - submittedVote : Option (Prod Id Vote) - txid : Txid -deriving Repr, BEq, Hashable, Inhabited - -structure Envelope where - src : Id - dst : Id - msg : Msg -deriving Repr, BEq, Hashable - -structure GlobalState where - actors : Array ActorState - timers : Array Bool - network : List Envelope -deriving Repr, BEq, Hashable, Inhabited - -inductive Action where - | deliver (envelope : Envelope) - | timeout (id : Id) -deriving Repr, BEq, Hashable - -structure Output where - sent : List (Prod Id Msg) := [] - setTimer : Bool := false -deriving Repr, BEq - -private def comma (values : List String) : String := - String.intercalate "," values - -def gossipKey (gossip : Gossip) : String := - s!"g({gossip.src},{gossip.txid})" - -def voteKey (vote : Vote) : String := - s!"v({vote.src},[{comma (vote.recv.map gossipKey)}])" - -def msgKey : Msg -> String - | .gossip gossip => gossipKey gossip - | .vote vote => voteKey vote - | .iAmOpen src => s!"o({src})" - -def envelopeKey (envelope : Envelope) : String := - s!"e({envelope.src},{envelope.dst},{msgKey envelope.msg})" - -def phaseKey : Phase -> String - | .vote => "vote" - | .openJoin => "openjoin" - | .open false => "open0" - | .open true => "open1" - | .join => "join" - -def submittedKey : Option (Prod Id Vote) -> String - | none => "none" - | some (dst, vote) => s!"some({dst},{voteKey vote})" - -def actorKey (actor : ActorState) : String := - s!"s({phaseKey actor.nextStep},[{comma (actor.gossips.map gossipKey)}],[{comma (actor.votes.map voteKey)}],{submittedKey actor.submittedVote},{actor.txid})" - -private def networkRunsFrom (current : Envelope) (count : Nat) : - List Envelope -> List (Prod Envelope Nat) - | [] => [(current, count)] - | head :: tail => - if head == current then - networkRunsFrom current (count + 1) tail - else - (current, count) :: networkRunsFrom head 1 tail - -private def networkRuns : List Envelope -> List (Prod Envelope Nat) - | [] => [] - | head :: tail => networkRunsFrom head 1 tail - -def stateKey (state : GlobalState) : String := - let actors := String.intercalate ";" (state.actors.toList.map actorKey) - let timers := comma (((List.range state.timers.size).filter - (fun id => state.timers[id]!)).map toString) - let network := comma ((networkRuns state.network).map fun (env, count) => - s!"{envelopeKey env}#{count}") - s!"S([{actors}],[{timers}],[{network}])" - -def actionKey : Action -> String - | .deliver env => s!"deliver({env.src},{env.dst},{msgKey env.msg})" - | .timeout id => s!"timeout({id},election)" - -private def insertSorted (before : a -> a -> Bool) (value : a) : List a -> List a - | [] => [value] - | head :: tail => - if before value head then - value :: head :: tail - else - head :: insertSorted before value tail - -private def insertUniqueSorted [BEq a] (before : a -> a -> Bool) (value : a) (values : List a) : - List a := - if values.contains value then values else insertSorted before value values - -private def removeOne [BEq a] (value : a) : List a -> List a - | [] => [] - | head :: tail => if head == value then tail else head :: removeOne value tail - -private def gossipGreater (left right : Gossip) : Bool := - right.txid < left.txid || (right.txid == left.txid && right.src < left.src) - -private def gossipBefore (left right : Gossip) : Bool := - left.src < right.src || (left.src == right.src && left.txid < right.txid) - -private def gossipListBefore : List Gossip -> List Gossip -> Bool - | [], [] => false - | [], _ :: _ => true - | _ :: _, [] => false - | left :: leftTail, right :: rightTail => - if left == right then gossipListBefore leftTail rightTail - else gossipBefore left right - -private def voteBefore (left right : Vote) : Bool := - left.src < right.src || (left.src == right.src && gossipListBefore left.recv right.recv) - -private def msgBefore : Msg -> Msg -> Bool - | .gossip left, .gossip right => gossipBefore left right - | .gossip _, _ => true - | .vote _, .gossip _ => false - | .vote left, .vote right => voteBefore left right - | .vote _, .iAmOpen _ => true - | .iAmOpen _, .gossip _ => false - | .iAmOpen _, .vote _ => false - | .iAmOpen left, .iAmOpen right => left < right - -private def envelopeBefore (left right : Envelope) : Bool := - left.src < right.src || - (left.src == right.src && - (left.dst < right.dst || (left.dst == right.dst && msgBefore left.msg right.msg))) - -private def maximumGossip : List Gossip -> Option Gossip - | [] => none - | head :: tail => - some (tail.foldl (fun current candidate => - if gossipGreater candidate current then candidate else current) head) - -private def voteForMax (gossips : List Gossip) (id : Id) : Option (Prod Id Vote) := do - let maximum <- maximumGossip gossips - pure (maximum.src, { src := id, recv := gossips }) - -private def otherPeers (n id : Nat) : List Id := - (List.range n).filter (fun peer => peer != id) - -private def advanceStep (n id : Nat) (timeout : Bool) (state : ActorState) : - Prod ActorState (Prod Output Bool) := - match state.nextStep with - | .vote => - if state.gossips.length == n || timeout then - match voteForMax state.gossips id with - | none => (state, {}, false) - | some (dst, vote) => - let next := { - state with - nextStep := .openJoin - submittedVote := some (dst, vote) - votes := if dst == id then insertUniqueSorted voteBefore vote state.votes else state.votes - } - let sent := if dst == id then [] else [(dst, Msg.vote vote)] - (next, { sent }, true) - else - (state, {}, false) - | .openJoin => - if state.votes.length >= (n + 1) / 2 || timeout then - let sent := (otherPeers n id).map (fun peer => (peer, Msg.iAmOpen id)) - ({ state with nextStep := .open timeout }, { sent }, true) - else - (state, {}, false) - | _ => (state, {}, false) - -def advanceSeveral (n id : Nat) (timeout : Bool) (state : ActorState) : - Prod ActorState Output := - let (state1, output1, advanced1) := advanceStep n id timeout state - if advanced1 then - let (state2, output2, _) := advanceStep n id timeout state1 - (state2, { sent := output1.sent ++ output2.sent }) - else - (state, {}) - -def onMessage (n id : Nat) (state : ActorState) (msg : Msg) : - Option (Prod ActorState Output) := - let received := - match msg with - | .gossip gossip => - if !state.gossips.contains gossip && state.submittedVote.isNone then - { state with gossips := insertUniqueSorted gossipBefore gossip state.gossips } - else - state - | .vote vote => - { state with votes := insertUniqueSorted voteBefore vote state.votes } - | .iAmOpen _ => - match state.nextStep with - | .open _ => state - | _ => { state with nextStep := .join } - let (next, output) := advanceSeveral n id false received - some (next, output) - -def onTimeout (n id : Nat) (state : ActorState) : Option (Prod ActorState Output) := - match state.nextStep with - | .vote => - if state.gossips.isEmpty then none - else - let (next, output) := advanceSeveral n id true state - some (next, { output with setTimer := true }) - | .openJoin => - if state.votes.isEmpty then none - else some (advanceSeveral n id true state) - | _ => none - -private def applyOutput (src : Id) (output : Output) (state : GlobalState) : GlobalState := - let network := output.sent.foldl - (fun current (dst, msg) => insertSorted envelopeBefore { src, dst, msg } current) - state.network - let timers := if output.setTimer then state.timers.set! src true else state.timers - { state with network, timers } - -private def startActor (n id : Nat) : Prod ActorState Output := - let gossip := { src := id, txid := id } - let initial : ActorState := { - nextStep := .vote - gossips := [gossip] - votes := [] - submittedVote := none - txid := id - } - let output : Output := { - sent := (otherPeers n id).map (fun peer => (peer, Msg.gossip gossip)) - setTimer := true - } - let (state, advanced) := advanceSeveral n id false initial - (state, { sent := output.sent ++ advanced.sent, setTimer := true }) - -def initialState (n : Nat) : GlobalState := - (List.range n).foldl (fun global id => - let (actor, output) := startActor n id - let withActor := { - global with - actors := global.actors.push actor - timers := global.timers.push false - } - applyOutput id output withActor) - { actors := #[], timers := #[], network := [] } - -private def distinctNetworkFrom (previous : Envelope) : List Envelope -> List Envelope - | [] => [] - | head :: tail => - if head == previous then - distinctNetworkFrom previous tail - else - head :: distinctNetworkFrom head tail - -private def distinctNetwork : List Envelope -> List Envelope - | [] => [] - | head :: tail => head :: distinctNetworkFrom head tail - -def actions (state : GlobalState) : List Action := - (distinctNetwork state.network).map Action.deliver ++ - ((List.range state.timers.size).filter - (fun id => state.timers[id]!)).map Action.timeout - -def nextState (n : Nat) (state : GlobalState) : Action -> Option GlobalState - | .deliver envelope => do - let actor <- state.actors[envelope.dst]? - let (nextActor, output) <- onMessage n envelope.dst actor envelope.msg - let delivered := { - state with - actors := state.actors.set! envelope.dst nextActor - network := removeOne envelope state.network - } - pure (applyOutput envelope.dst output delivered) - | .timeout id => do - guard (state.timers[id]?.getD false) - let actor <- state.actors[id]? - let (nextActor, output) <- onTimeout n id actor - let expired := { - state with - actors := state.actors.set! id nextActor - timers := state.timers.set! id false - } - pure (applyOutput id output expired) - -def reachedOpen (state : GlobalState) : Bool := - state.actors.any fun actor => - match actor.nextStep with - | .open _ => true - | _ => false - -def reachedOpenTimeout (state : GlobalState) (expected : Bool) : Bool := - state.actors.any fun actor => actor.nextStep == .open expected - -def unanimousVotes (n : Nat) (state : GlobalState) : Bool := - state.actors.all fun actor => - match actor.submittedVote with - | none => false - | some (_, vote) => - (List.range n).all fun peer => vote.recv.any (fun gossip => gossip.src == peer) - -def majorityHaveSameMaximum (state : GlobalState) : Bool := - let chosen := state.actors.toList.filterMap fun actor => do - let (_, vote) <- actor.submittedVote - let maximum <- maximumGossip vote.recv - pure maximum.src - let chosen := chosen.foldl (fun values id => - insertSorted (fun left right => left < right) id values) [] - let majorityIndex := state.actors.size / 2 - match chosen[majorityIndex]? with - | none => false - | some majority => (chosen.take majorityIndex).all (fun chosen => chosen == majority) - -private def implies (left right : Bool) : Bool := - !left || right - -def legacyValuations (n : Nat) (state : GlobalState) : Array Bool := - let openCount := state.actors.countP fun actor => - match actor.nextStep with - | .open _ => true - | _ => false - let allOpenJoin := state.actors.all (fun actor => actor.nextStep == .openJoin) - let allVotesDelivered := !state.network.any fun envelope => - match envelope.msg with - | .vote _ => true - | _ => false - let majorityIndex := state.actors.size / 2 - let commitTxid := (state.actors[majorityIndex]!).txid - let persisted := state.actors.all fun actor => - match actor.nextStep with - | .open _ => actor.txid >= commitTxid - | _ => true - #[ - implies (unanimousVotes n state) (reachedOpenTimeout state false), - reachedOpen state, - implies (majorityHaveSameMaximum state) (reachedOpenTimeout state false), - implies (!reachedOpenTimeout state true) (openCount <= 1), - !(allOpenJoin && allVotesDelivered), - implies (!reachedOpenTimeout state true) persisted, - implies (state.actors.size > 1) (reachedOpen state), - reachedOpenTimeout state true, - majorityHaveSameMaximum state && reachedOpenTimeout state false - ] - -def legacyPropertyNames : Array String := #[ - "Unanimous votes => no chance of a fork", - "Open", - "Majority votes => no fork", - "No open with timeout, no fork", - "Deadlock", - "Persist committed txs", - "Open is possible", - "Unsafe open with timeout", - "Majority vote still opens without timeout" -] - -def legacyExpectations : Array String := #[ - "eventually", "eventually", "eventually", - "always", "always", "always", - "sometimes", "sometimes", "sometimes" -] - -end DisasterRecoveryMigration.Legacy diff --git a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean b/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean deleted file mode 100644 index 6a3a74ccb613..000000000000 --- a/lean/disaster-recovery-migration/DisasterRecoveryMigration/Refinement.lean +++ /dev/null @@ -1,335 +0,0 @@ -import DisasterRecoveryMigration.Legacy.Model -import DisasterRecovery.Protocol.Model -import Mathlib.Logic.Relation - -namespace DisasterRecoveryMigration.Refinement - -open DisasterRecovery.Protocol.Model - -def projectPhase (state : NodeState) : DisasterRecoveryMigration.Legacy.Phase := - match state.phase with - | .gossiping => .vote - | .voting => .openJoin - | .opening | .open => - match state.openKind with - | some .failover => .open true - | _ => .open false - | .joining => .join - -inductive LegacyAtomic : - DisasterRecoveryMigration.Legacy.Phase -> DisasterRecoveryMigration.Legacy.Phase -> Prop where - | gossipToVoting : LegacyAtomic .vote .openJoin - | quorumOpen : LegacyAtomic .openJoin (.open false) - | failoverOpen : LegacyAtomic .openJoin (.open true) - | gossipToJoin : LegacyAtomic .vote .join - | votingToJoin : LegacyAtomic .openJoin .join - -abbrev LegacyWeakStep := - Relation.ReflTransGen LegacyAtomic - -def embeddedTxID - (config : Config) - (source : Location) - (txid : TxID) : Prop := - txid.view = 0 /\ config.expectedLocations[txid.seqno]? = some source - -structure LegacyDataAssumptions - (config : Config) - (event : Event) - (after : NodeState) : Prop where - /-- Recorded for a future data refinement; phase simulation does not assume it. -/ - oddNodeCount : - exists half, config.expectedLocations.length = 2 * half + 1 - acceptedExpectedInput : - match event with - | .receiveGossip source txid validation => - validation = .accepted /\ - expectedSource config source = true /\ - embeddedTxID config source txid - | .receiveVote source validation => - validation = .accepted /\ expectedSource config source = true - | .receiveIAmOpen source validation => - validation = .accepted /\ expectedSource config source = true - | .timeout | .retry => True - quorumOnly : - after.openKind != some .failover - -structure CompatibilityStep - (config : Config) - (before : NodeState) - (event : Event) - (after : NodeState) : Prop where - canonical : - after = (step config before event).state - -private theorem advance_simulates - (config : Config) - (state : NodeState) - (timeout : Bool) - (output : StepOutput) - (advanced : advance config state timeout = some output) : - LegacyWeakStep (projectPhase state) (projectPhase output.state) := by - cases timeout <;> cases phase : state.phase <;> - simp [advance, phase] at advanced <;> - repeat' split at advanced <;> - simp_all [projectPhase, advanceTimeoutLane, advanceTimeoutState] - all_goals subst output - all_goals simp_all [projectPhase, advanceTimeoutLane] - all_goals - first - | (split <;> simp_all) - | skip - all_goals - first - | exact .refl - | exact .single .gossipToVoting - | exact .single .quorumOpen - | exact .single .failoverOpen - -private theorem receive_gossip_simulates - (config : Config) - (before : NodeState) - (source : Location) - (txid : TxID) - (validation : Validation) : - LegacyWeakStep - (projectPhase before) - (projectPhase - (step config before (.receiveGossip source txid validation)).state) := by - cases validation with - | rejected => - simp [step, rejected] - exact .refl - | accepted => - by_cases frozen : before.chosen != none - case pos => - simp [step, frozen, rejected] - exact .refl - case neg => - let received := { - before with gossips := insertGossip source txid before.gossips } - have same : projectPhase received = projectPhase before := by - simp [received, projectPhase] - cases advanced : advance config received false with - | none => - simp [step, frozen, received, advanced, rejected] - exact .refl - | some output => - simp [step, frozen, received, advanced] - have simulation := - advance_simulates config received false output advanced - rw [same] at simulation - exact simulation - -private theorem receive_vote_simulates - (config : Config) - (before : NodeState) - (source : Location) - (validation : Validation) : - LegacyWeakStep - (projectPhase before) - (projectPhase - (step config before (.receiveVote source validation)).state) := by - cases validation with - | rejected => - simp [step, rejected] - exact .refl - | accepted => - let received := { before with votes := insertVote source before.votes } - have same : projectPhase received = projectPhase before := by - simp [received, projectPhase] - cases advanced : advance config received false with - | none => - simp [step, received, advanced, rejected] - exact .refl - | some output => - simp [step, received, advanced] - have simulation := - advance_simulates config received false output advanced - rw [same] at simulation - exact simulation - -private theorem receive_iamopen_simulates - (config : Config) - (before : NodeState) - (source : Location) - (validation : Validation) : - LegacyWeakStep - (projectPhase before) - (projectPhase - (step config before (.receiveIAmOpen source validation)).state) := by - cases validation with - | rejected => - simp [step, rejected] - exact .refl - | accepted => - cases phase : before.phase <;> - simp [step, phase, advance, rejected, projectPhase, - advanceTimeoutLane] - all_goals - first - | exact .single .gossipToJoin - | exact .single .votingToJoin - | exact .refl - -theorem canonical_step_simulates - (config : Config) - (before : NodeState) - (event : Event) : - LegacyWeakStep - (projectPhase before) - (projectPhase (step config before event).state) := by - cases event with - | receiveGossip source txid validation => - exact receive_gossip_simulates config before source txid validation - | receiveVote source validation => - exact receive_vote_simulates config before source validation - | receiveIAmOpen source validation => - exact receive_iamopen_simulates config before source validation - | timeout => - cases advanced : advance config before true with - | none => - simp [step, advanced, rejected] - exact .refl - | some output => - simp [step, advanced] - exact advance_simulates config before true output advanced - | retry => - exact .refl - -theorem compatibility_step_simulates - {config : Config} - {before after : NodeState} - {event : Event} - (compatible : CompatibilityStep config before event after) : - LegacyWeakStep (projectPhase before) (projectPhase after) := by - rw [compatible.canonical] - exact canonical_step_simulates config before event - -theorem retryCompatibility - (config : Config) - (state : NodeState) : - CompatibilityStep config state .retry state := { - canonical := rfl -} - -theorem voteQuorumCompatibility - (config : Config) - (before : NodeState) - (source : Location) : - CompatibilityStep config before - (.receiveVote source .accepted) - (step config before (.receiveVote source .accepted)).state := { - canonical := rfl -} - -theorem quorum_phase_step_is_weak - (before after : NodeState) - (beforePhase : before.phase = .voting) - (afterPhase : after.phase = .opening) - (kind : after.openKind = some .quorum) : - LegacyWeakStep (projectPhase before) (projectPhase after) := by - simp [projectPhase, beforePhase, afterPhase, kind] - exact .single .quorumOpen - -theorem opening_to_open_is_stuttering - (before after : NodeState) - (beforePhase : before.phase = .opening) - (afterPhase : after.phase = .open) - (kind : after.openKind = before.openKind) : - LegacyWeakStep (projectPhase before) (projectPhase after) := by - simp [projectPhase, beforePhase, afterPhase, kind] - exact .refl - -inductive CompatibilityTrace - (config : Config) : - NodeState -> - List Event -> - NodeState -> - Prop where - | nil (state) : CompatibilityTrace config state [] state - | cons - (first middle last event rest) - (head : CompatibilityStep config first event middle) - (tail : CompatibilityTrace config middle rest last) : - CompatibilityTrace config first (event :: rest) last - -theorem compatibility_trace_simulates - {config : Config} - {first last : NodeState} - {events : List Event} - (compatible : CompatibilityTrace config first events last) : - LegacyWeakStep (projectPhase first) (projectPhase last) := by - induction compatible with - | nil state => exact .refl - | cons first middle last event rest head tail induction => - exact Relation.ReflTransGen.trans - (compatibility_step_simulates head) induction - -theorem initial_phase_correspondence : - projectPhase (initialNode "node0") = DisasterRecoveryMigration.Legacy.Phase.vote := by - rfl - -theorem three_node_initial_correspondence : - let config : Config := { - instanceId := "compat" - expectedLocations := ["0", "1", "2"] - } - ((initialSystem config).nodes.map - (fun entry => projectPhase entry.2) == - (DisasterRecoveryMigration.Legacy.initialState 3).actors.toList.map - (fun actor => actor.nextStep)) = true := by - rfl - -theorem odd_quorum_matches_legacy - (nodes half : Nat) - (odd : nodes = 2 * half + 1) : - nodes / 2 + 1 = (nodes + 1) / 2 := by - subst nodes - simp [Nat.add_div] - -theorem even_quorum_exceeds_legacy_by_one - (nodes half : Nat) - (even : nodes = 2 * half) : - nodes / 2 + 1 = (nodes + 1) / 2 + 1 := by - subst nodes - simp [Nat.add_div] - -def canonicalReachedOpen (state : NodeState) : Prop := - state.phase = .opening \/ state.phase = .open - -def projectedReachedOpen (state : NodeState) : Prop := - match projectPhase state with - | .open _ => True - | _ => False - -theorem reached_open_is_preserved - (state : NodeState) : - canonicalReachedOpen state <-> projectedReachedOpen state := by - cases phase : state.phase <;> - cases kind : state.openKind <;> - simp [canonicalReachedOpen, projectedReachedOpen, projectPhase, phase, kind] - all_goals - rename_i value - cases value <;> - simp - -theorem quorum_kind_projects_to_non_timeout_open - (state : NodeState) - (phase : state.phase = .opening \/ state.phase = .open) - (kind : state.openKind = some .quorum) : - projectPhase state = .open false := by - cases phase with - | inl opening => - cases state - simp_all [projectPhase] - | inr opened => - cases state - simp_all [projectPhase] - -theorem single_node_full_initial_models_differ : - projectPhase (initialNode "0") != - (DisasterRecoveryMigration.Legacy.initialState 1).actors[0]!.nextStep := by - decide - -end DisasterRecoveryMigration.Refinement \ No newline at end of file diff --git a/lean/disaster-recovery-migration/ExportMain.lean b/lean/disaster-recovery-migration/ExportMain.lean deleted file mode 100644 index f7500f6a967c..000000000000 --- a/lean/disaster-recovery-migration/ExportMain.lean +++ /dev/null @@ -1,24 +0,0 @@ -import DisasterRecoveryMigration.Legacy.Checker - -open DisasterRecoveryMigration.Legacy - -private def usage : String := - "usage: migration-exporter [--nodes N]" - -private def parseNodes : List String -> Except String Nat - | [] => pure 3 - | ["--nodes", value] => - match value.toNat? with - | some n => if n > 0 then pure n else throw "--nodes must be positive" - | none => throw s!"invalid node count: {value}" - | _ => throw usage - -def main (args : List String) : IO UInt32 := do - match parseNodes args with - | .error message => - IO.eprintln message - pure 2 - | .ok n => - let graph <- enumerate n - exportGraph n graph - pure 0 diff --git a/lean/disaster-recovery-migration/Main.lean b/lean/disaster-recovery-migration/Main.lean deleted file mode 100644 index c943598da3bc..000000000000 --- a/lean/disaster-recovery-migration/Main.lean +++ /dev/null @@ -1,23 +0,0 @@ -import DisasterRecoveryMigration.Legacy.Checker - -open DisasterRecoveryMigration.Legacy - -private def usage : String := - "usage: migration-model-checker [--nodes N]" - -private def parseNodes : List String -> Except String Nat - | [] => pure 3 - | ["--nodes", value] => - match value.toNat? with - | some n => if n > 0 then pure n else throw "--nodes must be positive" - | none => throw s!"invalid node count: {value}" - | _ => throw usage - -def main (args : List String) : IO UInt32 := do - match parseNodes args with - | .error message => - IO.eprintln message - pure 2 - | .ok n => - let graph <- enumerate n - if <- checkGraph n graph then pure 0 else pure 1 diff --git a/lean/disaster-recovery-migration/README.md b/lean/disaster-recovery-migration/README.md deleted file mode 100644 index 3ea813d5400b..000000000000 --- a/lean/disaster-recovery-migration/README.md +++ /dev/null @@ -1,113 +0,0 @@ -# Temporary disaster recovery migration evidence - -This package is the temporary PR 2 evidence layer for migrating the legacy -Rust/Stateright disaster recovery model to Lean. It depends locally on the -canonical package in `../disaster-recovery`; it does not modify or duplicate -that package. This directory and the shared Lean workflow's migration-evidence -job are intended to be deleted by PR 3 once the evidence has served its -purpose. - -## Scope - -There are two distinct and deliberately weaker claims: - -1. The executable model in `DisasterRecoveryMigration.Legacy` is an exact - Lean mirror of the Rust/Stateright model in `tla/disaster-recovery`. - `compare.py` establishes exhaustive bounded equivalence for one, two, and - three nodes. -2. `DisasterRecoveryMigration.Refinement` relates the canonical C++-aligned - Lean model to the legacy Lean mirror only at the protocol-phase level. - -The bounded comparison is not a theorem about arbitrary node counts or a -formal semantics for Rust or Stateright. The phase refinement is not a full -bisimulation, data refinement, or proof that the canonical model is identical -to the Rust model. - -## Exact bounded equivalence - -Both exporters emit the stable `ccf-legacy-dr-graph-v1` format. State IDs are -assigned after sorting normalized state keys, independently of traversal -order. For each requested node count, `compare.py` checks: - -- the normalized initial state; -- every normalized reachable state in both directions; -- every labeled edge, including source and destination, in both directions; -- all nine registered predicate valuations for every reachable state; and -- the expected complete state and edge counts below. - -| Nodes | Reachable states | Labeled edges | Predicate values per state | -| ----: | ---------------: | ------------: | -------------------------: | -| 1 | 1 | 0 | 9 | -| 2 | 54 | 95 | 9 | -| 3 | 105,558 | 552,282 | 9 | - -The comparator fails on a difference from either exporter and reports a -shortest path to a representative state or edge mismatch. - -The mirror intentionally retains the legacy semantics, including message -multiplicity, unordered delivery, timer behavior, no-op suppression, immediate -multi-phase advancement, and the existing predicate definitions and names. -Differences in the canonical model are not backported into this oracle. - -## Canonical phase refinement and limitations - -`DisasterRecoveryMigration.Refinement` imports the canonical -`DisasterRecovery.Protocol.Model` through the local Lake dependency and -projects canonical phases as follows: - -- Gossiping maps to legacy Vote. -- Voting maps to legacy OpenJoin. -- canonical Opening and Open collapse to legacy Open, retaining quorum versus - failover as the legacy timeout flag. -- Joining maps to legacy Join. - -`canonical_step_simulates` proves that each canonical local step projects to a -reflexive-transitive legacy phase step. The file also proves finite compatible -trace simulation, collapsed-Open preservation, quorum-kind projection, and -Opening-to-Open stuttering. - -This phase-only result does not relate gossip sets, votes, timeout-lane state, -network state, transaction persistence, or all nine legacy predicates. It -does not establish a global scheduler correspondence or preserve the legacy -liveness expectations. - -Two intentional model differences are explicit: - -- The canonical quorum is the strict majority `n / 2 + 1`; the legacy quorum - is `(n + 1) / 2`. They agree for odd node counts, while for even node counts - the canonical threshold is one larger. -- With one node, the legacy full initial state opens immediately without a - timeout. The canonical initial node remains in Gossiping, whose projected - phase is Vote. `single_node_full_initial_models_differ` proves this mismatch. - -## Files - -| File | Purpose | -| ----------------------------------------------- | --------------------------------------------- | -| `DisasterRecoveryMigration/Legacy/Model.lean` | Exact executable legacy semantics | -| `DisasterRecoveryMigration/Legacy/Checker.lean` | BFS model checker and canonical graph encoder | -| `Main.lean` | Legacy model-checker CLI | -| `ExportMain.lean` | Separate Lean graph-exporter CLI | -| `Tests.lean` | Focused legacy semantic checks | -| `DisasterRecoveryMigration/Refinement.lean` | Canonical-to-legacy phase refinement | -| `compare.py` | Bidirectional exhaustive Rust/Lean comparison | - -## Validation - -Run from this directory: - -```console -lake exe cache get -lake exe mk_all --check --lib DisasterRecoveryMigration -lake build --wfail -lake lint -lake exe migration-semantic-checks -lake exe migration-model-checker --nodes 3 -python3 compare.py --nodes 1 2 3 -``` - -The canonical package's own axiom-audit configuration remains authoritative -for all canonical declarations and is run by the canonical job in the shared -Lean workflow. The migration Lake package pins Lean 4.33.1, transitively -resolves Mathlib v4.33.1, treats warnings as errors, verifies complete library -coverage with `mk_all --check`, and audits transitive axioms with `lake lint`. diff --git a/lean/disaster-recovery-migration/Tests.lean b/lean/disaster-recovery-migration/Tests.lean deleted file mode 100644 index 1555b42e0972..000000000000 --- a/lean/disaster-recovery-migration/Tests.lean +++ /dev/null @@ -1,72 +0,0 @@ -import DisasterRecoveryMigration.Legacy.Model - -open DisasterRecoveryMigration.Legacy - -private def expect (condition : Bool) (message : String) : IO Unit := - unless condition do throw (IO.userError message) - -private def deliverByKey (n : Nat) (state : GlobalState) (key : String) : Option GlobalState := do - let action <- (actions state).find? (fun action => actionKey action == key) - nextState n state action - -def main : IO UInt32 := do - let single := initialState 1 - expect (single.actors[0]!.nextStep == .open false) - "single node did not open immediately without timeout" - - let initial3 := initialState 3 - let timed <- match nextState 3 initial3 (.timeout 0) with - | some state => pure state - | none => throw (IO.userError "node 0 timeout was suppressed") - expect (timed.actors[0]!.nextStep == .open true) - "timeout did not drive vote and open-join closure to timeout-open" - - let opened := timed.actors[0]! - let lateGossip : Gossip := { src := 2, txid := 2 } - let frozen <- match onMessage 3 0 opened (.gossip lateGossip) with - | some result => pure result - | none => throw (IO.userError "message callback was unexpectedly suppressed") - expect (frozen.1.gossips == opened.gossips) - "gossip collection changed after the vote was submitted" - - let joinActor : ActorState := { - nextStep := .openJoin - gossips := [{ src := 1, txid := 1 }] - votes := [] - submittedVote := none - txid := 1 - } - let joined <- match onMessage 3 1 joinActor (.iAmOpen 0) with - | some result => pure result - | none => throw (IO.userError "IAmOpen was suppressed") - expect (joined.1.nextStep == .join) "IAmOpen did not cause Join" - - let firstOrder <- match deliverByKey 3 initial3 "deliver(1,0,g(1,1))" with - | some state => pure state - | none => throw (IO.userError "first unordered delivery failed") - let firstOrder <- match deliverByKey 3 firstOrder "deliver(2,0,g(2,2))" with - | some state => pure state - | none => throw (IO.userError "second unordered delivery failed") - let secondOrder <- match deliverByKey 3 initial3 "deliver(2,0,g(2,2))" with - | some state => pure state - | none => throw (IO.userError "reverse first unordered delivery failed") - let secondOrder <- match deliverByKey 3 secondOrder "deliver(1,0,g(1,1))" with - | some state => pure state - | none => throw (IO.userError "reverse second unordered delivery failed") - expect (firstOrder == secondOrder) "unordered deliveries produced different states" - - let duplicate : Envelope := { src := 1, dst := 0, msg := .gossip { src := 1, txid := 1 } } - let duplicated := { initial3 with network := duplicate :: duplicate :: initial3.network } - let once <- match nextState 3 duplicated (.deliver duplicate) with - | some state => pure state - | none => throw (IO.userError "first duplicate delivery was suppressed") - expect (once.network.count duplicate + 1 == duplicated.network.count duplicate) - "delivery did not remove exactly one duplicate" - let twice <- match nextState 3 once (.deliver duplicate) with - | some state => pure state - | none => throw (IO.userError "second duplicate delivery was suppressed") - expect (twice.network.count duplicate + 1 == once.network.count duplicate) - "second delivery did not remove exactly one duplicate" - - IO.println "all Lean semantic checks passed" - pure 0 diff --git a/lean/disaster-recovery-migration/compare.py b/lean/disaster-recovery-migration/compare.py deleted file mode 100755 index 005d09c1df5a..000000000000 --- a/lean/disaster-recovery-migration/compare.py +++ /dev/null @@ -1,358 +0,0 @@ -#!/usr/bin/env python3 -# Copyright (c) Microsoft Corporation. All rights reserved. -# Licensed under the Apache 2.0 License. - -import argparse -import filecmp -import subprocess -import sys -import tempfile -from collections import defaultdict, deque -from dataclasses import dataclass -from pathlib import Path - -FORMAT = "ccf-legacy-dr-graph-v1" -PROPERTY_NAMES = ( - "Unanimous votes => no chance of a fork", - "Open", - "Majority votes => no fork", - "No open with timeout, no fork", - "Deadlock", - "Persist committed txs", - "Open is possible", - "Unsafe open with timeout", - "Majority vote still opens without timeout", -) -EXPECTED_COUNTS = { - 1: (1, 0), - 2: (54, 95), - 3: (105558, 552282), -} - - -@dataclass(frozen=True) -class Summary: - initial_key: str - states: int - edges: int - - -@dataclass -class Graph: - initial: str - valuations: dict[str, str] - edges: set[tuple[str, str, str]] - - -def run(command: list[str], cwd: Path, output: Path | None = None) -> None: - print(f"+ (cd {cwd} && {' '.join(command)})", flush=True) - if output is None: - result = subprocess.run( - command, cwd=cwd, text=True, capture_output=True, check=False - ) - else: - with output.open("w", encoding="ascii", newline="") as stream: - result = subprocess.run( - command, - cwd=cwd, - text=True, - stdout=stream, - stderr=subprocess.PIPE, - check=False, - ) - if result.returncode != 0: - if result.stderr: - print(result.stderr, file=sys.stderr, end="") - raise RuntimeError(f"command exited with status {result.returncode}") - - -def validate(path: Path, expected_nodes: int) -> Summary: - ids_to_keys: list[str] = [] - initial_id: int | None = None - edge_count = 0 - previous_edge: tuple[int, str, int] | None = None - section = "header" - - with path.open(encoding="ascii") as stream: - for line_number, raw_line in enumerate(stream, 1): - fields = raw_line.rstrip("\n").split("\t") - if fields == ["format", FORMAT] and line_number == 1: - continue - if fields == ["nodes", str(expected_nodes)] and line_number == 2: - continue - if len(fields) == 2 and fields[0] == "init" and line_number == 3: - initial_id = int(fields[1]) - section = "states" - continue - if len(fields) == 4 and fields[0] == "state" and section == "states": - state_id = int(fields[1]) - if state_id != len(ids_to_keys): - raise ValueError( - f"{path}:{line_number}: expected dense state id " - f"{len(ids_to_keys)}, found {state_id}" - ) - if ids_to_keys and fields[2] <= ids_to_keys[-1]: - raise ValueError( - f"{path}:{line_number}: state keys are unsorted or duplicated" - ) - bits = fields[3] - if len(bits) != len(PROPERTY_NAMES) or set(bits) - {"0", "1"}: - raise ValueError( - f"{path}:{line_number}: invalid property bitstring" - ) - ids_to_keys.append(fields[2]) - continue - if len(fields) == 4 and fields[0] == "edge": - section = "edges" - edge = (int(fields[1]), fields[2], int(fields[3])) - if edge[0] >= len(ids_to_keys) or edge[2] >= len(ids_to_keys): - raise ValueError( - f"{path}:{line_number}: edge references unknown state" - ) - if previous_edge is not None and edge <= previous_edge: - raise ValueError( - f"{path}:{line_number}: edges are unsorted or duplicated" - ) - previous_edge = edge - edge_count += 1 - continue - raise ValueError( - f"{path}:{line_number}: invalid record: {raw_line.rstrip()}" - ) - - if initial_id is None or initial_id >= len(ids_to_keys): - raise ValueError(f"{path}: invalid or missing initial state") - return Summary(ids_to_keys[initial_id], len(ids_to_keys), edge_count) - - -def load(path: Path) -> Graph: - ids_to_keys: list[str] = [] - valuations: dict[str, str] = {} - raw_edges: list[tuple[int, str, int]] = [] - initial_id = -1 - with path.open(encoding="ascii") as stream: - for raw_line in stream: - fields = raw_line.rstrip("\n").split("\t") - if fields[0] == "init": - initial_id = int(fields[1]) - elif fields[0] == "state": - state_id = int(fields[1]) - key = fields[2] - if state_id != len(ids_to_keys): - raise ValueError(f"{path}: non-dense state IDs") - ids_to_keys.append(key) - valuations[key] = fields[3] - elif fields[0] == "edge": - raw_edges.append((int(fields[1]), fields[2], int(fields[3]))) - edges = { - (ids_to_keys[src], action, ids_to_keys[dst]) for src, action, dst in raw_edges - } - return Graph(ids_to_keys[initial_id], valuations, edges) - - -def shortest_paths(graph: Graph) -> tuple[dict[str, int], dict[str, tuple[str, str]]]: - adjacency: dict[str, list[tuple[str, str]]] = defaultdict(list) - for src, action, dst in graph.edges: - adjacency[src].append((action, dst)) - for outgoing in adjacency.values(): - outgoing.sort() - - distance = {graph.initial: 0} - parent: dict[str, tuple[str, str]] = {} - pending = deque([graph.initial]) - while pending: - src = pending.popleft() - for action, dst in adjacency[src]: - if dst not in distance: - distance[dst] = distance[src] + 1 - parent[dst] = (src, action) - pending.append(dst) - return distance, parent - - -def describe_path( - graph: Graph, target: str, cached: tuple[dict[str, int], dict[str, tuple[str, str]]] -) -> str: - distance, parent = cached - if target not in distance: - return f"unreachable target key {target}" - actions: list[str] = [] - cursor = target - while cursor != graph.initial: - cursor, action = parent[cursor] - actions.append(action) - actions.reverse() - rendered = "\n".join( - f" {index}. {action}" for index, action in enumerate(actions, 1) - ) - return f"target: {target}\n{rendered or ' '}" - - -def mismatch(rust: Graph, lean: Graph) -> str: - if rust.initial != lean.initial: - return f"initial state mismatch\nRust: {rust.initial}\nLean: {lean.initial}" - - rust_paths = lean_paths = None - rust_states = set(rust.valuations) - lean_states = set(lean.valuations) - if rust_states != lean_states: - rust_only = rust_states - lean_states - lean_only = lean_states - rust_states - candidates: list[tuple[int, str, str, Graph]] = [] - if rust_only: - rust_paths = shortest_paths(rust) - state = min( - rust_only, key=lambda key: (rust_paths[0].get(key, sys.maxsize), key) - ) - candidates.append( - (rust_paths[0].get(state, sys.maxsize), "Rust-only", state, rust) - ) - if lean_only: - lean_paths = shortest_paths(lean) - state = min( - lean_only, key=lambda key: (lean_paths[0].get(key, sys.maxsize), key) - ) - candidates.append( - (lean_paths[0].get(state, sys.maxsize), "Lean-only", state, lean) - ) - _, side, state, graph = min(candidates) - paths = rust_paths if graph is rust else lean_paths - return ( - f"reachable state mismatch ({len(rust_only)} Rust-only, " - f"{len(lean_only)} Lean-only); shortest is {side}\n" - f"{describe_path(graph, state, paths)}" - ) - - rust_only_edges = rust.edges - lean.edges - lean_only_edges = lean.edges - rust.edges - if rust_only_edges or lean_only_edges: - candidates = [] - if rust_only_edges: - rust_paths = shortest_paths(rust) - edge = min( - rust_only_edges, - key=lambda value: (rust_paths[0].get(value[0], sys.maxsize), value), - ) - candidates.append( - ( - rust_paths[0].get(edge[0], sys.maxsize), - "Rust-only", - edge, - rust, - ) - ) - if lean_only_edges: - lean_paths = shortest_paths(lean) - edge = min( - lean_only_edges, - key=lambda value: (lean_paths[0].get(value[0], sys.maxsize), value), - ) - candidates.append( - ( - lean_paths[0].get(edge[0], sys.maxsize), - "Lean-only", - edge, - lean, - ) - ) - _, side, (src, action, dst), graph = min(candidates) - paths = rust_paths if graph is rust else lean_paths - return ( - f"labeled edge mismatch ({len(rust_only_edges)} Rust-only, " - f"{len(lean_only_edges)} Lean-only); shortest source is {side}\n" - f"{describe_path(graph, src, paths)}\n" - f"missing edge action: {action}\ndestination: {dst}" - ) - - differing = { - key for key in rust_states if rust.valuations[key] != lean.valuations[key] - } - if differing: - rust_paths = shortest_paths(rust) - state = min( - differing, key=lambda key: (rust_paths[0].get(key, sys.maxsize), key) - ) - rust_bits = rust.valuations[state] - lean_bits = lean.valuations[state] - details = [ - f" {index + 1}. {name}: Rust={rust_bits[index]} Lean={lean_bits[index]}" - for index, name in enumerate(PROPERTY_NAMES) - if rust_bits[index] != lean_bits[index] - ] - return ( - f"property valuation mismatch in {len(differing)} states\n" - f"{describe_path(rust, state, rust_paths)}\n" + "\n".join(details) - ) - - return "canonical files differ despite identical graph content" - - -def compare(nodes: int, lean_dir: Path, rust_dir: Path, temporary: Path) -> Summary: - rust_path = temporary / f"rust-{nodes}.tsv" - lean_path = temporary / f"lean-{nodes}.tsv" - run( - [ - "cargo", - "run", - "--quiet", - "--", - "export", - "--nodes", - str(nodes), - "-o", - str(rust_path), - ], - rust_dir, - ) - run( - ["lake", "exe", "migration-exporter", "--nodes", str(nodes)], - lean_dir, - lean_path, - ) - rust_summary = validate(rust_path, nodes) - lean_summary = validate(lean_path, nodes) - if rust_summary != lean_summary or not filecmp.cmp( - rust_path, lean_path, shallow=False - ): - raise AssertionError(mismatch(load(rust_path), load(lean_path))) - expected = EXPECTED_COUNTS.get(nodes) - if expected is not None and (rust_summary.states, rust_summary.edges) != expected: - raise AssertionError( - f"n={nodes}: expected {expected[0]} states/{expected[1]} edges, " - f"found {rust_summary.states}/{rust_summary.edges}" - ) - return rust_summary - - -def main() -> int: - parser = argparse.ArgumentParser( - description="Exhaustively compare Rust/Stateright and Lean legacy DR graphs" - ) - parser.add_argument("--nodes", type=int, nargs="+", default=[1, 2, 3]) - args = parser.parse_args() - if any(nodes < 1 for nodes in args.nodes): - parser.error("node counts must be positive") - - lean_dir = Path(__file__).resolve().parent - rust_dir = lean_dir.parents[1] / "tla" / "disaster-recovery" - try: - scratch = lean_dir / ".lake" - scratch.mkdir(exist_ok=True) - with tempfile.TemporaryDirectory( - prefix="ccf-legacy-dr-", dir=scratch - ) as directory: - for nodes in args.nodes: - summary = compare(nodes, lean_dir, rust_dir, Path(directory)) - print( - f"n={nodes}: equivalent initial state, {summary.states} states, " - f"{summary.edges} labeled edges compared in both directions, " - f"{len(PROPERTY_NAMES)} valuations/state" - ) - except (AssertionError, OSError, RuntimeError, ValueError) as error: - print(f"equivalence failed: {error}", file=sys.stderr) - return 1 - return 0 - - -if __name__ == "__main__": - raise SystemExit(main()) diff --git a/lean/disaster-recovery-migration/lake-manifest.json b/lean/disaster-recovery-migration/lake-manifest.json deleted file mode 100644 index 2fcc2ce77743..000000000000 --- a/lean/disaster-recovery-migration/lake-manifest.json +++ /dev/null @@ -1,138 +0,0 @@ -{ - "version": "1.2.0", - "packagesDir": ".lake/packages", - "packages": [ - { - "type": "path", - "scope": "", - "name": "disaster_recovery", - "manifestFile": "lake-manifest.json", - "inherited": false, - "dir": "../disaster-recovery", - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/axiom-audit.git", - "type": "git", - "subDir": null, - "scope": "", - "rev": "46024e005996495c65ef609368e11ab39c4222e3", - "name": "axiomAudit", - "manifestFile": "lake-manifest.json", - "inputRev": "46024e005996495c65ef609368e11ab39c4222e3", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/mathlib4.git", - "type": "git", - "subDir": null, - "scope": "", - "rev": "0df444a360eaa60ab8c11dca51a86af692955474", - "name": "mathlib", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.33.1", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "b7eb3304aeae834b12dda98993a37f6a41f6f0bb", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/LeanSearchClient", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "5f4d51b81cbd3f6b32b156bfad9056621a040404", - "name": "LeanSearchClient", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/import-graph", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "16f02aa7642864af59f1ff0e384a015994db9118", - "name": "importGraph", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/ProofWidgets4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "4be2e3d5087eeb272cf5a8853b8f9dd025ef5957", - "name": "proofwidgets", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/aesop", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "3448c0bcc5ce01b2d1546e483ec3620e32df3d0e", - "name": "aesop", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/quote4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "92c15be17b7caf78c2ad767ec40f89052d908d81", - "name": "Qq", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/batteries", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "4488d40d070b9700d4d5a6aa342f0d40c31b2a2d", - "name": "batteries", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover/lean4-cli", - "type": "git", - "subDir": null, - "scope": "leanprover", - "rev": "6130a47896ce867c6a4a55373441e59e565bad0f", - "name": "Cli", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.33.0", - "inherited": true, - "configFile": "lakefile.toml" - } - ], - "name": "disaster_recovery_migration", - "lakeDir": ".lake", - "fixedToolchain": false -} diff --git a/lean/disaster-recovery-migration/lakefile.toml b/lean/disaster-recovery-migration/lakefile.toml deleted file mode 100644 index 2096426c753f..000000000000 --- a/lean/disaster-recovery-migration/lakefile.toml +++ /dev/null @@ -1,31 +0,0 @@ -name = "disaster_recovery_migration" -version = "0.1.0" -moreLeanArgs = ["-DwarningAsError=true"] -# Quote the hyphenated executable name for Lean's name parser. -lintDriver = "axiomAudit/\u00abaxiom-audit\u00bb" -lintDriverArgs = ["--root", "DisasterRecoveryMigration"] -defaultTargets = [ - "DisasterRecoveryMigration", - "migration-model-checker", - "migration-semantic-checks", - "migration-exporter", -] - -[[require]] -name = "disaster_recovery" -path = "../disaster-recovery" - -[[lean_lib]] -name = "DisasterRecoveryMigration" - -[[lean_exe]] -name = "migration-model-checker" -root = "Main" - -[[lean_exe]] -name = "migration-semantic-checks" -root = "Tests" - -[[lean_exe]] -name = "migration-exporter" -root = "ExportMain" diff --git a/lean/disaster-recovery-migration/lean-toolchain b/lean/disaster-recovery-migration/lean-toolchain deleted file mode 100644 index a8afa7d1b02d..000000000000 --- a/lean/disaster-recovery-migration/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:v4.33.1 diff --git a/tla/disaster-recovery/.gitignore b/tla/disaster-recovery/.gitignore deleted file mode 100644 index eb5a316cbd19..000000000000 --- a/tla/disaster-recovery/.gitignore +++ /dev/null @@ -1 +0,0 @@ -target diff --git a/tla/disaster-recovery/Cargo.lock b/tla/disaster-recovery/Cargo.lock deleted file mode 100644 index 9666614b5e3e..000000000000 --- a/tla/disaster-recovery/Cargo.lock +++ /dev/null @@ -1,592 +0,0 @@ -# This file is automatically @generated by Cargo. -# It is not intended for manual editing. -version = 4 - -[[package]] -name = "ahash" -version = "0.8.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5a15f179cd60c4584b8a8c596927aadc462e27f2ca70c04e0071964a73ba7a75" -dependencies = [ - "cfg-if", - "getrandom", - "once_cell", - "version_check", - "zerocopy", -] - -[[package]] -name = "anstream" -version = "0.6.19" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "301af1932e46185686725e0fad2f8f2aa7da69dd70bf6ecc44d6b703844a3933" -dependencies = [ - "anstyle", - "anstyle-parse", - "anstyle-query", - "anstyle-wincon", - "colorchoice", - "is_terminal_polyfill", - "utf8parse", -] - -[[package]] -name = "anstyle" -version = "1.0.11" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "862ed96ca487e809f1c8e5a8447f6ee2cf102f846893800b20cebdf541fc6bbd" - -[[package]] -name = "anstyle-parse" -version = "0.2.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4e7644824f0aa2c7b9384579234ef10eb7efb6a0deb83f9630a49594dd9c15c2" -dependencies = [ - "utf8parse", -] - -[[package]] -name = "anstyle-query" -version = "1.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6c8bdeb6047d8983be085bab0ba1472e6dc604e7041dbf6fcd5e71523014fae9" -dependencies = [ - "windows-sys", -] - -[[package]] -name = "anstyle-wincon" -version = "3.0.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "403f75924867bb1033c59fbf0797484329750cfbe3c4325cd33127941fabc882" -dependencies = [ - "anstyle", - "once_cell_polyfill", - "windows-sys", -] - -[[package]] -name = "ascii" -version = "1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d92bec98840b8f03a5ff5413de5293bfcd8bf96467cf5452609f939ec6f5de16" - -[[package]] -name = "autocfg" -version = "1.4.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ace50bade8e6234aa140d9a2f552bbee1db4d353f69b8217bc503490fc1a9f26" - -[[package]] -name = "bitflags" -version = "2.9.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1b8e56985ec62d17e9c1001dc89c88ecd7dc08e47eba5ec7c29c7b5eeecde967" - -[[package]] -name = "ccf-selfhealingopen" -version = "0.0.0" -dependencies = [ - "clap", - "stateright", -] - -[[package]] -name = "cfg-if" -version = "1.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9555578bc9e57714c812a1f84e4fc5b4d21fcb063490c624de019f7464c91268" - -[[package]] -name = "choice" -version = "0.0.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a3b71fc821deaf602a933ada5c845d088156d0cdf2ebf43ede390afe93466553" - -[[package]] -name = "chunked_transfer" -version = "1.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6e4de3bc4ea267985becf712dc6d9eed8b04c953b3fcfb339ebc87acd9804901" - -[[package]] -name = "clap" -version = "4.5.40" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "40b6887a1d8685cebccf115538db5c0efe625ccac9696ad45c409d96566e910f" -dependencies = [ - "clap_builder", - "clap_derive", -] - -[[package]] -name = "clap_builder" -version = "4.5.40" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e0c66c08ce9f0c698cbce5c0279d0bb6ac936d8674174fe48f736533b964f59e" -dependencies = [ - "anstream", - "anstyle", - "clap_lex", - "strsim", -] - -[[package]] -name = "clap_derive" -version = "4.5.40" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d2c7947ae4cc3d851207c1adb5b5e260ff0cca11446b1d6d1423788e442257ce" -dependencies = [ - "heck", - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "clap_lex" -version = "0.7.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b94f61472cee1439c0b966b47e3aca9ae07e45d070759512cd390ea2bebc6675" - -[[package]] -name = "colorchoice" -version = "1.0.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b05b61dc5112cbb17e4b6cd61790d9845d13888356391624cbe7e41efeac1e75" - -[[package]] -name = "crossbeam-utils" -version = "0.8.21" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d0a5c400df2834b80a4c3327b3aad3a4c4cd4de0629063962b03235697506a28" - -[[package]] -name = "dashmap" -version = "6.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5041cc499144891f3790297212f32a74fb938e5136a14943f338ef9e0ae276cf" -dependencies = [ - "cfg-if", - "crossbeam-utils", - "hashbrown", - "lock_api", - "once_cell", - "parking_lot_core", -] - -[[package]] -name = "getrandom" -version = "0.3.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "26145e563e54f2cadc477553f1ec5ee650b00862f0a58bcd12cbdc5f0ea2d2f4" -dependencies = [ - "cfg-if", - "libc", - "r-efi", - "wasi", -] - -[[package]] -name = "hashbrown" -version = "0.14.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e5274423e17b7c9fc20b6e7e208532f9b19825d82dfd615708b70edd83df41f1" - -[[package]] -name = "heck" -version = "0.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2304e00983f87ffb38b55b444b5e3b60a884b5d30c0fca7d82fe33449bbe55ea" - -[[package]] -name = "httpdate" -version = "1.0.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "df3b46402a9d5adb4c86a0cf463f42e19994e3ee891101b1841f30a545cb49a9" - -[[package]] -name = "id-set" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9633fadf6346456cf8531119ba4838bc6d82ac4ce84d9852126dd2aa34d49264" - -[[package]] -name = "is_terminal_polyfill" -version = "1.70.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7943c866cc5cd64cbc25b2e01621d07fa8eb2a1a23160ee81ce38704e97b8ecf" - -[[package]] -name = "itoa" -version = "1.0.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4a5f13b858c8d314ee3e8f639011f7ccefe71f97f96e50151fb991f267928e2c" - -[[package]] -name = "libc" -version = "0.2.173" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d8cfeafaffdbc32176b64fb251369d52ea9f0a8fbc6f8759edffef7b525d64bb" - -[[package]] -name = "lock_api" -version = "0.4.13" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "96936507f153605bddfcda068dd804796c84324ed2510809e5b2a624c81da765" -dependencies = [ - "autocfg", - "scopeguard", -] - -[[package]] -name = "log" -version = "0.4.27" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "13dc2df351e3202783a1fe0d44375f7295ffb4049267b0f3018346dc122a1d94" - -[[package]] -name = "memchr" -version = "2.7.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "32a282da65faaf38286cf3be983213fcf1d2e2a58700e808f83f4ea9a4804bc0" - -[[package]] -name = "nohash-hasher" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2bf50223579dc7cdcfb3bfcacf7069ff68243f8c363f62ffa99cf000a6b9c451" - -[[package]] -name = "once_cell" -version = "1.21.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "42f5e15c9953c5e4ccceeb2e7382a716482c34515315f7b03532b8b4e8393d2d" - -[[package]] -name = "once_cell_polyfill" -version = "1.70.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a4895175b425cb1f87721b59f0f286c2092bd4af812243672510e1ac53e2e0ad" - -[[package]] -name = "parking_lot" -version = "0.12.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "70d58bf43669b5795d1576d0641cfb6fbb2057bf629506267a92807158584a13" -dependencies = [ - "lock_api", - "parking_lot_core", -] - -[[package]] -name = "parking_lot_core" -version = "0.9.11" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bc838d2a56b5b1a6c25f55575dfc605fabb63bb2365f6c2353ef9159aa69e4a5" -dependencies = [ - "cfg-if", - "libc", - "redox_syscall", - "smallvec", - "windows-targets", -] - -[[package]] -name = "ppv-lite86" -version = "0.2.21" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "85eae3c4ed2f50dcfe72643da4befc30deadb458a9b590d720cde2f2b1e97da9" -dependencies = [ - "zerocopy", -] - -[[package]] -name = "proc-macro2" -version = "1.0.95" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "02b3e5e68a3a1a02aad3ec490a98007cbc13c37cbe84a3cd7b8e406d76e7f778" -dependencies = [ - "unicode-ident", -] - -[[package]] -name = "quote" -version = "1.0.40" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1885c039570dc00dcb4ff087a89e185fd56bae234ddc7f056a945bf36467248d" -dependencies = [ - "proc-macro2", -] - -[[package]] -name = "r-efi" -version = "5.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "74765f6d916ee2faa39bc8e68e4f3ed8949b48cccdac59983d287a7cb71ce9c5" - -[[package]] -name = "rand" -version = "0.9.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "44c5af06bb1b7d3216d91932aed5265164bf384dc89cd6ba05cf59a35f5f76ea" -dependencies = [ - "rand_chacha", - "rand_core", -] - -[[package]] -name = "rand_chacha" -version = "0.9.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d3022b5f1df60f26e1ffddd6c66e8aa15de382ae63b3a0c1bfc0e4d3e3f325cb" -dependencies = [ - "ppv-lite86", - "rand_core", -] - -[[package]] -name = "rand_core" -version = "0.9.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "99d9a13982dcf210057a8a78572b2217b667c3beacbf3a0d8b454f6f82837d38" -dependencies = [ - "getrandom", -] - -[[package]] -name = "redox_syscall" -version = "0.5.13" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0d04b7d0ee6b4a0207a0a7adb104d23ecb0b47d6beae7152d0fa34b692b29fd6" -dependencies = [ - "bitflags", -] - -[[package]] -name = "ryu" -version = "1.0.20" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "28d3b2b1366ec20994f1fd18c3c594f05c5dd4bc44d8bb0c1c632c8d6829481f" - -[[package]] -name = "scopeguard" -version = "1.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "94143f37725109f92c262ed2cf5e59bce7498c01bcc1502d7b9afe439a4e9f49" - -[[package]] -name = "serde" -version = "1.0.219" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5f0e2c6ed6606019b4e29e69dbaba95b11854410e5347d525002456dbbb786b6" -dependencies = [ - "serde_derive", -] - -[[package]] -name = "serde_derive" -version = "1.0.219" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5b0276cf7f2c73365f7157c8123c21cd9a50fbbd844757af28ca1f5925fc2a00" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "serde_json" -version = "1.0.140" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "20068b6e96dc6c9bd23e01df8827e6c7e1f2fddd43c21810382803c136b99373" -dependencies = [ - "itoa", - "memchr", - "ryu", - "serde", -] - -[[package]] -name = "smallvec" -version = "1.15.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67b1b7a3b5fe4f1376887184045fcf45c69e92af734b7aaddc05fb777b6fbd03" - -[[package]] -name = "stateright" -version = "0.31.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fd1157f21b11916f90fe1f2ac9a8d0e09a8813b28701584141060f414eedf6ba" -dependencies = [ - "ahash", - "choice", - "crossbeam-utils", - "dashmap", - "id-set", - "log", - "nohash-hasher", - "parking_lot", - "rand", - "serde", - "serde_json", - "tiny_http", -] - -[[package]] -name = "strsim" -version = "0.11.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7da8b5736845d9f2fcb837ea5d9e2628564b3b043a70948a3f0b778838c5fb4f" - -[[package]] -name = "syn" -version = "2.0.103" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e4307e30089d6fd6aff212f2da3a1f9e32f3223b1f010fb09b7c95f90f3ca1e8" -dependencies = [ - "proc-macro2", - "quote", - "unicode-ident", -] - -[[package]] -name = "tiny_http" -version = "0.12.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "389915df6413a2e74fb181895f933386023c71110878cd0825588928e64cdc82" -dependencies = [ - "ascii", - "chunked_transfer", - "httpdate", - "log", -] - -[[package]] -name = "unicode-ident" -version = "1.0.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5a5f39404a5da50712a4c1eecf25e90dd62b613502b7e925fd4e4d19b5c96512" - -[[package]] -name = "utf8parse" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "06abde3611657adf66d383f00b093d7faecc7fa57071cce2578660c9f1010821" - -[[package]] -name = "version_check" -version = "0.9.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0b928f33d975fc6ad9f86c8f283853ad26bdd5b10b7f1542aa2fa15e2289105a" - -[[package]] -name = "wasi" -version = "0.14.2+wasi-0.2.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9683f9a5a998d873c0d21fcbe3c083009670149a8fab228644b8bd36b2c48cb3" -dependencies = [ - "wit-bindgen-rt", -] - -[[package]] -name = "windows-sys" -version = "0.59.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1e38bc4d79ed67fd075bcc251a1c39b32a1776bbe92e5bef1f0bf1f8c531853b" -dependencies = [ - "windows-targets", -] - -[[package]] -name = "windows-targets" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9b724f72796e036ab90c1021d4780d4d3d648aca59e491e6b98e725b84e99973" -dependencies = [ - "windows_aarch64_gnullvm", - "windows_aarch64_msvc", - "windows_i686_gnu", - "windows_i686_gnullvm", - "windows_i686_msvc", - "windows_x86_64_gnu", - "windows_x86_64_gnullvm", - "windows_x86_64_msvc", -] - -[[package]] -name = "windows_aarch64_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "32a4622180e7a0ec044bb555404c800bc9fd9ec262ec147edd5989ccd0c02cd3" - -[[package]] -name = "windows_aarch64_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "09ec2a7bb152e2252b53fa7803150007879548bc709c039df7627cabbd05d469" - -[[package]] -name = "windows_i686_gnu" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8e9b5ad5ab802e97eb8e295ac6720e509ee4c243f69d781394014ebfe8bbfa0b" - -[[package]] -name = "windows_i686_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0eee52d38c090b3caa76c563b86c3a4bd71ef1a819287c19d586d7334ae8ed66" - -[[package]] -name = "windows_i686_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "240948bc05c5e7c6dabba28bf89d89ffce3e303022809e73deaefe4f6ec56c66" - -[[package]] -name = "windows_x86_64_gnu" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "147a5c80aabfbf0c7d901cb5895d1de30ef2907eb21fbbab29ca94c5b08b1a78" - -[[package]] -name = "windows_x86_64_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "24d5b23dc417412679681396f2b49f3de8c1473deb516bd34410872eff51ed0d" - -[[package]] -name = "windows_x86_64_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "589f6da84c646204747d1270a2a5661ea66ed1cced2631d546fdfb155959f9ec" - -[[package]] -name = "wit-bindgen-rt" -version = "0.39.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6f42320e61fe2cfd34354ecb597f86f413484a798ba44a8ca1165c58d42da6c1" -dependencies = [ - "bitflags", -] - -[[package]] -name = "zerocopy" -version = "0.8.25" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a1702d9583232ddb9174e01bb7c15a2ab8fb1bc6f227aa1233858c351a3ba0cb" -dependencies = [ - "zerocopy-derive", -] - -[[package]] -name = "zerocopy-derive" -version = "0.8.25" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "28a6e20d751156648aa063f3800b706ee209a32c0b4d9f24be3d980b01be55ef" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] diff --git a/tla/disaster-recovery/Cargo.toml b/tla/disaster-recovery/Cargo.toml deleted file mode 100644 index 92950edbfb19..000000000000 --- a/tla/disaster-recovery/Cargo.toml +++ /dev/null @@ -1,7 +0,0 @@ -[package] -name = "ccf-selfhealingopen" -version = "0.0.0" - -[dependencies] -clap = { version = "4.5.38", features = ["derive"] } -stateright = "0.31.0" diff --git a/tla/disaster-recovery/Readme.md b/tla/disaster-recovery/Readme.md deleted file mode 100644 index d13a98b9ac84..000000000000 --- a/tla/disaster-recovery/Readme.md +++ /dev/null @@ -1,59 +0,0 @@ -# Self-healing-open specification in [stateright](https://github.com/stateright/stateright) - -The properties are specified in [main.rs](./src/main.rs), while the model is specified in [model.rs](./src/model.rs). - -Due to stateright being executable, there is little syntactic sugar, and so there is quite a bit of boilerplate. -The functional parts of the specification are in `advance_step`, `on_start`, `on_timeout` and `on_msg`. - -The specification can be checked from the command line via `cargo run check`. - -However, a more useful UX is via the web-view which is hosted locally via `cargo run serve`. -This allows you to explore the specification actions interactively, and the checker can be exhaustively run using the `Run to completion` button, which should find several useful examples of states where the network is opened, and where a deadlock is reached. - -## Exporting the state graph - -`cargo run --quiet -- export --nodes [-o ]` exhaustively enumerates the reachable -state graph (via the public `stateright::Model` interface, i.e. `init_states`/`next_steps`) -and writes it to `` (or stdout) in the shared `ccf-legacy-dr-graph-v1` TSV contract, so -it can be diffed against an independent re-implementation of the same model (e.g. in Python -or Lean). The encoder (`src/export.rs`) never uses `Debug` formatting, so output is insulated -from field order, hash-set iteration order, and library-version changes. Full grammar and -design notes are documented in the module doc comment at the top of `src/export.rs`; summary: - -```text -format ccf-legacy-dr-graph-v1 -nodes -init -state (one per reachable state, ascending ) -edge (one per reachable transition, sorted) -``` - -- `` is a dense integer (`0..N_STATES`) assigned by sorting every reachable state's - `` lexicographically -- _not_ BFS/discovery order -- so numbering is a pure - function of the reachable state set. Edges reference states only by `` (not by - repeating ``), since e.g. `n=3` already has 105,558 states / 552,282 edges and - repeating full state keys per edge does not scale. `edge` records are sorted by the tuple - `(, text, )` -- numeric on the ids, lexicographic on the action -- - and de-duplicated. -- `` is 9 chars of `1`/`0`, one per predicate registered via - `ActorModel::property` (`model.properties`), in registration order -- the exact same `fn` - pointers used by `check`/`serve`, so the export can never drift from their semantics. -- `` is `S([ACTORS],[TIMERS],[ENVELOPES])`: `ACTORS` are semicolon-separated - `s(PHASE,[GOSSIPS],[VOTES],SUBMITTED,txid)` records (`PHASE` in `vote`/`openjoin`/`open0`/ - `open1`/`join`), `TIMERS` are the ids of actors with an active election timeout, and - `ENVELOPES` are `e(src,dst,msg)#count` in flight. `history`/`random_choices`/ - `actor_storages` (always the unit value `()` for this model) and `crashed` (always all - `false`, since `max_crashes` is never set above `0`) are omitted, as they carry no - information here. -- `` is `deliver(src,dst,msg)` or `timeout(id,election)`. -- Set elements (`GOSSIPS`, `VOTES`) and `ENVELOPES` are ordered using the real Rust - `#[derive(Ord)]` implementations of `GossipStruct`/`VoteStruct`/`Envelope` (not a - string sort). -- Per `Model::next_state`'s "`None` = no-op" contract, only actions where `next_state` - returns `Some` produce an `edge` line (`Model::next_steps`'s default implementation - already filters these out). - -`--nodes` is an alias for the existing `--n-nodes`/`-n` flag, and (being a global clap -argument) is accepted either before or after the subcommand, so existing invocations -(`cargo run -- --n-nodes 3 check`, `cargo run check`, `cargo run -- --n-nodes 3 serve`) keep -working unchanged alongside `cargo run --quiet -- export --nodes `. diff --git a/tla/disaster-recovery/src/export.rs b/tla/disaster-recovery/src/export.rs deleted file mode 100644 index e62e4702c8dc..000000000000 --- a/tla/disaster-recovery/src/export.rs +++ /dev/null @@ -1,377 +0,0 @@ -//! Dependency-free canonical export of the reachable state graph. -//! -//! Implements the shared `ccf-legacy-dr-graph-v1` TSV contract: the model is -//! enumerated exhaustively using only the public `stateright::Model` -//! interface (`init_states`, `next_steps`, `within_boundary`), and every -//! state/action is serialized with an explicit hand-written grammar (never -//! `Debug`), so the output is stable across compiler/library versions and -//! diffable byte-for-byte against an independent re-implementation (e.g. -//! Python, Lean) of the same state machine. -//! -//! No new dependencies are introduced: only `stateright` (already a direct -//! dependency) and `std` are used. -//! -//! # Format -//! -//! ```text -//! format\tccf-legacy-dr-graph-v1 -//! nodes\t -//! init\t -//! state\t\t\t (one per reachable state) -//! edge\t\t\t (one per reachable transition) -//! ``` -//! -//! `` is a canonical, dense integer id (`0..N_STATES`) assigned by -//! sorting every reachable state's `` (see below) lexicographically -//! and numbering them in that order -- *not* BFS/discovery order -- so ids are -//! reproducible independent of traversal strategy. `state` records are -//! emitted in ascending `` order (equivalently, ascending `` -//! order). `edge` records are emitted sorted by the tuple -//! `(, text, )` (numeric on the ids, lexicographic on -//! the action text), and de-duplicated. Repeating the full `` in -//! every edge does not scale (e.g. `n=3` already has 105,558 states / 552,282 -//! edges), so edges reference states only by ``; a reader reconstructs the -//! `` for any `` via the `state` block. -//! -//! `` is exactly 9 characters of `1`/`0`, one per predicate -//! currently registered on the model via `ActorModel::property` -//! (`model.properties`), in registration order (liveness, then invariant, -//! then reachable properties -- *not* alphabetical). Each bit is the exact -//! existing `Property::condition` closure evaluated on that state, so the -//! export can never drift from `check`/`serve` behaviour, and preserves each -//! predicate's existing (sometimes misleadingly worded) name/meaning even -//! though names themselves are not repeated in the TSV output. -//! -//! Grammar for ``/`` tokens (no token contains whitespace): -//! -//! - gossip: `g(src,txid)` -//! - vote: `v(src,[GOSSIPS])` where `GOSSIPS` is a comma-separated gossip list -//! - msg: a gossip, a vote, or `o(id)` (`IAmOpen`) -//! - envelope: `e(src,dst,msg)` -//! - submitted vote: `none` or `some(dst,vote)` -//! - actor: `s(PHASE,[GOSSIPS],[VOTES],SUBMITTED,txid)` where `PHASE` is one -//! of `vote`, `openjoin`, `open0` (`Open { timeout: false }`), `open1` -//! (`Open { timeout: true }`), `join` -//! - global state: `S([ACTORS],[TIMERS],[ENVELOPES])` where `ACTORS` is -//! semicolon-separated (positional, by actor index), `TIMERS` is a -//! comma-separated list of actor ids with an active election timeout, and -//! `ENVELOPES` is a comma-separated list of `envelope#count` (count being -//! the in-flight multiplicity of that exact envelope) -//! - action: `deliver(src,dst,msg)` or `timeout(id,election)` -//! -//! `history` (`H = ()`), `random_choices` (`Node::Random = ()`), -//! `actor_storages` (`Node::Storage = ()`), and `crashed` (always all-`false`, -//! since `max_crashes` is never configured above `0`) are all omitted from -//! `S(...)`: for this model they are always constant/empty and carry no -//! information. -//! -//! Set elements (`GOSSIPS`, `VOTES`) are ordered using the actual Rust -//! `#[derive(Ord)]` implementation of `GossipStruct`/`VoteStruct` (not a -//! string sort), and `ENVELOPES` are ordered using `Envelope`'s derived -//! `Ord`. Per `Model::next_state`'s documented contract ("`None` indicates -//! the action does not change state"), only actions for which `next_state` -//! returns `Some` produce an edge; this is preserved by using -//! `Model::next_steps`, whose default implementation already filters out -//! `None` results. - -use crate::model::{GossipStruct, ModelCfg, Msg, NextStep, Node, State, Timer, VoteStruct}; -use stateright::actor::{ - ActorModel, ActorModelAction, ActorModelState, Envelope, Id, Network, Timers, -}; -use stateright::Model; -use std::collections::{HashMap, VecDeque}; -use std::io::{self, Write}; - -const PREDICATE_COUNT: usize = 9; - -fn fmt_id(id: Id) -> String { - usize::from(id).to_string() -} - -fn fmt_gossip(g: &GossipStruct) -> String { - format!("g({},{})", fmt_id(g.src), g.txid) -} - -/// Clones and sorts a gossip set using `GossipStruct`'s derived `Ord` -/// (compares `src` then `txid`), per the shared contract's "sort set -/// elements by Rust derived Ord". -fn sorted_gossips(set: &stateright::util::HashableHashSet) -> Vec { - let mut v: Vec = set.iter().cloned().collect(); - v.sort(); - v -} - -fn fmt_gossip_list(set: &stateright::util::HashableHashSet) -> String { - let items: Vec = sorted_gossips(set).iter().map(fmt_gossip).collect(); - format!("[{}]", items.join(",")) -} - -fn fmt_vote(v: &VoteStruct) -> String { - format!("v({},{})", fmt_id(v.src), fmt_gossip_list(&v.recv)) -} - -/// Clones and sorts a vote set using `VoteStruct`'s derived `Ord` (compares -/// `src` then `recv`). -fn sorted_votes(set: &stateright::util::HashableHashSet) -> Vec { - let mut v: Vec = set.iter().cloned().collect(); - v.sort(); - v -} - -fn fmt_vote_list(set: &stateright::util::HashableHashSet) -> String { - let items: Vec = sorted_votes(set).iter().map(fmt_vote).collect(); - format!("[{}]", items.join(",")) -} - -fn fmt_submitted(sv: &Option<(Id, VoteStruct)>) -> String { - match sv { - None => "none".to_string(), - Some((dst, vote)) => format!("some({},{})", fmt_id(*dst), fmt_vote(vote)), - } -} - -fn fmt_phase(n: &NextStep) -> &'static str { - match n { - NextStep::Vote => "vote", - NextStep::OpenJoin => "openjoin", - NextStep::Open { timeout: false } => "open0", - NextStep::Open { timeout: true } => "open1", - NextStep::Join => "join", - } -} - -fn fmt_actor(s: &State) -> String { - format!( - "s({},{},{},{},{})", - fmt_phase(&s.next_step), - fmt_gossip_list(&s.gossips), - fmt_vote_list(&s.votes), - fmt_submitted(&s.submitted_vote), - s.txid, - ) -} - -fn fmt_msg(m: &Msg) -> String { - match m { - Msg::Gossip(g) => fmt_gossip(g), - Msg::Vote(v) => fmt_vote(v), - Msg::IAmOpen(id) => format!("o({})", fmt_id(*id)), - } -} - -fn fmt_envelope(env: &Envelope) -> String { - format!( - "e({},{},{})", - fmt_id(env.src), - fmt_id(env.dst), - fmt_msg(&env.msg) - ) -} - -/// Tallies in-flight multiplicity per distinct envelope. `Network::iter_all` -/// yields one item per unit of multiplicity regardless of the underlying -/// `Network` variant (this model only ever uses -/// `new_unordered_nonduplicating`, whose internal representation already -/// tracks a count directly), so tallying via `iter_all` is variant-agnostic -/// and stays correct if the network configuration ever changes. -fn network_counts(network: &Network) -> Vec<(Envelope, usize)> { - let mut counts: HashMap, usize> = HashMap::new(); - for env in network.iter_all() { - *counts.entry(env.to_cloned_msg()).or_insert(0) += 1; - } - let mut v: Vec<(Envelope, usize)> = counts.into_iter().collect(); - // Envelope's derived Ord (src, dst, msg), per the shared contract. - v.sort_by(|a, b| a.0.cmp(&b.0)); - v -} - -fn fmt_network(network: &Network) -> String { - let items: Vec = network_counts(network) - .iter() - .map(|(env, count)| format!("{}#{}", fmt_envelope(env), count)) - .collect(); - format!("[{}]", items.join(",")) -} - -/// Comma-separated, ascending list of actor ids with an active election -/// timeout. `Timer` currently has a single variant, so presence alone is -/// significant (no timer-kind tag is emitted). -fn fmt_timers(timers_set: &[Timers]) -> String { - let mut ids: Vec = timers_set - .iter() - .enumerate() - .filter(|(_, t)| t.iter().next().is_some()) - .map(|(i, _)| i) - .collect(); - ids.sort_unstable(); - let items: Vec = ids.iter().map(|i| i.to_string()).collect(); - format!("[{}]", items.join(",")) -} - -/// Canonical `S(...)` encoding of a full `ActorModelState`. Used both -/// as the state field in `state` records and as the basis of the canonical -/// state id, so two independent implementations that compute the same -/// reachable state always produce the same key, regardless of traversal order. -pub fn fmt_state(state: &ActorModelState) -> String { - let actors: Vec = state.actor_states.iter().map(|s| fmt_actor(s)).collect(); - format!( - "S([{}],{},{})", - actors.join(";"), - fmt_timers(&state.timers_set), - fmt_network(&state.network), - ) -} - -/// Canonical encoding of an `ActorModelAction`. Only `Deliver` and `Timeout` -/// are part of the `ccf-legacy-dr-graph-v1` contract: this model never -/// produces `Drop` (`LossyNetwork::No`), `Crash`/`Recover` (`max_crashes == -/// 0`), or `SelectRandom` (no `Actor` ever issues a `ChooseRandom` command), -/// so encountering one is a bug (e.g. a future model config change) rather -/// than a case the contract needs to define. -pub fn fmt_action(action: &ActorModelAction) -> String { - match action { - ActorModelAction::Deliver { src, dst, msg } => { - format!( - "deliver({},{},{})", - fmt_id(*src), - fmt_id(*dst), - fmt_msg(msg) - ) - } - ActorModelAction::Timeout(id, Timer::ElectionTimeout) => { - format!("timeout({},election)", fmt_id(*id)) - } - _ => unreachable!( - "action variant is outside the ccf-legacy-dr-graph-v1 contract \ - (only Deliver/Timeout are ever produced by this model's configuration)" - ), - } -} - -/// The 9-character `1`/`0` bitstring for `state`, one bit per predicate -/// currently registered on `model` (`model.properties`) in registration -/// order -- i.e. exactly the same `fn` pointers used by `check`/`serve`, so -/// this can never drift from their semantics. -fn predicate_bitstring( - model: &ActorModel, - state: &ActorModelState, -) -> String { - model - .properties - .iter() - .map(|p| { - if (p.condition)(model, state) { - '1' - } else { - '0' - } - }) - .collect() -} - -/// Exhaustively enumerates the reachable state graph of `model` via the -/// public `stateright::Model` interface (`init_states`, `next_steps`, -/// `within_boundary`) and writes it to `out` as `ccf-legacy-dr-graph-v1`. -/// -/// States are discovered by BFS (for traversal only), but ``s are -/// assigned afterwards by sorting all discovered ``s -/// lexicographically -- so the numbering is a pure function of the reachable -/// state set, independent of traversal order. Edges reference states by -/// `` only, keeping output size linear in (states + edges) rather than -/// (edges * average state size). -pub fn export_graph( - model: &ActorModel, - out: &mut W, -) -> io::Result<()> { - assert_eq!( - model.properties.len(), - PREDICATE_COUNT, - "ccf-legacy-dr-graph-v1 requires exactly {PREDICATE_COUNT} registered model properties" - ); - - // Indexed by BFS discovery order (a "discovery id"); remapped to the - // canonical sorted-key id only once the full state set is known. - let mut visited: HashMap, usize> = HashMap::new(); - let mut keys: Vec = Vec::new(); - let mut bits: Vec = Vec::new(); - let mut frontier: VecDeque> = VecDeque::new(); - // (discovery src id, action text, discovery dst id) - let mut edges: Vec<(usize, String, usize)> = Vec::new(); - - let mut init_states = model.init_states(); - assert_eq!( - init_states.len(), - 1, - "ccf-legacy-dr-graph-v1 assumes a single deterministic init state" - ); - let init_state = init_states.remove(0); - assert!( - model.within_boundary(&init_state), - "ccf-legacy-dr-graph-v1 assumes the init state is within the model boundary" - ); - let init_discovery_id = keys.len(); - keys.push(fmt_state(&init_state)); - bits.push(predicate_bitstring(model, &init_state)); - visited.insert(init_state.clone(), init_discovery_id); - frontier.push_back(init_state); - - while let Some(s) = frontier.pop_front() { - let src_discovery_id = *visited - .get(&s) - .expect("every frontier state was inserted into `visited` before being queued"); - // `next_steps` (default `Model` trait method) already filters out - // actions for which `next_state` returns `None`, preserving the - // documented no-op-suppression contract. - for (action, ns) in model.next_steps(&s) { - if !model.within_boundary(&ns) { - continue; - } - let action_key = fmt_action(&action); - let dst_discovery_id = if let Some(&id) = visited.get(&ns) { - id - } else { - let id = keys.len(); - keys.push(fmt_state(&ns)); - bits.push(predicate_bitstring(model, &ns)); - visited.insert(ns.clone(), id); - frontier.push_back(ns); - id - }; - edges.push((src_discovery_id, action_key, dst_discovery_id)); - } - } - - // Canonical id assignment: number every discovered state by the - // lexicographic order of its ``, not by discovery order. - let mut order: Vec = (0..keys.len()).collect(); - order.sort_by(|&a, &b| keys[a].cmp(&keys[b])); - let mut canonical_id: Vec = vec![0; keys.len()]; - for (id, &discovery_id) in order.iter().enumerate() { - canonical_id[discovery_id] = id; - } - - // Remap edges to canonical ids, then sort by (SRC_ID, ACTION, DST_ID) -- - // numeric on the ids (real `usize` comparison, not string comparison), - // lexicographic on the action text -- and de-duplicate. - let mut canonical_edges: Vec<(usize, String, usize)> = edges - .into_iter() - .map(|(src, action, dst)| (canonical_id[src], action, canonical_id[dst])) - .collect(); - canonical_edges.sort(); - canonical_edges.dedup(); - - writeln!(out, "format\tccf-legacy-dr-graph-v1")?; - writeln!(out, "nodes\t{}", model.actors.len())?; - writeln!(out, "init\t{}", canonical_id[init_discovery_id])?; - for (id, &discovery_id) in order.iter().enumerate() { - writeln!( - out, - "state\t{}\t{}\t{}", - id, keys[discovery_id], bits[discovery_id] - )?; - } - for (src, action, dst) in &canonical_edges { - writeln!(out, "edge\t{src}\t{action}\t{dst}")?; - } - Ok(()) -} diff --git a/tla/disaster-recovery/src/main.rs b/tla/disaster-recovery/src/main.rs deleted file mode 100644 index 15bcef28f7ad..000000000000 --- a/tla/disaster-recovery/src/main.rs +++ /dev/null @@ -1,274 +0,0 @@ -extern crate clap; -extern crate stateright; -use clap::Parser; -mod export; -mod model; -use export::export_graph; -use model::{ModelCfg, Msg, NextStep, Node, State}; -use stateright::{actor::*, report::WriteReporter, util::HashableHashSet, Checker, Model}; -use std::sync::Arc; - -fn implies(a: bool, b: bool) -> bool { - !a || b -} - -fn reached_open(state: &ActorModelState) -> bool { - state - .actor_states - .iter() - .any(|actor_state: &Arc| matches!(actor_state.next_step, NextStep::Open { .. })) -} - -fn reached_open_timeout(state: &ActorModelState, expected_to_timeout: bool) -> bool { - state.actor_states.iter().any(|actor_state: &Arc| { - matches! ( - actor_state.next_step, - NextStep::Open {timeout} if timeout == expected_to_timeout - ) - }) -} - -fn unanimous_votes(model: &ActorModel, state: &ActorModelState) -> bool { - let peers: HashableHashSet = (0..model.cfg.n_nodes) - .map(|i| Id::from(i as usize)) - .collect(); - state.actor_states.iter().all(|actor_state: &Arc| { - actor_state.submitted_vote.is_some() - && peers.iter().all(|peer| { - actor_state - .submitted_vote - .clone() - .unwrap() - .1 - .recv - .iter() - .any(|g| g.src == *peer) - }) - }) -} - -fn majority_have_same_maximum(state: &ActorModelState) -> bool { - // get the chosen replica of each replica into a vector and sort that vector - // that there is only one value up to the n/2th index - let mut chosen_replicas: Vec = state - .actor_states - .iter() - .filter(|actor_state: &&Arc| actor_state.submitted_vote.is_some()) - .map(|actor_state| { - actor_state - .submitted_vote - .clone() - .unwrap() - .1 - .recv - .iter() - .max_by_key(|g| (g.txid, g.src)) - .unwrap() - .src - }) - .collect(); - chosen_replicas.sort(); - let majority_idx = state.actor_states.len() / 2; - let majority_chosen_replica = chosen_replicas.get(majority_idx); - majority_chosen_replica.is_some() - && chosen_replicas[0..majority_idx] - .iter() - .all(|&r| r == *majority_chosen_replica.unwrap()) -} - -fn liveness_properties(model: ActorModel) -> ActorModel { - let model = model - .property( - stateright::Expectation::Eventually, - "Unanimous votes => no chance of a fork", - |model: &ActorModel, state: &ActorModelState| { - // Define deadlock as a path which does not reach open without - // Hence unanimous votes => reach open - // Hence on every path unanimous votes => <> reached open - // Since votes are not forgotten on a node, we check for a state where unanimous votes => reached open - return implies( - unanimous_votes(model, state), - reached_open_timeout(state, false), - ); - }, - ) - .property( - stateright::Expectation::Eventually, - "Open", - |_, state: &ActorModelState| { - // all runs should eventually open, either via the reliable method, or via the failover timeout - reached_open(state) - }, - ) - .property( - stateright::Expectation::Eventually, - "Majority votes => no fork", - |_, state: &ActorModelState| { - return implies( - majority_have_same_maximum(state), - reached_open_timeout(state, false), - ); - }, - ); - return model; -} - -fn invariant_properties(model: ActorModel) -> ActorModel { - let model = model - .property( - stateright::Expectation::Always, - "No open with timeout, no fork", - |_model: &ActorModel, state: &ActorModelState| { - // Check if there is no fork in the state - let open_node_count = state - .actor_states - .iter() - .filter(|actor_state: &&Arc| { - matches!(actor_state.next_step, NextStep::Open { .. }) - }) - .count(); - implies(!reached_open_timeout(state, true), open_node_count <= 1) - }, - ) - .property( - stateright::Expectation::Always, - "Deadlock", - |_model, state| { - let all_open_join = state - .actor_states - .iter() - .all(|actor_state: &Arc| actor_state.next_step == NextStep::OpenJoin); - let all_votes_delivered = state - .network - .iter_all() - .filter(|msg| matches!(msg.msg, Msg::Vote(_))) - .count() - == 0; - !(all_open_join && all_votes_delivered) - }, - ) - .property( - stateright::Expectation::Always, - "Persist committed txs", - |_model: &ActorModel, state: &ActorModelState| { - let majority_idx = state.actor_states.len() / 2; - let commit_txid = state - .actor_states - .iter() - .map(|actor_state| actor_state.txid) - .collect::>()[majority_idx]; - let cond = state - .actor_states - .iter() - .filter(|actor_state: &&Arc| { - matches!(actor_state.next_step, NextStep::Open { .. }) - }) - .all(|actor_state: &Arc| actor_state.txid >= commit_txid); - implies(!reached_open_timeout(state, true), cond) - }, - ); - return model; -} - -fn reachable_properties(model: ActorModel) -> ActorModel { - let model = model - .property( - stateright::Expectation::Sometimes, - "Open is possible", - |_, state| implies(state.actor_states.len() > 1, reached_open(state)), - ) - .property( - stateright::Expectation::Sometimes, - "Unsafe open with timeout", - |_, state| reached_open_timeout(state, true), - ) - .property( - stateright::Expectation::Sometimes, - "Majority vote still opens without timeout", - |_model, state| majority_have_same_maximum(state) && reached_open_timeout(state, false), - ); - return model; -} - -fn properties(model: ActorModel) -> ActorModel { - let model = liveness_properties(model); - let model = invariant_properties(model); - let model = reachable_properties(model); - return model; -} - -#[derive(Parser, Debug)] -#[command(version, about = "Model for CCF's self-healing-open", long_about = None)] -struct CliArgs { - /// `global = true` lets this be given either before or after the - /// subcommand (e.g. `--n-nodes 3 check` or `export --nodes 3`); the - /// `nodes` alias matches the shared exporter invocation - /// `export --nodes N`. - #[clap(short, long, alias = "nodes", default_value = "3", global = true)] - n_nodes: usize, - - #[command(subcommand)] - command: Commands, -} - -#[derive(Parser, Debug)] -enum Commands { - /// Check the model - Check, - /// Serve the model on localhost:8080 - Serve, - /// Export the exhaustive reachable state graph in a stable, canonical, - /// line-oriented text format (see Readme.md), suitable for byte-for-byte - /// comparison against an independent re-implementation of the model. - Export { - /// Output file path; defaults to stdout - #[clap(short, long)] - out: Option, - }, -} - -fn check(model: ActorModel) { - let checker = model - .checker() - .spawn_bfs() - .join_and_report(&mut WriteReporter::new(&mut std::io::stderr())); - checker.assert_properties(); -} - -fn serve(model: ActorModel) { - let checker = model.checker(); - println!("Serving model on http://localhost:8080"); - checker.serve("localhost:8080"); -} - -fn export(model: ActorModel, out: Option) { - match out { - Some(path) => { - let mut file = std::fs::File::create(&path) - .unwrap_or_else(|e| panic!("failed to create '{}': {}", path, e)); - export_graph(&model, &mut file).expect("failed to write model export"); - } - None => { - let stdout = std::io::stdout(); - let mut handle = stdout.lock(); - export_graph(&model, &mut handle).expect("failed to write model export"); - } - } -} - -fn main() { - let args = CliArgs::parse(); - - let model = ModelCfg { - n_nodes: args.n_nodes, - } - .into_model(); - - let model = properties(model); - - match args.command { - Commands::Check => check(model), - Commands::Serve => serve(model), - Commands::Export { out } => export(model, out), - } -} diff --git a/tla/disaster-recovery/src/model.rs b/tla/disaster-recovery/src/model.rs deleted file mode 100644 index 735db3193186..000000000000 --- a/tla/disaster-recovery/src/model.rs +++ /dev/null @@ -1,193 +0,0 @@ -extern crate stateright; -use stateright::{actor::*, util::HashableHashSet}; -use std::borrow::Cow; - -type Txid = u64; - -#[derive(Debug, Clone, Hash, PartialEq, Eq, PartialOrd, Ord)] -pub struct GossipStruct { - pub src: Id, - pub txid: Txid, -} - -#[derive(Debug, Clone, Hash, PartialEq, Eq, PartialOrd, Ord)] -pub struct VoteStruct { - pub src: Id, - pub recv: HashableHashSet, -} - -#[derive(Debug, Clone, Hash, PartialEq, Eq, PartialOrd, Ord)] -pub enum Msg { - Gossip(GossipStruct), - Vote(VoteStruct), - IAmOpen(Id), -} - -#[derive(Debug, Clone, Hash, PartialEq, Eq, PartialOrd, Ord)] -pub enum Timer { - ElectionTimeout, -} - -#[derive(Debug, Clone, Hash, PartialEq, Eq, PartialOrd, Ord)] -pub enum NextStep { - Vote, - OpenJoin, - Open { timeout: bool }, - Join, -} - -#[derive(Debug, Clone, Hash, PartialEq, Eq, PartialOrd, Ord)] -pub struct State { - pub next_step: NextStep, - pub gossips: HashableHashSet, - pub votes: HashableHashSet, - pub submitted_vote: Option<(Id, VoteStruct)>, - pub txid: Txid, -} - -#[derive(Debug, Clone, Hash, PartialEq, Eq)] -pub struct Node { - pub peers: HashableHashSet, -} - -impl Node { - fn vote_for_max<'a>(gossips: &HashableHashSet, id: Id) -> (Id, VoteStruct) { - let dst = gossips - .iter() - .max_by_key(|g| (g.txid, g.src)) - .unwrap() - .src; - let vote = VoteStruct { - src: id, - recv: gossips.clone(), - }; - return (dst, vote); - } - - fn other_peers(&self, id: Id) -> Vec { - self.peers.iter().filter(|&&p| p != id).cloned().collect() - } - - fn advance_step(&self, state: &mut State, o: &mut Out, id: Id, timeout: bool) -> bool { - match state.next_step { - NextStep::Vote if state.gossips.len() == self.peers.len() || timeout => { - let (dst, vote) = Node::vote_for_max(&state.gossips, id); - state.submitted_vote = Some((dst, vote.clone())); - if dst == id { - state.votes.insert(vote); - } else { - o.send(dst, Msg::Vote(vote)); - } - state.next_step = NextStep::OpenJoin; - return true; - } - NextStep::OpenJoin if state.votes.len() >= (self.peers.len() + 1) / 2 || timeout => { - state.next_step = NextStep::Open { timeout }; - o.broadcast(&self.other_peers(id), &Msg::IAmOpen(id)); - return true; - } - _ => false, - } - } - - fn advance_several(&self, state: &mut State, o: &mut Out, id: Id, timeout: bool) { - while self.advance_step(state, o, id, timeout) {} - } -} - -impl Actor for Node { - type Msg = Msg; - type State = State; - type Timer = Timer; - type Storage = (); - type Random = (); - - fn on_start(&self, id: Id, _storage: &Option, o: &mut Out) -> Self::State { - let txid = usize::from(id) as Txid; // Use id as txid for simplicity - let gossip = GossipStruct { src: id, txid }; - let mut gossips = HashableHashSet::new(); - gossips.insert(gossip.clone()); - let mut state = State { - next_step: NextStep::Vote, - gossips, - votes: HashableHashSet::new(), - submitted_vote: None, - txid: usize::from(id) as Txid, - }; - o.broadcast(&self.other_peers(id), &Msg::Gossip(gossip)); - o.set_timer(Timer::ElectionTimeout, model_timeout()); - self.advance_several(&mut state, o, id, false); - return state; - } - - fn on_timeout(&self, id: Id, state: &mut Cow, timer: &Timer, o: &mut Out) { - match timer { - Timer::ElectionTimeout => match state.next_step { - NextStep::Vote if !state.gossips.is_empty() => { - let state = state.to_mut(); - self.advance_several(state, o, id, true); - o.set_timer(Timer::ElectionTimeout, model_timeout()); - } - NextStep::OpenJoin if !state.votes.is_empty() => { - let state = state.to_mut(); - self.advance_several(state, o, id, true); - } - _ => { - o.set_timer(Timer::ElectionTimeout, model_timeout()); - } - }, - } - } - - fn on_msg( - &self, - id: Id, - state: &mut Cow, - _src: Id, - msg: Self::Msg, - o: &mut Out, - ) { - let state = state.to_mut(); - match msg { - Msg::Gossip(gossip) => { - // Freeze gossip collection after voting is submitted - if !state.gossips.contains(&gossip) && state.submitted_vote.is_none() { - state.gossips.insert(gossip.clone()); - } - } - Msg::Vote(vote) => { - if !state.votes.contains(&vote) { - state.votes.insert(vote); - } - } - Msg::IAmOpen(_) => { - if !matches!(state.next_step, NextStep::Open { .. }) { - state.next_step = NextStep::Join; - } - } - }; - self.advance_several(state, o, id, false); - } -} - -#[derive(Debug, Clone, Hash, PartialEq, Eq)] -pub struct ModelCfg { - pub n_nodes: usize, -} - -impl ModelCfg { - pub fn into_model(self) -> ActorModel { - let peers: HashableHashSet = (0..self.n_nodes).map(|i| Id::from(i as usize)).collect(); - ActorModel::new(self.clone(), ()) - .actors( - (0..self.n_nodes) - .map(|_| Node { - peers: peers.clone(), - }) - .collect::>(), - ) - //.init_network(Network::new_ordered([])) - .init_network(Network::new_unordered_nonduplicating([])) - .lossy_network(LossyNetwork::No) - } -} From f491105e63ef2b441dc020d17120d6fc2b9aecd4 Mon Sep 17 00:00:00 2001 From: achamayou Date: Mon, 7 Sep 2026 21:01:52 +0100 Subject: [PATCH 24/35] Keep scheduled Lean checks in shared workflow Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> Copilot-Session: ed9f1e31-297c-4592-a089-2d37c49c2434 --- .github/workflows/README.md | 2 +- .github/workflows/ci-verification.yml | 32 --------------------------- .github/workflows/lean.yml | 2 ++ 3 files changed, 3 insertions(+), 33 deletions(-) diff --git a/.github/workflows/README.md b/.github/workflows/README.md index bf65dc78162a..c96c3a7bf59b 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -108,7 +108,7 @@ added as jobs to this workflow. The disaster recovery job builds the canonical model with `lake build --wfail`, audits its transitive axiom dependencies with `lake lint`, and runs its -executable canonical behavior checks on relevant pull requests. +executable canonical behavior checks on relevant pull requests and weekly. The build and audit include both the human-reviewed model and system properties and the proof implementation files marked as generated for review purposes. The standard `mk_all --check` command ensures that the audit root imports every diff --git a/.github/workflows/ci-verification.yml b/.github/workflows/ci-verification.yml index 71bf6fa49b82..12c03e553f14 100644 --- a/.github/workflows/ci-verification.yml +++ b/.github/workflows/ci-verification.yml @@ -242,35 +242,3 @@ jobs: name: tlc-trace-validation-consensus path: | tla/traces/* - - lean-disaster-recovery: - name: Lean Disaster Recovery - Canonical Model - runs-on: ubuntu-latest - timeout-minutes: 30 - - steps: - - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 - - - name: Install Lean - shell: bash - run: | - set -euo pipefail - sudo apt-get update - sudo apt-get install -y elan - elan toolchain install "$(cat lean/disaster-recovery/lean-toolchain)" - - - name: Restore Mathlib cache - working-directory: lean/disaster-recovery - shell: bash - run: | - set -euo pipefail - lake exe cache get - - - name: Build and check canonical model - working-directory: lean/disaster-recovery - shell: bash - run: | - set -euo pipefail - lake build - lake env lean -DwarningAsError=true AxiomChecks.lean - lake exe canonical-checks diff --git a/.github/workflows/lean.yml b/.github/workflows/lean.yml index 081a8fc0604b..e96583d107c4 100644 --- a/.github/workflows/lean.yml +++ b/.github/workflows/lean.yml @@ -5,6 +5,8 @@ on: paths: - "lean/**" - ".github/workflows/lean.yml" + schedule: + - cron: "0 0 * * 0" concurrency: group: ${{ github.workflow }}-${{ github.ref }} From 07681f499043b54a38c6c292a1ae5ab8c863fc47 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 12:01:05 +0100 Subject: [PATCH 25/35] Defer recovery restart until commit Request host restart only from the committed JOINING state hook so aborted recovery transactions cannot trigger a restart. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- CHANGELOG.md | 1 + src/node/recovery_decision_protocol.cpp | 13 +++++++++++-- src/node/recovery_decision_protocol.h | 1 + 3 files changed, 13 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ae0238056120..5ab19cf9f215 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -45,6 +45,7 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0. - Corrected the OpenAPI schema name for `ccf::ds::SizeString` from `TimeString` to `SizeString` (#8261). - A transaction in a JavaScript application endpoint which conflicts with compaction is now re-executed, rather than returning `500 Internal Server Error` (#8289). - A `Range` header requesting a suffix longer than the file is now clamped to the whole file, per RFC 9110. Ranges which select no bytes, such as `bytes=-0`, are now rejected with `400 Bad Request` (#8299). +- Recovery-decision-protocol nodes now request host restart only after the `JOINING` state transaction commits, preventing restart for an aborted transaction. (#8282) ### Changed diff --git a/src/node/recovery_decision_protocol.cpp b/src/node/recovery_decision_protocol.cpp index 3b91cf137a27..a7da1c661156 100644 --- a/src/node/recovery_decision_protocol.cpp +++ b/src/node/recovery_decision_protocol.cpp @@ -25,6 +25,11 @@ namespace ccf node_state(node_state_) {} + void RecoveryDecisionProtocolSubsystem::restart_after_commit() + { + RINGBUFFER_WRITE_MESSAGE(AdminMessage::restart, node_state->to_host); + } + void RecoveryDecisionProtocolSubsystem::reset_state(ccf::kv::Tx& tx) { // Clear any previous state @@ -90,6 +95,12 @@ namespace ccf start_message_retry_timers(); start_failover_timers(); } + else if ( + w.has_value() && + w.value() == recovery_decision_protocol::StateMachine::JOINING) + { + restart_after_commit(); + } })); } @@ -245,8 +256,6 @@ namespace ccf auto service_cert = ccf::crypto::cert_der_to_pem(node_config->service_cert_der); LOG_INFO_FMT("{}", service_cert.str()); - - RINGBUFFER_WRITE_MESSAGE(AdminMessage::restart, node_state->to_host); } case recovery_decision_protocol::StateMachine::OPENING: { diff --git a/src/node/recovery_decision_protocol.h b/src/node/recovery_decision_protocol.h index 6c761ad65843..6833c9ea7726 100644 --- a/src/node/recovery_decision_protocol.h +++ b/src/node/recovery_decision_protocol.h @@ -72,6 +72,7 @@ namespace ccf // Stop periodic tasks void stop_timers(); + void restart_after_commit(); // Steady state operations recovery_decision_protocol::RequestNodeInfo& get_node_info( From c36443843c3a2f8aa372197fa6b611546318a615 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 12:01:43 +0100 Subject: [PATCH 26/35] Add commit-aware recovery tracing Gate versioned RDP_TRACE records behind CCF_RECOVERY_TRACE and publish receive, timeout, effect, and retry-send events only at their required commit boundaries. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- CMakeLists.txt | 9 + .../ccf/service/tables/self_healing_open.h | 26 ++ src/node/recovery_decision_protocol.cpp | 416 ++++++++++++++++-- src/node/recovery_decision_protocol.h | 68 ++- src/node/rpc/self_healing_open_handlers.h | 69 ++- 5 files changed, 548 insertions(+), 40 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 47c29fe35779..42a83a76d120 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -458,6 +458,15 @@ if(CCF_RAFT_TRACING) add_compile_definitions(CCF_RAFT_TRACING) endif() +option( + CCF_RECOVERY_TRACE + "Enable committed recovery-decision-protocol tracing" + OFF +) +if(CCF_RECOVERY_TRACE) + add_compile_definitions(CCF_RECOVERY_TRACE) +endif() + # Build common library for CCF enclaves set( CCF_IMPL_SOURCE diff --git a/include/ccf/service/tables/self_healing_open.h b/include/ccf/service/tables/self_healing_open.h index 20066451e8ee..21f6dfed8561 100644 --- a/include/ccf/service/tables/self_healing_open.h +++ b/include/ccf/service/tables/self_healing_open.h @@ -94,6 +94,28 @@ namespace ccf using TimeoutSMState = ServiceValue; using OpenKind = ServiceValue; + +#ifdef CCF_RECOVERY_TRACE + struct TraceEvent + { + std::string kind; + std::optional message_id = std::nullopt; + std::optional caused_by = std::nullopt; + std::optional source = std::nullopt; + std::optional view = std::nullopt; + std::optional seqno = std::nullopt; + std::string pre; + std::string post; + std::optional open_kind = std::nullopt; + std::optional send = std::nullopt; + }; + DECLARE_JSON_TYPE_WITH_OPTIONAL_FIELDS(TraceEvent); + DECLARE_JSON_REQUIRED_FIELDS(TraceEvent, kind, pre, post); + DECLARE_JSON_OPTIONAL_FIELDS( + TraceEvent, message_id, caused_by, source, view, seqno, open_kind, send); + + using TraceEvents = ServiceMap; +#endif } namespace Tables @@ -112,5 +134,9 @@ namespace ccf "public:ccf.gov.recovery_decision_protocol.timeout_sm_state"; static constexpr auto RECOVERY_DECISION_PROTOCOL_OPEN_KIND = "public:ccf.gov.recovery_decision_protocol.open_kind"; +#ifdef CCF_RECOVERY_TRACE + static constexpr auto RECOVERY_DECISION_PROTOCOL_TRACE_EVENTS = + "public:ccf.internal.recovery_decision_protocol.trace_events"; +#endif } } diff --git a/src/node/recovery_decision_protocol.cpp b/src/node/recovery_decision_protocol.cpp index a7da1c661156..1248bab01840 100644 --- a/src/node/recovery_decision_protocol.cpp +++ b/src/node/recovery_decision_protocol.cpp @@ -19,6 +19,45 @@ namespace ccf { +#ifdef CCF_RECOVERY_TRACE + static constexpr auto RECOVERY_TRACE_VERSION = + "ccf.recovery_decision_protocol.trace/1"; + static constexpr auto RECOVERY_TRACE_MARKER = "RDP_TRACE"; + + static std::string trace_state_name( + recovery_decision_protocol::StateMachine state) + { + switch (state) + { + case recovery_decision_protocol::StateMachine::GOSSIPING: + return "GOSSIPING"; + case recovery_decision_protocol::StateMachine::VOTING: + return "VOTING"; + case recovery_decision_protocol::StateMachine::OPENING: + return "OPENING"; + case recovery_decision_protocol::StateMachine::JOINING: + return "JOINING"; + case recovery_decision_protocol::StateMachine::OPEN: + return "OPEN"; + default: + throw std::logic_error("Unknown recovery-decision-protocol state"); + } + } + + static std::string trace_open_kind_name( + recovery_decision_protocol::OpenKinds kind) + { + switch (kind) + { + case recovery_decision_protocol::OpenKinds::QUORUM: + return "QUORUM"; + case recovery_decision_protocol::OpenKinds::FAILOVER: + return "FAILOVER"; + default: + throw std::logic_error("Unknown recovery-decision-protocol open kind"); + } + } +#endif RecoveryDecisionProtocolSubsystem::RecoveryDecisionProtocolSubsystem( NodeState* node_state_) : @@ -30,6 +69,235 @@ namespace ccf RINGBUFFER_WRITE_MESSAGE(AdminMessage::restart, node_state->to_host); } +#ifdef CCF_RECOVERY_TRACE + void RecoveryDecisionProtocolSubsystem::initialise_trace(ccf::kv::Tx& tx) + { + const auto previous_service_cert = + tx.ro(node_state->network.previous_service_identity)->get(); + if (!previous_service_cert.has_value()) + { + throw std::logic_error( + "Previous service identity not found while initialising " + "recovery-decision-protocol tracing"); + } + + { + std::lock_guard guard(trace_lock); + next_trace_record_id = 0; + next_trace_sequence = 0; + next_trace_message_number = 0; + trace_instance_id = + recovery_decision_protocol::service_fingerprint_from_pem( + previous_service_cert.value()); + trace_node = get_location().name; + trace_committed_state = "GOSSIPING"; + trace_expected_locations.clear(); + for (const auto& location : get_config().expected_locations) + { + trace_expected_locations.push_back(location.name); + } + } + + node_state->network.tables->set_global_hook( + Tables::RECOVERY_DECISION_PROTOCOL_TRACE_EVENTS, + recovery_decision_protocol::TraceEvents::wrap_commit_hook( + [this]( + ccf::kv::Version, + const recovery_decision_protocol::TraceEvents::Write& writes) { + for (const auto& [_, event] : writes) + { + if (event.has_value()) + { + emit_trace_event(event.value()); + if (event->kind == "join_restart") + { + restart_after_commit(); + } + } + } + })); + } + + void RecoveryDecisionProtocolSubsystem::emit_trace_event( + recovery_decision_protocol::TraceEvent event) + { + std::lock_guard guard(trace_lock); + emit_trace_event_unsafe(std::move(event)); + } + + void RecoveryDecisionProtocolSubsystem::emit_trace_event_unsafe( + recovery_decision_protocol::TraceEvent event) + { + if (event.kind == "send") + { + event.pre = trace_committed_state; + event.post = trace_committed_state; + } + else + { + trace_committed_state = event.post; + } + nlohmann::json trace = event; + trace["version"] = RECOVERY_TRACE_VERSION; + trace["instance"] = trace_instance_id; + trace["expected_locations"] = trace_expected_locations; + trace["node"] = trace_node; + trace["sequence"] = next_trace_sequence++; + LOG_INFO_FMT("{} {}", RECOVERY_TRACE_MARKER, trace.dump()); + } + + void RecoveryDecisionProtocolSubsystem::record_trace_event( + ccf::kv::Tx& tx, recovery_decision_protocol::TraceEvent event) + { + uint64_t record_id = 0; + { + std::lock_guard guard(trace_lock); + record_id = next_trace_record_id++; + } + tx.rw( + Tables::RECOVERY_DECISION_PROTOCOL_TRACE_EVENTS) + ->put(record_id, std::move(event)); + } + + std::string RecoveryDecisionProtocolSubsystem::new_trace_message_id() + { + std::lock_guard guard(trace_lock); + return new_trace_message_id_unsafe(); + } + + std::string RecoveryDecisionProtocolSubsystem::new_trace_message_id_unsafe() + { + return fmt::format( + "{}:{}:{}", trace_instance_id, trace_node, next_trace_message_number++); + } + + recovery_decision_protocol::StateMachine RecoveryDecisionProtocolSubsystem:: + get_trace_state(kv::ReadOnlyTx& tx) + { + const auto state = tx.ro( + Tables::RECOVERY_DECISION_PROTOCOL_SM_STATE) + ->get(); + if (!state.has_value()) + { + throw std::logic_error( + "Recovery-decision-protocol state not set while tracing"); + } + return state.value(); + } + + void RecoveryDecisionProtocolSubsystem::emit_trace_send_unsafe( + const std::string& message_id, + const std::string& description, + const std::optional& txid) + { + recovery_decision_protocol::TraceEvent event{ + .kind = "send", + .message_id = message_id, + .pre = "", + .post = "", + .send = description, + }; + if (txid.has_value()) + { + event.view = txid->view; + event.seqno = txid->seqno; + } + emit_trace_event_unsafe(std::move(event)); + } + + void RecoveryDecisionProtocolSubsystem::record_trace_effects( + ccf::kv::Tx& tx, + recovery_decision_protocol::StateMachine pre, + recovery_decision_protocol::StateMachine post) + { + if ( + post == recovery_decision_protocol::StateMachine::OPENING && + pre != recovery_decision_protocol::StateMachine::OPENING) + { + const auto open_kind = tx.ro( + Tables::RECOVERY_DECISION_PROTOCOL_OPEN_KIND) + ->get(); + if (!open_kind.has_value()) + { + throw std::logic_error( + "Recovery-decision-protocol open kind not set while tracing"); + } + record_trace_event( + tx, + { + .kind = "open", + .pre = "OPENING", + .post = "OPENING", + .open_kind = trace_open_kind_name(open_kind.value()), + }); + } + + if (post == recovery_decision_protocol::StateMachine::JOINING) + { + record_trace_event( + tx, + { + .kind = "join_restart", + .pre = "JOINING", + .post = "JOINING", + }); + } + + if ( + pre == recovery_decision_protocol::StateMachine::OPENING && + post == recovery_decision_protocol::StateMachine::OPEN) + { + record_trace_event( + tx, + { + .kind = "complete", + .pre = "OPEN", + .post = "OPEN", + }); + } + } + + void RecoveryDecisionProtocolSubsystem::record_trace_receive( + ccf::kv::Tx& tx, + const std::string& kind, + const std::optional& caused_by, + const std::string& source, + const std::optional& txid, + recovery_decision_protocol::StateMachine pre) + { + const auto post = get_trace_state(tx); + recovery_decision_protocol::TraceEvent event{ + .kind = kind, + .message_id = new_trace_message_id(), + .caused_by = caused_by, + .source = source, + .pre = trace_state_name(pre), + .post = trace_state_name(post), + }; + if (txid.has_value()) + { + event.view = txid->view; + event.seqno = txid->seqno; + } + record_trace_event(tx, std::move(event)); + record_trace_effects(tx, pre, post); + } + + void RecoveryDecisionProtocolSubsystem::record_trace_timeout( + ccf::kv::Tx& tx, recovery_decision_protocol::StateMachine pre) + { + const auto post = get_trace_state(tx); + record_trace_event( + tx, + { + .kind = "timeout", + .pre = trace_state_name(pre), + .post = trace_state_name(post), + }); + record_trace_effects(tx, pre, post); + } +#endif + void RecoveryDecisionProtocolSubsystem::reset_state(ccf::kv::Tx& tx) { // Clear any previous state @@ -54,6 +322,11 @@ namespace ccf tx.rw( Tables::RECOVERY_DECISION_PROTOCOL_OPEN_KIND) ->clear(); +#ifdef CCF_RECOVERY_TRACE + tx.rw( + Tables::RECOVERY_DECISION_PROTOCOL_TRACE_EVENTS) + ->clear(); +#endif } void RecoveryDecisionProtocolSubsystem::try_start( @@ -74,6 +347,10 @@ namespace ccf LOG_INFO_FMT("Starting recovery-decision-protocol"); +#ifdef CCF_RECOVERY_TRACE + initialise_trace(tx); +#endif + tx.rw( Tables::RECOVERY_DECISION_PROTOCOL_SM_STATE) ->put(recovery_decision_protocol::StateMachine::GOSSIPING); @@ -92,6 +369,13 @@ namespace ccf w.has_value() && w.value() == recovery_decision_protocol::StateMachine::GOSSIPING) { +#ifdef CCF_RECOVERY_TRACE + emit_trace_event({ + .kind = "start", + .pre = "GOSSIPING", + .post = "GOSSIPING", + }); +#endif start_message_retry_timers(); start_failover_timers(); } @@ -99,7 +383,11 @@ namespace ccf w.has_value() && w.value() == recovery_decision_protocol::StateMachine::JOINING) { +#ifndef CCF_RECOVERY_TRACE restart_after_commit(); +#else + // The trace-event commit hook emits join_restart before restarting. +#endif } })); } @@ -342,10 +630,21 @@ namespace ccf return; } + std::optional + gossip_request = std::nullopt; + std::optional + vote_request = std::nullopt; + std::optional chosen_node_info = + std::nullopt; + std::optional + iamopen_request = std::nullopt; + switch (sm_state) { case recovery_decision_protocol::StateMachine::GOSSIPING: - send_gossip_unsafe(tx); + gossip_request = recovery_decision_protocol::GossipRequest{}; + gossip_request->info = get_node_info(tx); + gossip_request->txid = get_last_recovered_signed_txid(); break; case recovery_decision_protocol::StateMachine::VOTING: { @@ -360,7 +659,7 @@ namespace ccf throw std::logic_error( "Recovery-decision-protocol chosen node not set, cannot vote"); } - auto chosen_node_info = + chosen_node_info = node_info_handle->get(chosen_replica_handle->get().value()); if (!chosen_node_info.has_value()) { @@ -368,13 +667,15 @@ namespace ccf "Recovery-decision-protocol chosen node {} not found", chosen_replica_handle->get().value())); } - send_vote_unsafe(tx, chosen_node_info.value()); - // keep gossiping to allow lagging nodes to eventually vote - send_gossip_unsafe(tx); + vote_request = recovery_decision_protocol::TaggedWithNodeInfo{ + .info = get_node_info(tx)}; + gossip_request = recovery_decision_protocol::GossipRequest{}; + gossip_request->info = vote_request->info; + gossip_request->txid = get_last_recovered_signed_txid(); break; } case recovery_decision_protocol::StateMachine::OPENING: - send_iamopen_unsafe(tx); + iamopen_request = get_iamopen_request(tx); break; case recovery_decision_protocol::StateMachine::JOINING: case recovery_decision_protocol::StateMachine::OPEN: @@ -385,6 +686,47 @@ namespace ccf "Unknown recovery-decision-protocol state: {}", static_cast(sm_state))); } + + const auto self_signed_node_cert = + node_state->get_self_signed_certificate(); + const auto node_private_key = + node_state->node_sign_kp->private_key_pem(); + +#ifdef CCF_RECOVERY_TRACE + std::lock_guard trace_guard(trace_lock); + if (trace_committed_state != trace_state_name(sm_state)) + { + return; + } +#endif + + switch (sm_state) + { + case recovery_decision_protocol::StateMachine::GOSSIPING: + send_gossip_unsafe( + gossip_request.value(), self_signed_node_cert, node_private_key); + break; + case recovery_decision_protocol::StateMachine::VOTING: + send_vote_unsafe( + vote_request.value(), + chosen_node_info.value(), + self_signed_node_cert, + node_private_key); + // Keep gossiping to allow lagging nodes to eventually vote. + send_gossip_unsafe( + gossip_request.value(), self_signed_node_cert, node_private_key); + break; + case recovery_decision_protocol::StateMachine::OPENING: + send_iamopen_unsafe( + iamopen_request.value(), self_signed_node_cert, node_private_key); + break; + case recovery_decision_protocol::StateMachine::JOINING: + case recovery_decision_protocol::StateMachine::OPEN: + default: + throw std::logic_error(fmt::format( + "Unexpected prepared recovery-decision-protocol state: {}", + static_cast(sm_state))); + } }, "RecoveryDecisionProtocolRetry"); @@ -590,23 +932,28 @@ namespace ccf return node_info_cache.value(); } - void RecoveryDecisionProtocolSubsystem::send_gossip_unsafe(kv::ReadOnlyTx& tx) + void RecoveryDecisionProtocolSubsystem::send_gossip_unsafe( + recovery_decision_protocol::GossipRequest request, + const crypto::Pem& self_signed_node_cert, + const crypto::Pem& node_private_key) { auto& config = get_config(); LOG_TRACE_FMT("Broadcasting recovery-decision-protocol gossip"); - recovery_decision_protocol::GossipRequest request; - request.info = get_node_info(tx); - request.txid = get_last_recovered_signed_txid(); - nlohmann::json request_json = request; - const auto self_signed_node_cert = - node_state->get_self_signed_certificate(); - const auto node_private_key = node_state->node_sign_kp->private_key_pem(); - for (auto& target : config.expected_locations) { auto target_address = target.address; +#ifdef CCF_RECOVERY_TRACE + request.trace_message_id = new_trace_message_id_unsafe(); +#endif + nlohmann::json request_json = request; +#ifdef CCF_RECOVERY_TRACE + emit_trace_send_unsafe( + request.trace_message_id.value(), + fmt::format("gossip:{}", target.name), + request.txid); +#endif dispatch_authenticated_message( request_json, target_address, @@ -617,25 +964,31 @@ namespace ccf } void RecoveryDecisionProtocolSubsystem::send_vote_unsafe( - kv::ReadOnlyTx& tx, const recovery_decision_protocol::NodeInfo& node_info) + recovery_decision_protocol::TaggedWithNodeInfo request, + const recovery_decision_protocol::NodeInfo& node_info, + const crypto::Pem& self_signed_node_cert, + const crypto::Pem& node_private_key) { LOG_TRACE_FMT( "Sending recovery-decision-protocol vote to {} at {}", node_info.location.name, node_info.location.address); - recovery_decision_protocol::TaggedWithNodeInfo request{ - .info = get_node_info(tx)}; +#ifdef CCF_RECOVERY_TRACE + request.trace_message_id = new_trace_message_id_unsafe(); +#endif nlohmann::json request_json = request; - const auto self_signed_node_cert = - node_state->get_self_signed_certificate(); - +#ifdef CCF_RECOVERY_TRACE + emit_trace_send_unsafe( + request.trace_message_id.value(), + fmt::format("vote:{}", node_info.location.name)); +#endif dispatch_authenticated_message( request_json, node_info.location.address, "vote", self_signed_node_cert, - node_state->node_sign_kp->private_key_pem()); + node_private_key); } recovery_decision_protocol::IAmOpenRequest& @@ -676,18 +1029,14 @@ namespace ccf } void RecoveryDecisionProtocolSubsystem::send_iamopen_unsafe( - ccf::kv::ReadOnlyTx& tx) + recovery_decision_protocol::IAmOpenRequest request, + const crypto::Pem& self_signed_node_cert, + const crypto::Pem& node_private_key) { auto& config = get_config(); auto& location = get_location(); LOG_TRACE_FMT("Sending recovery-decision-protocol iamopen"); - - nlohmann::json request_json = get_iamopen_request(tx); - const auto self_signed_node_cert = - node_state->get_self_signed_certificate(); - const auto node_private_key = node_state->node_sign_kp->private_key_pem(); - for (auto& target : config.expected_locations) { if (target.name == location.name) @@ -695,6 +1044,15 @@ namespace ccf // Don't send to self continue; } +#ifdef CCF_RECOVERY_TRACE + request.trace_message_id = new_trace_message_id_unsafe(); +#endif + nlohmann::json request_json = request; +#ifdef CCF_RECOVERY_TRACE + emit_trace_send_unsafe( + request.trace_message_id.value(), + fmt::format("iamopen:{}", target.name)); +#endif dispatch_authenticated_message( request_json, target.address, diff --git a/src/node/recovery_decision_protocol.h b/src/node/recovery_decision_protocol.h index 6833c9ea7726..c822d8bcee23 100644 --- a/src/node/recovery_decision_protocol.h +++ b/src/node/recovery_decision_protocol.h @@ -16,9 +16,18 @@ namespace ccf::recovery_decision_protocol { public: RequestNodeInfo info; +#ifdef CCF_RECOVERY_TRACE + std::optional trace_message_id = std::nullopt; +#endif }; +#ifdef CCF_RECOVERY_TRACE + DECLARE_JSON_TYPE_WITH_OPTIONAL_FIELDS(TaggedWithNodeInfo); + DECLARE_JSON_REQUIRED_FIELDS(TaggedWithNodeInfo, info); + DECLARE_JSON_OPTIONAL_FIELDS(TaggedWithNodeInfo, trace_message_id); +#else DECLARE_JSON_TYPE(TaggedWithNodeInfo); DECLARE_JSON_REQUIRED_FIELDS(TaggedWithNodeInfo, info); +#endif struct GossipRequest : public TaggedWithNodeInfo { @@ -56,6 +65,17 @@ namespace ccf std::optional iamopen_request_cache; +#ifdef CCF_RECOVERY_TRACE + ds::Mutex trace_lock; + uint64_t next_trace_record_id = 0; + uint64_t next_trace_sequence = 0; + uint64_t next_trace_message_number = 0; + std::string trace_instance_id; + std::vector trace_expected_locations; + std::string trace_node; + std::string trace_committed_state; +#endif + public: RecoveryDecisionProtocolSubsystem(NodeState* node_state); void reset_state(ccf::kv::Tx& tx); @@ -65,6 +85,20 @@ namespace ccf recovery_decision_protocol::IAmOpenRequest& get_iamopen_request( kv::ReadOnlyTx& tx); +#ifdef CCF_RECOVERY_TRACE + recovery_decision_protocol::StateMachine get_trace_state( + kv::ReadOnlyTx& tx); + void record_trace_receive( + ccf::kv::Tx& tx, + const std::string& kind, + const std::optional& caused_by, + const std::string& source, + const std::optional& txid, + recovery_decision_protocol::StateMachine pre); + void record_trace_timeout( + ccf::kv::Tx& tx, recovery_decision_protocol::StateMachine pre); +#endif + private: // Start path void start_message_retry_timers(); @@ -77,14 +111,40 @@ namespace ccf // Steady state operations recovery_decision_protocol::RequestNodeInfo& get_node_info( kv::ReadOnlyTx& tx); - void send_gossip_unsafe(kv::ReadOnlyTx& tx); + void send_gossip_unsafe( + recovery_decision_protocol::GossipRequest request, + const crypto::Pem& self_signed_node_cert, + const crypto::Pem& node_private_key); void send_vote_unsafe( - kv::ReadOnlyTx& tx, - const recovery_decision_protocol::NodeInfo& node_info); - void send_iamopen_unsafe(kv::ReadOnlyTx& tx); + recovery_decision_protocol::TaggedWithNodeInfo request, + const recovery_decision_protocol::NodeInfo& node_info, + const crypto::Pem& self_signed_node_cert, + const crypto::Pem& node_private_key); + void send_iamopen_unsafe( + recovery_decision_protocol::IAmOpenRequest request, + const crypto::Pem& self_signed_node_cert, + const crypto::Pem& node_private_key); RecoveryDecisionProtocolConfig& get_config(); sealing_recovery::Location& get_location(); ccf::TxID get_last_recovered_signed_txid(); + +#ifdef CCF_RECOVERY_TRACE + void initialise_trace(ccf::kv::Tx& tx); + void record_trace_event( + ccf::kv::Tx& tx, recovery_decision_protocol::TraceEvent event); + void record_trace_effects( + ccf::kv::Tx& tx, + recovery_decision_protocol::StateMachine pre, + recovery_decision_protocol::StateMachine post); + void emit_trace_event(recovery_decision_protocol::TraceEvent event); + void emit_trace_event_unsafe(recovery_decision_protocol::TraceEvent event); + std::string new_trace_message_id(); + std::string new_trace_message_id_unsafe(); + void emit_trace_send_unsafe( + const std::string& message_id, + const std::string& description, + const std::optional& txid = std::nullopt); +#endif }; } diff --git a/src/node/rpc/self_healing_open_handlers.h b/src/node/rpc/self_healing_open_handlers.h index e61dfc659369..6cbf1be6d578 100644 --- a/src/node/rpc/self_healing_open_handlers.h +++ b/src/node/rpc/self_healing_open_handlers.h @@ -15,6 +15,8 @@ #include "node/recovery_decision_protocol.h" #include "node/rpc/node_frontend_utils.h" +#include + namespace ccf::node { template @@ -25,9 +27,10 @@ namespace ccf::node template static HandlerJsonParamsAndForward wrap_recovery_decision_protocol( RecoveryDecisionProtocolHandler cb, - ccf::AbstractNodeContext& node_context) + ccf::AbstractNodeContext& node_context, + const std::string& trace_kind) { - return [cb = std::move(cb), &node_context]( + return [cb = std::move(cb), &node_context, trace_kind]( endpoints::EndpointContext& args, const nlohmann::json& params) { auto config = node_context.get_subsystem(); auto node_operation = node_context.get_subsystem(); @@ -54,6 +57,16 @@ namespace ccf::node auto in = params.get(); recovery_decision_protocol::RequestNodeInfo info = in.info; +#ifdef CCF_RECOVERY_TRACE + if (!in.trace_message_id.has_value()) + { + return make_error( + HTTP_STATUS_BAD_REQUEST, + ccf::errors::InvalidInput, + "Recovery trace message ID is required in trace-enabled builds"); + } +#endif + // ---- Validate the quote against our store and store the node info ---- auto cert_der = ccf::crypto::public_key_der_from_cert( @@ -112,6 +125,22 @@ namespace ccf::node node_info_handle->put(info.location.name, src_info); } +#ifdef CCF_RECOVERY_TRACE + const auto trace_pre = args.tx + .ro( + Tables::RECOVERY_DECISION_PROTOCOL_SM_STATE) + ->get(); + if (!trace_pre.has_value()) + { + return make_error( + HTTP_STATUS_INTERNAL_SERVER_ERROR, + ccf::errors::InternalError, + "Recovery-decision-protocol state not set while tracing"); + } +#else + (void)trace_kind; +#endif + // ---- Run callback ---- auto ret = cb(args, in); @@ -125,7 +154,24 @@ namespace ccf::node try { - node_operation->recovery_decision_protocol().advance(args.tx, false); + auto& protocol = node_operation->recovery_decision_protocol(); + protocol.advance(args.tx, false); +#ifdef CCF_RECOVERY_TRACE + std::optional trace_txid = std::nullopt; + if constexpr (std::is_same_v< + Input, + recovery_decision_protocol::GossipRequest>) + { + trace_txid = in.txid; + } + protocol.record_trace_receive( + args.tx, + trace_kind, + in.trace_message_id, + info.location.name, + trace_txid, + trace_pre.value()); +#endif } catch (const std::logic_error& e) { @@ -186,7 +232,7 @@ namespace ccf::node HTTP_PUT, json_adapter(wrap_recovery_decision_protocol< recovery_decision_protocol::GossipRequest>( - recovery_decision_protocol_gossip, node_context)), + recovery_decision_protocol_gossip, node_context, "gossip_accepted")), no_auth_required) .set_forwarding_required(endpoints::ForwardingRequired::Never) .set_openapi_hidden(true) @@ -212,7 +258,7 @@ namespace ccf::node HTTP_PUT, json_adapter(wrap_recovery_decision_protocol< recovery_decision_protocol::TaggedWithNodeInfo>( - recovery_decision_protocol_vote, node_context)), + recovery_decision_protocol_vote, node_context, "vote_accepted")), no_auth_required) .set_forwarding_required(endpoints::ForwardingRequired::Never) .set_openapi_hidden(true) @@ -284,7 +330,9 @@ namespace ccf::node HTTP_PUT, json_adapter(wrap_recovery_decision_protocol< recovery_decision_protocol::IAmOpenRequest>( - recovery_decision_protocol_iamopen, node_context)), + recovery_decision_protocol_iamopen, + node_context, + "iamopen_accepted")), no_auth_required) .set_forwarding_required(endpoints::ForwardingRequired::Never) .set_openapi_hidden(true) @@ -343,7 +391,14 @@ namespace ccf::node try { - node_operation->recovery_decision_protocol().advance(args.tx, true); + auto& protocol = node_operation->recovery_decision_protocol(); +#ifdef CCF_RECOVERY_TRACE + const auto trace_pre = protocol.get_trace_state(args.tx); +#endif + protocol.advance(args.tx, true); +#ifdef CCF_RECOVERY_TRACE + protocol.record_trace_timeout(args.tx, trace_pre); +#endif } catch (const std::logic_error& e) { From 37fd251fd0c66a99844b9e6ea744a039280102f1 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 12:07:39 +0100 Subject: [PATCH 27/35] Add isolated Lean trace validator Replay strict version 1 recovery traces against the canonical model through a local package dependency, with focused rejection tests, no-sorry checks, documentation, and a shallow workflow. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../lean-disaster-recovery-trace.yml | 55 +++ lean/disaster-recovery-trace/.gitignore | 1 + lean/disaster-recovery-trace/AxiomChecks.lean | 21 + .../DisasterRecoveryTrace.lean | 1 + .../DisasterRecoveryTrace/Protocol/Trace.lean | 2 + .../Protocol/Trace/Format.lean | 143 ++++++ .../Protocol/Trace/Replay.lean | 454 ++++++++++++++++++ lean/disaster-recovery-trace/README.md | 33 ++ .../TRACE_FORMAT_V1.md | 143 ++++++ lean/disaster-recovery-trace/TraceMain.lean | 23 + lean/disaster-recovery-trace/TraceTests.lean | 227 +++++++++ .../lake-manifest.json | 102 ++++ lean/disaster-recovery-trace/lakefile.toml | 28 ++ lean/disaster-recovery-trace/lean-toolchain | 1 + 14 files changed, 1234 insertions(+) create mode 100644 .github/workflows/lean-disaster-recovery-trace.yml create mode 100644 lean/disaster-recovery-trace/.gitignore create mode 100644 lean/disaster-recovery-trace/AxiomChecks.lean create mode 100644 lean/disaster-recovery-trace/DisasterRecoveryTrace.lean create mode 100644 lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace.lean create mode 100644 lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean create mode 100644 lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean create mode 100644 lean/disaster-recovery-trace/README.md create mode 100644 lean/disaster-recovery-trace/TRACE_FORMAT_V1.md create mode 100644 lean/disaster-recovery-trace/TraceMain.lean create mode 100644 lean/disaster-recovery-trace/TraceTests.lean create mode 100644 lean/disaster-recovery-trace/lake-manifest.json create mode 100644 lean/disaster-recovery-trace/lakefile.toml create mode 100644 lean/disaster-recovery-trace/lean-toolchain diff --git a/.github/workflows/lean-disaster-recovery-trace.yml b/.github/workflows/lean-disaster-recovery-trace.yml new file mode 100644 index 000000000000..3c1605c8f2b1 --- /dev/null +++ b/.github/workflows/lean-disaster-recovery-trace.yml @@ -0,0 +1,55 @@ +name: "Lean Disaster Recovery Trace" + +on: + pull_request: + paths: + - "lean/disaster-recovery-trace/**" + - "lean/disaster-recovery/**" + - "include/ccf/service/tables/self_healing_open.h" + - "src/node/recovery_decision_protocol.cpp" + - "src/node/recovery_decision_protocol.h" + - "src/node/rpc/self_healing_open_handlers.h" + - "tests/e2e_operations.py" + - "tests/infra/recovery_trace.py" + - "CMakeLists.txt" + - ".github/workflows/ci.yml" + - ".github/workflows/lean-disaster-recovery-trace.yml" + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +permissions: read-all + +jobs: + trace-validator: + name: Trace Validator + runs-on: ubuntu-latest + timeout-minutes: 20 + + steps: + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Lean + shell: bash + run: | + set -euo pipefail + sudo apt-get update + sudo apt-get install -y elan + elan toolchain install "$(cat lean/disaster-recovery-trace/lean-toolchain)" + + - name: Restore Mathlib cache + working-directory: lean/disaster-recovery-trace + shell: bash + run: | + set -euo pipefail + lake exe cache get + + - name: Build and test validator + working-directory: lean/disaster-recovery-trace + shell: bash + run: | + set -euo pipefail + lake build + lake env lean -DwarningAsError=true AxiomChecks.lean + lake exe trace-checks diff --git a/lean/disaster-recovery-trace/.gitignore b/lean/disaster-recovery-trace/.gitignore new file mode 100644 index 000000000000..4080d07dfc31 --- /dev/null +++ b/lean/disaster-recovery-trace/.gitignore @@ -0,0 +1 @@ +/.lake/ diff --git a/lean/disaster-recovery-trace/AxiomChecks.lean b/lean/disaster-recovery-trace/AxiomChecks.lean new file mode 100644 index 000000000000..4ce748b74a9c --- /dev/null +++ b/lean/disaster-recovery-trace/AxiomChecks.lean @@ -0,0 +1,21 @@ +import DisasterRecoveryTrace +import Lean.Elab.Command +import Lean.Util.CollectAxioms + +open Lean Elab Command + +elab "#assert_no_trace_sorries" : command => do + let env <- getEnv + let mut offenders : Array Name := #[] + for (name, _) in env.constants.toList do + if name.toString.startsWith "DisasterRecoveryTrace" then + let axioms <- liftCoreM <| Lean.collectAxioms name + if axioms.contains (Name.mkSimple "sorryAx") then + offenders := offenders.push name + unless offenders.isEmpty do + throwError "trace declarations contain sorryAx: {offenders}" + +#assert_no_trace_sorries + +def main : IO Unit := + pure () diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean new file mode 100644 index 000000000000..0e19cc5345fc --- /dev/null +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean @@ -0,0 +1 @@ +import DisasterRecoveryTrace.Protocol.Trace diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace.lean new file mode 100644 index 000000000000..cf9314260d5e --- /dev/null +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace.lean @@ -0,0 +1,2 @@ +import DisasterRecoveryTrace.Protocol.Trace.Format +import DisasterRecoveryTrace.Protocol.Trace.Replay diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean new file mode 100644 index 000000000000..3eeee9ae8954 --- /dev/null +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean @@ -0,0 +1,143 @@ +import DisasterRecovery.Protocol.Model +import Lean.Data.Json +import Lean.Data.Json.FromToJson + +namespace DisasterRecoveryTrace.Protocol.Trace + +open DisasterRecovery.Protocol + +open Lean + +def contractVersion : String := + "ccf.recovery_decision_protocol.trace/1" + +inductive Kind where + | start + | gossipAccepted + | voteAccepted + | iAmOpenAccepted + | timeout + | send + | open + | joinRestart + | complete +deriving Repr, BEq, Inhabited + +structure TraceEvent where + version : String + instanceId : String + expectedLocations : List Location + node : Location + sequence : Nat + kind : Kind + messageId : Option String + causedBy : Option String + source : Option Location + txid : Option TxID + pre : Option Phase + post : Option Phase + openKind : Option OpenKind + send : Option String +deriving Repr, BEq, Inhabited + +private def parseKind : String -> Except String Kind + | "start" => pure .start + | "gossip_accepted" => pure .gossipAccepted + | "vote_accepted" => pure .voteAccepted + | "iamopen_accepted" => pure .iAmOpenAccepted + | "timeout" => pure .timeout + | "send" => pure .send + | "open" => pure .open + | "join_restart" => pure .joinRestart + | "complete" => pure .complete + | value => throw s!"unknown kind '{value}'" + +private def parsePhase : String -> Except String Phase + | "GOSSIPING" => pure .gossiping + | "VOTING" => pure .voting + | "OPENING" => pure .opening + | "JOINING" => pure .joining + | "OPEN" => pure .open + | value => throw s!"unknown phase '{value}'" + +private def parseOpenKind : String -> Except String OpenKind + | "QUORUM" => pure .quorum + | "FAILOVER" => pure .failover + | value => throw s!"unknown open kind '{value}'" + +private def optionalString (json : Json) (key : String) : + Except String (Option String) := + match json.getObjVal? key with + | .error _ | .ok .null => pure none + | .ok value => some <$> value.getStr? + +private def optionalNat (json : Json) (key : String) : + Except String (Option Nat) := + match json.getObjVal? key with + | .error _ | .ok .null => pure none + | .ok value => some <$> value.getNat? + +private def optionalParsed + (json : Json) + (key : String) + (parse : String -> Except String α) : + Except String (Option α) := do + match <- optionalString json key with + | none => pure none + | some value => some <$> parse value + +def parseEvent (line : String) : Except String TraceEvent := do + let json <- Json.parse line + let version <- json.getObjValAs? String "version" + if version != contractVersion then + throw s!"unsupported version '{version}'" + + let view <- optionalNat json "view" + let seqno <- optionalNat json "seqno" + if view.isSome != seqno.isSome then + throw "view and seqno must appear together" + + let instanceId <- json.getObjValAs? String "instance" + let expectedLocations <- + json.getObjValAs? (List String) "expected_locations" + let node <- json.getObjValAs? String "node" + let sequence <- json.getObjValAs? Nat "sequence" + let kindName <- json.getObjValAs? String "kind" + let kind <- parseKind kindName + let messageId <- optionalString json "message_id" + let causedBy <- optionalString json "caused_by" + let source <- optionalString json "source" + let pre <- optionalParsed json "pre" parsePhase + let post <- optionalParsed json "post" parsePhase + let openKind <- optionalParsed json "open_kind" parseOpenKind + let send <- optionalString json "send" + pure { + version + instanceId + expectedLocations + node + sequence + kind + messageId + causedBy + source + txid := match view, seqno with + | some view, some seqno => some { view, seqno } + | _, _ => none + pre + post + openKind + send + } + +def parseNDJSON (input : String) : Except String (List TraceEvent) := do + let lines := (input.splitOn "\n").filter + (fun line => !line.trimAscii.isEmpty) + let mut events := [] + for (line, index) in lines.zipIdx do + match parseEvent line with + | .ok event => events := event :: events + | .error message => throw s!"line {index + 1}: {message}" + pure events.reverse + +end DisasterRecoveryTrace.Protocol.Trace diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean new file mode 100644 index 000000000000..58fdf106a7c8 --- /dev/null +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean @@ -0,0 +1,454 @@ +import DisasterRecoveryTrace.Protocol.Trace.Format + +namespace DisasterRecoveryTrace.Protocol.Trace + +open DisasterRecovery.Protocol + +structure Failure where + prefixLength : Nat + message : String + expected : List String +deriving Repr, BEq + +structure ObservedSend where + messageId : String + source : Location + description : String + txid : Option TxID +deriving Repr, BEq + +structure PendingEffect where + node : Location + effect : Effect +deriving Repr, BEq + +structure PendingSendBatch where + node : Location + remaining : List String +deriving Repr, BEq + +structure ActiveReplay where + config : Config + system : SystemState + startedNodes : List Location + sends : List ObservedSend := [] + consumedSendIds : List String := [] + pendingEffects : List PendingEffect := [] + pendingSendBatches : List PendingSendBatch := [] + terminalNodes : List Location := [] + completedNodes : List Location := [] +deriving Repr, BEq + +structure ReplayState where + active : Option ActiveReplay := none + nextSequence : List (Prod Location Nat) := [] + seenMessageIds : List String := [] +deriving Repr, BEq, Inhabited + +private def nodeState (system : SystemState) (node : Location) : Option NodeState := + (system.nodes.find? fun entry => entry.1 == node).map Prod.snd + +private def phaseMatches (expected : Option Phase) (actual : Phase) : Bool := + expected == some actual + +private def isReceive : Kind -> Bool + | .gossipAccepted | .voteAccepted | .iAmOpenAccepted => true + | _ => false + +private def shapeError (event : TraceEvent) : Option String := + if event.pre.isNone || event.post.isNone then + some "pre and post are required" + else if isReceive event.kind && + (event.messageId.isNone || event.causedBy.isNone || event.source.isNone) then + some "message_id, caused_by, and source are required for receives" + else if event.kind == .gossipAccepted && event.txid.isNone then + some "view and seqno are required for gossip" + else if event.kind == .send && + (event.messageId.isNone || event.send.isNone) then + some "message_id and send are required for sends" + else if event.kind == .send && + (event.send.getD "").startsWith "gossip:" && event.txid.isNone then + some "view and seqno are required for gossip sends" + else if event.kind == .open && event.openKind.isNone then + some "open_kind is required for open" + else if !isReceive event.kind && event.causedBy.isSome then + some "caused_by is only valid on receive events" + else if event.messageId.map String.isEmpty |>.getD false then + some "message_id must not be empty" + else if event.causedBy.map String.isEmpty |>.getD false then + some "caused_by must not be empty" + else if event.source.map String.isEmpty |>.getD false then + some "source must not be empty" + else + none + +private def configError (config : Config) : Option String := + if config.instanceId.isEmpty then + some "instance must not be empty" + else if config.expectedLocations.isEmpty then + some "expected_locations must not be empty" + else if config.expectedLocations.any String.isEmpty then + some "expected_locations must not contain an empty name" + else if config.expectedLocations.eraseDups.length != + config.expectedLocations.length then + some "expected_locations must not contain duplicates" + else + none + +private def expectedSequence (state : ReplayState) (node : Location) : Nat := + (state.nextSequence.find? fun entry => entry.1 == node).map Prod.snd |>.getD 0 + +private def setSequence + (sequences : List (Prod Location Nat)) + (node : Location) + (next : Nat) : + List (Prod Location Nat) := + if sequences.any (fun entry => entry.1 == node) then + sequences.map fun entry => if entry.1 == node then (node, next) else entry + else + (node, next) :: sequences + +private def effectName : Effect -> Option String + | .sendGossip destination => some s!"gossip:{destination}" + | .sendVote destination => some s!"vote:{destination}" + | .sendIAmOpen destination => some s!"iamopen:{destination}" + | _ => none + +private def sendBatch (config : Config) (state : NodeState) : List String := + (step config state .retry).effects.filterMap effectName + +private def setPendingSendBatch + (node : Location) + (remaining : List String) + (batches : List PendingSendBatch) : + List PendingSendBatch := + let others := batches.filter (fun batch => batch.node != node) + if remaining.isEmpty then + others + else + { node, remaining } :: others + +private def receiveDescription (event : TraceEvent) : Option String := + match event.kind with + | .gossipAccepted => some s!"gossip:{event.node}" + | .voteAccepted => some s!"vote:{event.node}" + | .iAmOpenAccepted => some s!"iamopen:{event.node}" + | _ => none + +private def eventInput (event : TraceEvent) : Option Event := + match event.kind, event.source, event.txid with + | .gossipAccepted, some source, some txid => + some (.receiveGossip source txid .accepted) + | .voteAccepted, some source, _ => + some (.receiveVote source .accepted) + | .iAmOpenAccepted, some source, _ => + some (.receiveIAmOpen source .accepted) + | .timeout, _, _ => some .timeout + | _, _, _ => none + +private def isOneShotEffect : Effect -> Bool + | .opening _ | .restart _ | .completed => true + | _ => false + +private def addEffects + (node : Location) + (effects : List Effect) + (pending : List PendingEffect) : + List PendingEffect := + pending ++ (effects.filter isOneShotEffect).map fun effect => + ({ node := node, effect := effect } : PendingEffect) + +private def removeEffect (node : Location) (target : Effect) : + List PendingEffect -> Option (List PendingEffect) + | [] => none + | pending :: rest => + if pending.node == node && pending.effect == target then + some rest + else + (removeEffect node target rest).map (fun remaining => + pending :: remaining) + +private def removeRestart (node : Location) : + List PendingEffect -> Option (List PendingEffect) + | [] => none + | pending :: rest => + if pending.node == node then + match pending.effect with + | .restart _ => some rest + | _ => (removeRestart node rest).map (fun remaining => + pending :: remaining) + else + (removeRestart node rest).map (fun remaining => pending :: remaining) + +private def consumeCause + (active : ActiveReplay) + (event : TraceEvent) : Except String ActiveReplay := do + let cause := event.causedBy.getD "" + if active.consumedSendIds.contains cause then + throw s!"caused_by '{cause}' was already consumed" + let send <- match active.sends.find? (fun send => send.messageId == cause) with + | none => throw s!"caused_by '{cause}' has no prior send" + | some send => pure send + let source := event.source.getD "" + let description := receiveDescription event |>.getD "" + if send.source != source || send.description != description then + throw s!"caused_by '{cause}' has the wrong source, class, or destination" + if event.kind == .gossipAccepted && send.txid != event.txid then + throw s!"caused_by '{cause}' has the wrong gossip TxID" + pure { + active with + consumedSendIds := cause :: active.consumedSendIds + } + +private def applyTransition + (active : ActiveReplay) + (event : TraceEvent) : Except String ActiveReplay := do + let before <- match nodeState active.system event.node with + | none => throw s!"unknown node {event.node}" + | some state => pure state + if !phaseMatches event.pre before.phase then + throw s!"pre phase does not match {phaseName before.phase}" + let input <- match eventInput event with + | none => throw "event is not a protocol transition" + | some input => pure input + let (system, output) <- match + systemStep active.config active.system event.node input with + | none => throw s!"unknown node {event.node}" + | some result => pure result + if !output.accepted then + throw "protocol transition was rejected" + if !phaseMatches event.post output.state.phase then + throw s!"post phase does not match {phaseName output.state.phase}" + pure { + active with + system + pendingEffects := + addEffects event.node output.effects active.pendingEffects + } + +private def applyReceive + (active : ActiveReplay) + (event : TraceEvent) : Except String ActiveReplay := do + applyTransition (← consumeCause active event) event + +private def applySend + (active : ActiveReplay) + (event : TraceEvent) : Except String ActiveReplay := do + let state <- match nodeState active.system event.node with + | none => throw s!"unknown node {event.node}" + | some state => pure state + if !phaseMatches event.pre state.phase || !phaseMatches event.post state.phase then + throw s!"send phase does not match {phaseName state.phase}" + let description := event.send.getD "" + let batch := (active.pendingSendBatches.find? + (fun batch => batch.node == event.node)).map (fun batch => batch.remaining) + |>.getD (sendBatch active.config state) + let expected <- match batch with + | [] => throw "no retry send batch is enabled" + | expected :: _ => pure expected + if description != expected then + throw s!"expected send '{expected}', got '{description}'" + pure { + active with + sends := { + messageId := event.messageId.getD "" + source := event.node + description + txid := event.txid + } :: active.sends + pendingSendBatches := + setPendingSendBatch event.node batch.tail active.pendingSendBatches + } + +private def applyObservation + (active : ActiveReplay) + (event : TraceEvent) : Except String ActiveReplay := do + let state <- match nodeState active.system event.node with + | none => throw s!"unknown node {event.node}" + | some state => pure state + if !phaseMatches event.pre state.phase || !phaseMatches event.post state.phase then + throw s!"observation phase does not match {phaseName state.phase}" + match event.kind with + | .open => + if state.phase != .opening || event.openKind != state.openKind then + throw "open observation does not match state" + let pendingEffects <- match + removeEffect event.node (.opening event.openKind.get!) active.pendingEffects with + | none => throw "open observation has no pending opening effect" + | some pending => pure pending + pure { active with pendingEffects } + | .joinRestart => + if state.phase != .joining || !state.restartRequested then + throw "join_restart observation does not match state" + let pendingEffects <- match removeRestart event.node active.pendingEffects with + | none => throw "join_restart has no pending restart effect" + | some pending => pure pending + pure { + active with + pendingEffects + terminalNodes := event.node :: active.terminalNodes + } + | .complete => + if state.phase != .open then + throw "complete observation does not match state" + let pendingEffects <- match + removeEffect event.node .completed active.pendingEffects with + | none => throw "complete has no pending completion effect" + | some pending => pure pending + pure { + active with + pendingEffects + terminalNodes := event.node :: active.terminalNodes + completedNodes := event.node :: active.completedNodes + } + | _ => throw "event is not a protocol observation" + +private def expectedEvents (active : ActiveReplay) (node : Location) : + List String := + let phase := nodeState active.system node |>.map + (fun state => phaseName state.phase) |>.getD "UNKNOWN" + [s!"state={phase}", "send", "gossip_accepted", "vote_accepted", + "iamopen_accepted", "timeout", "open", "join_restart", "complete"] + +private def start + (active : Option ActiveReplay) + (config : Config) + (event : TraceEvent) : Except String ActiveReplay := do + if !config.expectedLocations.contains event.node then + throw s!"start node {event.node} is not expected" + let current := active.getD { + config + system := initialSystem config + startedNodes := [] + } + if current.config != config then + throw "instance or expected_locations changed" + if current.startedNodes.contains event.node then + throw s!"duplicate start event for node {event.node}" + let state <- match nodeState current.system event.node with + | none => throw s!"unknown node {event.node}" + | some state => pure state + if !phaseMatches event.pre state.phase || !phaseMatches event.post state.phase then + throw "start pre/post phase does not match GOSSIPING" + pure { + current with + startedNodes := event.node :: current.startedNodes + } + +private def processActive + (active : ActiveReplay) + (event : TraceEvent) : Except String ActiveReplay := do + if active.config.instanceId != event.instanceId || + active.config.expectedLocations != event.expectedLocations then + throw "instance or expected_locations changed" + if !active.startedNodes.contains event.node then + throw s!"node {event.node} has no start event" + if event.kind != .send && + active.pendingSendBatches.any (fun batch => batch.node == event.node) then + throw s!"node {event.node} has an incomplete retry send batch" + match event.kind with + | .gossipAccepted | .voteAccepted | .iAmOpenAccepted => + applyReceive active event + | .timeout => applyTransition active event + | .send => applySend active event + | .open | .joinRestart | .complete => applyObservation active event + | .start => throw "unexpected start event" + +private def fail + (index : Nat) + (message : String) + (expected : List String := []) : + Except Failure α := + throw { prefixLength := index + 1, message, expected } + +private def process + (index : Nat) + (state : ReplayState) + (event : TraceEvent) : Except Failure ReplayState := do + if let some message := shapeError event then + fail index message + let config : Config := { + instanceId := event.instanceId + expectedLocations := event.expectedLocations + } + if let some message := configError config then + fail index message + let expectedSeq := expectedSequence state event.node + if event.sequence != expectedSeq then + fail index s!"node {event.node} sequence {event.sequence}, expected {expectedSeq}" + if let some messageId := event.messageId then + if state.seenMessageIds.contains messageId then + fail index s!"message_id '{messageId}' was already used" + if event.causedBy == some messageId then + fail index "message_id and caused_by must identify distinct observations" + + let nextActive <- match event.kind with + | .start => + match start state.active config event with + | .ok active => pure active + | .error message => fail index message + | _ => + match state.active with + | none => fail index "trace must begin with start" ["start"] + | some active => + match processActive active event with + | .ok next => pure next + | .error message => fail index message (expectedEvents active event.node) + + pure { + active := some nextActive + nextSequence := + setSequence state.nextSequence event.node (expectedSeq + 1) + seenMessageIds := event.messageId.toList ++ state.seenMessageIds + } + +def validate (events : List TraceEvent) : Except Failure Unit := do + if events.isEmpty then + throw { + prefixLength := 0 + message := "empty trace" + expected := ["start"] + } + let mut state : ReplayState := {} + for (event, index) in events.zipIdx do + state <- process index state event + let active <- match state.active with + | none => + throw { + prefixLength := events.length + message := "trace has no start event" + expected := ["start"] + } + | some active => pure active + if !active.pendingEffects.isEmpty then + throw { + prefixLength := events.length + message := "trace ended with unobserved committed effects" + expected := ["open", "join_restart", "complete"] + } + if !active.pendingSendBatches.isEmpty then + throw { + prefixLength := events.length + message := "trace ended with incomplete retry send batches" + expected := ["send"] + } + if !active.startedNodes.all (fun node => active.terminalNodes.contains node) then + throw { + prefixLength := events.length + message := "trace ended before every participating node terminated" + expected := ["join_restart", "complete"] + } + if active.completedNodes.isEmpty then + throw { + prefixLength := events.length + message := "trace has no completed opener" + expected := ["complete"] + } + +def renderFailure (failure : Failure) : String := + let expected := + if failure.expected.isEmpty then "" + else s!"\nexpected compatible events:\n {String.intercalate "\n " failure.expected}" + s!"shortest failing prefix: {failure.prefixLength}\n{failure.message}{expected}" + +end DisasterRecoveryTrace.Protocol.Trace diff --git a/lean/disaster-recovery-trace/README.md b/lean/disaster-recovery-trace/README.md new file mode 100644 index 000000000000..6f8875dd4c35 --- /dev/null +++ b/lean/disaster-recovery-trace/README.md @@ -0,0 +1,33 @@ +# Disaster recovery trace validation + +This package validates version 1 implementation traces from CCF's C++ recovery +decision protocol against the permanent model in `../disaster-recovery`. It is +deliberately separate from the canonical model and depends only on +`DisasterRecovery.Protocol.Model`. + +`DisasterRecoveryTrace.Protocol.Trace.Format` parses the strict versioned +NDJSON contract. `DisasterRecoveryTrace.Protocol.Trace.Replay` replays each +event against the canonical transition system. The validator rejects the first +incompatible event and reports the shortest failing prefix. + +## Build and test + +```sh +lake exe cache get +lake build +lake exe trace-checks +lake exe axiom-checks +``` + +Run the validator with: + +```sh +lake exe trace-validator -- TRACE.recovery.ndjson +``` + +`TraceTests.lean` contains small in-memory parser and replay tests. These tests +exercise rejection behavior; they are not implementation conformance evidence. +Conformance evidence is produced only from real C++ SNP recovery runs and is +uploaded by the Milan and Genoa jobs. + +See [TRACE_FORMAT_V1.md](TRACE_FORMAT_V1.md) for the complete contract. diff --git a/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md b/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md new file mode 100644 index 000000000000..0eb8ef10e3cf --- /dev/null +++ b/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md @@ -0,0 +1,143 @@ +# Recovery decision protocol trace format, version 1 + +The media type is newline-delimited JSON. Each nonempty line is one committed +semantic observation. The version string is: + +```text +ccf.recovery_decision_protocol.trace/1 +``` + +## Record + +Every record is a JSON object with these required fields: + +| Field | Type | Meaning | +| -------------------- | ---------------- | ----------------------------------- | +| `version` | string | Exactly the version above | +| `instance` | string | Stable recovery instance identifier | +| `expected_locations` | array of strings | Stable configured location names | +| `node` | string | Observed node/location name | +| `sequence` | natural number | Per-node sequence, starting at zero | +| `kind` | string | Event kind from the table below | + +These fields are optional unless the event requires them: + +| Field | Type | Meaning | +| ------------ | ---------------- | ------------------------------------------------------------------------- | +| `message_id` | string | Globally unique ID for an observed send or receive | +| `caused_by` | string | `message_id` of the send that caused a receive | +| `source` | string | Sender location name | +| `view` | natural number | Gossip TxID view | +| `seqno` | natural number | Gossip TxID sequence number | +| `pre` | phase string | Observable phase before the event | +| `post` | phase string | Observable phase after the event | +| `open_kind` | open-kind string | `QUORUM` or `FAILOVER` for an `open` observation | +| `send` | string | Send class and destination: `gossip:NAME`, `vote:NAME`, or `iamopen:NAME` | + +Phase strings are `GOSSIPING`, `VOTING`, `OPENING`, `JOINING`, and `OPEN`. +Unknown fields are ignored for forward-compatible instrumentation metadata. +All integers must be nonnegative Lean `Nat` values. + +## Event kinds + +| Kind | Required event fields | Canonical boundary | +| ------------------ | ----------------------------------------------------------------------------------------------------- | ------------------------------------------- | +| `start` | `pre`, `post` | Protocol state initialized | +| `gossip_accepted` | `message_id`, `caused_by`, `source`, `view`, `seqno`, `pre`, `post` | Validated gossip callback committed | +| `vote_accepted` | `message_id`, `caused_by`, `source`, `pre`, `post` | Validated vote callback committed | +| `iamopen_accepted` | `message_id`, `caused_by`, `source`, `pre`, `post` | IAmOpen selected peer and Joining committed | +| `timeout` | `pre`, `post` | Timeout transaction committed | +| `send` | `send` in `class:destination` form, `message_id`, `pre`, `post`; gossip also requires `view`, `seqno` | Transport send observed | +| `open` | `open_kind`, `pre`, `post` | Service-open transition committed | +| `join_restart` | `pre`, `post` | Joining/restart side effect committed | +| `complete` | `pre`, `post` | Opening-to-Open completion committed | + +Every receive uses `caused_by` to identify an earlier `send`. The validator +checks the sender, destination, message class, gossip TxID payload, and single +consumption of that send. Message IDs, causal IDs, and source names must be +nonempty, and message IDs cannot be reused. Non-receive events must omit +`caused_by`. + +Each participating configured node has one `start` event at sequence zero. The +first creates the replay system; later starts activate other configured nodes +without resetting it. Non-start events for a node +before its start are rejected. Configured but unavailable nodes may have no +start event. Subsequent records must preserve `instance` and +`expected_locations`, refer to a configured node, and increment that node's +sequence exactly. Empty instance IDs, empty configurations, empty location +names, and duplicate configured names are rejected. + +The NDJSON record order is a topological linearization of the distributed +trace. Per-node `sequence` and `caused_by` edges define the ordering; wall-clock +timestamps do not. + +## Strict replay + +Version 1 is a complete successful-execution trace: every transport send, +accepted receive, committed timeout, and one-shot effect is explicit. +`DisasterRecoveryTrace/Protocol/Trace/Replay.lean` folds these events over one deterministic `SystemState`. +It retains only observed sends, consumed causal IDs, per-node sequences, and +pending ordered retry-send batches and `open`, `join_restart`, or `complete` +effects. + +The validator rejects the first event that is not enabled by the canonical +model or whose recorded pre/post state, cause, or effect does not match. It +reports this shortest failing prefix with the current phase and expected event +classes. + +Rejected HTTP/validation inputs do not mutate the modeled state and are not +part of version 1. A future need to validate rejection behavior or incomplete +traces should use a new contract version rather than adding implicit behavior +to this deterministic replay. + +## C++ instrumentation + +Configure CCF with `-DCCF_RECOVERY_TRACE=ON` to enable implementation tracing. +Accepted receive and timeout events are written to +`public:ccf.internal.recovery_decision_protocol.trace_events` in the same +transaction as the modeled state change. A global commit hook emits them only +after commit, followed by any `open`, `join_restart`, or `complete` effect from +that transition. Aborted transactions therefore emit nothing. +In trace-enabled builds the joiner restart request is issued by the trace hook +after the committed receive and `join_restart` records are emitted. Default +builds issue the restart from the committed state hook. Both modes therefore +wait for global commit before requesting restart. + +The committed start hook emits `start` before scheduling retry and failover +tasks. Transport sends are emitted immediately before dispatch and propagate +their generated `message_id` in the internal request as `trace_message_id`; +the committed receive records it as `caused_by`. +If a retry observes a locally committed phase that is not yet globally visible +to the trace hook, tracing defers that retry invocation. Once phases match, the +trace lock serializes the complete send batch against later commit publication. + +Each log record contains `RDP_TRACE ` followed by the event object. +`../../tests/infra/recovery_trace.py` extracts records from all participating node +logs, topologically orders them by per-node sequence and causal send edges, +writes NDJSON, and invokes the Lean validator. The quorum, failover, and +multiple-timeout SNP e2e scenarios call this helper. +Each generated `*.recovery.ndjson` file is retained with the SNP job's uploaded +logs, so a failed replay can be reproduced locally. + +The e2e helper additionally requires scenario-specific terminal evidence before +accepting the trace: the expected open kind, at least one completed opener, and +a `complete` or `join_restart` event for every participating node. + +## Example + +```json +{ + "version": "ccf.recovery_decision_protocol.trace/1", + "instance": "example", + "expected_locations": ["node0"], + "node": "node0", + "sequence": 0, + "kind": "start", + "pre": "GOSSIPING", + "post": "GOSSIPING" +} +``` + +No recovery-decision-protocol traces are checked into the repository. Every +NDJSON trace passed to the validator in CI is captured from the running C++ +implementation. diff --git a/lean/disaster-recovery-trace/TraceMain.lean b/lean/disaster-recovery-trace/TraceMain.lean new file mode 100644 index 000000000000..1d792a751347 --- /dev/null +++ b/lean/disaster-recovery-trace/TraceMain.lean @@ -0,0 +1,23 @@ +import DisasterRecoveryTrace.Protocol.Trace + +open DisasterRecoveryTrace.Protocol.Trace + +def main (args : List String) : IO UInt32 := do + match args with + | [path] => + let input <- IO.FS.readFile path + match parseNDJSON input with + | .error message => + IO.eprintln message + pure 1 + | .ok events => + match validate events with + | .error failure => + IO.eprintln (renderFailure failure) + pure 1 + | .ok () => + IO.println s!"trace accepted: {events.length} events" + pure 0 + | _ => + IO.eprintln "usage: trace-validator TRACE.ndjson" + pure 2 diff --git a/lean/disaster-recovery-trace/TraceTests.lean b/lean/disaster-recovery-trace/TraceTests.lean new file mode 100644 index 000000000000..25ac131896ca --- /dev/null +++ b/lean/disaster-recovery-trace/TraceTests.lean @@ -0,0 +1,227 @@ +import DisasterRecoveryTrace.Protocol.Trace + +open DisasterRecovery.Protocol +open DisasterRecoveryTrace.Protocol.Trace + +private def expect (condition : Bool) (message : String) : IO Unit := + unless condition do throw (IO.userError message) + +private def baseEvent + (locations : List Location) + (node : Location) + (sequence : Nat) + (kind : Kind) : TraceEvent := { + version := contractVersion + instanceId := "trace-tests" + expectedLocations := locations + node + sequence + kind + messageId := none + causedBy := none + source := none + txid := none + pre := none + post := none + openKind := none + send := none +} + +private def startEvent + (locations : List Location) + (node : Location) : TraceEvent := { + baseEvent locations node 0 .start with + pre := some .gossiping + post := some .gossiping +} + +private def sendEvent + (locations : List Location) + (sequence : Nat) + (messageId description : String) + (phase : Phase) : TraceEvent := { + baseEvent locations "A" sequence .send with + messageId := some messageId + pre := some phase + post := some phase + txid := if description.startsWith "gossip:" then + some { view := 1, seqno := 1 } + else + none + send := some description +} + +private def gossipEvent + (locations : List Location) + (sequence : Nat) + (messageId cause : String) + (post : Phase) : TraceEvent := { + baseEvent locations "A" sequence .gossipAccepted with + messageId := some messageId + causedBy := some cause + source := some "A" + txid := some { view := 1, seqno := 1 } + pre := some .gossiping + post := some post +} + +private def voteEvent + (locations : List Location) + (sequence : Nat) + (messageId cause : String) + (post : Phase) : TraceEvent := { + baseEvent locations "A" sequence .voteAccepted with + messageId := some messageId + causedBy := some cause + source := some "A" + pre := some .voting + post := some post +} + +private def timeoutEvent + (locations : List Location) + (sequence : Nat) + (pre post : Phase) : TraceEvent := { + baseEvent locations "A" sequence .timeout with + pre := some pre + post := some post +} + +private def openEvent + (locations : List Location) + (sequence : Nat) + (kind : OpenKind) : TraceEvent := { + baseEvent locations "A" sequence .open with + pre := some .opening + post := some .opening + openKind := some kind +} + +private def completeEvent + (locations : List Location) + (sequence : Nat) : TraceEvent := { + baseEvent locations "A" sequence .complete with + pre := some .open + post := some .open +} + +private def validationSucceeds (events : List TraceEvent) : Bool := + match validate events with + | .ok () => true + | .error _ => false + +private def failedAt (events : List TraceEvent) (expectedPrefix : Nat) : Bool := + match validate events with + | .error failure => failure.prefixLength == expectedPrefix + | .ok () => false + +private def parseFails (value : String) : Bool := + match parseEvent value with + | .error _ => true + | .ok _ => false + +private def quorumTrace : List TraceEvent := + let locations := ["A"] + [ + startEvent locations "A", + sendEvent locations 1 "send-gossip" "gossip:A" .gossiping, + gossipEvent locations 2 "receive-gossip" "send-gossip" .voting, + sendEvent locations 3 "send-vote" "vote:A" .voting, + sendEvent locations 4 "send-voting-gossip" "gossip:A" .voting, + voteEvent locations 5 "receive-vote" "send-vote" .opening, + openEvent locations 6 .quorum, + timeoutEvent locations 7 .opening .opening, + timeoutEvent locations 8 .opening .opening, + timeoutEvent locations 9 .opening .open, + completeEvent locations 10 + ] + +def main : IO UInt32 := do + expect (validationSucceeds quorumTrace) "complete quorum trace was rejected" + + let locations := ["A", "B"] + expect + (failedAt [startEvent locations "A", startEvent locations "B"] 2) + "incomplete multi-node trace was accepted" + expect + (failedAt [startEvent locations "A"] 1) + "incomplete single-node trace was accepted" + expect + (failedAt [startEvent locations "A", startEvent locations "A"] 2) + "duplicate start was accepted" + expect + (failedAt [startEvent ["A", "A"] "A"] 1) + "duplicate expected locations were accepted" + expect + (failedAt [{ startEvent ["A"] "A" with instanceId := "" }] 1) + "empty recovery instance was accepted" + + let single := ["A"] + let start := startEvent single "A" + let gossipSend := sendEvent single 1 "send-gossip" "gossip:A" .gossiping + let missingCause := { + gossipEvent single 2 "receive-gossip" "missing" .voting with + causedBy := none + } + expect + (failedAt [start, gossipSend, missingCause] 3) + "receive without caused_by was accepted" + + let wrongClass := { + voteEvent single 2 "receive-vote" "send-gossip" .voting with + pre := some .gossiping + } + expect + (failedAt [start, gossipSend, wrongClass] 3) + "vote consumed a gossip send" + + let wrongTxid := { + gossipEvent single 2 "receive-gossip" "send-gossip" .voting with + txid := some { view := 9, seqno := 9 } + } + expect + (failedAt [start, gossipSend, wrongTxid] 3) + "gossip received a different TxID than its send" + + let wrongPost := gossipEvent single 2 "receive-gossip" "send-gossip" .open + expect + (failedAt [start, gossipSend, wrongPost] 3) + "invalid gossip post-state was accepted" + + let received := gossipEvent single 2 "receive-gossip" "send-gossip" .voting + let reusedCause := { + voteEvent single 3 "receive-vote" "send-gossip" .voting with + pre := some .voting + } + expect + (failedAt [start, gossipSend, received, reusedCause] 4) + "one send caused multiple receives" + + let badSend := sendEvent single 1 "send-vote" "vote:A" .gossiping + expect + (failedAt [start, badSend] 2) + "Voting send was accepted while Gossiping" + + let abortedTimeout := timeoutEvent single 1 .gossiping .gossiping + expect + (failedAt [start, abortedTimeout] 2) + "aborted empty-gossip timeout was accepted" + + let throughOpen := quorumTrace.take 7 + expect + (failedAt (throughOpen ++ [openEvent single 7 .quorum]) 8) + "one opening transition produced multiple open observations" + expect + (failedAt (quorumTrace.take 6) 6) + "trace with an unobserved opening effect was accepted" + + let rejectedJson := + "{\"version\":\"ccf.recovery_decision_protocol.trace/1\"," + ++ "\"instance\":\"x\",\"expected_locations\":[\"A\"]," + ++ "\"node\":\"A\",\"sequence\":0,\"kind\":\"gossip_rejected\"," + ++ "\"pre\":\"GOSSIPING\",\"post\":\"GOSSIPING\"}" + expect (parseFails rejectedJson) + "unused rejection event remains in the strict v1 format" + + IO.println "all strict trace replay checks passed" + pure 0 diff --git a/lean/disaster-recovery-trace/lake-manifest.json b/lean/disaster-recovery-trace/lake-manifest.json new file mode 100644 index 000000000000..569faa3bb97f --- /dev/null +++ b/lean/disaster-recovery-trace/lake-manifest.json @@ -0,0 +1,102 @@ +{"version": "1.1.0", + "packagesDir": ".lake/packages", + "packages": + [{"type": "path", + "scope": "", + "name": "disaster_recovery", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "../disaster-recovery", + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/mathlib4.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", + "name": "mathlib", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/LeanSearchClient", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "name": "LeanSearchClient", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/import-graph", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", + "name": "importGraph", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/ProofWidgets4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", + "name": "proofwidgets", + "manifestFile": "lake-manifest.json", + "inputRev": "v0.0.87", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/aesop", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", + "name": "aesop", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/quote4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", + "name": "Qq", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/batteries", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", + "name": "batteries", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover/lean4-cli", + "type": "git", + "subDir": null, + "scope": "leanprover", + "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.toml"}], + "name": "disaster_recovery_trace", + "lakeDir": ".lake"} diff --git a/lean/disaster-recovery-trace/lakefile.toml b/lean/disaster-recovery-trace/lakefile.toml new file mode 100644 index 000000000000..09d013b891ad --- /dev/null +++ b/lean/disaster-recovery-trace/lakefile.toml @@ -0,0 +1,28 @@ +name = "disaster_recovery_trace" +version = "0.1.0" +moreLeanArgs = ["-DwarningAsError=true"] +defaultTargets = [ + "DisasterRecoveryTrace", + "trace-checks", + "trace-validator", + "axiom-checks", +] + +[[require]] +name = "disaster_recovery" +path = "../disaster-recovery" + +[[lean_lib]] +name = "DisasterRecoveryTrace" + +[[lean_exe]] +name = "trace-checks" +root = "TraceTests" + +[[lean_exe]] +name = "trace-validator" +root = "TraceMain" + +[[lean_exe]] +name = "axiom-checks" +root = "AxiomChecks" diff --git a/lean/disaster-recovery-trace/lean-toolchain b/lean/disaster-recovery-trace/lean-toolchain new file mode 100644 index 000000000000..4c685fa085fa --- /dev/null +++ b/lean/disaster-recovery-trace/lean-toolchain @@ -0,0 +1 @@ +leanprover/lean4:v4.28.0 From adc31fa9345819fd63fbc1f0dac6b3710a9d967b Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 12:08:30 +0100 Subject: [PATCH 28/35] Add deterministic recovery trace extraction Validate trace identity, per-node sequences, message IDs, and causal edges before producing a deterministic NDJSON linearization for the isolated Lean validator. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- tests/infra/recovery_trace.py | 268 +++++++++++++++++++++++++++++ tests/infra/recovery_trace_test.py | 210 ++++++++++++++++++++++ 2 files changed, 478 insertions(+) create mode 100644 tests/infra/recovery_trace.py create mode 100644 tests/infra/recovery_trace_test.py diff --git a/tests/infra/recovery_trace.py b/tests/infra/recovery_trace.py new file mode 100644 index 000000000000..521a8a216ba5 --- /dev/null +++ b/tests/infra/recovery_trace.py @@ -0,0 +1,268 @@ +# Copyright (c) Microsoft Corporation. All rights reserved. +# Licensed under the Apache 2.0 License. + +import heapq +import itertools +import json +import logging +import os +import pathlib +import subprocess +import time + +TRACE_MARKER = "RDP_TRACE " +TRACE_VALIDATOR_ENV = "CCF_LEAN_TRACE_VALIDATOR" +TRACE_VERSION = "ccf.recovery_decision_protocol.trace/1" +LOG = logging.getLogger(__name__) + + +def _event_from_log_line(line, path, line_number): + message = line + try: + outer = json.loads(line) + if isinstance(outer, dict) and isinstance(outer.get("msg"), str): + message = outer["msg"] + except json.JSONDecodeError: + pass + + marker = message.find(TRACE_MARKER) + if marker < 0: + return None + + payload = message[marker + len(TRACE_MARKER) :].lstrip() + try: + event, _ = json.JSONDecoder().raw_decode(payload) + except json.JSONDecodeError as error: + raise ValueError( + f"{path}:{line_number}: invalid recovery trace JSON: {error}" + ) from error + if not isinstance(event, dict): + raise TypeError(f"{path}:{line_number}: recovery trace is not an object") + return event + + +def extract_events(nodes): + events = [] + for node in nodes: + out_path, _ = node.get_logs() + if out_path is None or not os.path.isfile(out_path): + continue + with open(out_path, encoding="utf-8", errors="replace") as log: + for line_number, line in enumerate(log, 1): + event = _event_from_log_line(line, out_path, line_number) + if event is not None: + events.append(event) + if not events: + raise ValueError("no recovery-decision-protocol trace events found") + return events + + +def linearize(events): + successors = [set() for _ in events] + indegree = [0 for _ in events] + + def add_edge(source, destination): + if destination not in successors[source]: + successors[source].add(destination) + indegree[destination] += 1 + + by_node = {} + message_ids = {} + identity = None + for index, event in enumerate(events): + try: + version = event["version"] + instance = event["instance"] + expected_locations = event["expected_locations"] + node = event["node"] + sequence = event["sequence"] + kind = event["kind"] + except KeyError as error: + raise ValueError( + f"trace event {index} is missing {error.args[0]}" + ) from error + if version != TRACE_VERSION: + raise ValueError(f"trace event {index} has unsupported version {version}") + if not isinstance(instance, str) or not instance: + raise ValueError(f"trace event {index} has an invalid instance") + if ( + not isinstance(expected_locations, list) + or not expected_locations + or any( + not isinstance(location, str) or not location + for location in expected_locations + ) + or len(set(expected_locations)) != len(expected_locations) + ): + raise ValueError( + f"trace event {index} has invalid expected_locations" + ) + event_identity = (instance, tuple(expected_locations)) + if identity is None: + identity = event_identity + elif event_identity != identity: + raise ValueError(f"trace event {index} changes recovery identity") + if ( + not isinstance(node, str) + or not node + or node not in expected_locations + or type(sequence) is not int + or sequence < 0 + or not isinstance(kind, str) + ): + raise TypeError(f"trace event {index} has an invalid node or sequence") + by_node.setdefault(node, []).append((sequence, index)) + + message_id = event.get("message_id") + if message_id is not None: + if not isinstance(message_id, str) or not message_id: + raise ValueError(f"trace event {index} has an invalid message_id") + if message_id in message_ids: + raise ValueError(f"duplicate trace message_id {message_id}") + message_ids[message_id] = (index, kind) + + for node, node_events in by_node.items(): + node_events.sort() + sequences = [sequence for sequence, _ in node_events] + if sequences != list(range(len(node_events))): + raise ValueError( + f"node {node} trace sequence is not contiguous from zero: {sequences}" + ) + for (_, previous), (_, current) in itertools.pairwise(node_events): + add_edge(previous, current) + + for index, event in enumerate(events): + caused_by = event.get("caused_by") + if caused_by is None: + continue + if not isinstance(caused_by, str) or not caused_by: + raise ValueError(f"trace event {index} has an invalid caused_by") + if caused_by not in message_ids: + raise ValueError(f"caused_by {caused_by} has no matching send event") + source, kind = message_ids[caused_by] + if kind != "send": + raise ValueError(f"caused_by {caused_by} does not identify a send event") + add_edge(source, index) + + ready = [] + for index, degree in enumerate(indegree): + if degree == 0: + event = events[index] + heapq.heappush( + ready, (event["node"], event["sequence"], event["kind"], index) + ) + + ordered = [] + while ready: + _, _, _, index = heapq.heappop(ready) + ordered.append(events[index]) + for successor in successors[index]: + indegree[successor] -= 1 + if indegree[successor] == 0: + event = events[successor] + heapq.heappush( + ready, + (event["node"], event["sequence"], event["kind"], successor), + ) + + if len(ordered) != len(events): + raise ValueError("recovery trace contains a causal cycle") + return ordered + + +def _validator_path(): + configured = os.getenv(TRACE_VALIDATOR_ENV) + if configured: + return pathlib.Path(configured) + repository = pathlib.Path(__file__).resolve().parents[2] + return ( + repository + / "lean" + / "disaster-recovery-trace" + / ".lake" + / "build" + / "bin" + / "trace-validator" + ) + + +def _participating_node_count(nodes): + return sum(node.remote is not None for node in nodes) + + +def wait_for_terminal_events(network, expected_open_kind, timeout): + expected_node_count = _participating_node_count(network.nodes) + end_time = time.time() + timeout + events = [] + while time.time() < end_time: + try: + events = extract_events(network.nodes) + except ValueError: + time.sleep(0.1) + continue + + started = {event["node"] for event in events if event["kind"] == "start"} + completed = {event["node"] for event in events if event["kind"] == "complete"} + terminal = completed | { + event["node"] for event in events if event["kind"] == "join_restart" + } + opened = [event for event in events if event["kind"] == "open"] + if ( + len(started) == expected_node_count + and started <= terminal + and completed + and opened + and all(event.get("open_kind") == expected_open_kind for event in opened) + ): + return events + time.sleep(0.1) + + raise TimeoutError( + "timed out waiting for terminal recovery trace events: " + f"expected_node_count={expected_node_count}, " + f"started={sorted(started) if events else []}, " + f"expected_open_kind={expected_open_kind}, events={events}" + ) + + +def validate_recovery_trace(network, label, expected_open_kind=None, timeout=20): + if expected_open_kind is None: + events = extract_events(network.nodes) + else: + events = wait_for_terminal_events(network, expected_open_kind, timeout) + events = linearize(events) + trace_path = pathlib.Path(network.common_dir) / f"{label}.recovery.ndjson" + with open(trace_path, "w", encoding="utf-8") as trace: + for event in events: + trace.write(json.dumps(event, separators=(",", ":"), sort_keys=True)) + trace.write("\n") + + validator = _validator_path() + if not validator.is_file(): + raise FileNotFoundError( + f"Lean trace validator not found at {validator}; set {TRACE_VALIDATOR_ENV}" + ) + result = subprocess.run( + [validator, trace_path], + text=True, + capture_output=True, + check=False, + ) + if result.returncode != 0: + raise AssertionError( + f"Lean recovery trace validation failed for {trace_path}:\n" + f"{result.stdout}{result.stderr}" + ) + LOG.info(result.stdout.strip()) + return trace_path + + +def validate_recovery_trace_if_enabled(network, label, expected_open_kind, timeout=20): + if not os.getenv(TRACE_VALIDATOR_ENV): + return None + return validate_recovery_trace( + network, + label, + expected_open_kind=expected_open_kind, + timeout=timeout, + ) diff --git a/tests/infra/recovery_trace_test.py b/tests/infra/recovery_trace_test.py new file mode 100644 index 000000000000..4d295e2c45fa --- /dev/null +++ b/tests/infra/recovery_trace_test.py @@ -0,0 +1,210 @@ +# Copyright (c) Microsoft Corporation. All rights reserved. +# Licensed under the Apache 2.0 License. + +import json +import pathlib +import tempfile +import unittest +from unittest import mock + +import infra.recovery_trace + +VERSION = "ccf.recovery_decision_protocol.trace/1" +EXPECTED_LOCATIONS = ["A", "B"] + + +def event(node, sequence, kind, **extra): + value = { + "version": VERSION, + "instance": "synthetic", + "expected_locations": EXPECTED_LOCATIONS, + "node": node, + "sequence": sequence, + "kind": kind, + "pre": "GOSSIPING", + "post": "GOSSIPING", + } + value.update(extra) + return value + + +class FakeNode: + def __init__(self, path, name=None): + self.path = path + self.name = name + self.remote = object() if name is not None else None + + def get_logs(self): + return str(self.path), None + + def get_sealing_recovery_location(self): + return {"name": self.name} + + +class FakeNetwork: + def __init__(self, nodes, common_dir): + self.nodes = nodes + self.common_dir = common_dir + + +class RecoveryTraceTest(unittest.TestCase): + def test_extract_linearize_and_validate(self): + with tempfile.TemporaryDirectory() as directory: + root = pathlib.Path(directory) + a_log = root / "a.out" + b_log = root / "b.out" + a_events = [ + event("A", 0, "start"), + event( + "A", + 1, + "send", + message_id="send-a-b", + send="gossip:B", + ), + ] + b_events = [ + event("B", 0, "start"), + event( + "B", + 1, + "gossip_accepted", + message_id="receive-a-b", + caused_by="send-a-b", + source="A", + view=1, + seqno=1, + ), + ] + a_log.write_text( + "".join( + f"[info] RDP_TRACE {json.dumps(trace_event)}\n" + for trace_event in a_events + ), + encoding="utf-8", + ) + b_log.write_text( + "".join( + json.dumps({"msg": f"RDP_TRACE {json.dumps(trace_event)}"}) + "\n" + for trace_event in b_events + ), + encoding="utf-8", + ) + network = FakeNetwork( + [FakeNode(b_log), FakeNode(a_log)], + directory, + ) + + extracted = infra.recovery_trace.extract_events(network.nodes) + ordered = infra.recovery_trace.linearize(extracted) + self.assertEqual( + [(item["node"], item["sequence"]) for item in ordered], + [("A", 0), ("A", 1), ("B", 0), ("B", 1)], + ) + + def test_rejects_non_contiguous_sequence(self): + broken = [ + event("A", 0, "start"), + event("A", 2, "timeout"), + ] + with self.assertRaisesRegex(ValueError, "not contiguous"): + infra.recovery_trace.linearize(broken) + + def test_rejects_unresolved_cause(self): + broken = [ + event("A", 0, "start"), + event( + "A", + 1, + "gossip_accepted", + message_id="receive", + caused_by="missing-send", + source="B", + view=1, + seqno=1, + ), + ] + with self.assertRaisesRegex(ValueError, "no matching send"): + infra.recovery_trace.linearize(broken) + + def test_rejects_identity_change(self): + broken = [ + event("A", 0, "start"), + { + **event("A", 1, "timeout"), + "instance": "different", + }, + ] + with self.assertRaisesRegex(ValueError, "changes recovery identity"): + infra.recovery_trace.linearize(broken) + + def test_rejects_duplicate_message_id(self): + broken = [ + event("A", 0, "start", message_id="duplicate"), + event("A", 1, "send", message_id="duplicate"), + ] + with self.assertRaisesRegex(ValueError, "duplicate trace message_id"): + infra.recovery_trace.linearize(broken) + + def test_rejects_causal_cycle(self): + broken = [ + event("A", 0, "start"), + event( + "A", + 1, + "gossip_accepted", + message_id="receive-b", + caused_by="send-b", + ), + event("A", 2, "send", message_id="send-a"), + event("B", 0, "start"), + event( + "B", + 1, + "gossip_accepted", + message_id="receive-a", + caused_by="send-a", + ), + event("B", 2, "send", message_id="send-b"), + ] + with self.assertRaisesRegex(ValueError, "causal cycle"): + infra.recovery_trace.linearize(broken) + + def test_disabled_validation_preserves_default_tests(self): + with mock.patch.dict( + "os.environ", + {infra.recovery_trace.TRACE_VALIDATOR_ENV: ""}, + clear=False, + ): + self.assertIsNone( + infra.recovery_trace.validate_recovery_trace_if_enabled( + FakeNetwork([], "."), "disabled", "QUORUM" + ) + ) + + def test_waits_for_terminal_scenario_evidence(self): + with tempfile.TemporaryDirectory() as directory: + log_path = pathlib.Path(directory) / "a.out" + events = [ + event("A", 0, "start"), + event("A", 1, "open", open_kind="QUORUM"), + event("A", 2, "complete"), + ] + log_path.write_text( + "".join( + f"RDP_TRACE {json.dumps(trace_event)}\n" for trace_event in events + ), + encoding="utf-8", + ) + network = FakeNetwork( + [FakeNode(log_path, "A")], + directory, + ) + self.assertEqual( + infra.recovery_trace.wait_for_terminal_events(network, "QUORUM", 0.1), + events, + ) + + +if __name__ == "__main__": + unittest.main() From bd2fa7ec37ffcb51d4f1171b66c1aad57e418723 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 12:09:18 +0100 Subject: [PATCH 29/35] Validate SNP recovery scenarios with Lean Build the isolated validator in Milan and Genoa trace-enabled jobs, validate quorum, failover, and repeated-timeout recoveries, and retain generated NDJSON artifacts on failure. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .github/workflows/README.md | 9 + .github/workflows/ci.yml | 38 ++- .../lake-manifest.json | 227 ++++++++++-------- tests/e2e_operations.py | 10 + tests/infra/recovery_trace.py | 4 +- 5 files changed, 181 insertions(+), 107 deletions(-) diff --git a/.github/workflows/README.md b/.github/workflows/README.md index c96c3a7bf59b..55d9d823eb85 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -117,6 +117,15 @@ library module, so newly added proofs cannot silently escape the checks. File: `lean.yml` 3rd party dependencies: None +# Lean Disaster Recovery Trace + +Builds the isolated strict trace validator and runs its parser, replay, and +no-sorry checks. The Milan and Genoa SNP jobs in `ci.yml` validate real +committed C++ recovery traces and upload the generated NDJSON evidence. + +File: `lean-disaster-recovery-trace.yml` +3rd party dependencies: None + # Vendored Dependency Verification Verifies that files under `3rdparty/` match the Git commits or release artifacts diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e0ff26ae8765..0cb9dd9b314e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -292,13 +292,28 @@ jobs: python3 tests/infra/platform_detection.py snp milan shell: bash + - name: "Build Lean recovery trace validator" + run: | + set -euo pipefail + curl --proto '=https' --tlsv1.2 -sSf \ + https://raw.githubusercontent.com/leanprover/elan/58e8d545e33641f66dbcbd22c4283109e71757be/elan-init.sh \ + -o /tmp/elan-init.sh + sh /tmp/elan-init.sh -y --default-toolchain none + rm /tmp/elan-init.sh + export PATH="${HOME}/.elan/bin:${PATH}" + elan toolchain install "$(cat lean/disaster-recovery-trace/lean-toolchain)" + cd lean/disaster-recovery-trace + lake exe cache get + lake build trace-validator + shell: bash + - name: "Build Debug" run: | set -ex git config --global --add safe.directory /__w/CCF/CCF mkdir build cd build - cmake -GNinja -DCMAKE_BUILD_TYPE=Debug -DWORKER_THREADS=1 .. + cmake -GNinja -DCMAKE_BUILD_TYPE=Debug -DWORKER_THREADS=1 -DCCF_RECOVERY_TRACE=ON .. ninja shell: bash @@ -314,6 +329,7 @@ jobs: shell: bash env: CCF_TEST_SYNC_AFTER_SETUP: 1 + CCF_LEAN_TRACE_VALIDATOR: ${{ github.workspace }}/lean/disaster-recovery-trace/.lake/build/bin/trace-validator ELECTION_TIMEOUT_MS: 10000 - name: "Capture dmesg" @@ -336,6 +352,7 @@ jobs: build/workspace/*/out build/workspace/*/err build/workspace/*/*.ledger/* + build/workspace/**/*.recovery.ndjson build/workspace/*/stack_trace build/workspace/**/openapi_coverage.json if-no-files-found: ignore @@ -378,13 +395,28 @@ jobs: python3 tests/infra/platform_detection.py snp genoa shell: bash + - name: "Build Lean recovery trace validator" + run: | + set -euo pipefail + curl --proto '=https' --tlsv1.2 -sSf \ + https://raw.githubusercontent.com/leanprover/elan/58e8d545e33641f66dbcbd22c4283109e71757be/elan-init.sh \ + -o /tmp/elan-init.sh + sh /tmp/elan-init.sh -y --default-toolchain none + rm /tmp/elan-init.sh + export PATH="${HOME}/.elan/bin:${PATH}" + elan toolchain install "$(cat lean/disaster-recovery-trace/lean-toolchain)" + cd lean/disaster-recovery-trace + lake exe cache get + lake build trace-validator + shell: bash + - name: "Build Debug" run: | set -ex git config --global --add safe.directory /__w/CCF/CCF mkdir build cd build - cmake -GNinja -DCMAKE_BUILD_TYPE=Debug -DWORKER_THREADS=1 .. + cmake -GNinja -DCMAKE_BUILD_TYPE=Debug -DWORKER_THREADS=1 -DCCF_RECOVERY_TRACE=ON .. ninja shell: bash @@ -400,6 +432,7 @@ jobs: shell: bash env: CCF_TEST_SYNC_AFTER_SETUP: 1 + CCF_LEAN_TRACE_VALIDATOR: ${{ github.workspace }}/lean/disaster-recovery-trace/.lake/build/bin/trace-validator ELECTION_TIMEOUT_MS: 10000 - name: "Capture dmesg" @@ -422,6 +455,7 @@ jobs: build/workspace/*/out build/workspace/*/err build/workspace/*/*.ledger/* + build/workspace/**/*.recovery.ndjson build/workspace/*/stack_trace build/workspace/**/openapi_coverage.json if-no-files-found: ignore diff --git a/lean/disaster-recovery-trace/lake-manifest.json b/lean/disaster-recovery-trace/lake-manifest.json index 569faa3bb97f..a963e4648c8f 100644 --- a/lean/disaster-recovery-trace/lake-manifest.json +++ b/lean/disaster-recovery-trace/lake-manifest.json @@ -1,102 +1,125 @@ -{"version": "1.1.0", - "packagesDir": ".lake/packages", - "packages": - [{"type": "path", - "scope": "", - "name": "disaster_recovery", - "manifestFile": "lake-manifest.json", - "inherited": false, - "dir": "../disaster-recovery", - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/mathlib4.git", - "type": "git", - "subDir": null, - "scope": "", - "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", - "name": "mathlib", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", - "inherited": true, - "configFile": "lakefile.lean"}, - {"url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/LeanSearchClient", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", - "name": "LeanSearchClient", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/import-graph", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", - "name": "importGraph", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/ProofWidgets4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", - "name": "proofwidgets", - "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.87", - "inherited": true, - "configFile": "lakefile.lean"}, - {"url": "https://github.com/leanprover-community/aesop", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", - "name": "aesop", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/quote4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", - "name": "Qq", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover-community/batteries", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", - "name": "batteries", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml"}, - {"url": "https://github.com/leanprover/lean4-cli", - "type": "git", - "subDir": null, - "scope": "leanprover", - "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", - "name": "Cli", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", - "inherited": true, - "configFile": "lakefile.toml"}], - "name": "disaster_recovery_trace", - "lakeDir": ".lake"} +{ + "version": "1.1.0", + "packagesDir": ".lake/packages", + "packages": [ + { + "type": "path", + "scope": "", + "name": "disaster_recovery", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "../disaster-recovery", + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/mathlib4.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", + "name": "mathlib", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.lean" + }, + { + "url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/LeanSearchClient", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "name": "LeanSearchClient", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/import-graph", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", + "name": "importGraph", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/ProofWidgets4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", + "name": "proofwidgets", + "manifestFile": "lake-manifest.json", + "inputRev": "v0.0.87", + "inherited": true, + "configFile": "lakefile.lean" + }, + { + "url": "https://github.com/leanprover-community/aesop", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", + "name": "aesop", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/quote4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", + "name": "Qq", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/batteries", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", + "name": "batteries", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover/lean4-cli", + "type": "git", + "subDir": null, + "scope": "leanprover", + "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.28.0", + "inherited": true, + "configFile": "lakefile.toml" + } + ], + "name": "disaster_recovery_trace", + "lakeDir": ".lake" +} diff --git a/tests/e2e_operations.py b/tests/e2e_operations.py index 97655aea6e1e..9bff22cc6bd3 100644 --- a/tests/e2e_operations.py +++ b/tests/e2e_operations.py @@ -38,6 +38,7 @@ import infra.path import infra.platform_detection import infra.proc +import infra.recovery_trace import infra.utils import suite.test_requirements as reqs from ccf.tx_id import TxID @@ -2915,6 +2916,9 @@ def run_recovery_decision_protocol(const_args): assert ( recovery_type == '"Quorum"' ), f"Network self-healing open type was {recovery_type} instead of Quorum" + infra.recovery_trace.validate_recovery_trace_if_enabled( + recovered_network, args.label, "QUORUM" + ) def run_recovery_decision_protocol_timeout_path(const_args): @@ -2967,6 +2971,9 @@ def run_recovery_decision_protocol_timeout_path(const_args): assert ( recovery_type == '"Failover"' ), f"Network self-healing open type was {recovery_type} instead of Failover" + infra.recovery_trace.validate_recovery_trace_if_enabled( + recovered_network, args.label, "FAILOVER" + ) def run_recovery_decision_protocol_multiple_timeout(const_args): @@ -3019,6 +3026,9 @@ def run_recovery_decision_protocol_multiple_timeout(const_args): node.refresh_network_state(verify_ca=False) assert len(recovered_network.get_joined_nodes()) == len(args.nodes) + infra.recovery_trace.validate_recovery_trace_if_enabled( + recovered_network, args.label, "FAILOVER" + ) def run_read_ledger_on_testdata(args): diff --git a/tests/infra/recovery_trace.py b/tests/infra/recovery_trace.py index 521a8a216ba5..055c76c29084 100644 --- a/tests/infra/recovery_trace.py +++ b/tests/infra/recovery_trace.py @@ -94,9 +94,7 @@ def add_edge(source, destination): ) or len(set(expected_locations)) != len(expected_locations) ): - raise ValueError( - f"trace event {index} has invalid expected_locations" - ) + raise ValueError(f"trace event {index} has invalid expected_locations") event_identity = (instance, tuple(expected_locations)) if identity is None: identity = event_identity From 5f8c29806cc565df4458fbf95e96c1416f3e92f5 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Fri, 4 Sep 2026 12:27:13 +0100 Subject: [PATCH 30/35] Run trace ordering checks in CI Exercise the focused Python extraction and causal-ordering suite in the dedicated trace workflow. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .github/workflows/lean-disaster-recovery-trace.yml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.github/workflows/lean-disaster-recovery-trace.yml b/.github/workflows/lean-disaster-recovery-trace.yml index 3c1605c8f2b1..86285675e9b9 100644 --- a/.github/workflows/lean-disaster-recovery-trace.yml +++ b/.github/workflows/lean-disaster-recovery-trace.yml @@ -53,3 +53,10 @@ jobs: lake build lake env lean -DwarningAsError=true AxiomChecks.lean lake exe trace-checks + + - name: Test trace extraction and ordering + working-directory: tests + shell: bash + run: | + set -euo pipefail + python3 -m unittest infra.recovery_trace_test From 55751d26126f905146020fc8bc756347d9af7f98 Mon Sep 17 00:00:00 2001 From: achamayou Date: Mon, 7 Sep 2026 21:08:59 +0100 Subject: [PATCH 31/35] Upgrade Lean trace validation to 4.33.1 Consolidate the trace checks into the shared Lean workflow and replace the handwritten sorry scan with the standard axiom audit. Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> Copilot-Session: ed9f1e31-297c-4592-a089-2d37c49c2434 --- .github/workflows/README.md | 14 ++--- .../lean-disaster-recovery-trace.yml | 62 ------------------- .github/workflows/lean.yml | 49 +++++++++++++++ lean/disaster-recovery-trace/.gitignore | 1 - lean/disaster-recovery-trace/AxiomChecks.lean | 21 ------- .../DisasterRecoveryTrace.lean | 2 + lean/disaster-recovery-trace/README.md | 7 ++- .../lake-manifest.json | 41 +++++++----- lean/disaster-recovery-trace/lakefile.toml | 12 ++-- lean/disaster-recovery-trace/lean-toolchain | 2 +- 10 files changed, 95 insertions(+), 116 deletions(-) delete mode 100644 .github/workflows/lean-disaster-recovery-trace.yml delete mode 100644 lean/disaster-recovery-trace/.gitignore delete mode 100644 lean/disaster-recovery-trace/AxiomChecks.lean diff --git a/.github/workflows/README.md b/.github/workflows/README.md index 55d9d823eb85..e4c6162f2550 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -114,16 +114,12 @@ and the proof implementation files marked as generated for review purposes. The standard `mk_all --check` command ensures that the audit root imports every library module, so newly added proofs cannot silently escape the checks. -File: `lean.yml` -3rd party dependencies: None - -# Lean Disaster Recovery Trace +The trace-validator job builds and audits the isolated strict trace validator, +then runs its parser, replay, extraction, and ordering checks. The Milan and +Genoa SNP jobs in `ci.yml` validate real committed C++ recovery traces and +upload the generated NDJSON evidence. -Builds the isolated strict trace validator and runs its parser, replay, and -no-sorry checks. The Milan and Genoa SNP jobs in `ci.yml` validate real -committed C++ recovery traces and upload the generated NDJSON evidence. - -File: `lean-disaster-recovery-trace.yml` +File: `lean.yml` 3rd party dependencies: None # Vendored Dependency Verification diff --git a/.github/workflows/lean-disaster-recovery-trace.yml b/.github/workflows/lean-disaster-recovery-trace.yml deleted file mode 100644 index 86285675e9b9..000000000000 --- a/.github/workflows/lean-disaster-recovery-trace.yml +++ /dev/null @@ -1,62 +0,0 @@ -name: "Lean Disaster Recovery Trace" - -on: - pull_request: - paths: - - "lean/disaster-recovery-trace/**" - - "lean/disaster-recovery/**" - - "include/ccf/service/tables/self_healing_open.h" - - "src/node/recovery_decision_protocol.cpp" - - "src/node/recovery_decision_protocol.h" - - "src/node/rpc/self_healing_open_handlers.h" - - "tests/e2e_operations.py" - - "tests/infra/recovery_trace.py" - - "CMakeLists.txt" - - ".github/workflows/ci.yml" - - ".github/workflows/lean-disaster-recovery-trace.yml" - -concurrency: - group: ${{ github.workflow }}-${{ github.ref }} - cancel-in-progress: true - -permissions: read-all - -jobs: - trace-validator: - name: Trace Validator - runs-on: ubuntu-latest - timeout-minutes: 20 - - steps: - - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 - - - name: Install Lean - shell: bash - run: | - set -euo pipefail - sudo apt-get update - sudo apt-get install -y elan - elan toolchain install "$(cat lean/disaster-recovery-trace/lean-toolchain)" - - - name: Restore Mathlib cache - working-directory: lean/disaster-recovery-trace - shell: bash - run: | - set -euo pipefail - lake exe cache get - - - name: Build and test validator - working-directory: lean/disaster-recovery-trace - shell: bash - run: | - set -euo pipefail - lake build - lake env lean -DwarningAsError=true AxiomChecks.lean - lake exe trace-checks - - - name: Test trace extraction and ordering - working-directory: tests - shell: bash - run: | - set -euo pipefail - python3 -m unittest infra.recovery_trace_test diff --git a/.github/workflows/lean.yml b/.github/workflows/lean.yml index e96583d107c4..766a76c923e9 100644 --- a/.github/workflows/lean.yml +++ b/.github/workflows/lean.yml @@ -4,6 +4,15 @@ on: pull_request: paths: - "lean/**" + - "include/ccf/service/tables/self_healing_open.h" + - "src/node/recovery_decision_protocol.cpp" + - "src/node/recovery_decision_protocol.h" + - "src/node/rpc/self_healing_open_handlers.h" + - "tests/e2e_operations.py" + - "tests/infra/recovery_trace.py" + - "tests/infra/recovery_trace_test.py" + - "CMakeLists.txt" + - ".github/workflows/ci.yml" - ".github/workflows/lean.yml" schedule: - cron: "0 0 * * 0" @@ -47,3 +56,43 @@ jobs: lake build --wfail lake lint lake exe canonical-checks + + trace-validator: + name: Trace validator + runs-on: ubuntu-latest + timeout-minutes: 20 + + steps: + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Lean + shell: bash + run: | + set -euo pipefail + sudo apt-get update + sudo apt-get install -y elan + elan toolchain install "$(cat lean/disaster-recovery-trace/lean-toolchain)" + + - name: Restore Mathlib cache + working-directory: lean/disaster-recovery-trace + shell: bash + run: | + set -euo pipefail + lake exe cache get + + - name: Build and test validator + working-directory: lean/disaster-recovery-trace + shell: bash + run: | + set -euo pipefail + lake exe mk_all --check --lib DisasterRecoveryTrace + lake build --wfail + lake lint + lake exe trace-checks + + - name: Test trace extraction and ordering + working-directory: tests + shell: bash + run: | + set -euo pipefail + python3 -m unittest infra.recovery_trace_test diff --git a/lean/disaster-recovery-trace/.gitignore b/lean/disaster-recovery-trace/.gitignore deleted file mode 100644 index 4080d07dfc31..000000000000 --- a/lean/disaster-recovery-trace/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/.lake/ diff --git a/lean/disaster-recovery-trace/AxiomChecks.lean b/lean/disaster-recovery-trace/AxiomChecks.lean deleted file mode 100644 index 4ce748b74a9c..000000000000 --- a/lean/disaster-recovery-trace/AxiomChecks.lean +++ /dev/null @@ -1,21 +0,0 @@ -import DisasterRecoveryTrace -import Lean.Elab.Command -import Lean.Util.CollectAxioms - -open Lean Elab Command - -elab "#assert_no_trace_sorries" : command => do - let env <- getEnv - let mut offenders : Array Name := #[] - for (name, _) in env.constants.toList do - if name.toString.startsWith "DisasterRecoveryTrace" then - let axioms <- liftCoreM <| Lean.collectAxioms name - if axioms.contains (Name.mkSimple "sorryAx") then - offenders := offenders.push name - unless offenders.isEmpty do - throwError "trace declarations contain sorryAx: {offenders}" - -#assert_no_trace_sorries - -def main : IO Unit := - pure () diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean index 0e19cc5345fc..61c0e23240c0 100644 --- a/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean @@ -1 +1,3 @@ import DisasterRecoveryTrace.Protocol.Trace +import DisasterRecoveryTrace.Protocol.Trace.Format +import DisasterRecoveryTrace.Protocol.Trace.Replay diff --git a/lean/disaster-recovery-trace/README.md b/lean/disaster-recovery-trace/README.md index 6f8875dd4c35..06bf655c53d5 100644 --- a/lean/disaster-recovery-trace/README.md +++ b/lean/disaster-recovery-trace/README.md @@ -3,7 +3,7 @@ This package validates version 1 implementation traces from CCF's C++ recovery decision protocol against the permanent model in `../disaster-recovery`. It is deliberately separate from the canonical model and depends only on -`DisasterRecovery.Protocol.Model`. +`DisasterRecovery.Protocol.Model`. Both packages are pinned to Lean 4.33.1. `DisasterRecoveryTrace.Protocol.Trace.Format` parses the strict versioned NDJSON contract. `DisasterRecoveryTrace.Protocol.Trace.Replay` replays each @@ -14,9 +14,10 @@ incompatible event and reports the shortest failing prefix. ```sh lake exe cache get -lake build +lake exe mk_all --check --lib DisasterRecoveryTrace +lake build --wfail +lake lint lake exe trace-checks -lake exe axiom-checks ``` Run the validator with: diff --git a/lean/disaster-recovery-trace/lake-manifest.json b/lean/disaster-recovery-trace/lake-manifest.json index a963e4648c8f..4a2b58280327 100644 --- a/lean/disaster-recovery-trace/lake-manifest.json +++ b/lean/disaster-recovery-trace/lake-manifest.json @@ -1,7 +1,19 @@ { - "version": "1.1.0", + "version": "1.2.0", "packagesDir": ".lake/packages", "packages": [ + { + "url": "https://github.com/leanprover-community/axiom-audit.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "46024e005996495c65ef609368e11ab39c4222e3", + "name": "axiomAudit", + "manifestFile": "lake-manifest.json", + "inputRev": "46024e005996495c65ef609368e11ab39c4222e3", + "inherited": false, + "configFile": "lakefile.toml" + }, { "type": "path", "scope": "", @@ -16,10 +28,10 @@ "type": "git", "subDir": null, "scope": "", - "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", + "rev": "0df444a360eaa60ab8c11dca51a86af692955474", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", + "inputRev": "v4.33.1", "inherited": true, "configFile": "lakefile.lean" }, @@ -28,7 +40,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", + "rev": "b7eb3304aeae834b12dda98993a37f6a41f6f0bb", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -40,7 +52,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "rev": "5f4d51b81cbd3f6b32b156bfad9056621a040404", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -52,7 +64,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", + "rev": "16f02aa7642864af59f1ff0e384a015994db9118", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -64,10 +76,10 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", + "rev": "4be2e3d5087eeb272cf5a8853b8f9dd025ef5957", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.87", + "inputRev": "main", "inherited": true, "configFile": "lakefile.lean" }, @@ -76,7 +88,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", + "rev": "3448c0bcc5ce01b2d1546e483ec3620e32df3d0e", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -88,7 +100,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", + "rev": "92c15be17b7caf78c2ad767ec40f89052d908d81", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -100,7 +112,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", + "rev": "4488d40d070b9700d4d5a6aa342f0d40c31b2a2d", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -112,14 +124,15 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", + "rev": "6130a47896ce867c6a4a55373441e59e565bad0f", "name": "Cli", "manifestFile": "lake-manifest.json", - "inputRev": "v4.28.0", + "inputRev": "v4.33.0", "inherited": true, "configFile": "lakefile.toml" } ], "name": "disaster_recovery_trace", - "lakeDir": ".lake" + "lakeDir": ".lake", + "fixedToolchain": false } diff --git a/lean/disaster-recovery-trace/lakefile.toml b/lean/disaster-recovery-trace/lakefile.toml index 09d013b891ad..cebc96ce56d7 100644 --- a/lean/disaster-recovery-trace/lakefile.toml +++ b/lean/disaster-recovery-trace/lakefile.toml @@ -1,17 +1,23 @@ name = "disaster_recovery_trace" version = "0.1.0" moreLeanArgs = ["-DwarningAsError=true"] +lintDriver = "axiomAudit/\u00abaxiom-audit\u00bb" +lintDriverArgs = ["--root", "DisasterRecoveryTrace"] defaultTargets = [ "DisasterRecoveryTrace", "trace-checks", "trace-validator", - "axiom-checks", ] [[require]] name = "disaster_recovery" path = "../disaster-recovery" +[[require]] +name = "axiomAudit" +git = "https://github.com/leanprover-community/axiom-audit.git" +rev = "46024e005996495c65ef609368e11ab39c4222e3" # v0.1.2 + [[lean_lib]] name = "DisasterRecoveryTrace" @@ -22,7 +28,3 @@ root = "TraceTests" [[lean_exe]] name = "trace-validator" root = "TraceMain" - -[[lean_exe]] -name = "axiom-checks" -root = "AxiomChecks" diff --git a/lean/disaster-recovery-trace/lean-toolchain b/lean/disaster-recovery-trace/lean-toolchain index 4c685fa085fa..a8afa7d1b02d 100644 --- a/lean/disaster-recovery-trace/lean-toolchain +++ b/lean/disaster-recovery-trace/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.28.0 +leanprover/lean4:v4.33.1 From bca9e9fa5e4e9509acd5deb3777b214208704f73 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Wed, 9 Sep 2026 15:09:07 +0100 Subject: [PATCH 32/35] Fix trace validator model namespace Update trace parsing, replay, and tests for the canonical model namespace introduced lower in the stack. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../DisasterRecoveryTrace/Protocol/Trace/Format.lean | 2 +- .../DisasterRecoveryTrace/Protocol/Trace/Replay.lean | 2 +- lean/disaster-recovery-trace/TraceTests.lean | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean index 3eeee9ae8954..892ce9397b21 100644 --- a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean @@ -4,7 +4,7 @@ import Lean.Data.Json.FromToJson namespace DisasterRecoveryTrace.Protocol.Trace -open DisasterRecovery.Protocol +open DisasterRecovery.Protocol.Model open Lean diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean index 58fdf106a7c8..23b21db5e273 100644 --- a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean @@ -2,7 +2,7 @@ import DisasterRecoveryTrace.Protocol.Trace.Format namespace DisasterRecoveryTrace.Protocol.Trace -open DisasterRecovery.Protocol +open DisasterRecovery.Protocol.Model structure Failure where prefixLength : Nat diff --git a/lean/disaster-recovery-trace/TraceTests.lean b/lean/disaster-recovery-trace/TraceTests.lean index 25ac131896ca..0d128e5b8cd5 100644 --- a/lean/disaster-recovery-trace/TraceTests.lean +++ b/lean/disaster-recovery-trace/TraceTests.lean @@ -1,6 +1,6 @@ import DisasterRecoveryTrace.Protocol.Trace -open DisasterRecovery.Protocol +open DisasterRecovery.Protocol.Model open DisasterRecoveryTrace.Protocol.Trace private def expect (condition : Bool) (message : String) : IO Unit := From 09c7efbaccadb2ac573aded4caeeea6748a981c2 Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Sun, 13 Sep 2026 15:24:08 +0100 Subject: [PATCH 33/35] Validate raw recovery logs directly in Lean Move extraction, causal ordering, and completion waiting out of Python. Remove the Python infrastructure unit tests and their CI step, retaining Lean rejection checks and real SNP trace validation. Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- .github/workflows/README.md | 2 +- .github/workflows/ci.yml | 2 - .github/workflows/lean.yml | 8 - .../DisasterRecoveryTrace.lean | 1 + .../DisasterRecoveryTrace/Protocol/Trace.lean | 1 + .../Protocol/Trace/Logs.lean | 167 +++++++++++ .../Protocol/Trace/Replay.lean | 18 +- lean/disaster-recovery-trace/README.md | 27 +- .../TRACE_FORMAT_V1.md | 27 +- lean/disaster-recovery-trace/TraceMain.lean | 38 ++- lean/disaster-recovery-trace/TraceTests.lean | 273 +++++++++++++++++- tests/infra/recovery_trace.py | 229 ++------------- tests/infra/recovery_trace_test.py | 210 -------------- 13 files changed, 545 insertions(+), 458 deletions(-) create mode 100644 lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Logs.lean delete mode 100644 tests/infra/recovery_trace_test.py diff --git a/.github/workflows/README.md b/.github/workflows/README.md index a5fde4a16c50..e2e92c17529a 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -117,7 +117,7 @@ library module, so newly added proofs cannot silently escape the checks. The trace-validator job builds and audits the isolated strict trace validator, then runs its parser, replay, extraction, and ordering checks. The Milan and Genoa SNP jobs in `ci.yml` validate real committed C++ recovery traces and -upload the generated NDJSON evidence. +upload the original node logs consumed directly by Lean. File: `lean.yml` 3rd party dependencies: None diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0cb9dd9b314e..c5804478ab7f 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -352,7 +352,6 @@ jobs: build/workspace/*/out build/workspace/*/err build/workspace/*/*.ledger/* - build/workspace/**/*.recovery.ndjson build/workspace/*/stack_trace build/workspace/**/openapi_coverage.json if-no-files-found: ignore @@ -455,7 +454,6 @@ jobs: build/workspace/*/out build/workspace/*/err build/workspace/*/*.ledger/* - build/workspace/**/*.recovery.ndjson build/workspace/*/stack_trace build/workspace/**/openapi_coverage.json if-no-files-found: ignore diff --git a/.github/workflows/lean.yml b/.github/workflows/lean.yml index 764b292c4dd5..388ef79fef2d 100644 --- a/.github/workflows/lean.yml +++ b/.github/workflows/lean.yml @@ -10,7 +10,6 @@ on: - "src/node/rpc/self_healing_open_handlers.h" - "tests/e2e_operations.py" - "tests/infra/recovery_trace.py" - - "tests/infra/recovery_trace_test.py" - "CMakeLists.txt" - ".github/workflows/ci.yml" - ".github/workflows/lean.yml" @@ -87,10 +86,3 @@ jobs: lake build --wfail lake lint lake exe trace-checks - - - name: Test trace extraction and ordering - working-directory: tests - shell: bash - run: | - set -euo pipefail - python3 -m unittest infra.recovery_trace_test diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean index 61c0e23240c0..0ac2a8af41d3 100644 --- a/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace.lean @@ -1,3 +1,4 @@ import DisasterRecoveryTrace.Protocol.Trace import DisasterRecoveryTrace.Protocol.Trace.Format +import DisasterRecoveryTrace.Protocol.Trace.Logs import DisasterRecoveryTrace.Protocol.Trace.Replay diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace.lean index cf9314260d5e..ed6543ea4b46 100644 --- a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace.lean +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace.lean @@ -1,2 +1,3 @@ import DisasterRecoveryTrace.Protocol.Trace.Format +import DisasterRecoveryTrace.Protocol.Trace.Logs import DisasterRecoveryTrace.Protocol.Trace.Replay diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Logs.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Logs.lean new file mode 100644 index 000000000000..4ce91f54b1ea --- /dev/null +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Logs.lean @@ -0,0 +1,167 @@ +import DisasterRecoveryTrace.Protocol.Trace.Replay + +namespace DisasterRecoveryTrace.Protocol.Trace + +open DisasterRecovery.Protocol.Model +open Lean + +inductive LogError where + | invalid (message : String) + | incomplete (message : String) +deriving Repr, BEq + +structure LocatedEvent where + path : String + line : Nat + event : TraceEvent +deriving Repr, BEq + +def LocatedEvent.origin (record : LocatedEvent) : String := + s!"{record.path}:{record.line}" + +structure LogSnapshot where + events : List LocatedEvent := [] + partialLines : List String := [] +deriving Repr + +private def logEvent (line : String) : Except String (Option TraceEvent) := do + let message <- match Json.parse line with + | .ok json => + match json.getObjVal? "msg" with + | .ok (.str message) => pure message + | _ => pure "" + | .error _ => pure line + match message.splitOn "RDP_TRACE " with + | [] | [_] => pure none + | _ :: rest => some <$> parseEvent (String.intercalate "RDP_TRACE " rest) + +def extractLog (path input : String) : Except LogError LogSnapshot := do + let lines := input.splitOn "\n" + let mut snapshot : LogSnapshot := {} + -- Only newline-terminated records are stable while the node is writing. + for (line, index) in lines.dropLast.zipIdx do + match logEvent line with + | .error message => + throw (.invalid s!"{path}:{index + 1}: invalid trace record: {message}") + | .ok none => pure () + | .ok (some event) => + snapshot := { snapshot with + events := { path, line := index + 1, event } :: snapshot.events } + if !(lines.getLast?.getD "").isEmpty then + snapshot := { snapshot with partialLines := [s!"{path}:{lines.length}"] } + pure { snapshot with events := snapshot.events.reverse } + +def extractLogBytes (path : String) (input : ByteArray) : Except LogError LogSnapshot := do + let mut endOffset := 0 + let mut line := 1 + for index in [:input.size] do + if input[index]! == 10 then + endOffset := index + 1 + line := line + 1 + let some text := String.fromUTF8? (input.extract 0 endOffset) + | throw (.invalid s!"{path}: invalid UTF-8 in newline-terminated log data") + let snapshot <- extractLog path text + pure { snapshot with + partialLines := if endOffset < input.size then [s!"{path}:{line}"] else [] } + +private def eventLE (a b : LocatedEvent) : Bool := + a.event.node < b.event.node || + (a.event.node == b.event.node && a.event.sequence <= b.event.sequence) + +def linearize (events : List LocatedEvent) : + Except LogError (List LocatedEvent) := do + let some first := events.head? + | throw (.incomplete "no recovery-decision-protocol trace events found") + let sorted := events.mergeSort eventLE + let mut previous : Option TraceEvent := none + let mut messageIds : List (String × LocatedEvent) := [] + let mut missing : List String := [] + for record in sorted do + let event := record.event + if event.instanceId != first.event.instanceId || + event.expectedLocations != first.event.expectedLocations then + throw (.invalid s!"{record.origin}: recovery identity changed") + if let some id := event.messageId then + if messageIds.any (fun entry => entry.1 == id) then + throw (.invalid s!"{record.origin}: duplicate message_id '{id}'") + messageIds := (id, record) :: messageIds + let expected := match previous with + | some prev => + if prev.node == event.node then prev.sequence + 1 else 0 + | none => 0 + if event.sequence < expected then + throw (.invalid s!"{record.origin}: duplicate node sequence {event.sequence}") + if event.sequence > expected then + missing := s!"{record.origin}: node {event.node} sequence {event.sequence}, expected {expected}" + :: missing + previous := some event + for record in sorted do + if let some cause := record.event.causedBy then + match messageIds.find? (fun entry => entry.1 == cause) with + | none => + missing := s!"{record.origin}: caused_by '{cause}' has no matching send" :: missing + | some (_, source) => + if source.event.kind != .send then + throw (.invalid s!"{record.origin}: caused_by '{cause}' does not identify a send") + if !missing.isEmpty then + throw (.incomplete (String.intercalate "\n" missing.reverse)) + + let mut remaining := sorted + let mut ordered : List LocatedEvent := [] + let mut emittedIds : List String := [] + let mut nextSequence : List (Location × Nat) := [] + for _ in events do + let ready := remaining.find? fun record => + let event := record.event + let sequence := (nextSequence.find? (fun entry => entry.1 == event.node)).map Prod.snd + |>.getD 0 + event.sequence == sequence && + (event.causedBy.map emittedIds.contains |>.getD true) + let some record := ready + | throw (.invalid "recovery trace contains a causal cycle") + remaining := remaining.filter fun other => + other.event.node != record.event.node || other.event.sequence != record.event.sequence + ordered := record :: ordered + emittedIds := record.event.messageId.toList ++ emittedIds + nextSequence := (record.event.node, record.event.sequence + 1) :: + nextSequence.filter (fun entry => entry.1 != record.event.node) + pure ordered.reverse + +structure Scenario where + participatingNodes : Nat + openKind : OpenKind +deriving Repr + +def validateLogs (logs : List (String × ByteArray)) (scenario : Scenario) : + Except LogError Nat := do + if scenario.participatingNodes == 0 then + throw (.invalid "expected participating-node count must be positive") + let mut events := [] + let mut partialLines := [] + for (path, input) in logs do + let snapshot <- extractLogBytes path input + events := events ++ snapshot.events + partialLines := partialLines ++ snapshot.partialLines + for record in events do + if record.event.kind == .open && record.event.openKind != some scenario.openKind then + throw (.invalid s!"{record.origin}: unexpected scenario open kind") + let ordered <- linearize events + let state <- match replay (ordered.map LocatedEvent.event) with + | .ok state => pure state + | .error failure => + let origin := (ordered[failure.prefixLength - 1]?).map LocatedEvent.origin + |>.getD "trace" + throw (.invalid s!"{origin}: {renderFailure failure}") + let started := state.active.map (fun active => active.startedNodes.length) |>.getD 0 + if started > scenario.participatingNodes then + throw (.invalid s!"started {started} nodes, expected {scenario.participatingNodes}") + if started < scenario.participatingNodes then + throw (.incomplete s!"started {started} nodes, expected {scenario.participatingNodes}") + match finish state ordered.length with + | .error failure => throw (.incomplete (renderFailure failure)) + | .ok () => pure () + if !partialLines.isEmpty then + throw (.incomplete s!"unterminated log lines: {String.intercalate ", " partialLines}") + pure ordered.length + +end DisasterRecoveryTrace.Protocol.Trace diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean index 23b21db5e273..b9c6e7e11e9c 100644 --- a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Replay.lean @@ -402,7 +402,7 @@ private def process seenMessageIds := event.messageId.toList ++ state.seenMessageIds } -def validate (events : List TraceEvent) : Except Failure Unit := do +def replay (events : List TraceEvent) : Except Failure ReplayState := do if events.isEmpty then throw { prefixLength := 0 @@ -412,39 +412,45 @@ def validate (events : List TraceEvent) : Except Failure Unit := do let mut state : ReplayState := {} for (event, index) in events.zipIdx do state <- process index state event + pure state + +def finish (state : ReplayState) (eventCount : Nat) : Except Failure Unit := do let active <- match state.active with | none => throw { - prefixLength := events.length + prefixLength := eventCount message := "trace has no start event" expected := ["start"] } | some active => pure active if !active.pendingEffects.isEmpty then throw { - prefixLength := events.length + prefixLength := eventCount message := "trace ended with unobserved committed effects" expected := ["open", "join_restart", "complete"] } if !active.pendingSendBatches.isEmpty then throw { - prefixLength := events.length + prefixLength := eventCount message := "trace ended with incomplete retry send batches" expected := ["send"] } if !active.startedNodes.all (fun node => active.terminalNodes.contains node) then throw { - prefixLength := events.length + prefixLength := eventCount message := "trace ended before every participating node terminated" expected := ["join_restart", "complete"] } if active.completedNodes.isEmpty then throw { - prefixLength := events.length + prefixLength := eventCount message := "trace has no completed opener" expected := ["complete"] } +def validate (events : List TraceEvent) : Except Failure Unit := do + finish (← replay events) events.length + def renderFailure (failure : Failure) : String := let expected := if failure.expected.isEmpty then "" diff --git a/lean/disaster-recovery-trace/README.md b/lean/disaster-recovery-trace/README.md index 06bf655c53d5..bef27f8ff72d 100644 --- a/lean/disaster-recovery-trace/README.md +++ b/lean/disaster-recovery-trace/README.md @@ -6,9 +6,12 @@ deliberately separate from the canonical model and depends only on `DisasterRecovery.Protocol.Model`. Both packages are pinned to Lean 4.33.1. `DisasterRecoveryTrace.Protocol.Trace.Format` parses the strict versioned -NDJSON contract. `DisasterRecoveryTrace.Protocol.Trace.Replay` replays each -event against the canonical transition system. The validator rejects the first -incompatible event and reports the shortest failing prefix. +NDJSON contract. `DisasterRecoveryTrace.Protocol.Trace.Logs` extracts records +directly from text or JSON node logs and orders them using per-node sequences +and causal send edges, not timestamps. +`DisasterRecoveryTrace.Protocol.Trace.Replay` replays each event against the +canonical transition system. The validator rejects the first incompatible event +and reports its original file/line location and shortest failing ordered prefix. ## Build and test @@ -23,10 +26,24 @@ lake exe trace-checks Run the validator with: ```sh -lake exe trace-validator -- TRACE.recovery.ndjson +lake exe trace-validator --logs 3 QUORUM 20000 node0/out node1/out node2/out ``` -`TraceTests.lean` contains small in-memory parser and replay tests. These tests +The arguments are the expected participating-node count, expected open kind +(`QUORUM` or `FAILOVER`), timeout in milliseconds, and raw log paths. Lean waits +for complete newline-terminated records and scenario terminal evidence. Missing +sequences, send causes, or terminal effects are incomplete input; if they do not +arrive before the deadline, validation fails. Malformed records, causal cycles, +duplicate identifiers, wrong outcomes, and invalid replay transitions fail +without retrying. File read errors also fail rather than silently skipping logs. +Python only supplies log paths and scenario expectations and reports the result. + +The original node logs are the reproduction artifact uploaded by SNP CI. For +an offline check use a timeout of `0`. Already ordered NDJSON remains supported +with `lake exe trace-validator TRACE.ndjson`; it does not perform the additional +scenario checks. + +`TraceTests.lean` contains parser, ordering, scenario, and replay tests. These tests exercise rejection behavior; they are not implementation conformance evidence. Conformance evidence is produced only from real C++ SNP recovery runs and is uploaded by the Milan and Genoa jobs. diff --git a/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md b/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md index 0eb8ef10e3cf..0299656b5730 100644 --- a/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md +++ b/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md @@ -112,16 +112,21 @@ to the trace hook, tracing defers that retry invocation. Once phases match, the trace lock serializes the complete send batch against later commit publication. Each log record contains `RDP_TRACE ` followed by the event object. -`../../tests/infra/recovery_trace.py` extracts records from all participating node -logs, topologically orders them by per-node sequence and causal send edges, -writes NDJSON, and invokes the Lean validator. The quorum, failover, and -multiple-timeout SNP e2e scenarios call this helper. -Each generated `*.recovery.ndjson` file is retained with the SNP job's uploaded -logs, so a failed replay can be reproduced locally. - -The e2e helper additionally requires scenario-specific terminal evidence before -accepting the trace: the expected open kind, at least one completed opener, and -a `complete` or `join_restart` event for every participating node. +`../../tests/infra/recovery_trace.py` passes the original participating node log +paths and scenario expectations to the Lean validator without reading or +rewriting their contents. Lean extracts the records from text logs or JSON +`msg` envelopes, topologically orders them by per-node sequence and causal send +edges, and replays them. The quorum, failover, and multiple-timeout SNP e2e +scenarios call this helper. The original logs are retained with the SNP job's +uploaded artifacts, so a failed replay can be reproduced locally. + +Lean additionally requires scenario-specific terminal evidence before accepting +the trace: the expected number of participating nodes and open kind, at least +one completed opener, and a `complete` or `join_restart` event for every +participating node. While logs are growing, it waits for missing records and +terminal evidence up to the supplied deadline. Contradictory or malformed +complete records fail immediately; an unterminated final line remains +incomplete and cannot be accepted. ## Example @@ -139,5 +144,5 @@ a `complete` or `join_restart` event for every participating node. ``` No recovery-decision-protocol traces are checked into the repository. Every -NDJSON trace passed to the validator in CI is captured from the running C++ +raw log passed to the validator in CI is captured from the running C++ implementation. diff --git a/lean/disaster-recovery-trace/TraceMain.lean b/lean/disaster-recovery-trace/TraceMain.lean index 1d792a751347..4a5e81780fec 100644 --- a/lean/disaster-recovery-trace/TraceMain.lean +++ b/lean/disaster-recovery-trace/TraceMain.lean @@ -2,8 +2,42 @@ import DisasterRecoveryTrace.Protocol.Trace open DisasterRecoveryTrace.Protocol.Trace +private def validateLogFiles + (paths : List String) (scenario : Scenario) (timeoutMs : Nat) : IO UInt32 := do + let deadline := (← IO.monoMsNow) + timeoutMs + repeat + let logs <- paths.mapM fun (path : String) => do + pure (path, ← IO.FS.readBinFile path) + match validateLogs logs scenario with + | .ok count => + IO.println s!"trace accepted: {count} events from {paths.length} logs" + return 0 + | .error (.invalid message) => + IO.eprintln message + return 1 + | .error (.incomplete message) => + if (← IO.monoMsNow) >= deadline then + IO.eprintln s!"timed out waiting for a complete recovery trace:\n{message}" + return 1 + IO.sleep 100 + +private def usage : IO UInt32 := do + IO.eprintln ("usage: trace-validator TRACE.ndjson\n" ++ + " trace-validator --logs NODE_COUNT QUORUM|FAILOVER TIMEOUT_MS LOG...") + pure 2 + def main (args : List String) : IO UInt32 := do match args with + | "--logs" :: count :: kind :: timeout :: paths => do + let some participatingNodes := count.toNat? | usage + let some timeoutMs := timeout.toNat? | usage + let openKind <- match kind with + | "QUORUM" => pure DisasterRecovery.Protocol.Model.OpenKind.quorum + | "FAILOVER" => pure DisasterRecovery.Protocol.Model.OpenKind.failover + | _ => return ← usage + if participatingNodes == 0 || paths.isEmpty then + return ← usage + validateLogFiles paths { participatingNodes, openKind } timeoutMs | [path] => let input <- IO.FS.readFile path match parseNDJSON input with @@ -18,6 +52,4 @@ def main (args : List String) : IO UInt32 := do | .ok () => IO.println s!"trace accepted: {events.length} events" pure 0 - | _ => - IO.eprintln "usage: trace-validator TRACE.ndjson" - pure 2 + | _ => usage diff --git a/lean/disaster-recovery-trace/TraceTests.lean b/lean/disaster-recovery-trace/TraceTests.lean index 0d128e5b8cd5..ad5e502341f9 100644 --- a/lean/disaster-recovery-trace/TraceTests.lean +++ b/lean/disaster-recovery-trace/TraceTests.lean @@ -136,7 +136,278 @@ private def quorumTrace : List TraceEvent := completeEvent locations 10 ] +private def eventJson (event : TraceEvent) : Lean.Json := + let kind := match event.kind with + | .start => "start" + | .send => "send" + | .gossipAccepted => "gossip_accepted" + | .voteAccepted => "vote_accepted" + | .iAmOpenAccepted => "iamopen_accepted" + | .timeout => "timeout" + | .open => "open" + | .joinRestart => "join_restart" + | .complete => "complete" + Lean.Json.mkObj ([ + ("version", Lean.toJson event.version), + ("instance", Lean.toJson event.instanceId), + ("expected_locations", Lean.toJson event.expectedLocations), + ("node", Lean.toJson event.node), + ("sequence", Lean.toJson event.sequence), + ("kind", Lean.toJson kind) + ] ++ + (event.messageId.toList.map fun value => ("message_id", Lean.toJson value)) ++ + (event.causedBy.toList.map fun value => ("caused_by", Lean.toJson value)) ++ + (event.source.toList.map fun value => ("source", Lean.toJson value)) ++ + (event.txid.toList.flatMap fun value => + [("view", Lean.toJson value.view), ("seqno", Lean.toJson value.seqno)]) ++ + (event.pre.toList.map fun value => ("pre", Lean.toJson (phaseName value))) ++ + (event.post.toList.map fun value => ("post", Lean.toJson (phaseName value))) ++ + (event.openKind.toList.map fun value => ("open_kind", Lean.toJson (openKindName value))) ++ + (event.send.toList.map fun value => ("send", Lean.toJson value))) + +private def textLog (events : List TraceEvent) : String := + String.join (events.map fun event => s!"[info] RDP_TRACE {(eventJson event).compress}\n") + +private def jsonLog (events : List TraceEvent) : String := + String.join (events.map fun event => + (Lean.Json.mkObj [("msg", Lean.toJson s!"RDP_TRACE {(eventJson event).compress}")]).compress + ++ "\n") + +private def located (events : List TraceEvent) : List LocatedEvent := + events.zipIdx.map fun (event, index) => { path := "test.out", line := index + 1, event } + +private def expectInvalid (result : Except LogError α) (message : String) : IO Unit := do + match result with + | .error (.invalid _) => pure () + | _ => throw (IO.userError message) + +private def expectIncomplete (result : Except LogError α) (message : String) : IO Unit := do + match result with + | .error (.incomplete _) => pure () + | _ => throw (IO.userError message) + +private def accepted [BEq α] (result : Except LogError α) (expected : α) : Bool := + match result with + | .ok value => value == expected + | .error _ => false + +private def validateTextLogs (logs : List (String × String)) (scenario : Scenario) : + Except LogError Nat := + validateLogs (logs.map fun (path, text) => (path, text.toUTF8)) scenario + +private def checkLogs : IO Unit := do + let scenario : Scenario := { participatingNodes := 1, openKind := .quorum } + let logs := [("node.out", textLog quorumTrace)] + expect (accepted (validateTextLogs logs scenario) quorumTrace.length) + "raw text quorum log was rejected" + expect + (accepted + (validateTextLogs [("node.out", "unrelated\n{\"msg\":42}\n\n" ++ jsonLog quorumTrace)] scenario) + quorumTrace.length) + "JSON envelope quorum log was rejected" + expect + (accepted (validateTextLogs [("node.out", textLog quorumTrace.reverse)] scenario) + quorumTrace.length) + "per-node sequences were not used to order records" + expect + (accepted (validateTextLogs [("node.out", (textLog quorumTrace).replace "\n" "\r\n")] scenario) + quorumTrace.length) + "CRLF log was rejected" + + let first := quorumTrace.head! + let escaped := quorumTrace.map fun event => + { event with instanceId := "escaped \"quote\" \\ slash RDP_TRACE value" } + expect + (accepted (validateTextLogs [("node.out", jsonLog escaped)] scenario) escaped.length) + "escaped JSON message or embedded marker was misparsed" + expectInvalid (extractLog "bad.out" "noise\nRDP_TRACE {broken}\n") + "malformed marked record was ignored" + expectInvalid (extractLog "bad.out" s!"RDP_TRACE {(eventJson first).compress} junk\n") + "trailing garbage after an event was ignored" + match extractLog "bad.out" "noise\nRDP_TRACE {broken}\n" with + | .error (.invalid message) => + expect (message.startsWith "bad.out:2:") "raw source location was lost" + | _ => throw (IO.userError "malformed input accepted") + expectIncomplete (validateTextLogs [] scenario) "empty trace was accepted" + expectIncomplete (validateTextLogs [("node.out", textLog (quorumTrace.take 6))] scenario) + "unobserved committed effect was accepted" + expectIncomplete (validateTextLogs [("node.out", textLog quorumTrace.dropLast)] scenario) + "missing completion was accepted" + expectIncomplete + (validateTextLogs [("node.out", textLog quorumTrace ++ "RDP_TRACE {")] scenario) + "unterminated record after completion was accepted" + expectIncomplete + (validateTextLogs logs { scenario with participatingNodes := 2 }) + "absent participating node was accepted" + expectInvalid (validateTextLogs logs { scenario with participatingNodes := 0 }) + "zero participating nodes was accepted" + expectInvalid (validateTextLogs logs { scenario with openKind := .failover }) + "wrong scenario open kind was accepted" + expectInvalid + (validateTextLogs [("node.out", textLog (quorumTrace ++ [first]))] scenario) + "duplicate node sequence was accepted" + expectIncomplete + (linearize (located [first, { first with sequence := 2, kind := .timeout }])) + "sequence gap was accepted" + expectInvalid + (linearize (located [first, { first with sequence := 1, instanceId := "other" }])) + "recovery identity change was accepted" + expectInvalid + (linearize (located [ + { first with messageId := some "duplicate" }, + { first with sequence := 1, messageId := some "duplicate" } + ])) + "duplicate message ID was accepted" + expectIncomplete + (linearize (located [first, gossipEvent ["A"] 1 "receive" "missing" .voting])) + "unresolved cause was accepted" + expectInvalid + (linearize (located [ + { first with messageId := some "not-a-send" }, + gossipEvent ["A"] 1 "receive" "not-a-send" .voting + ])) + "receive used a non-send cause" + expectInvalid + (validateTextLogs [("node.out", textLog (quorumTrace.map fun event => + if event.sequence == 2 then { event with post := some .open } else event))] scenario) + "invalid replay transition was treated as incomplete input" + let partialUTF8 := (textLog quorumTrace).toUTF8.push 0xc3 + expectIncomplete (validateLogs [("node.out", partialUTF8)] scenario) + "partial UTF-8 write was accepted or treated as malformed" + expectInvalid (validateLogs [("node.out", partialUTF8.push 10)] scenario) + "malformed UTF-8 in a complete line was accepted" + + let locations := ["A", "B"] + let aStart := startEvent locations "A" + let bStart := startEvent locations "B" + let aReceive := { + gossipEvent locations 1 "receive-a" "send-b" .gossiping with source := some "B" } + let bReceive := { + gossipEvent locations 1 "receive-b" "send-a" .gossiping with node := "B" } + let aSend := sendEvent locations 2 "send-a" "gossip:B" .gossiping + let bSend := { sendEvent locations 2 "send-b" "gossip:A" .gossiping with node := "B" } + expectInvalid (linearize (located [aStart, aReceive, aSend, bStart, bReceive, bSend])) + "causal cycle was accepted" + let causal := [aStart, aReceive, bStart, { bSend with sequence := 1 }] + match linearize (located causal) with + | .ok records => + expect + (records.map (fun record => (record.event.node, record.event.sequence)) == + [("A", 0), ("B", 0), ("B", 1), ("A", 1)]) + "cross-node cause did not precede its receive" + | .error error => throw (IO.userError s!"causal trace rejected: {repr error}") + match linearize (located causal), linearize (located causal.reverse) with + | .ok forward, .ok backward => + expect (forward.map LocatedEvent.event == backward.map LocatedEvent.event) + "ordering depends on log argument order" + | _, _ => throw (IO.userError "causal ordering failed") + +private def failoverTrace : List TraceEvent := + let locations := ["A", "B"] + [ + startEvent locations "A", + sendEvent locations 1 "gossip-a" "gossip:A" .gossiping, + sendEvent locations 2 "gossip-b" "gossip:B" .gossiping, + gossipEvent locations 3 "receive-gossip" "gossip-a" .gossiping, + timeoutEvent locations 4 .gossiping .voting, + sendEvent locations 5 "vote-a" "vote:A" .voting, + sendEvent locations 6 "voting-gossip-a" "gossip:A" .voting, + sendEvent locations 7 "voting-gossip-b" "gossip:B" .voting, + voteEvent locations 8 "receive-vote" "vote-a" .voting, + timeoutEvent locations 9 .voting .opening, + openEvent locations 10 .failover, + timeoutEvent locations 11 .opening .open, + completeEvent locations 12 + ] + +private def checkMultiNodeLogs : IO Unit := do + let locations := ["A", "B"] + let opener := failoverTrace.take 11 ++ [ + sendEvent locations 11 "send-open-b" "iamopen:B" .opening, + timeoutEvent locations 12 .opening .open, + completeEvent locations 13 + ] + let joiner := [ + startEvent locations "B", + { baseEvent locations "B" 1 .iAmOpenAccepted with + messageId := some "receive-open-b" + causedBy := some "send-open-b" + source := some "A" + pre := some .gossiping + post := some .joining }, + { baseEvent locations "B" 2 .joinRestart with + pre := some .joining + post := some .joining } + ] + let logs := [("b.out", jsonLog joiner), ("a.out", textLog opener)] + let scenario : Scenario := { participatingNodes := 2, openKind := .failover } + expect (accepted (validateTextLogs logs scenario) (opener.length + joiner.length)) + "distributed opener/joiner logs were rejected" + expect (accepted (validateTextLogs logs.reverse scenario) (opener.length + joiner.length)) + "log path order changed distributed validation" + expectIncomplete + (validateTextLogs [("b.out", jsonLog joiner.dropLast), ("a.out", textLog opener)] scenario) + "unterminated joiner was accepted" + expectInvalid (validateTextLogs logs { scenario with participatingNodes := 1 }) + "extra participating node was accepted" + +private def checkLogCLI : IO Unit := do + IO.FS.withTempDir fun directory => do + let path := directory / "node log.out" + let validator := ".lake/build/bin/trace-validator" + let run := fun (kind : String) (timeout : String) => IO.Process.output { + cmd := validator + args := #["--logs", "1", kind, timeout, path.toString] + } + IO.FS.writeFile path (textLog quorumTrace) + let accepted <- run "QUORUM" "0" + expect (accepted.exitCode == 0) s!"raw log CLI failed: {accepted.stderr}" + IO.FS.writeFile path (jsonLog failoverTrace) + let failover <- run "FAILOVER" "0" + expect (failover.exitCode == 0) s!"failover log CLI failed: {failover.stderr}" + let wrongKind <- run "QUORUM" "0" + expect (wrongKind.exitCode == 1) "CLI accepted wrong scenario" + IO.FS.writeFile path (textLog quorumTrace.dropLast) + let incomplete <- run "QUORUM" "0" + expect (incomplete.exitCode == 1) "CLI accepted missing completion" + let child <- IO.Process.spawn { + cmd := validator + args := #["--logs", "1", "QUORUM", "2000", path.toString] + stdout := .piped + stderr := .piped + } + IO.sleep 100 + IO.FS.withFile path .append fun handle => + handle.putStr (textLog [quorumTrace.getLast!]) + let code <- child.wait + let error <- child.stderr.readToEnd + expect (code == 0) s!"CLI did not wait for appended completion: {error}" + IO.FS.writeFile path "RDP_TRACE {broken}\n" + let before <- IO.monoMsNow + let invalid <- run "QUORUM" "30000" + expect (invalid.exitCode == 1) "CLI accepted malformed trace JSON" + expect ((← IO.monoMsNow) - before < 5000) "CLI retried malformed input" + let missing <- IO.Process.output { + cmd := validator + args := #["--logs", "1", "QUORUM", "0", (directory / "missing").toString] + } + expect (missing.exitCode != 0) "CLI ignored unreadable log" + for args in [ + #["--logs", "0", "QUORUM", "0", path.toString], + #["--logs", "1", "WRONG", "0", path.toString], + #["--logs", "1", "QUORUM", "-1", path.toString], + #["--logs", "1", "QUORUM", "0"]] do + let badArgs <- IO.Process.output { cmd := validator, args } + expect (badArgs.exitCode == 2) "CLI accepted invalid arguments" + IO.FS.writeFile path (String.join (quorumTrace.map fun event => + (eventJson event).compress ++ "\n")) + let ndjson <- IO.Process.output { cmd := validator, args := #[path.toString] } + expect (ndjson.exitCode == 0) "existing ordered NDJSON interface was broken" + def main : IO UInt32 := do + checkLogs + checkMultiNodeLogs + checkLogCLI expect (validationSucceeds quorumTrace) "complete quorum trace was rejected" let locations := ["A", "B"] @@ -223,5 +494,5 @@ def main : IO UInt32 := do expect (parseFails rejectedJson) "unused rejection event remains in the strict v1 format" - IO.println "all strict trace replay checks passed" + IO.println "all raw log, CLI, and strict trace replay checks passed" pure 0 diff --git a/tests/infra/recovery_trace.py b/tests/infra/recovery_trace.py index 055c76c29084..2341211741af 100644 --- a/tests/infra/recovery_trace.py +++ b/tests/infra/recovery_trace.py @@ -1,173 +1,15 @@ # Copyright (c) Microsoft Corporation. All rights reserved. # Licensed under the Apache 2.0 License. -import heapq -import itertools -import json import logging import os import pathlib import subprocess -import time -TRACE_MARKER = "RDP_TRACE " TRACE_VALIDATOR_ENV = "CCF_LEAN_TRACE_VALIDATOR" -TRACE_VERSION = "ccf.recovery_decision_protocol.trace/1" LOG = logging.getLogger(__name__) -def _event_from_log_line(line, path, line_number): - message = line - try: - outer = json.loads(line) - if isinstance(outer, dict) and isinstance(outer.get("msg"), str): - message = outer["msg"] - except json.JSONDecodeError: - pass - - marker = message.find(TRACE_MARKER) - if marker < 0: - return None - - payload = message[marker + len(TRACE_MARKER) :].lstrip() - try: - event, _ = json.JSONDecoder().raw_decode(payload) - except json.JSONDecodeError as error: - raise ValueError( - f"{path}:{line_number}: invalid recovery trace JSON: {error}" - ) from error - if not isinstance(event, dict): - raise TypeError(f"{path}:{line_number}: recovery trace is not an object") - return event - - -def extract_events(nodes): - events = [] - for node in nodes: - out_path, _ = node.get_logs() - if out_path is None or not os.path.isfile(out_path): - continue - with open(out_path, encoding="utf-8", errors="replace") as log: - for line_number, line in enumerate(log, 1): - event = _event_from_log_line(line, out_path, line_number) - if event is not None: - events.append(event) - if not events: - raise ValueError("no recovery-decision-protocol trace events found") - return events - - -def linearize(events): - successors = [set() for _ in events] - indegree = [0 for _ in events] - - def add_edge(source, destination): - if destination not in successors[source]: - successors[source].add(destination) - indegree[destination] += 1 - - by_node = {} - message_ids = {} - identity = None - for index, event in enumerate(events): - try: - version = event["version"] - instance = event["instance"] - expected_locations = event["expected_locations"] - node = event["node"] - sequence = event["sequence"] - kind = event["kind"] - except KeyError as error: - raise ValueError( - f"trace event {index} is missing {error.args[0]}" - ) from error - if version != TRACE_VERSION: - raise ValueError(f"trace event {index} has unsupported version {version}") - if not isinstance(instance, str) or not instance: - raise ValueError(f"trace event {index} has an invalid instance") - if ( - not isinstance(expected_locations, list) - or not expected_locations - or any( - not isinstance(location, str) or not location - for location in expected_locations - ) - or len(set(expected_locations)) != len(expected_locations) - ): - raise ValueError(f"trace event {index} has invalid expected_locations") - event_identity = (instance, tuple(expected_locations)) - if identity is None: - identity = event_identity - elif event_identity != identity: - raise ValueError(f"trace event {index} changes recovery identity") - if ( - not isinstance(node, str) - or not node - or node not in expected_locations - or type(sequence) is not int - or sequence < 0 - or not isinstance(kind, str) - ): - raise TypeError(f"trace event {index} has an invalid node or sequence") - by_node.setdefault(node, []).append((sequence, index)) - - message_id = event.get("message_id") - if message_id is not None: - if not isinstance(message_id, str) or not message_id: - raise ValueError(f"trace event {index} has an invalid message_id") - if message_id in message_ids: - raise ValueError(f"duplicate trace message_id {message_id}") - message_ids[message_id] = (index, kind) - - for node, node_events in by_node.items(): - node_events.sort() - sequences = [sequence for sequence, _ in node_events] - if sequences != list(range(len(node_events))): - raise ValueError( - f"node {node} trace sequence is not contiguous from zero: {sequences}" - ) - for (_, previous), (_, current) in itertools.pairwise(node_events): - add_edge(previous, current) - - for index, event in enumerate(events): - caused_by = event.get("caused_by") - if caused_by is None: - continue - if not isinstance(caused_by, str) or not caused_by: - raise ValueError(f"trace event {index} has an invalid caused_by") - if caused_by not in message_ids: - raise ValueError(f"caused_by {caused_by} has no matching send event") - source, kind = message_ids[caused_by] - if kind != "send": - raise ValueError(f"caused_by {caused_by} does not identify a send event") - add_edge(source, index) - - ready = [] - for index, degree in enumerate(indegree): - if degree == 0: - event = events[index] - heapq.heappush( - ready, (event["node"], event["sequence"], event["kind"], index) - ) - - ordered = [] - while ready: - _, _, _, index = heapq.heappop(ready) - ordered.append(events[index]) - for successor in successors[index]: - indegree[successor] -= 1 - if indegree[successor] == 0: - event = events[successor] - heapq.heappush( - ready, - (event["node"], event["sequence"], event["kind"], successor), - ) - - if len(ordered) != len(events): - raise ValueError("recovery trace contains a causal cycle") - return ordered - - def _validator_path(): configured = os.getenv(TRACE_VALIDATOR_ENV) if configured: @@ -184,56 +26,14 @@ def _validator_path(): ) -def _participating_node_count(nodes): - return sum(node.remote is not None for node in nodes) - - -def wait_for_terminal_events(network, expected_open_kind, timeout): - expected_node_count = _participating_node_count(network.nodes) - end_time = time.time() + timeout - events = [] - while time.time() < end_time: - try: - events = extract_events(network.nodes) - except ValueError: - time.sleep(0.1) - continue - - started = {event["node"] for event in events if event["kind"] == "start"} - completed = {event["node"] for event in events if event["kind"] == "complete"} - terminal = completed | { - event["node"] for event in events if event["kind"] == "join_restart" - } - opened = [event for event in events if event["kind"] == "open"] - if ( - len(started) == expected_node_count - and started <= terminal - and completed - and opened - and all(event.get("open_kind") == expected_open_kind for event in opened) - ): - return events - time.sleep(0.1) - - raise TimeoutError( - "timed out waiting for terminal recovery trace events: " - f"expected_node_count={expected_node_count}, " - f"started={sorted(started) if events else []}, " - f"expected_open_kind={expected_open_kind}, events={events}" - ) - - -def validate_recovery_trace(network, label, expected_open_kind=None, timeout=20): - if expected_open_kind is None: - events = extract_events(network.nodes) - else: - events = wait_for_terminal_events(network, expected_open_kind, timeout) - events = linearize(events) - trace_path = pathlib.Path(network.common_dir) / f"{label}.recovery.ndjson" - with open(trace_path, "w", encoding="utf-8") as trace: - for event in events: - trace.write(json.dumps(event, separators=(",", ":"), sort_keys=True)) - trace.write("\n") +def validate_recovery_trace(network, label, expected_open_kind, timeout=20): + nodes = [node for node in network.nodes if node.remote is not None] + log_paths = [] + for node in nodes: + out_path, _ = node.get_logs() + if out_path is None: + raise FileNotFoundError(f"missing recovery trace log for {label}") + log_paths.append(out_path) validator = _validator_path() if not validator.is_file(): @@ -241,18 +41,25 @@ def validate_recovery_trace(network, label, expected_open_kind=None, timeout=20) f"Lean trace validator not found at {validator}; set {TRACE_VALIDATOR_ENV}" ) result = subprocess.run( - [validator, trace_path], + [ + validator, + "--logs", + str(len(nodes)), + expected_open_kind, + str(round(timeout * 1000)), + *log_paths, + ], text=True, capture_output=True, check=False, + timeout=timeout + 5, ) if result.returncode != 0: raise AssertionError( - f"Lean recovery trace validation failed for {trace_path}:\n" + f"Lean recovery trace validation failed for {label} ({log_paths}):\n" f"{result.stdout}{result.stderr}" ) LOG.info(result.stdout.strip()) - return trace_path def validate_recovery_trace_if_enabled(network, label, expected_open_kind, timeout=20): diff --git a/tests/infra/recovery_trace_test.py b/tests/infra/recovery_trace_test.py deleted file mode 100644 index 4d295e2c45fa..000000000000 --- a/tests/infra/recovery_trace_test.py +++ /dev/null @@ -1,210 +0,0 @@ -# Copyright (c) Microsoft Corporation. All rights reserved. -# Licensed under the Apache 2.0 License. - -import json -import pathlib -import tempfile -import unittest -from unittest import mock - -import infra.recovery_trace - -VERSION = "ccf.recovery_decision_protocol.trace/1" -EXPECTED_LOCATIONS = ["A", "B"] - - -def event(node, sequence, kind, **extra): - value = { - "version": VERSION, - "instance": "synthetic", - "expected_locations": EXPECTED_LOCATIONS, - "node": node, - "sequence": sequence, - "kind": kind, - "pre": "GOSSIPING", - "post": "GOSSIPING", - } - value.update(extra) - return value - - -class FakeNode: - def __init__(self, path, name=None): - self.path = path - self.name = name - self.remote = object() if name is not None else None - - def get_logs(self): - return str(self.path), None - - def get_sealing_recovery_location(self): - return {"name": self.name} - - -class FakeNetwork: - def __init__(self, nodes, common_dir): - self.nodes = nodes - self.common_dir = common_dir - - -class RecoveryTraceTest(unittest.TestCase): - def test_extract_linearize_and_validate(self): - with tempfile.TemporaryDirectory() as directory: - root = pathlib.Path(directory) - a_log = root / "a.out" - b_log = root / "b.out" - a_events = [ - event("A", 0, "start"), - event( - "A", - 1, - "send", - message_id="send-a-b", - send="gossip:B", - ), - ] - b_events = [ - event("B", 0, "start"), - event( - "B", - 1, - "gossip_accepted", - message_id="receive-a-b", - caused_by="send-a-b", - source="A", - view=1, - seqno=1, - ), - ] - a_log.write_text( - "".join( - f"[info] RDP_TRACE {json.dumps(trace_event)}\n" - for trace_event in a_events - ), - encoding="utf-8", - ) - b_log.write_text( - "".join( - json.dumps({"msg": f"RDP_TRACE {json.dumps(trace_event)}"}) + "\n" - for trace_event in b_events - ), - encoding="utf-8", - ) - network = FakeNetwork( - [FakeNode(b_log), FakeNode(a_log)], - directory, - ) - - extracted = infra.recovery_trace.extract_events(network.nodes) - ordered = infra.recovery_trace.linearize(extracted) - self.assertEqual( - [(item["node"], item["sequence"]) for item in ordered], - [("A", 0), ("A", 1), ("B", 0), ("B", 1)], - ) - - def test_rejects_non_contiguous_sequence(self): - broken = [ - event("A", 0, "start"), - event("A", 2, "timeout"), - ] - with self.assertRaisesRegex(ValueError, "not contiguous"): - infra.recovery_trace.linearize(broken) - - def test_rejects_unresolved_cause(self): - broken = [ - event("A", 0, "start"), - event( - "A", - 1, - "gossip_accepted", - message_id="receive", - caused_by="missing-send", - source="B", - view=1, - seqno=1, - ), - ] - with self.assertRaisesRegex(ValueError, "no matching send"): - infra.recovery_trace.linearize(broken) - - def test_rejects_identity_change(self): - broken = [ - event("A", 0, "start"), - { - **event("A", 1, "timeout"), - "instance": "different", - }, - ] - with self.assertRaisesRegex(ValueError, "changes recovery identity"): - infra.recovery_trace.linearize(broken) - - def test_rejects_duplicate_message_id(self): - broken = [ - event("A", 0, "start", message_id="duplicate"), - event("A", 1, "send", message_id="duplicate"), - ] - with self.assertRaisesRegex(ValueError, "duplicate trace message_id"): - infra.recovery_trace.linearize(broken) - - def test_rejects_causal_cycle(self): - broken = [ - event("A", 0, "start"), - event( - "A", - 1, - "gossip_accepted", - message_id="receive-b", - caused_by="send-b", - ), - event("A", 2, "send", message_id="send-a"), - event("B", 0, "start"), - event( - "B", - 1, - "gossip_accepted", - message_id="receive-a", - caused_by="send-a", - ), - event("B", 2, "send", message_id="send-b"), - ] - with self.assertRaisesRegex(ValueError, "causal cycle"): - infra.recovery_trace.linearize(broken) - - def test_disabled_validation_preserves_default_tests(self): - with mock.patch.dict( - "os.environ", - {infra.recovery_trace.TRACE_VALIDATOR_ENV: ""}, - clear=False, - ): - self.assertIsNone( - infra.recovery_trace.validate_recovery_trace_if_enabled( - FakeNetwork([], "."), "disabled", "QUORUM" - ) - ) - - def test_waits_for_terminal_scenario_evidence(self): - with tempfile.TemporaryDirectory() as directory: - log_path = pathlib.Path(directory) / "a.out" - events = [ - event("A", 0, "start"), - event("A", 1, "open", open_kind="QUORUM"), - event("A", 2, "complete"), - ] - log_path.write_text( - "".join( - f"RDP_TRACE {json.dumps(trace_event)}\n" for trace_event in events - ), - encoding="utf-8", - ) - network = FakeNetwork( - [FakeNode(log_path, "A")], - directory, - ) - self.assertEqual( - infra.recovery_trace.wait_for_terminal_events(network, "QUORUM", 0.1), - events, - ) - - -if __name__ == "__main__": - unittest.main() From 2f982db8b1c08322a8a0f52ce91b8e1879169bbb Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Sun, 13 Sep 2026 15:32:57 +0100 Subject: [PATCH 34/35] Remove trace versioning from the Lean validator Use the trace format from the code under test rather than maintaining a versioned compatibility contract. Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- .../DisasterRecoveryTrace/Protocol/Trace/Format.lean | 9 --------- lean/disaster-recovery-trace/README.md | 6 +++--- lean/disaster-recovery-trace/TraceTests.lean | 7 ++----- 3 files changed, 5 insertions(+), 17 deletions(-) diff --git a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean index 892ce9397b21..fea56d9fc119 100644 --- a/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean +++ b/lean/disaster-recovery-trace/DisasterRecoveryTrace/Protocol/Trace/Format.lean @@ -8,9 +8,6 @@ open DisasterRecovery.Protocol.Model open Lean -def contractVersion : String := - "ccf.recovery_decision_protocol.trace/1" - inductive Kind where | start | gossipAccepted @@ -24,7 +21,6 @@ inductive Kind where deriving Repr, BEq, Inhabited structure TraceEvent where - version : String instanceId : String expectedLocations : List Location node : Location @@ -88,10 +84,6 @@ private def optionalParsed def parseEvent (line : String) : Except String TraceEvent := do let json <- Json.parse line - let version <- json.getObjValAs? String "version" - if version != contractVersion then - throw s!"unsupported version '{version}'" - let view <- optionalNat json "view" let seqno <- optionalNat json "seqno" if view.isSome != seqno.isSome then @@ -112,7 +104,6 @@ def parseEvent (line : String) : Except String TraceEvent := do let openKind <- optionalParsed json "open_kind" parseOpenKind let send <- optionalString json "send" pure { - version instanceId expectedLocations node diff --git a/lean/disaster-recovery-trace/README.md b/lean/disaster-recovery-trace/README.md index bef27f8ff72d..5efccf199582 100644 --- a/lean/disaster-recovery-trace/README.md +++ b/lean/disaster-recovery-trace/README.md @@ -1,11 +1,11 @@ # Disaster recovery trace validation -This package validates version 1 implementation traces from CCF's C++ recovery +This package validates implementation traces from CCF's C++ recovery decision protocol against the permanent model in `../disaster-recovery`. It is deliberately separate from the canonical model and depends only on `DisasterRecovery.Protocol.Model`. Both packages are pinned to Lean 4.33.1. -`DisasterRecoveryTrace.Protocol.Trace.Format` parses the strict versioned +`DisasterRecoveryTrace.Protocol.Trace.Format` parses the strict NDJSON contract. `DisasterRecoveryTrace.Protocol.Trace.Logs` extracts records directly from text or JSON node logs and orders them using per-node sequences and causal send edges, not timestamps. @@ -48,4 +48,4 @@ exercise rejection behavior; they are not implementation conformance evidence. Conformance evidence is produced only from real C++ SNP recovery runs and is uploaded by the Milan and Genoa jobs. -See [TRACE_FORMAT_V1.md](TRACE_FORMAT_V1.md) for the complete contract. +See [TRACE_FORMAT.md](TRACE_FORMAT.md) for the complete contract. diff --git a/lean/disaster-recovery-trace/TraceTests.lean b/lean/disaster-recovery-trace/TraceTests.lean index ad5e502341f9..8a0361a8695b 100644 --- a/lean/disaster-recovery-trace/TraceTests.lean +++ b/lean/disaster-recovery-trace/TraceTests.lean @@ -11,7 +11,6 @@ private def baseEvent (node : Location) (sequence : Nat) (kind : Kind) : TraceEvent := { - version := contractVersion instanceId := "trace-tests" expectedLocations := locations node @@ -148,7 +147,6 @@ private def eventJson (event : TraceEvent) : Lean.Json := | .joinRestart => "join_restart" | .complete => "complete" Lean.Json.mkObj ([ - ("version", Lean.toJson event.version), ("instance", Lean.toJson event.instanceId), ("expected_locations", Lean.toJson event.expectedLocations), ("node", Lean.toJson event.node), @@ -487,12 +485,11 @@ def main : IO UInt32 := do "trace with an unobserved opening effect was accepted" let rejectedJson := - "{\"version\":\"ccf.recovery_decision_protocol.trace/1\"," - ++ "\"instance\":\"x\",\"expected_locations\":[\"A\"]," + "{\"instance\":\"x\",\"expected_locations\":[\"A\"]," ++ "\"node\":\"A\",\"sequence\":0,\"kind\":\"gossip_rejected\"," ++ "\"pre\":\"GOSSIPING\",\"post\":\"GOSSIPING\"}" expect (parseFails rejectedJson) - "unused rejection event remains in the strict v1 format" + "unused rejection event remains in the trace format" IO.println "all raw log, CLI, and strict trace replay checks passed" pure 0 From 6ae5026f674c73c80aa78cf277fcb190421ddf5a Mon Sep 17 00:00:00 2001 From: Amaury Chamayou Date: Sun, 13 Sep 2026 15:44:50 +0100 Subject: [PATCH 35/35] Document the unversioned recovery trace format Tie CI traces to the producer and validator from the same source revision instead of promising format-version compatibility. Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- .../{TRACE_FORMAT_V1.md => TRACE_FORMAT.md} | 20 +++++++------------ 1 file changed, 7 insertions(+), 13 deletions(-) rename lean/disaster-recovery-trace/{TRACE_FORMAT_V1.md => TRACE_FORMAT.md} (93%) diff --git a/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md b/lean/disaster-recovery-trace/TRACE_FORMAT.md similarity index 93% rename from lean/disaster-recovery-trace/TRACE_FORMAT_V1.md rename to lean/disaster-recovery-trace/TRACE_FORMAT.md index 0299656b5730..21c41a918e54 100644 --- a/lean/disaster-recovery-trace/TRACE_FORMAT_V1.md +++ b/lean/disaster-recovery-trace/TRACE_FORMAT.md @@ -1,11 +1,8 @@ -# Recovery decision protocol trace format, version 1 +# Recovery decision protocol trace format The media type is newline-delimited JSON. Each nonempty line is one committed -semantic observation. The version string is: - -```text -ccf.recovery_decision_protocol.trace/1 -``` +semantic observation. This format is used by CI with the producer and validator +from the same source revision; it is not a versioned compatibility contract. ## Record @@ -13,7 +10,6 @@ Every record is a JSON object with these required fields: | Field | Type | Meaning | | -------------------- | ---------------- | ----------------------------------- | -| `version` | string | Exactly the version above | | `instance` | string | Stable recovery instance identifier | | `expected_locations` | array of strings | Stable configured location names | | `node` | string | Observed node/location name | @@ -35,7 +31,7 @@ These fields are optional unless the event requires them: | `send` | string | Send class and destination: `gossip:NAME`, `vote:NAME`, or `iamopen:NAME` | Phase strings are `GOSSIPING`, `VOTING`, `OPENING`, `JOINING`, and `OPEN`. -Unknown fields are ignored for forward-compatible instrumentation metadata. +Unknown fields are ignored as instrumentation metadata. All integers must be nonnegative Lean `Nat` values. ## Event kinds @@ -73,7 +69,7 @@ timestamps do not. ## Strict replay -Version 1 is a complete successful-execution trace: every transport send, +A trace describes a complete successful execution: every transport send, accepted receive, committed timeout, and one-shot effect is explicit. `DisasterRecoveryTrace/Protocol/Trace/Replay.lean` folds these events over one deterministic `SystemState`. It retains only observed sends, consumed causal IDs, per-node sequences, and @@ -86,9 +82,8 @@ reports this shortest failing prefix with the current phase and expected event classes. Rejected HTTP/validation inputs do not mutate the modeled state and are not -part of version 1. A future need to validate rejection behavior or incomplete -traces should use a new contract version rather than adding implicit behavior -to this deterministic replay. +part of this trace format. Supporting rejection behavior or incomplete traces +would require explicit changes to the instrumentation and deterministic replay. ## C++ instrumentation @@ -132,7 +127,6 @@ incomplete and cannot be accepted. ```json { - "version": "ccf.recovery_decision_protocol.trace/1", "instance": "example", "expected_locations": ["node0"], "node": "node0",