leopold/inductive-verification-lean
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Translated library, started to prove NS_Public
Lean Action CI / build (push) Has been cancelled
Details

Browse Source
This commit is contained in:
Your Name
2026-02-23 09:06:13 +01:00
parent 61616dc3b1
commit 31e638dd90
7 changed files with 1427 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files
InductiveVerification/Message.lean
+186 -144
View File
@@ -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