This commit is contained in:
@@ -1,2 +1,3 @@
|
||||
/.lake
|
||||
.aider*
|
||||
*~
|
||||
|
||||
@@ -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
|
||||
+186
-144
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -1,4 +1,5 @@
|
||||
import InductiveVerification
|
||||
-- import InductiveVerification
|
||||
import InductiveVerification.Public
|
||||
|
||||
def main : IO Unit :=
|
||||
IO.println "Hello, world!"
|
||||
|
||||
@@ -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"}
|
||||
Reference in New Issue
Block a user