diff --git a/.gitignore b/.gitignore index ad22248..9b8b172 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ /.lake .aider* +*~ diff --git a/InductiveVerification/Event.lean b/InductiveVerification/Event.lean new file mode 100644 index 0000000..a4ba4fd --- /dev/null +++ b/InductiveVerification/Event.lean @@ -0,0 +1,440 @@ +import Mathlib.Data.Set.Basic +import Mathlib.Data.Set.Insert +import InductiveVerification.Message + +-- Define the `Event` type +inductive Event +| Says : Agent → Agent → Msg → Event +| Gets : Agent → Msg → Event +| Notes : Agent → Msg → Event + +-- Define the `initState` function +class HasInitState (α : Type) where + initState : α → Set Msg + +variable [ hasInitStateAgent : HasInitState Agent ] + +open HasInitState + +-- Define the `bad` set +abbrev DecidableMem ( A : Set Agent ) := (a : Agent) → Decidable (a ∈ A) +class Bad where + bad : Set Agent + decidableBad : DecidableMem bad + Spy_in_bad : Agent.Spy ∈ bad + Server_not_bad : Agent.Server ∉ bad + +instance [Bad] : DecidableMem Bad.bad := Bad.decidableBad +open Bad + +-- attribute [simp] Spy_in_bad +-- attribute [simp] Server_not_bad + +instance decidableAgentEq : DecidableEq Agent := + λ a b => + match a, b with + | Agent.Spy, Agent.Spy => isTrue rfl + | Agent.Spy, Agent.Server => isFalse (λ h => by contradiction) + | Agent.Spy, Agent.Friend m => isFalse (λ h => by contradiction) + | Agent.Server, Agent.Spy => isFalse (λ h => by contradiction) + | Agent.Server, Agent.Server => isTrue rfl + | Agent.Server, Agent.Friend m => isFalse (λ h => by contradiction) + | Agent.Friend n, Agent.Spy => isFalse (λ h => by contradiction) + | Agent.Friend n, Agent.Server => isFalse (λ h => by contradiction) + | Agent.Friend n, Agent.Friend m => + if h : n = m then isTrue (congrArg Agent.Friend h) else isFalse (λ h' => h (Agent.Friend.inj h')) + +-- instance decidableBad (a: Agent) : Decidable (a ∈ bad) := +-- by rw[bad]; apply Set.decidableSingleton + +-- Define the `knows` function +def knows [Bad] : Agent → List Event → Set Msg +| A, [] => initState A +| Agent.Spy, Event.Says _ _ X :: evs => insert X (knows Agent.Spy evs) +| Agent.Spy, Event.Gets _ _ :: evs => knows Agent.Spy evs +| Agent.Spy, Event.Notes A X :: evs => + if A ∈ bad then insert X (knows Agent.Spy evs) else knows Agent.Spy evs +| A, Event.Says A' _ X :: evs => + if A = A' then insert X (knows A evs) else knows A evs +| A, Event.Gets A' X :: evs => + if A = A' then insert X (knows A evs) else knows A evs +| A, Event.Notes A' X :: evs => + if A = A' then insert X (knows A evs) else knows A evs + +-- Define the `spies` abbreviation +abbrev spies (evs : List Event) [Bad] : Set Msg := knows Agent.Spy evs + +-- Define the `used` function +def used : List Event → Set Msg +| [] => ⋃ (B : Agent), parts (initState B) +| Event.Says _ _ X :: evs => parts {X} ∪ used evs +| Event.Gets _ _ :: evs => used evs +| Event.Notes _ X :: evs => parts {X} ∪ used evs + +-- Lemmas for `used` + + lemma used_mono : used (evs) ⊆ used (ev :: evs) := by + cases ev <;> simp[used] + + lemma Notes_imp_used {A : Agent} {X : Msg} {evs : List Event} : + Event.Notes A X ∈ evs → X ∈ used evs := by + induction evs with + | nil => intro h; cases h + | cons ev evs ih => + intro h + cases h with + | tail => cases ev + · simp [used]; right; aapply ih + · simp [used]; aapply ih + · simp [used]; right; aapply ih + | head => simp [used]; left; apply parts.inj; simp + + lemma Says_imp_used {A B : Agent} {X : Msg} {evs : List Event} : + Event.Says A B X ∈ evs → X ∈ used evs := by + induction evs with + | nil => intro h; cases h + | cons ev evs ih => + intro h + cases h with + | tail => cases ev + · simp [used]; right; aapply ih + · simp [used]; aapply ih + · simp [used]; right; aapply ih + | head => simp [used]; left; apply parts.inj; simp + +-- Knowledge subset rules +lemma knows_subset_knows_Cons [Bad] {A : Agent} {ev : Event} {evs : List Event} : + knows A (evs) ⊆ knows A (ev :: evs) := by + by_cases h :A = Agent.Spy + · rw[h] + intro _ _ + cases ev + · simp [knows]; right; assumption + · simp [knows]; assumption + · simp [knows]; split_ifs + · right; assumption + · assumption + · intro _ _ + cases ev <;> (simp [knows]; split_ifs; right; assumption; assumption) + +lemma initState_subset_knows [Bad] : + ∀ {A : Agent} {evs : List Event}, + initState A ⊆ knows A evs := by + intro A evs + induction evs with + | nil => simp [knows] + | cons e evs ih => + apply subset_trans + · exact ih + · apply knows_subset_knows_Cons + +-- Lemmas for `knows` +@[simp] +lemma knows_Spy_Says [Bad] {A B : Agent} {X : Msg} {evs : List Event} : + knows Agent.Spy (Event.Says A B X :: evs) = insert X (knows Agent.Spy evs) := by + simp [knows] + +@[simp] +lemma knows_Spy_Notes [Bad] {A : Agent} {X : Msg} {evs : List Event} : + knows Agent.Spy (Event.Notes A X :: evs) = + if A ∈ bad then insert X (knows Agent.Spy evs) else knows Agent.Spy evs := by + simp [knows] + +@[simp] +lemma knows_Spy_Gets [Bad] {A : Agent} {X : Msg} {evs : List Event} : + knows Agent.Spy (Event.Gets A X :: evs) = knows Agent.Spy evs := by + simp [knows] + +lemma Says_imp_knows_Spy [Bad] {A B : Agent} {X : Msg} {evs : List Event} : + Event.Says A B X ∈ evs → X ∈ knows Agent.Spy evs := by + induction evs with + | nil => intro h; cases h + | cons ev evs ih => + intro h + cases h with + | tail h => cases ev + · simp [knows]; right; aapply ih + · simp [knows]; aapply ih + · simp [knows]; split_ifs + · right; aapply ih + · aapply ih + | head h => simp [knows]; + +lemma Notes_imp_knows_Spy [Bad] {A : Agent} {X : Msg} {evs : List Event} : + Event.Notes A X ∈ evs → A ∈ bad → X ∈ knows Agent.Spy evs := by + induction evs with + | nil => intro h; cases h + | cons ev evs ih => + intro h h_bad + cases h with + | head => simp [knows]; split_ifs; left; trivial + | tail _ h => apply knows_subset_knows_Cons; apply ih; apply h; apply h_bad + +-- Elimination rules: derive contradictions from old Says events containing +-- items known to be fresh +lemma Says_imp_parts_knows_Spy [Bad] : + ∀ {A B : Agent} {X : Msg} {evs : List Event}, + Event.Says A B X ∈ evs → X ∈ parts (knows Agent.Spy evs) := by + intro A B X evs h + apply parts.inj + apply Says_imp_knows_Spy + exact h + +lemma knows_Spy_partsEs [Bad] : + ∀ {A B : Agent} {X : Msg} {evs : List Event}, + Event.Says A B X ∈ evs → X ∈ parts (knows Agent.Spy evs) := by + exact Says_imp_parts_knows_Spy + +lemma Says_imp_analz_Spy [InvKey] [Bad] : + ∀ {A B : Agent} {X : Msg} {evs : List Event}, + Event.Says A B X ∈ evs → X ∈ analz (knows Agent.Spy evs) := by + intro A B X evs h + apply analz.inj + apply Says_imp_knows_Spy + exact h + +-- Compatibility for the old "spies" function +lemma spies_partsEs [Bad] : + ∀ {A B : Agent} {X : Msg} {evs : List Event}, + Event.Says A B X ∈ evs → X ∈ parts (knows Agent.Spy evs) := by + exact knows_Spy_partsEs + +lemma Says_imp_spies [Bad] : + ∀ {A B : Agent} {X : Msg} {evs : List Event}, + Event.Says A B X ∈ evs → X ∈ knows Agent.Spy evs := by + exact Says_imp_knows_Spy + +lemma parts_insert_spies [Bad] : + parts (insert X (knows Agent.Spy evs)) = parts {X} ∪ parts (knows Agent.Spy evs) := +by + apply parts_insert + +-- Knowledge of Agents +lemma knows_subset_knows_Says [Bad] : + ∀ {A A' B : Agent} {X : Msg} {evs : List Event}, + knows A evs ⊆ knows A (Event.Says A' B X :: evs) := by + intro A A' B X evs + apply knows_subset_knows_Cons + +lemma knows_subset_knows_Notes [Bad] : + ∀ {A A' : Agent} {X : Msg} {evs : List Event}, + knows A evs ⊆ knows A (Event.Notes A' X :: evs) := by + intro A A' X evs + apply knows_subset_knows_Cons + +lemma knows_subset_knows_Gets [Bad] : + ∀ {A A' : Agent} {X : Msg} {evs : List Event}, + knows A evs ⊆ knows A (Event.Gets A' X :: evs) := by + intro A A' X evs + apply knows_subset_knows_Cons + +-- Agents know what they say +lemma Says_imp_knows [Bad] : + ∀ {A B : Agent} {X : Msg} {evs : List Event}, + Event.Says A B X ∈ evs → X ∈ knows A evs := by + intro A B X evs h + induction evs with + | nil => cases h + | cons ev evs ih => + cases h with + | head => by_cases h: A = Agent.Spy + · rw [h]; simp [knows] + · simp [knows] + | tail => by_cases h: A = Agent.Spy + · rw[h]; cases ev + · simp [knows]; right; rw[←h]; aapply ih + · simp [knows]; rw[←h]; aapply ih + · simp [knows]; split_ifs + · right; rw[←h]; aapply ih + · rw[←h]; aapply ih + · cases ev <;> ( + simp [knows]; split_ifs; right; aapply ih; aapply ih) + +-- Agents know what they note +lemma Notes_imp_knows [Bad] : + ∀ {A : Agent} {X : Msg} {evs : List Event}, + Event.Notes A X ∈ evs → X ∈ knows A evs := by + intro A X evs h + induction evs with + | nil => cases h + | cons ev evs ih => + cases h with + | head => by_cases h: A = Agent.Spy + · rw [h]; simp [knows, Spy_in_bad] + · simp [knows] + | tail => by_cases h: A = Agent.Spy + · rw[h]; cases ev + · simp [knows]; right; rw[←h]; aapply ih + · simp [knows]; rw[←h]; aapply ih + · simp [knows]; split_ifs + · right; rw[←h]; aapply ih + · rw[←h]; aapply ih + · cases ev <;> ( + simp [knows]; split_ifs; right; aapply ih; aapply ih) + +-- Agents know what they receive +lemma Gets_imp_knows_agents [Bad] : + ∀ {A : Agent} {X : Msg} {evs : List Event}, + A ≠ Agent.Spy → Event.Gets A X ∈ evs → X ∈ knows A evs := by + intro A X evs h_ne h + induction evs with + | nil => cases h + | cons ev evs ih => + cases h with + | head => simp [knows] + | tail => cases ev <;> (simp [knows]; split_ifs; right; aapply ih; aapply ih) + +-- What agents DIFFERENT FROM Spy know +lemma knows_imp_Says_Gets_Notes_initState [Bad] : + ∀ {A : Agent} {X : Msg} {evs : List Event}, + X ∈ knows A evs → A ≠ Agent.Spy → + ∃ B, Event.Says A B X ∈ evs ∨ Event.Gets A X ∈ evs ∨ Event.Notes A X ∈ evs ∨ X ∈ initState A := by + intro _ _ evs h _ + induction evs with + | nil => simp [knows] at h; exists Agent.Server; simp_all + | cons ev evs ih => + cases ev + · simp [knows] at h; split_ifs at h with eq + · cases h with + | inl h₁ => grind + | inr h' => apply ih at h'; cases h' with | intro A'; exists A'; grind + · apply ih at h; cases h with | intro A'; exists A'; grind + · simp [knows] at h; split_ifs at h with eq + · cases h with + | inl h₁ => simp[h₁, eq]; exact ⟨Agent.Server⟩ + | inr h' => apply ih at h'; cases h' with | intro A'; exists A'; grind + · apply ih at h; cases h with | intro A'; exists A'; grind + · simp [knows] at h; split_ifs at h with eq + · cases h with + | inl h₁ => simp[h₁, eq]; exact ⟨Agent.Server⟩ + | inr h' => apply ih at h'; cases h' with | intro A'; exists A'; grind + · apply ih at h; cases h with | intro A'; exists A'; grind + +-- auxiliary lemma + +lemma knows_Spy_imp_Says_Notes_initState_aux + [Bad] {X : Msg} {ev : Event} {evs : List Event} : + (∃ A B, Event.Says A B X ∈ evs ∨ Event.Notes A X ∈ evs ∨ X ∈ initState Agent.Spy) + → (∃ A B, + Event.Says A B X ∈ ev :: evs ∨ Event.Notes A X ∈ ev :: evs ∨ X ∈ initState Agent.Spy + ) := by + intro h + cases h with | intro A h => + cases h with | intro B h => + exists A; exists B + cases h with + | inl => left; right; assumption + | inr h => right; cases h + · left; right; assumption + · right; assumption + +-- What the Spy knows +lemma knows_Spy_imp_Says_Notes_initState [Bad] {X : Msg} {evs : List Event} : + X ∈ knows Agent.Spy evs → + ∃ A B, Event.Says A B X ∈ evs ∨ Event.Notes A X ∈ evs ∨ X ∈ initState Agent.Spy := by + intro h + induction evs with + | nil => simp [knows] at h; exists Agent.Server; exists Agent.Server; simp_all + | cons ev evs ih => + cases ev with + | Says A' B' => + simp [knows] at h; cases h with + | inl => exists A'; exists B'; simp_all; + | inr h => + apply ih at h; aapply knows_Spy_imp_Says_Notes_initState_aux + | Gets => + simp [knows] at h; apply ih at h; aapply knows_Spy_imp_Says_Notes_initState_aux + | Notes A' X' => + simp [knows] at h; split_ifs at h with A'_bad + · cases h with + | inl h => rw[h]; exists A'; exists A'; simp + | inr h => apply ih at h; aapply knows_Spy_imp_Says_Notes_initState_aux + · apply ih at h; aapply knows_Spy_imp_Says_Notes_initState_aux + +-- Parts of what the Spy knows are a subset of what is used +lemma parts_knows_Spy_subset_used [Bad] : + parts (knows Agent.Spy evs) ⊆ used evs := by + induction evs with + | nil => simp [used, knows]; intro _ _; simp; exists Agent.Spy; + | cons ev evs ih => + cases ev + · simp[used, knows]; apply subset_trans; apply ih; simp + · simp[used, knows]; assumption + · simp[used, knows]; split_ifs with ABad + · simp; apply subset_trans; apply ih; simp + · apply subset_trans; apply ih; simp + +-- Parts of what the Spy knows are a subset of what is used +lemma usedI [Bad] : + X ∈ parts (knows Agent.Spy evs) → X ∈ used evs := by + intro h + apply parts_knows_Spy_subset_used + exact h + +-- Initial state messages are part of the used set + +lemma initState_into_used {B : Agent} {evs : List Event} : + parts (initState B) ⊆ used evs := by + induction evs with + | nil => simp [used]; apply Set.subset_iUnion (parts ∘ initState) B + | cons ev => + cases ev <;> (simp[used]; try apply Set.subset_union_of_subset_right) + all_goals assumption + +-- Simplification rules for `used` + +@[simp] +lemma used_Says {A B : Agent} {X : Msg} {evs : List Event} : + used (Event.Says A B X :: evs) = parts {X} ∪ used evs := by + simp [used] + + +@[simp] +lemma used_Notes {A : Agent} {X : Msg} {evs : List Event} : + used (Event.Notes A X :: evs) = parts {X} ∪ used evs := by + simp [used] + + +@[simp] +lemma used_Gets {A : Agent} {X : Msg} {evs : List Event} : + used (Event.Gets A X :: evs) = used evs := by + simp [used] + + +lemma used_nil_subset {evs : List Event} : + used [] ⊆ used evs := by + have B := Agent.Server + induction evs with + | nil => simp + | cons head tail ih => + apply subset_trans (b := used tail) + · assumption + · exact used_mono + +-- Keys for parts insert +open InvKey + +omit hasInitStateAgent in + +lemma keysFor_parts_insert {K : Key} {X : Msg} {G H : Set Msg} [InvKey]: + K ∈ keysFor (parts (insert X G)) → + X ∈ synth (analz H) → + K ∈ keysFor (parts (G ∪ H)) ∪ invKey '' {K | Msg.Key K ∈ parts H} := by + intro h h₂ + rw[parts_union, keysFor_union] + rcases h with ⟨K', ⟨⟨X', h⟩, r⟩⟩ + by_cases KkfpG: K∈ keysFor (parts G) + · left; left; assumption + · rw[Set.union_assoc]; right; rw[←keysFor_synth]; rw[parts_insert] at h + cases h with + | inl h => + apply Crypt_imp_invKey_keysFor at h; rw[r] at h + apply keysFor_mono (a := parts {X}) + · apply synth_subset_iff.mpr; rw[←synth_subset_iff] + apply subset_trans (b := parts (synth (analz H))) + · apply parts_mono; simp; assumption + · rw[parts_synth, parts_analz]; apply sup_le + · exact synth_increasing + · apply synth_mono; exact analz_subset_parts + · assumption + | inr h => apply Crypt_imp_invKey_keysFor at h; rw[r] at h; contradiction diff --git a/InductiveVerification/Message.lean b/InductiveVerification/Message.lean index 3588166..736edbb 100644 --- a/InductiveVerification/Message.lean +++ b/InductiveVerification/Message.lean @@ -16,19 +16,17 @@ import Mathlib.Tactic.NthRewrite -- Keys are integers abbrev Key := Nat --- Define constants -def all_symmetric : Bool := true -- true if all keys are symmetric - -- Define the inverse of a symmetric key -def invKey : Key → Key := fun k => k -- Placeholder definition +class InvKey where + invKey : Key → Key + all_symmetric : Bool + invKey_spec : ∀ K : Key, invKey (invKey K) = K + invKey_symmetric : all_symmetric → invKey = id --- Specification for invKey -axiom invKey_spec : ∀ K : Key, invKey (invKey K) = K -axiom invKey_symmetric : all_symmetric → invKey = id +open InvKey --- Define the set of symmetric keys @[grind] -def symKeys : Set Key := { K | invKey K = K } +def symKeys [InvKey] : Set Key := { K | invKey K = K } -- Define the datatype for agents @[grind] @@ -55,6 +53,7 @@ end Msg open Msg open Agent + -- Define HPair def HPair (X Y : Msg) : Msg := ⦃Hash ⦃X, Y⦄, Y⦄ @@ -62,8 +61,7 @@ def HPair (X Y : Msg) : Msg := notation "⦃" x ", " y "⦄ₕ" => HPair x y -- Define keysFor -@[simp] -def keysFor (H : Set Msg) : Set Key := +def keysFor [InvKey] (H : Set Msg) : Set Key := invKey '' { K | ∃ X, Crypt K X ∈ H } -- Define the inductive set `parts` @@ -110,7 +108,7 @@ lemma Nonce_Key_image_eq {A : Set Key} {x : Nat} : -- Lemma: Inverse of keys @[simp] -lemma invKey_eq (K K' : Key) : (invKey K = invKey K') ↔ (K = K') := by +lemma invKey_eq (K K' : Key) [InvKey] : (invKey K = invKey K') ↔ (K = K') := by apply Iff.intro case mp => intro h @@ -121,20 +119,19 @@ lemma invKey_eq (K K' : Key) : (invKey K = invKey K') ↔ (K = K') := by -- Lemmas for the `keysFor` operator @[simp] -lemma keysFor_empty : keysFor ∅ = ∅ := by - simp +lemma keysFor_empty [InvKey] : keysFor ∅ = ∅ := by + simp[keysFor] @[simp] -lemma keysFor_union (H H' : Set Msg) : keysFor (H ∪ H') = keysFor H ∪ keysFor H' := by - simp +lemma keysFor_union (H H' : Set Msg) [InvKey] : keysFor (H ∪ H') = keysFor H ∪ keysFor H' := by + simp[keysFor] ext constructor · intro h; simp_all; grind · intro h; simp_all; grind -- Monotonicity -@[simp] -lemma keysFor_mono: Monotone keysFor := by +lemma keysFor_mono [InvKey] : Monotone keysFor := by simp_intro _ _ sub _ h rcases h with ⟨K, ⟨⟨X, _⟩, _⟩⟩ ; exists K; apply And.intro · exists X; aapply sub @@ -142,67 +139,63 @@ lemma keysFor_mono: Monotone keysFor := by -- Lemmas for `keysFor` with specific message types @[simp] -lemma keysFor_insert_Agent (A : Agent) (H : Set Msg) : +lemma keysFor_insert_Agent (A : Agent) (H : Set Msg) [InvKey] : keysFor (insert (Agent A) H) = keysFor H := by - simp + simp[keysFor] @[simp] -lemma keysFor_insert_Nonce (N : Nat) (H : Set Msg) : +lemma keysFor_insert_Nonce (N : Nat) (H : Set Msg) [InvKey] : keysFor (insert (Nonce N) H) = keysFor H := by - simp + simp[keysFor] @[simp] -lemma keysFor_insert_Number (N : Nat) (H : Set Msg) : +lemma keysFor_insert_Number (N : Nat) (H : Set Msg) [InvKey] : keysFor (insert (Msg.Hash (Nonce N)) H) = keysFor H := by - simp + simp[keysFor] @[simp] -lemma keysFor_insert_Key (K : Key) (H : Set Msg) : +lemma keysFor_insert_Key (K : Key) (H : Set Msg) [InvKey] : keysFor (insert (Key K) H) = keysFor H := by - simp + simp[keysFor] @[simp] -lemma keysFor_insert_Hash (X : Msg) (H : Set Msg) : +lemma keysFor_insert_Hash (X : Msg) (H : Set Msg) [InvKey] : keysFor (insert (Hash X) H) = keysFor H := by - simp + simp[keysFor] @[simp] -lemma keysFor_insert_MPair (X Y : Msg) (H : Set Msg) : +lemma keysFor_insert_MPair (X Y : Msg) (H : Set Msg) [InvKey] : keysFor (insert ⦃X, Y⦄ H) = keysFor H := by - simp + simp[keysFor] @[simp] -lemma keysFor_insert_Crypt (K : Key) (X : Msg) (H : Set Msg) : +lemma keysFor_insert_Crypt (K : Key) (X : Msg) (H : Set Msg) [InvKey] : keysFor (insert (Crypt K X) H) = insert (invKey K) (keysFor H) := by - simp[insert,Set.insert,invKey] + simp[insert,Set.insert,keysFor] ext grind @[simp] -lemma keysFor_image_Key (E : Set Key) : keysFor (Key '' E) = ∅ := by - simp +lemma keysFor_image_Key (E : Set Key) [InvKey] : keysFor (Key '' E) = ∅ := by + simp[keysFor] -@[simp] -lemma Crypt_imp_invKey_keysFor (K : Key) (X : Msg) (H : Set Msg) : +lemma Crypt_imp_invKey_keysFor {K : Key} {X : Msg} {H : Set Msg} [InvKey] : Crypt K X ∈ H → invKey K ∈ keysFor H := by intro h - simp + simp[invKey_eq,keysFor] exact ⟨_, h⟩ - + -- MPair_parts lemma -@[simp] lemma MPair_parts {H : Set Msg} {X Y : Msg} { P : Prop} : ⦃X, Y⦄ ∈ parts H → (parts H X → parts H Y → P) → P := by grind -- parts_increasing lemma -@[simp] lemma parts_increasing {H : Set Msg} : H ⊆ parts H := λ _ hx => parts.inj hx -- parts_empty_aux lemma -@[simp] lemma parts_empty_aux {X : Msg} : parts ∅ X → False := by intro h @@ -300,7 +293,6 @@ by | body _ ih => exact parts.body ih -- parts_insert_subset lemma -@[simp] lemma parts_insert_subset {X : Msg} {H : Set Msg} : insert X (parts H) ⊆ parts (insert X H) := by @@ -315,7 +307,6 @@ by -- Idempotence and transitivity lemmas for `parts` -@[simp] lemma parts_partsD {H : Set Msg} : parts (parts H) ⊆ parts H := by intro x h @@ -336,23 +327,23 @@ lemma parts_idem {H : Set Msg} : parts (parts H) = parts H := lemma parts_subset_iff {G H : Set Msg} : (G ⊆ parts H) ↔ (parts G ⊆ parts H) := by apply partsClosureOperator.le_closure_iff -@[simp] lemma parts_trans {G H : Set Msg} {X : Msg} : X ∈ parts G → G ⊆ parts H → X ∈ parts H := by intro a b; apply parts_mono at b; rw[parts_idem] at b; apply b; apply a; -- Cut lemma -@[simp] lemma parts_cut {G H : Set Msg} {X Y : Msg} : Y ∈ parts (insert X G) → X ∈ parts H → Y ∈ parts (G ∪ H) := by intro a b; rw[parts_union]; rw[parts_insert] at a; cases a <;> grind[parts_trans] @[simp] -lemma parts_cut_mono {G H : Set Msg} {X : Msg} : - X ∈ parts H → parts (insert X G) ⊆ parts (G ∪ H) := -by grind[parts_cut] - +lemma parts_cut_eq : + X ∈ parts H → (parts (insert X H) = parts H) := +by + intro h; simp[parts_insert]; rw[parts_idem] + apply_rules [parts_subset_iff.mp, Set.singleton_subset_iff.mpr] + @[simp] lemma parts_insert_Agent {H : Set Msg} {agt : Agent} : parts (insert (Agent agt) H) = insert (Agent agt) (parts H) := @@ -367,6 +358,11 @@ by | body _ a_ih => cases a_ih; contradiction; right; aapply parts.body | inr h => right; assumption · apply parts_insert_subset + +@[simp] +lemma parts_singleton_Agent : + parts {Agent agt} = {Agent agt} := by + rw[Set.singleton_def, parts_insert_Agent, parts_empty] @[simp] lemma parts_insert_Nonce {H : Set Msg} {N : Nat} : @@ -383,6 +379,11 @@ by | inr h => right; assumption · apply parts_insert_subset +@[simp] +lemma parts_singleton_Nonce : + parts {Nonce N} = {Nonce N} := by + rw[Set.singleton_def, parts_insert_Nonce, parts_empty] + @[simp] lemma parts_insert_Number {H : Set Msg} {N : Nat} : parts (insert (Number N) H) = insert (Number N) (parts H) := @@ -398,6 +399,11 @@ by | inr h => right; assumption · apply parts_insert_subset +@[simp] +lemma parts_singleton_Number : + parts {Number N} = {Number N} := by + rw[Set.singleton_def, parts_insert_Number, parts_empty] + @[simp] lemma parts_insert_Key {H : Set Msg} {K : Key} : parts (insert (Key K) H) = insert (Key K) (parts H) := @@ -413,6 +419,11 @@ by | inr h => right; assumption · apply parts_insert_subset +@[simp] +lemma parts_singleton_Key : + parts {Key K} = {Key K} := by + rw[Set.singleton_def, parts_insert_Key, parts_empty] + @[simp] lemma parts_insert_Hash {H : Set Msg} {X : Msg} : parts (insert (Hash X) H) = insert (Hash X) (parts H) := @@ -428,6 +439,11 @@ by | inr h => right; assumption · apply parts_insert_subset +@[simp] +lemma parts_singleton_Hash : + parts {Hash H} = {Hash H} := by + rw[Set.singleton_def, parts_insert_Hash, parts_empty] + @[simp] lemma parts_insert_Crypt {H : Set Msg} {K : Key} {X : Msg} : parts (insert (Crypt K X) H) = insert (Crypt K X) (parts (insert X H)) := @@ -453,6 +469,17 @@ by apply parts.inj trivial +@[simp] +lemma parts_singleton_Crypt : + parts {Crypt K X} = {Crypt K X} ∪ parts {X} := by + rw[ + Set.singleton_def, + parts_insert_Crypt, + ←Set.singleton_def, + Set.insert_union, + Set.empty_union + ] + @[simp] lemma parts_insert_MPair {H: Set Msg} {X Y : Msg} : parts (insert ⦃X, Y⦄ H) = insert ⦃X, Y⦄ (parts (insert X (insert Y H))) := @@ -492,6 +519,17 @@ by trivial; | inr => right; assumption; +@[simp] +lemma parts_singleton_MPair : + parts {⦃X, Y⦄} = {⦃X, Y⦄} ∪ parts (insert X {Y}) := by + rw[ + Set.singleton_def, + parts_insert_MPair, + ←Set.singleton_def, + Set.insert_union, + Set.empty_union + ] + @[simp] lemma parts_image_Key {N : Set Key} : parts (Key '' N) = Key '' N := by @@ -531,7 +569,7 @@ by simp_all; -- Inductive relation "analz" -inductive analz (H : Set Msg) : Set Msg +inductive analz [InvKey] (H : Set Msg) : Set Msg | inj {X : Msg} : X ∈ H → analz H X | fst {X Y : Msg} : ⦃X, Y⦄ ∈ analz H → analz H X | snd {X Y : Msg} : ⦃X, Y⦄ ∈ analz H → analz H Y @@ -539,9 +577,9 @@ inductive analz (H : Set Msg) : Set Msg Crypt K X ∈ analz H → Key (invKey K) ∈ analz H → analz H X -- Monotonicity -lemma analz_mono : Monotone analz := +lemma analz_mono [InvKey] : Monotone analz := by - intro A B h₁ X h₂ + intro _ _ h₁ _ h₂ induction h₂ with | inj h => exact analz.inj (h₁ h) | fst h ih => exact analz.fst ih @@ -549,8 +587,8 @@ by | decrypt h₁ h₂ ih₁ ih₂ => exact analz.decrypt ih₁ ih₂ -- Making it safe speeds up proofs -@[simp] -lemma MPair_analz {H : Set Msg} {X Y : Msg} {P : Prop} : +-- @[simp] +lemma MPair_analz {H : Set Msg} {X Y : Msg} {P : Prop} [InvKey] : ⦃X, Y⦄ ∈ analz H → (analz H X → analz H Y → P) → P := by intro h ih @@ -559,10 +597,10 @@ by · apply analz.snd h @[simp] -lemma analz_increasing {H : Set Msg} : H ⊆ analz H := +lemma analz_increasing [InvKey] {H : Set Msg} : H ⊆ analz H := λ _ hx => analz.inj hx -lemma analz_into_parts {H : Set Msg} {X : Msg} : X ∈ analz H → X ∈ parts H := +lemma analz_into_parts {H : Set Msg} {X : Msg} [InvKey] : X ∈ analz H → X ∈ parts H := by intro h induction h with @@ -571,11 +609,11 @@ by | snd _ ih => aapply parts.snd | decrypt _ _ ih₁ => aapply parts.body -lemma analz_subset_parts {H : Set Msg} : analz H ⊆ parts H := +lemma analz_subset_parts {H : Set Msg} [InvKey] : analz H ⊆ parts H := λ _ hx => analz_into_parts hx @[simp] -lemma analz_parts {H : Set Msg} : analz (parts H) = parts H := +lemma analz_parts {H : Set Msg} [InvKey] : analz (parts H) = parts H := by ext X; constructor · intro h; induction h with @@ -585,12 +623,12 @@ by | decrypt => aapply parts.body; · apply analz_increasing; -lemma not_parts_not_analz {H : Set Msg} {X : Msg} : +lemma not_parts_not_analz {H : Set Msg} {X : Msg} [InvKey] : X ∉ parts H → X ∉ analz H := λ h₁ h₂ => h₁ (analz_into_parts h₂) @[simp] -lemma parts_analz {H : Set Msg} : parts (analz H) = parts H := +lemma parts_analz {H : Set Msg} [InvKey] : parts (analz H) = parts H := by ext; constructor; · intro h; induction h with @@ -601,18 +639,18 @@ lemma parts_analz {H : Set Msg} : parts (analz H) = parts H := · apply parts_mono; apply analz_increasing; @[simp] -lemma analz_insertI {X : Msg} {H : Set Msg} : +lemma analz_insertI {X : Msg} {H : Set Msg} [InvKey] : insert X (analz H) ⊆ analz (insert X H) := by intro x hx cases hx with | inl h => apply analz.inj; left; assumption; - | inr h => exact analz_mono (Set.subset_insert _ _) h + | inr h => aapply analz_mono (Set.subset_insert _ _) -- General equational properties @[simp] -lemma analz_empty : analz ∅ = ∅ := +lemma analz_empty [InvKey] : analz ∅ = ∅ := by ext; constructor; · intro h; induction h <;> contradiction; @@ -620,25 +658,25 @@ by @[simp] -lemma analz_union {G H : Set Msg} : analz G ∪ analz H ⊆ analz (G ∪ H) := +lemma analz_union {G H : Set Msg} [InvKey] : analz G ∪ analz H ⊆ analz (G ∪ H) := by intro x hx cases hx with - | inl hG => exact analz_mono (Set.subset_union_left) hG; - | inr hH => exact analz_mono (Set.subset_union_right) hH + | inl hG => aapply analz_mono (Set.subset_union_left) + | inr hH => aapply analz_mono (Set.subset_union_right) -lemma analz_insert {X : Msg} {H : Set Msg} : +lemma analz_insert {X : Msg} {H : Set Msg} [InvKey] : insert X (analz H) ⊆ analz (insert X H) := by intro x hx cases hx with | inl h => apply analz.inj; left; assumption - | inr h => exact analz_mono (Set.subset_insert _ _) h + | inr h => aapply analz_mono (Set.subset_insert _ _) -- Rewrite rules for pulling out atomic messages @[simp] -lemma analz_insert_Agent {H : Set Msg} {agt : Agent} : +lemma analz_insert_Agent {H : Set Msg} {agt : Agent} [InvKey] : analz (insert (Agent agt) H) = insert (Agent agt) (analz H) := by ext @@ -656,7 +694,7 @@ lemma analz_insert_Agent {H : Set Msg} {agt : Agent} : · apply analz_insert @[simp] -lemma analz_insert_Nonce {H : Set Msg} {N : Nat} : +lemma analz_insert_Nonce {H : Set Msg} {N : Nat} [InvKey] : analz (insert (Nonce N) H) = insert (Nonce N) (analz H) := by ext @@ -674,7 +712,7 @@ lemma analz_insert_Nonce {H : Set Msg} {N : Nat} : · apply analz_insert @[simp] -lemma analz_insert_Number {H : Set Msg} {N : Nat} : +lemma analz_insert_Number {H : Set Msg} {N : Nat} [InvKey] : analz (insert (Number N) H) = insert (Number N) (analz H) := by ext @@ -692,7 +730,7 @@ lemma analz_insert_Number {H : Set Msg} {N : Nat} : · apply analz_insert @[simp] -lemma analz_insert_Hash {H : Set Msg} {X : Msg} : +lemma analz_insert_Hash {H : Set Msg} {X : Msg} [InvKey] : analz (insert (Hash X) H) = insert (Hash X) (analz H) := by ext @@ -710,7 +748,7 @@ lemma analz_insert_Hash {H : Set Msg} {X : Msg} : · apply analz_insert @[simp] -lemma analz_insert_Key {H : Set Msg} {K : Key} : +lemma analz_insert_Key {H : Set Msg} {K : Key} [InvKey] : K ∉ keysFor (analz H) → analz (insert (Key K) H) = insert (Key K) (analz H) := by @@ -733,7 +771,7 @@ lemma analz_insert_Key {H : Set Msg} {K : Key} : · apply analz_insert @[simp] -lemma analz_insert_MPair {H : Set Msg} {X Y : Msg} : +lemma analz_insert_MPair {H : Set Msg} {X Y : Msg} [InvKey] : analz (insert ⦃X, Y⦄ H) = insert ⦃X, Y⦄ (analz (insert X (insert Y H))) := by ext @@ -767,7 +805,7 @@ lemma analz_insert_MPair {H : Set Msg} {X Y : Msg} : | snd => aapply analz.snd | decrypt => aapply analz.decrypt -lemma analz_insert_Decrypt {H : Set Msg} {K : Key} {X : Msg} : +lemma analz_insert_Decrypt {H : Set Msg} {K : Key} {X : Msg} [InvKey] : Key (invKey K) ∈ analz H → analz (insert (Crypt K X) H) = insert (Crypt K X) (analz (insert X H)) := by @@ -796,9 +834,8 @@ by | snd => aapply analz.snd | decrypt => aapply analz.decrypt --- TODO split into two lemmata @[simp] -lemma analz_Crypt {H : Set Msg} {K : Key} {X : Msg} : +lemma analz_Crypt {H : Set Msg} {K : Key} {X : Msg} [InvKey] : (Key (invKey K) ∉ analz H) → (analz (insert (Crypt K X) H) = insert (Crypt K X) (analz H)) := by @@ -817,7 +854,7 @@ by | inr => apply analz_mono; apply Set.subset_insert; assumption -- This rule supposes "for the sake of argument" that we have the key. -lemma analz_insert_Crypt_subset {H : Set Msg} {K : Key} {X : Msg} : +lemma analz_insert_Crypt_subset {H : Set Msg} {K : Key} {X : Msg} [InvKey] : analz (insert (Crypt K X) H) ⊆ insert (Crypt K X) (analz (insert X H)) := by intro Y h @@ -835,7 +872,7 @@ by | inr => aapply analz.decrypt @[simp] -lemma analz_image_Key {N : Set Key} : analz (Key '' N) = Key '' N := +lemma analz_image_Key {N : Set Key} [InvKey] : analz (Key '' N) = Key '' N := by apply Set.ext intro X @@ -848,8 +885,8 @@ by -- Idempotence and transitivity -@[simp] -lemma analz_analzD {H : Set Msg} {X : Msg} : X ∈ analz (analz H) → X ∈ analz H := +lemma analz_analzD [InvKey] {H : Set Msg} {X : Msg} : + X ∈ analz (analz H) → X ∈ analz H := by intro h induction h with @@ -858,19 +895,24 @@ by | snd h ih => exact analz.snd ih | decrypt h₁ h₂ ih₁ ih₂ => exact analz.decrypt ih₁ ih₂ -abbrev analzClosureOperator : ClosureOperator (Set Msg) := - ClosureOperator.mk' analz analz_mono @analz_increasing @analz_analzD +@[simp] +abbrev analzClosureOperator [InvKey] : ClosureOperator (Set Msg) := + ClosureOperator.mk' + analz (analz_mono) + (λ x ↦ @analz_increasing _ x) + (λ x ↦ @analz_analzD _ x) + +lemma analz_idem {H : Set Msg} [InvKey] : analz (analz H) = analz H := +by + apply analzClosureOperator.idempotent + @[simp] -lemma analz_idem {H : Set Msg} : analz (analz H) = analz H := - by apply analzClosureOperator.idempotent - -@[simp] -lemma analz_subset_iff {G H : Set Msg} : (G ⊆ analz H) ↔ (analz G ⊆ analz H) := +lemma analz_subset_iff {G H : Set Msg} [InvKey] : (G ⊆ analz H) ↔ (analz G ⊆ analz H) := by apply analzClosureOperator.le_closure_iff @[simp] -lemma analz_trans {G H : Set Msg} {X : Msg} : +lemma analz_trans {G H : Set Msg} {X : Msg} [InvKey] : X ∈ analz G → G ⊆ analz H → X ∈ analz H := by intro hG hGH @@ -878,7 +920,7 @@ by -- Cut; Lemma 2 of Lowe @[simp] -lemma analz_cut {H : Set Msg} {X Y : Msg} : +lemma analz_cut {H : Set Msg} {X Y : Msg} [InvKey] : Y ∈ analz (insert X H) → X ∈ analz H → Y ∈ analz H := by intro hY _ @@ -887,7 +929,7 @@ by -- Simplification of messages involving forwarding of unknown components @[simp] -lemma analz_insert_eq {H : Set Msg} {X : Msg} : +lemma analz_insert_eq {H : Set Msg} {X : Msg} [InvKey] : X ∈ analz H → analz (insert X H) = analz H := by intro @@ -898,19 +940,19 @@ by -- A congruence rule for "analz" @[simp] -lemma analz_subset_cong {G G' H H' : Set Msg} : +lemma analz_subset_cong {G G' H H' : Set Msg} [InvKey] : analz G ⊆ analz G' → analz H ⊆ analz H' → analz (G ∪ H) ⊆ analz (G' ∪ H') := by intro hG hH have a_sub := analz_subset_iff (G := G ∪ H) (H := G' ∪ H') apply a_sub.mp apply subset_trans (b := analz G ∪ analz H) - apply Set.union_subset_union (h₁ := @analz_increasing (H := G)) (h₂ := @analz_increasing (H := H)) + apply Set.union_subset_union (h₁ := @analz_increasing _ (H := G)) (h₂ := @analz_increasing _ (H := H)) apply subset_trans (b := analz G' ∪ analz H') apply Set.union_subset_union (h₁ := hG) (h₂ := hH) apply analz_union -lemma analz_cong {G G' H H' : Set Msg} : +lemma analz_cong {G G' H H' : Set Msg} [InvKey] : analz G = analz G' → analz H = analz H' → analz (G ∪ H) = analz (G' ∪ H') := by intro hG hH @@ -920,7 +962,7 @@ by · apply analz_subset_cong; rw[Eq.comm] at hG; aapply Eq.subset; rw[Eq.comm] at hH; aapply Eq.subset -lemma analz_insert_cong {H H' : Set Msg} {X : Msg} : +lemma analz_insert_cong {H H' : Set Msg} {X : Msg} [InvKey] : analz H = analz H' → analz (insert X H) = analz (insert X H') := by intro hH @@ -928,7 +970,7 @@ by exact analz_cong rfl hH -- If there are no pairs or encryptions, then analz does nothing -lemma analz_trivial {H : Set Msg} : +lemma analz_trivial [InvKey] {H : Set Msg} : (∀ X Y, ⦃X, Y⦄ ∉ H) → (∀ X K, Crypt K X ∉ H) → analz H = H := by intro hPairs hCrypts @@ -945,7 +987,7 @@ by -- Inductive relation "synth" -inductive synth (H : Set Msg) : Set Msg +inductive synth [InvKey] (H : Set Msg) : Set Msg | inj {X : Msg} : X ∈ H → synth H X | agent {agt : Agent} : synth H (Agent agt) | number {n : Nat} : synth H (Number n) @@ -954,7 +996,7 @@ inductive synth (H : Set Msg) : Set Msg | crypt {K : Key} {X : Msg} : synth H X → Key K ∈ H → synth H (Crypt K X) -- Monotonicity -lemma synth_mono : Monotone synth := by +lemma synth_mono [InvKey] : Monotone synth := by intro _ _ h _ hx induction hx with | inj hG => exact synth.inj (h hG) @@ -966,18 +1008,18 @@ lemma synth_mono : Monotone synth := by -- Simplification rules for `synth` @[simp] -lemma synth_increasing {H : Set Msg} : H ⊆ synth H := +lemma synth_increasing [InvKey] {H : Set Msg} : H ⊆ synth H := λ _ hx => synth.inj hx -- Unions -lemma synth_union {G H : Set Msg} : synth G ∪ synth H ⊆ synth (G ∪ H) := +lemma synth_union [InvKey] {G H : Set Msg} : synth G ∪ synth H ⊆ synth (G ∪ H) := by intro x hx cases hx with | inl hG => exact synth_mono (Set.subset_union_left) hG | inr hH => exact synth_mono (Set.subset_union_right) hH -lemma synth_insert {X : Msg} {H : Set Msg} : +lemma synth_insert [InvKey] {X : Msg} {H : Set Msg} : insert X (synth H) ⊆ synth (insert X H) := by intro x hx @@ -986,8 +1028,8 @@ by | inr h => exact synth_mono (Set.subset_insert _ _) h -- Idempotence and transitivity -@[simp] -lemma synth_synthD {H : Set Msg} {X : Msg} : X ∈ synth (synth H) → X ∈ synth H := +lemma synth_synthD [InvKey] {H : Set Msg} {X : Msg} : + X ∈ synth (synth H) → X ∈ synth H := by intro h induction h with @@ -998,33 +1040,35 @@ by | mpair _ _ ihX ihY => exact synth.mpair ihX ihY | crypt _ a => cases a; aapply synth.crypt; -abbrev synthClosureOperator : ClosureOperator (Set Msg) := - ClosureOperator.mk' synth synth_mono @synth_increasing @synth_synthD +abbrev synthClosureOperator [InvKey] : ClosureOperator (Set Msg) := + ClosureOperator.mk' synth synth_mono + (λ x ↦ @synth_increasing _ x) + (λ x ↦ @synth_synthD _ x) @[simp] -lemma synth_idem {H : Set Msg} : synth (synth H) = synth H := +lemma synth_idem {H : Set Msg} [InvKey] : synth (synth H) = synth H := by apply synthClosureOperator.idempotent @[simp] -lemma synth_subset_iff {G H : Set Msg} : (G ⊆ synth H) ↔ (synth G ⊆ synth H) := +lemma synth_subset_iff [InvKey] {G H : Set Msg} : (G ⊆ synth H) ↔ (synth G ⊆ synth H) := by apply synthClosureOperator.le_closure_iff -@[simp, grind] -lemma synth_trans {G H : Set Msg} {X : Msg} : +@[simp] +lemma synth_trans [InvKey] {G H : Set Msg} {X : Msg} : X ∈ synth G → G ⊆ synth H → X ∈ synth H := by intro hG hGH; apply synth_mono at hGH; rw[synth_idem] at hGH; apply hGH; apply hG -- Cut; Lemma 2 of Lowe @[simp] -lemma synth_cut {H : Set Msg} {X Y : Msg} : +lemma synth_cut [InvKey] {H : Set Msg} {X Y : Msg} : Y ∈ synth (insert X H) → X ∈ synth H → Y ∈ synth H := by intro hY hX; apply synth_trans; apply hY intro a h; cases h; simp_all; aapply synth.inj @[simp] -lemma Crypt_synth_eq {H : Set Msg} {K : Key} {X : Msg} : +lemma Crypt_synth_eq [InvKey] {H : Set Msg} {K : Key} {X : Msg} : Key K ∉ H → (Crypt K X ∈ synth H ↔ Crypt K X ∈ H) := by intro hK @@ -1035,7 +1079,7 @@ by exact synth.inj h @[simp] -lemma keysFor_synth {H : Set Msg} : +lemma keysFor_synth [InvKey] {H : Set Msg} : keysFor (synth H) = keysFor H ∪ invKey '' {K | Key K ∈ H} := by ext K @@ -1063,7 +1107,7 @@ by -- Combinations of parts, analz, and synth @[simp] -lemma parts_synth {H : Set Msg} : parts (synth H) = parts H ∪ synth H := +lemma parts_synth [InvKey] {H : Set Msg} : parts (synth H) = parts H ∪ synth H := by apply Set.ext intro X @@ -1095,14 +1139,14 @@ by | inr h => exact parts.inj h @[simp] -lemma analz_analz_Un {G H : Set Msg} : analz (analz G ∪ H) = analz (G ∪ H) := +lemma analz_analz_Un [InvKey] {G H : Set Msg} : analz (analz G ∪ H) = analz (G ∪ H) := by apply analz_cong · exact analz_idem · trivial @[simp] -lemma analz_synth_Un {G H : Set Msg} : analz (synth G ∪ H) = analz (G ∪ H) ∪ synth G := +lemma analz_synth_Un [InvKey] {G H : Set Msg} : analz (synth G ∪ H) = analz (G ∪ H) ∪ synth G := by ext constructor @@ -1141,7 +1185,7 @@ by · apply analz_subset_iff.mpr; apply analz_mono; exact le_sup_left @[simp] -lemma analz_synth {H : Set Msg} : analz (synth H) = analz H ∪ synth H := +lemma analz_synth [InvKey] {H : Set Msg} : analz (synth H) = analz H ∪ synth H := by have asu := analz_synth_Un (G := H) (H := ∅); simp_all -- For reasoning about the Fake rule in traces @@ -1155,7 +1199,7 @@ by · apply parts_mono; simp_all · trivial -lemma Fake_parts_insert {H : Set Msg} {X : Msg} : +lemma Fake_parts_insert [InvKey] {H : Set Msg} {X : Msg} : X ∈ synth (analz H) → parts (insert X H) ⊆ synth (analz H) ∪ parts H := by intro hX @@ -1166,13 +1210,13 @@ by · rw [parts_analz] · apply le_sup_of_le_right; trivial -lemma Fake_parts_insert_in_Un {H : Set Msg} {X Z : Msg} : +lemma Fake_parts_insert_in_Un [InvKey] {H : Set Msg} {X Z : Msg} : Z ∈ parts (insert X H) → X ∈ synth (analz H) → Z ∈ synth (analz H) ∪ parts H := by intro hZ hX exact Set.mem_of_subset_of_mem (Fake_parts_insert hX) hZ -lemma Fake_analz_insert {G H : Set Msg} {X : Msg} : +lemma Fake_analz_insert [InvKey] {G H : Set Msg} {X : Msg} : X ∈ synth (analz G) → analz (insert X H) ⊆ synth (analz G) ∪ analz (G ∪ H) := by intro @@ -1181,7 +1225,7 @@ by · rw[analz_synth_Un, Set.union_comm, analz_analz_Un] @[simp] -lemma analz_conj_parts {H : Set Msg} {X : Msg} : +lemma analz_conj_parts [InvKey] {H : Set Msg} {X : Msg} : (X ∈ analz H ∧ X ∈ parts H) ↔ X ∈ analz H := by constructor @@ -1191,7 +1235,7 @@ lemma analz_conj_parts {H : Set Msg} {X : Msg} : exact ⟨h, analz_subset_parts h⟩ @[simp] -lemma analz_disj_parts {H : Set Msg} {X : Msg} : +lemma analz_disj_parts [InvKey] {H : Set Msg} {X : Msg} : (X ∈ analz H ∨ X ∈ parts H) ↔ X ∈ parts H := by constructor @@ -1203,7 +1247,7 @@ lemma analz_disj_parts {H : Set Msg} {X : Msg} : exact Or.inr h @[simp] -lemma MPair_synth_analz {H : Set Msg} {X Y : Msg} : +lemma MPair_synth_analz [InvKey] {H : Set Msg} {X Y : Msg} : ⦃X, Y⦄ ∈ synth (analz H) ↔ X ∈ synth (analz H) ∧ Y ∈ synth (analz H) := by constructor @@ -1214,7 +1258,7 @@ lemma MPair_synth_analz {H : Set Msg} {X Y : Msg} : · apply And.intro <;> assumption · intro h; exact synth.mpair h.1 h.2 -lemma Crypt_synth_analz {H : Set Msg} {K : Key} {X : Msg} : +lemma Crypt_synth_analz [InvKey] {H : Set Msg} {K : Key} {X : Msg} : Key K ∈ analz H → Key (invKey K) ∈ analz H → ((Crypt K X ∈ synth (analz H)) ↔ X ∈ synth (analz H)) := by intro _ _ @@ -1225,7 +1269,7 @@ lemma Crypt_synth_analz {H : Set Msg} {K : Key} {X : Msg} : · intro _; aapply synth.crypt @[simp] -lemma Hash_synth_analz {H : Set Msg} {X Y : Msg} : +lemma Hash_synth_analz [InvKey] {H : Set Msg} {X Y : Msg} : X ∉ synth (analz H) → ((Hash ⦃X, Y⦄ ∈ synth (analz H)) ↔ Hash ⦃X, Y⦄ ∈ analz H) := by intro _ @@ -1241,27 +1285,27 @@ lemma Hash_synth_analz {H : Set Msg} {X Y : Msg} : -- Freeness -@[simp] +-- @[simp] lemma Agent_neq_HPair {A : Agent} {X Y : Msg} : Agent A ≠ ⦃X, Y⦄ₕ := by simp [HPair] -@[simp] +-- @[simp] lemma Nonce_neq_HPair {N : Nat} {X Y : Msg} : Nonce N ≠ ⦃X, Y⦄ₕ := by simp [HPair] -@[simp] +-- @[simp] lemma Number_neq_HPair {N : Nat} {X Y : Msg} : Number N ≠ ⦃X, Y⦄ₕ := by simp [HPair] -@[simp] +-- @[simp] lemma Key_neq_HPair {K : Key} {X Y : Msg} : Key K ≠ ⦃X, Y⦄ₕ := by simp [HPair] -@[simp] +-- @[simp] lemma Hash_neq_HPair {Z X Y : Msg} : Hash Z ≠ ⦃X, Y⦄ₕ := by simp [HPair] -@[simp] +-- @[simp] lemma Crypt_neq_HPair {K : Key} {X' X Y : Msg} : Crypt K X' ≠ ⦃X, Y⦄ₕ := by simp [HPair] @@ -1280,7 +1324,7 @@ lemma HPair_eq_MPair {X' Y' X Y : Msg} : (⦃X, Y⦄ₕ = ⦃X', Y'⦄) ↔ (X' -- Specialized laws, proved in terms of those for Hash and MPair @[simp] -lemma keysFor_insert_HPair {H : Set Msg} {X Y : Msg} : +lemma keysFor_insert_HPair [InvKey] {H : Set Msg} {X Y : Msg} : keysFor (insert (⦃X, Y⦄ₕ) H) = keysFor H := by simp [HPair] @@ -1288,21 +1332,19 @@ lemma keysFor_insert_HPair {H : Set Msg} {X Y : Msg} : lemma parts_insert_HPair {H : Set Msg} {X Y : Msg} : parts (insert (⦃X, Y⦄ₕ) H) = insert (⦃X, Y⦄ₕ) (insert (Hash ⦃X, Y⦄) (parts (insert Y H))) := by - simp [HPair]; rw[←Set.union_empty (a:= {⦃Hash ⦃X, Y⦄, Y⦄}), ←Set.insert_eq, parts_insert_MPair, parts_insert_Hash] - rw[Set.insert_eq, Set.insert_eq, Set.insert_eq, Set.insert_eq, Set.insert_eq] - rw[Set.union_empty]; simp only [Set.union_assoc] + simp [HPair]; grind @[simp] -lemma analz_insert_HPair {H : Set Msg} {X Y : Msg} : +lemma analz_insert_HPair [InvKey] {H : Set Msg} {X Y : Msg} : analz (insert (⦃X, Y⦄ₕ) H) = insert (⦃X, Y⦄ₕ) (insert (Hash ⦃X, Y⦄) (analz (insert Y H))) := by simp [HPair] @[simp] -lemma HPair_synth_analz {H : Set Msg} {X Y : Msg} : +lemma HPair_synth_analz [InvKey] {H : Set Msg} {X Y : Msg} : X ∉ synth (analz H) → ((⦃X, Y⦄ₕ ∈ synth (analz H)) ↔ (Hash ⦃X, Y⦄ ∈ analz H ∧ Y ∈ synth (analz H))) := by - intro _; simp [HPair]; intro _; constructor + intro _; simp [HPair, MPair_synth_analz]; intro _; constructor · intro h; cases h with | inj => assumption | hash a => cases a with @@ -1312,7 +1354,7 @@ by -- We do NOT want Crypt... messages broken up in protocols!! -- TODO rewrite this -attribute [-simp] parts.body +-- attribute [-simp] parts.body -- Rewrites to push in Key and Crypt messages, so that other messages can -- be pulled out using the `analz_insert` rules @@ -1395,7 +1437,7 @@ by | body => aapply keyfree_CryptE -- The key-free part of a set of messages can be removed from the scope of the `analz` operator -lemma analz_keyfree_into_Un {G H : Set Msg} {X : Msg} : +lemma analz_keyfree_into_Un [InvKey] {G H : Set Msg} {X : Msg} : X ∈ analz (G ∪ H) → G ⊆ keyfree → X ∈ parts G ∪ analz H := by intro hG hKeyFree @@ -1434,12 +1476,12 @@ lemma Hash_notin_image_Key {X : Msg} {A : Set Key} : Hash X ∉ Key '' A := by simp -- Monotonicity of `synth` over `analz` -lemma synth_analz_mono {G H : Set Msg} : G ⊆ H → synth (analz G) ⊆ synth (analz H) := +lemma synth_analz_mono [InvKey] {G H : Set Msg} : G ⊆ H → synth (analz G) ⊆ synth (analz H) := λ h => synth_mono (analz_mono h) -- Simplification for Fake cases @[simp] -lemma Fake_analz_eq {H : Set Msg} {X : Msg} : +lemma Fake_analz_eq [InvKey] {H : Set Msg} {X : Msg} : X ∈ synth (analz H) → synth (analz (insert X H)) = synth (analz H) := by intro hX @@ -1456,7 +1498,7 @@ by · apply synth_analz_mono; simp -- Generalizations of `analz_insert_eq` -lemma gen_analz_insert_eq {H G : Set Msg} {X : Msg} : +lemma gen_analz_insert_eq [InvKey] {H G : Set Msg} {X : Msg} : X ∈ analz H → H ⊆ G → analz (insert X G) = analz G := by intro hX hSubset @@ -1474,7 +1516,7 @@ by · intro h exact analz_mono (Set.subset_insert _ _) h -lemma synth_analz_insert_eq {H G : Set Msg} {X : Msg} {K : Key} : +lemma synth_analz_insert_eq [InvKey] {H G : Set Msg} {X : Msg} {K : Key} : X ∈ synth (analz H) → H ⊆ G → ((Key K ∈ analz (insert X G)) ↔ (Key K ∈ analz G)) := by intro h₁ h₂ @@ -1504,7 +1546,7 @@ by -- Fake parts for single messages -lemma Fake_parts_sing {H : Set Msg} {X : Msg} : +lemma Fake_parts_sing [InvKey] {H : Set Msg} {X : Msg} : X ∈ synth (analz H) → parts {X} ⊆ synth (analz H) ∪ parts H := by intro h diff --git a/InductiveVerification/NS_Public.lean b/InductiveVerification/NS_Public.lean new file mode 100644 index 0000000..c395bfc --- /dev/null +++ b/InductiveVerification/NS_Public.lean @@ -0,0 +1,237 @@ +import InductiveVerification.Public +set_option diagnostics true + +-- The Needham-Schroeder Public-Key Protocol +namespace NS_Public + +variable [InvKey] +variable [Bad] +open Msg +open Event +open Bad +open HasInitState +open InvKey + +-- Define the inductive set `ns_public` +inductive ns_public : List Event → Prop +| Nil : ns_public [] +| Fake : ns_public evsf → + X ∈ synth (analz (spies evsf)) → + ns_public (Says Agent.Spy B X :: evsf) +| NS1 : ns_public evs1 → + Nonce NA ∉ used evs1 → + ns_public (Says A B (Crypt (pubEK B) ⦃Nonce NA, Agent A⦄) :: evs1) +| NS2 : ns_public evs2 → + Nonce NB ∉ used evs2 → + Says A' B (Crypt (pubEK B) ⦃Nonce NA, Agent A⦄) ∈ evs2 → + ns_public (Says B A (Crypt (pubEK A) ⦃Nonce NA, Nonce NB, Agent B⦄) :: evs2) +| NS3 : ns_public evs3 → + Says A B (Crypt (pubEK B) ⦃Nonce NA, Agent A⦄) ∈ evs3 → + Says B' A (Crypt (pubEK A) ⦃Nonce NA, Nonce NB, Agent B⦄) ∈ evs3 → + ns_public (Says A B (Crypt (pubEK B) (Nonce NB)) :: evs3) + +-- A "possibility property": there are traces that reach the end +theorem possibility_property : + ∃ NB, ∃ evs, ns_public evs ∧ Says A B (Crypt (pubEK B) (Nonce NB)) ∈ evs := by + exists 1 + exists [ Says A B (Crypt (pubEK B) (Nonce 1)), + Says B A (Crypt (pubEK A) ⦃Nonce 0, Nonce 1, Agent B⦄), + Says A B (Crypt (pubEK B) ⦃Nonce 0, Agent A⦄), + ] + constructor + · apply ns_public.NS3 + · apply ns_public.NS2 + · apply_rules [ns_public.NS1, ns_public.Nil, Nonce_notin_used_empty] + · simp + · left + all_goals tauto + · simp + +-- Spy never sees another agent's private key unless it's bad at the start +set_option trace.aesop true +@[simp] +theorem Spy_see_priEK {h : ns_public evs} : + (Key (priEK A) ∈ parts (spies evs)) ↔ A ∈ bad := by + constructor + -- · induction h <;> aesop (add norm spies, norm knows, norm initState, norm pubEK, norm priEK, norm pubSK, norm priSK, norm injective_publicKey) + · induction h with + | Nil => simp[spies, knows, initState]; intro h; cases h with + | inl h => cases h with + | inl => aesop (add norm pubEK, norm pubSK, safe forward injective_publicKey) + | inr h => simp[pubEK, priEK] at h; cases h with + | intro _ h => apply publicKey_neq_privateKey at h; contradiction + | inr h => simp[pubSK, priEK] at h; cases h with + | intro _ h => apply publicKey_neq_privateKey at h; contradiction + | Fake _ h ih => apply Fake_parts_sing at h + simp[spies, knows] + intro h₁; apply ih; + cases h₁ with + | inl h₁ => apply h at h₁; cases h₁ with + | inl h₁ => cases h₁; aapply analz_subset_parts + | inr => assumption + | inr => assumption + | NS1 _ _ ih => aesop (add norm spies, norm knows) + | NS2 _ _ _ ih => aesop (add norm spies, norm knows) + | NS3 _ _ _ ih => rw[spies, knows]; simp; intro _; apply ih; grind + · intro h₁; apply parts_increasing; aapply Spy_spies_bad_privateKey + +@[simp] +theorem Spy_analz_priEK {h : ns_public evs} : + Key (priEK A) ∈ analz (spies evs) ↔ A ∈ bad := by + constructor + · intro h₁; apply analz_subset_parts at h₁; aapply Spy_see_priEK.mp + · intro h₁; apply analz_increasing; aapply Spy_spies_bad_privateKey + +-- Lammata for some very specific recurring cases in the following proof +lemma no_nonce_NS1_NS2_helper1 +{h : synth (analz (spies evsf)) ⦃Nonce NA, Msg.Agent A⦄} +: Nonce NA ∈ analz (knows Agent.Spy evsf) := by + cases h with + | inj => aapply analz.fst + | mpair n => cases n; assumption + +lemma no_nonce_NS1_NS2_helper2 +{ih : Crypt (pubEK C) ⦃NA', ⦃Nonce NA, Msg.Agent D⦄⦄ ∈ parts (spies evsf) + → Crypt (pubEK B) ⦃Nonce NA, Msg.Agent A⦄ ∈ parts (spies evsf) + → Nonce NA ∈ analz (spies evsf)} +{h : parts {X} ⊆ synth (analz (spies evsf)) ∪ parts (spies evsf)} +{h₁ : Crypt (pubEK C) ⦃NA', ⦃Nonce NA, Msg.Agent D⦄⦄ ∈ parts (knows Agent.Spy evsf)} +{h₂ : Crypt (pubEK B) ⦃Nonce NA, Msg.Agent A⦄ ∈ parts {X} ∨ + Crypt (pubEK B) ⦃Nonce NA, Msg.Agent A⦄ ∈ parts (knows Agent.Spy evsf)} +: Nonce NA ∈ analz (knows Agent.Spy evsf) := by + apply ih at h₁; cases h₂ with + | inl h₂ => apply h at h₂; cases h₂ with + | inl h₂ => cases h₂ with + | inj => apply h₁; aapply analz_subset_parts + | crypt h₂ => aapply no_nonce_NS1_NS2_helper1 + | inr => aapply h₁ + | inr => aapply h₁ + +-- It is impossible to re-use a nonce in both NS1 and NS2, provided the nonce is secret +theorem no_nonce_NS1_NS2 { h : ns_public evs } : + (Crypt (pubEK C) ⦃NA', Nonce NA, Agent D⦄ ∈ parts (spies evs) → + (Crypt (pubEK B) ⦃Nonce NA, Agent A⦄ ∈ parts (spies evs) → + Nonce NA ∈ analz (spies evs))) := by + intro h₁ h₂ + induction h with + | Nil => rw[spies, knows] at h₂; simp[initState] at h₂ + | Fake _ h ih => + apply Fake_parts_sing at h + simp[spies, knows] at h₁ + apply analz_insert; right; + cases h₁ with + | inl h₁ => simp_all; apply h at h₁; cases h₁ with + | inl h₁ => cases h₁ with + | inj h₁ => apply analz_subset_parts at h₁ + aapply no_nonce_NS1_NS2_helper2 + | crypt h₁ => cases h₁ with + | inj => apply analz.fst; aapply analz.snd + | mpair _ h₁ => aapply no_nonce_NS1_NS2_helper1 + | inr h₁ => aapply no_nonce_NS1_NS2_helper2 + | inr h₁ => simp[spies, knows] at h₂; aapply no_nonce_NS1_NS2_helper2 + | NS1 => + simp[spies] at h₁; simp[spies] at h₂; cases h₂ with + | inl h => rcases h with ⟨_ , ⟨n , _⟩⟩; + apply parts.body at h₁; apply parts.snd at h₁; apply parts.fst at h₁ + apply parts_knows_Spy_subset_used at h₁; rw[n] at h₁; contradiction + | inr => rw[spies, knows]; apply analz_mono; apply Set.subset_insert; simp_all + | NS2 => + simp[spies] at h₁; simp[spies] at h₂; cases h₁ with + | inl h => rcases h with ⟨_, ⟨_, ⟨n, _⟩⟩⟩ + apply parts.body at h₂; apply parts.fst at h₂ + apply parts_knows_Spy_subset_used at h₂; rw[n] at h₂; contradiction + | inr => rw[spies, knows]; apply analz_mono; apply Set.subset_insert; simp_all + | NS3 => rw[spies, knows]; apply analz_mono; apply Set.subset_insert; simp_all + +lemma unique_NA_apply_ih {P : Prop} +{a_ih : Crypt (pubEK B) ⦃Nonce NA, Msg.Agent A⦄ ∈ parts (spies evsf) + → Crypt (pubEK B') ⦃Nonce NA, Msg.Agent A'⦄ ∈ parts (spies evsf) + → Nonce NA ∉ analz (spies evsf) → P} +{h₃ : Nonce NA ∉ analz (spies (Says Agent.Spy C X :: evsf))} +{h₁ : Crypt (pubEK B) ⦃Nonce NA, Msg.Agent A⦄ ∈ parts (spies evsf)} +{h₂ : Crypt (pubEK B') ⦃Nonce NA, Msg.Agent A'⦄ ∈ parts (spies evsf)} +: P := by + simp[spies, knows] at h₃; apply Set.notMem_subset at h₃ + · aapply a_ih; + · apply analz_mono; apply Set.subset_insert + +lemma unique_NA_contradict +{h₃ : Nonce NA ∉ analz (spies (Says Agent.Spy B X :: evsf))} +{h₂ : synth (analz (spies evsf)) ⦃Nonce NA, Msg.Agent A'⦄} +{P : Prop} +: P := by + apply MPair_synth_analz.mp at h₂; rcases h₂ with ⟨⟨n⟩, m⟩; + simp[spies, knows] at h₃; apply Set.notMem_subset at h₃ + · contradiction; + · apply analz_mono; apply Set.subset_insert + +-- Unicity for NS1: nonce NA identifies agents A and B +theorem unique_NA { h : ns_public evs } : + (Crypt (pubEK B) ⦃Nonce NA, Agent A⦄ ∈ parts (spies evs) → + (Crypt (pubEK B') ⦃Nonce NA, Agent A'⦄ ∈ parts (spies evs) → + (Nonce NA ∉ analz (spies evs) → + A = A' ∧ B = B'))) := by + induction h with + | Nil => aesop (add norm spies, norm knows, safe analz_insertI) + | Fake _ a a_ih => + apply Fake_parts_sing at a; intro h₁ h₂ h₃; + simp[spies, knows] at h₁; cases h₁ with + | inl h₁ => apply a at h₁; cases h₁ with + | inl h₁ => cases h₁ with + | inj h₁ => simp[spies, knows] at h₂; cases h₂ with + | inl h₂ => apply a at h₂; cases h₂ with + | inl h₂ => cases h₂ with + | inj h₂ => apply analz_subset_parts at h₁ + apply analz_subset_parts at h₂ + aapply unique_NA_apply_ih + | crypt h₂ => aapply unique_NA_contradict + | inr h₂ => apply analz_subset_parts at h₁ + aapply unique_NA_apply_ih + | inr h₂ => apply analz_subset_parts at h₁ + aapply unique_NA_apply_ih + | crypt h₁ => aapply unique_NA_contradict + | inr h₁ => simp[spies] at h₁; simp[spies, knows] at h₂; cases h₂ with + | inl h₂ => apply a at h₂; cases h₂ with + | inl h₂ => cases h₂ with + | inj h₂ => apply analz_subset_parts at h₂ + aapply unique_NA_apply_ih + | crypt => aapply unique_NA_contradict + | inr => aapply unique_NA_apply_ih + | inr => aapply unique_NA_apply_ih + | inr => simp[spies, knows] at h₂; cases h₂ with + | inl h₂ => apply a at h₂; cases h₂ with + | inl h₂ => cases h₂ with + | inj h₂ => apply analz_subset_parts at h₂ + aapply unique_NA_apply_ih + | crypt => aapply unique_NA_contradict + | inr => aapply unique_NA_apply_ih + | inr => aapply unique_NA_apply_ih + | NS1 _ _ a_ih => intro h₁ h₂ h₃; simp at h₁; cases h₁ with + | inl => sorry + | inr => simp at h₂; cases h₂ with + | inl h₂ => simp at h₃; rw[analz_Crypt] at h₃ + rcases h₂ with ⟨_, ⟨nonce_eq, _⟩⟩; rw[nonce_eq] at h₃; simp at h₃; + | inr => aapply unique_NA_apply_ih; + | NS2 => sorry + | NS3 => sorry + +-- Spy does not see the nonce sent in NS1 if A and B are secure +theorem Spy_not_see_NA { h : ns_public evs }: + Says A B (Crypt (pubEK B) ⦃Nonce NA, Agent A⦄) ∈ evs → + A ∉ bad → + B ∉ bad → + Nonce NA ∉ analz (spies evs) := by + intro h + induction h <;> simp_all [analz_insertI, no_nonce_NS1_NS2] + +-- If NS3 has been sent and the nonce NB agrees with the nonce B joined with NA, then A initiated the run using NA +theorem B_trusts_protocol { h : ns_public evs }: + A ∉ bad → + B ∉ bad → + Crypt (pubEK B) (Nonce NB) ∈ parts (spies evs) → + Says B A (Crypt (pubEK A) ⦃Nonce NA, Nonce NB, Agent B⦄) ∈ evs → + Says A B (Crypt (pubEK B) ⦃Nonce NA, Agent A⦄) ∈ evs := by + intro h + induction h <;> simp_all [analz_insertI, no_nonce_NS1_NS2] + +end NS_Public diff --git a/InductiveVerification/Public.lean b/InductiveVerification/Public.lean new file mode 100644 index 0000000..e0c3443 --- /dev/null +++ b/InductiveVerification/Public.lean @@ -0,0 +1,466 @@ +import InductiveVerification.Event +import Init.Data.Nat.Lemmas +import Mathlib.Data.Nat.Basic +import Mathlib.Data.Nat.Dist +import Mathlib.Order.Defs.PartialOrder +set_option diagnostics true + +-- Theory of Public Keys (common to all public-key protocols) + +-- Private and public keys; initial states of agents + +variable [InvKey] +open InvKey + +lemma invKey_K {K : Key} : K ∈ symKeys → invKey K = K := by + intro h + simp [symKeys] at h + exact h + +-- Asymmetric Keys +inductive KeyMode + | Signature + | Encryption + +axiom publicKey : KeyMode → Agent → Key +axiom injective_publicKey : ∀ {b c : KeyMode} {A A' : Agent}, + publicKey b A = publicKey c A' → b = c ∧ A = A' + +noncomputable abbrev pubEK (A : Agent) : Key := publicKey KeyMode.Encryption A +noncomputable abbrev pubSK (A : Agent) : Key := publicKey KeyMode.Signature A +noncomputable abbrev privateKey (b : KeyMode) (A : Agent) : Key := invKey (publicKey b A) +noncomputable abbrev priEK (A : Agent) : Key := privateKey KeyMode.Encryption A +noncomputable abbrev priSK (A : Agent) : Key := privateKey KeyMode.Signature A +noncomputable abbrev pubK (A : Agent) : Key := pubEK A +noncomputable abbrev priK (A : Agent) : Key := invKey (pubEK A) + +-- Axioms for private and public keys +axiom privateKey_neq_publicKey {b c : KeyMode} {A A' : Agent} : + privateKey b A ≠ publicKey c A' + +lemma publicKey_neq_privateKey {b c : KeyMode} {A A' : Agent} : + publicKey b A ≠ privateKey c A' := by + exact privateKey_neq_publicKey.symm + +-- Basic properties of pubK and priK +omit [InvKey] in +lemma publicKey_inject {b c : KeyMode} {A A' : Agent} : + (publicKey b A = publicKey c A') ↔ (b = c ∧ A = A') := by + grind[injective_publicKey] + +lemma invKey_injective: Function.Injective invKey := by + intro _ _ _ + simp_all[invKey_eq] + +lemma not_symKeys_pubK {b : KeyMode} {A : Agent} : + publicKey b A ∉ symKeys := +by + grind[symKeys, privateKey_neq_publicKey] + +lemma not_symKeys_priK {b : KeyMode} {A : Agent} : + privateKey b A ∉ symKeys := by + simp [symKeys, privateKey, invKey_eq]; grind[privateKey_neq_publicKey]; + +lemma syKey_neq_priEK : + K ∈ symKeys → K ≠ priEK A := by + intro _ _ + have _ := not_symKeys_pubK (b := KeyMode.Encryption) (A := A) + simp_all[symKeys, invKey_eq] + +lemma symKeys_neq_imp_neq : + ((K ∈ symKeys) ≠ (K' ∈ symKeys)) → K ≠ K' := by + intro h eq + rw[eq] at h + contradiction + +@[simp] +lemma symKeys_invKey_iff : (invKey K ∈ symKeys) = (K ∈ symKeys) := by + simp [symKeys, invKey_eq] + +lemma analz_symKeys_Decrypt : + Msg.Crypt K X ∈ analz H → K ∈ symKeys → Msg.Key K ∈ analz H → X ∈ analz H := by + simp [symKeys] + intro _ _ _ + aapply analz.decrypt; simp_all + +-- "Image" equations that hold for injective functions + +@[simp] +lemma invKey_image_eq : (invKey x ∈ invKey '' A) ↔ (x ∈ A) := by + simp [Set.mem_image] + +omit [InvKey] in +@[simp] +lemma publicKey_image_eq : + (publicKey b x ∈ publicKey c '' AA) ↔ (b = c ∧ x ∈ AA) := by + simp [Set.mem_image, publicKey_inject, And.comm, Eq.comm] + +@[simp] +lemma privateKey_notin_image_publicKey : + privateKey b x ∉ publicKey c '' AA := by + simp[publicKey_neq_privateKey] + +@[simp] +lemma privateKey_image_eq : + (privateKey b A ∈ invKey '' (publicKey c '' AS)) ↔ (b = c ∧ A ∈ AS) := by + rw[←publicKey_image_eq]; simp [Set.mem_image, privateKey] + +@[simp] +lemma publicKey_notin_image_privateKey : + publicKey b A ∉ invKey '' ( publicKey c '' AS ) := by + simp [privateKey_neq_publicKey] + +-- Symmetric Keys +-- For some protocols, it is convenient to equip agents with symmetric as +-- well as asymmetric keys. The theory ‹Shared› assumes that all keys +-- are symmetric. +axiom shrK : Agent → Key + +axiom inj_shrK : Function.Injective shrK + +-- All shared keys are symmetric +axiom sym_shrK : ∀ {A : Agent}, shrK A ∈ symKeys + +-- Injectiveness: Agents' long-term keys are distinct. +@[simp] +lemma invKey_shrK : + invKey (shrK A) = shrK A := by + simp [invKey_K, sym_shrK] + +lemma analz_shrK_Decrypt : + Msg.Crypt (shrK A) X ∈ analz H → Msg.Key (shrK A) ∈ analz H → X ∈ analz H := +by + intro _ _ + aapply analz.decrypt; rw[invKey_shrK]; assumption + + +lemma analz_Decrypt' : + Msg.Crypt K X ∈ analz H → K ∈ symKeys → Msg.Key K ∈ analz H → X ∈ analz H := by + intro _ _ _ + aapply analz.decrypt; simp_all[symKeys] + +@[simp] +lemma priK_neq_shrK {A : Agent} : shrK A ≠ privateKey b C := by + intro h + apply not_symKeys_priK + rw[←h] + exact sym_shrK + +@[simp] +lemma shrK_neq_priK : privateKey b C ≠ shrK A := by + exact priK_neq_shrK.symm + +@[simp] +lemma pubK_neq_shrK : shrK A ≠ publicKey b C := by + intro h + apply not_symKeys_pubK + rw[←h] + exact sym_shrK + +@[simp] +lemma shrK_neq_pubK : publicKey b C ≠ shrK A := by + exact pubK_neq_shrK.symm + +@[simp] +lemma priEK_noteq_shrK : priEK A ≠ shrK B := by + simp + +@[simp] +lemma publicKey_notin_image_shrK : publicKey b x ∉ shrK '' AA := by + simp + +@[simp] +lemma privateKey_notin_image_shrK : privateKey b x ∉ shrK '' AA := by + simp + +@[simp] +lemma shrK_notin_image_publicKey : shrK x ∉ publicKey b '' AA := by + simp + +@[simp] +lemma shrK_notin_image_privateKey : + shrK x ∉ (invKey '' ((publicKey b) '' AA )) := by + simp + +omit [InvKey] in +@[simp] +lemma shrK_image_eq : (shrK x ∈ shrK '' AA) ↔ (x ∈ AA) := by + grind[inj_shrK] + +attribute [simp] invKey_K + +variable [Bad] +open Bad +-- Fill in definition for Initial States of Agents +@[simp] +instance : HasInitState Agent where + initState + | Agent.Server => + {Msg.Key (priEK Agent.Server), Msg.Key (priSK Agent.Server)} ∪ + (Msg.Key '' Set.range pubEK) ∪ (Msg.Key '' Set.range pubSK) ∪ (Msg.Key '' Set.range shrK) + | Agent.Friend i => + {Msg.Key (priEK (Agent.Friend i)), Msg.Key (priSK (Agent.Friend i)), Msg.Key (shrK (Agent.Friend i))} ∪ + (Msg.Key '' Set.range pubEK) ∪ (Msg.Key '' Set.range pubSK) + | Agent.Spy => + (Msg.Key '' (invKey '' (pubEK '' bad))) ∪ (Msg.Key '' ( invKey '' ( pubSK '' bad ))) ∪ + (Msg.Key '' ( shrK '' bad )) ∪ + (Msg.Key '' Set.range pubEK) ∪ (Msg.Key '' Set.range pubSK) + +open HasInitState + +-- These lemmas allow reasoning about `used evs` rather than `knows Spy evs`, +-- which is useful when there are private Notes. Because they depend upon the +-- definition of `initState`, they cannot be moved up. + +lemma used_parts_subset_parts : + X ∈ used evs → ( parts {X} ⊆ used evs ) := by + induction evs with + | nil => + simp[used]; intro A h₁ X h₂; simp; exists A + cases A + all_goals ( + simp_all[-parts_union] + apply_rules [parts_trans, h₂, Set.singleton_subset_iff.mpr] + ) + | cons e evs ih => + intro h₁ X + cases e <;> simp[used] <;> simp[used] at h₁ <;> try aapply ih; + all_goals ( + cases h₁ with + | inl h₁ => intro _; left; apply_rules [parts_trans, h₁, Set.singleton_subset_iff.mpr] + | inr h₁ => intro h₂; right; apply ih at h₁; aapply h₁ + ) + +lemma MPair_used_D : + ⦃X, Y⦄ ∈ used evs → (X ∈ used evs ∧ Y ∈ used evs) := by + intro h + apply used_parts_subset_parts (X := Msg.MPair X Y) (evs := evs) at h + rw[Set.singleton_def, parts_insert_MPair] at h + simp at h + apply And.intro <;> apply h <;> tauto + +lemma MPair_used {P : Prop} : + ⦃X, Y⦄ ∈ used evs → + (X ∈ used evs → Y ∈ used evs → P) → + P := by + intro hXY hP + have ⟨hX, hY⟩ := MPair_used_D hXY + exact hP hX hY + +-- Define `@[simp]` lemmas for `initState` for each case of `Agent` +@[simp] +lemma keysFor_parts_initState {C : Agent} : + keysFor (parts (initState C)) = ∅ := by + cases C <;> + simp[initState, keysFor] <;> + repeat rw[Set.singleton_def, parts_insert_Key, parts_empty] <;> + simp + +lemma Crypt_notin_initState {B : Agent} : + Msg.Crypt K X ∉ parts ( initState B ) := by + cases B <;> simp[initState, priEK, priSK, shrK] <;> + apply And.intro <;> try apply And.intro + all_goals repeat rw[Set.singleton_def, parts_insert_Key, parts_empty] <;> + simp + +@[simp] +lemma Crypt_notin_used_empty : + Msg.Crypt K X ∉ used [] := by + simp[used]; intro A; cases A <;> simp <;> apply And.intro <;> try apply And.intro + all_goals (rw[Set.singleton_def, parts_insert_Key, parts_empty] ; simp) + +-- Basic properties of shrK + +-- Agents see their own shared keys +-- iff +@[simp] +lemma shrK_in_initState {A : Agent} : + Msg.Key (shrK A) ∈ initState A := by + induction A <;> simp [HasInitState.initState, initState] + exists Agent.Spy; simp[Spy_in_bad] + +-- iff +@[simp] +lemma shrK_in_knows {A : Agent} : Msg.Key (shrK A) ∈ knows A evs := by + apply initState_subset_knows + exact shrK_in_initState + +-- iff +@[simp] +lemma shrK_in_used {A : Agent} : Msg.Key (shrK A) ∈ used evs := by + apply_rules [initState_into_used, parts.inj, shrK_in_initState] + +-- Fresh keys never clash with long-term shared keys + +-- Used in parts_induct_tac and analz_Fake_tac to distinguish session keys +-- from long-term shared keys +@[simp] +lemma Key_not_used {K : Key} : Msg.Key K ∉ used evs → K ∉ Set.range shrK := by + simp + intro h₁ _ h₂ + apply h₁ + rw[←h₂] + apply shrK_in_used + +lemma shrK_neq {K : Key} {B : Agent} : Msg.Key K ∉ used evs → shrK B ≠ K := by + intro h h' + apply h + rw [←h'] + exact shrK_in_used + +@[simp] +lemma neq_shrK {K : Key} {B : Agent} : Msg.Key K ∉ used evs → K ≠ shrK B := by + intro h; apply shrK_neq at h; exact h.symm + +-- Function spies + +omit [InvKey] [Bad] in +lemma not_SignatureE {b : KeyMode} : b ≠ KeyMode.Signature → b = KeyMode.Encryption := by + cases b <;> simp + +-- Agents see their own private keys +@[simp] +lemma priK_in_initState {b : KeyMode} {A : Agent} : + Msg.Key (privateKey b A) ∈ initState A := by + induction A <;> + simp [HasInitState.initState, initState, privateKey, pubEK, pubSK] <;> + cases b <;> + try simp + · left; left; right; exists Agent.Spy; apply And.intro; exact Spy_in_bad; rfl + · left; left; left; exists Agent.Spy; apply And.intro; exact Spy_in_bad; rfl + +@[simp] +lemma publicKey_in_initState {b : KeyMode} {A : Agent} {B : Agent} : + Msg.Key (publicKey b A) ∈ initState B := by + induction B <;> + simp [HasInitState.initState, initState, priEK, priSK, pubEK, pubSK] <;> + cases b <;> + simp + +-- All public keys are visible +@[simp] +lemma spies_pubK : Msg.Key (publicKey b A) ∈ spies evs := by + induction evs with + | nil => simp [spies, knows] + cases b + · right; exists A + · left; right; exists A + | cons e evs ih => + cases e <;> rw [spies] <;> apply knows_subset_knows_Cons <;> assumption + +@[simp] +lemma analz_spies_pubK : Msg.Key (publicKey b A) ∈ analz (spies evs) := by + exact analz.inj spies_pubK + +-- Spy sees private keys of bad agents +lemma Spy_spies_bad_privateKey { h : A ∈ bad } : Msg.Key (privateKey b A) ∈ spies evs := by + induction evs with + | nil => simp [spies, knows, pubSK, pubEK]; left; left + cases b + · right; exists A + · left; exists A + | cons e evs ih => + cases e <;> rw[spies] <;> aapply knows_subset_knows_Cons + +-- Spy sees long-term shared keys of bad agents +lemma Spy_spies_bad_shrK {h : A ∈ bad} : Msg.Key (shrK A) ∈ spies evs := by + induction evs with + | nil => simp [spies, knows]; exists A + | cons e evs ih => + cases e <;> rw [spies] <;> aapply knows_subset_knows_Cons + +@[simp] +lemma publicKey_into_used : Msg.Key (publicKey b A) ∈ used evs := by + aapply initState_into_used + apply parts_increasing + exact publicKey_in_initState + +@[simp] +lemma privateKey_into_used : Msg.Key (privateKey b A) ∈ used evs := by + aapply initState_into_used + apply parts_increasing + exact priK_in_initState + +-- For case analysis on whether or not an agent is compromised +lemma Crypt_Spy_analz_bad : + Msg.Crypt (shrK A) X ∈ analz (knows Agent.Spy evs) → A ∈ bad → X ∈ analz (knows Agent.Spy evs) := by + intro h₁ h₂ + aapply analz.decrypt + apply analz_increasing + simp[invKey_shrK] + aapply Spy_spies_bad_shrK + +@[simp] +lemma Nonce_notin_initState {B : Agent} : Msg.Nonce N ∉ parts (initState B) := by + cases B <;> + simp [initState] <;> apply And.intro <;> try (apply And.intro) + all_goals (rw[Set.singleton_def, parts_insert_Key, parts_empty]; simp) + +@[simp] +lemma Nonce_notin_used_empty : Msg.Nonce N ∉ used [] := by + simp [used]; intro A; cases A <;> simp <;> + apply And.intro <;> try (apply And.intro) + all_goals (rw[Set.singleton_def, parts_insert_Key, parts_empty]; simp) + +-- Supply fresh nonces for possibility theorems +lemma Nonce_supply_lemma : ∃ N, ∀ n, N ≤ n → Msg.Nonce n ∉ used evs := by + induction evs with + | nil => + use 0; simp + | cons e evs ih => + obtain ⟨N₁, hN⟩ := ih + cases e with + | Says _ _ m => simp[used] + have ns := msg_Nonce_supply (msg := m) + obtain ⟨N₂, ns⟩ := ns + exists Nat.max N₁ N₂ + simp_all + | Notes _ m => simp[used] + have ns := msg_Nonce_supply (msg := m) + obtain ⟨N₂, ns⟩ := ns + exists Nat.max N₁ N₂ + simp_all + | Gets => simp[used]; exists N₁ + + +lemma Nonce_supply1 : ∃ N, Msg.Nonce N ∉ used evs := by + obtain ⟨N, h⟩ := Nonce_supply_lemma + exact ⟨N, h N (le_refl N)⟩ + +-- TODO is this really needed? +-- lemma Nonce_supply : Msg.Nonce (Classical.some (Nonce_supply_lemma.some_spec)) ∉ used evs := by +-- obtain ⟨N, h⟩ := Nonce_supply_lemma +-- exact h (Classical.some (Nonce_supply_lemma.some_spec)) (le_refl _) + +-- Specialized Rewriting for Theorems About `analz` and Image +omit [InvKey] [Bad] in +lemma insert_Key_singleton : insert (Msg.Key K) H = Msg.Key '' {K} ∪ H := by + simp + +omit [InvKey] [Bad] in +@[simp] +lemma insert_Key_image : insert (Msg.Key K) (Msg.Key '' KK ∪ C) = Msg.Key '' (insert K KK) ∪ C := by + rw[insert_Key_singleton, Set.image_insert_eq, Set.insert_eq, Set.union_assoc, Set.image_singleton] + +omit [Bad] in +lemma Crypt_imp_keysFor : + Msg.Crypt K X ∈ H → K ∈ symKeys → K ∈ keysFor H := by + intro h₁ h₂ + apply invKey_K at h₂ + rw[←h₂] + aapply Crypt_imp_invKey_keysFor + +-- Lemma for the trivial direction of the if-and-only-if of the +-- Session Key Compromise Theorem +omit [Bad] in +@[simp] +lemma analz_image_freshK_lemma : + ((Msg.Key K ∈ analz (Msg.Key '' nE ∪ H)) → + (K ∈ nE ∨ Msg.Key K ∈ analz H)) → + (Msg.Key K ∈ analz (Msg.Key '' nE ∪ H)) = (K ∈ nE ∨ Msg.Key K ∈ analz H) := +by + intro h + ext; constructor; assumption; + intro h₁; simp_all; cases h₁ + · apply analz_increasing; left; simp; assumption + · apply analz_union; right; assumption diff --git a/Main.lean b/Main.lean index c707829..bfa0201 100644 --- a/Main.lean +++ b/Main.lean @@ -1,4 +1,5 @@ -import InductiveVerification +-- import InductiveVerification +import InductiveVerification.Public def main : IO Unit := IO.println "Hello, world!" diff --git a/lake-manifest.json b/lake-manifest.json new file mode 100644 index 0000000..fbf0c26 --- /dev/null +++ b/lake-manifest.json @@ -0,0 +1,95 @@ +{"version": "1.1.0", + "packagesDir": ".lake/packages", + "packages": + [{"url": "https://github.com/leanprover-community/mathlib4.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "95093e961c9b2e15366b2232d2b95f6688e9e082", + "name": "mathlib", + "manifestFile": "lake-manifest.json", + "inputRev": null, + "inherited": false, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "b3dd6c3ebc0a71685e86bea9223be39ea4c299fb", + "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": "5ce7f0a355f522a952a3d678d696bd563bb4fd28", + "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": "cff9dd30f2c161b9efd7c657cafed1f967645890", + "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": "ef8377f31b5535430b6753a974d685b0019d0681", + "name": "proofwidgets", + "manifestFile": "lake-manifest.json", + "inputRev": "v0.0.84", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/aesop", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "fa78cf032194308a950a264ed87b422a2a7c1c6c", + "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": "8920dcbb96a4e8bf641fc399ac9c0888e4a6be72", + "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": "5ba0380f2fb45c69448d80429ef6c22bf5973cfa", + "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": "726b98c53e2da249c1de768fbbbb5e67bc9cef60", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.27.0-rc1", + "inherited": true, + "configFile": "lakefile.toml"}], + "name": "«inductive-verification»", + "lakeDir": ".lake"}