Proved basic properties of Blanchet protocol

InductiveVerification/Public.lean

@@ -21,9 +21,30 @@ 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'
+-- TODO replace axioms with classes
+-- Also make sure that there are infinite key supplies
+class AgentKeys where
+  publicKey : KeyMode → Agent → Key
+  injective_publicKey : ∀ {b c : KeyMode} {A A' : Agent},
+    publicKey b A = publicKey c A' → b = c ∧ A = A'
+  privateKey_neq_publicKey : invKey (publicKey b A) ≠ publicKey c A'
+  not_surjective_publicKey_asymK : (¬all_symmetric) →
+    (∀ K : Key, ∃ K' > K,
+    K' ∉ symKeys ∧
+    (∀ b : KeyMode, ∀ A : Agent,
+    publicKey b A ≠ K' ∧ invKey (publicKey b A) ≠ K'))
+-- 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.
+  shrK : Agent → Key
+  inj_shrK : Function.Injective shrK
+  sym_shrK : ∀ {A : Agent}, shrK A ∈ symKeys 
+  not_surjective_shrK_symK : ∀ K : Key, ∃ K' > K,
+    K' ∈ symKeys ∧ (∀ A : Agent, shrK A ≠ K')
+
+open AgentKeys
+variable [AgentKeys]
 
 noncomputable abbrev pubEK (A : Agent) : Key := publicKey KeyMode.Encryption A
 noncomputable abbrev pubSK (A : Agent) : Key := publicKey KeyMode.Signature A
@@ -33,28 +54,27 @@ 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)
 
+abbrev Sign (K : Key) (M : Msg) := ⦃Msg.Crypt K M, M⦄
+
 attribute [simp] pubEK
 attribute [simp] pubSK
 -- attribute [simp] priEK
 -- attribute [simp] priSK
+attribute [simp] privateKey_neq_publicKey
 
 -- Axioms for private and public keys
-@[simp]
-axiom privateKey_neq_publicKey {b c : KeyMode} {A A' : Agent} :
-    privateKey b A ≠ publicKey c A'
-
 @[simp]
 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
 @[simp]
 lemma publicKey_inject {b c : KeyMode} {A A' : Agent} :
     (publicKey b A = publicKey c A') ↔ (b = c ∧ A = A') := by
   grind[injective_publicKey]
 
+omit [AgentKeys] in
 lemma invKey_injective: Function.Injective invKey := by
   intro _ _ _
   simp_all[invKey_eq]
@@ -67,23 +87,42 @@ by
 lemma not_symKeys_priK {b : KeyMode} {A : Agent} :
     privateKey b A ∉ symKeys := by
   simp [symKeys, privateKey, invKey_eq, privateKey_neq_publicKey]
+  
+@[simp]
+lemma pubK_neq_symK {b : KeyMode} {A : Agent} {h : K ∈ symKeys} :
+   publicKey b A ≠ K
+:= by
+  intro h₁; have h₂ := not_symKeys_pubK (b := b) (A := A); simp_all
 
-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]
+@[simp]
+lemma priK_neq_symK {b : KeyMode} {A : Agent} {h : K ∈ symKeys} :
+   privateKey b A ≠ K
+:= by
+  intro h₁; have h₂ := not_symKeys_priK (b := b) (A := A); simp_all
 
+@[simp]
+lemma symK_neq_pubK {b : KeyMode} {A : Agent} {h : K ∈ symKeys} :
+   K ≠ publicKey b A
+:= by intro h₁; aapply pubK_neq_symK; simp_all
+
+@[simp]
+lemma symK_neq_priK {b : KeyMode} {A : Agent} {h : K ∈ symKeys} :
+   K ≠ privateKey b A
+:= by intro h₁; aapply priK_neq_symK; simp_all
+
+omit [AgentKeys] in
 lemma symKeys_neq_imp_neq :
   ((K ∈ symKeys) ≠ (K' ∈ symKeys)) → K ≠ K' := by
   intro h eq
   rw[eq] at h
   contradiction
 
+omit [AgentKeys] in
 @[simp]
 lemma symKeys_invKey_iff : (invKey K ∈ symKeys) = (K ∈ symKeys) := by
   simp [symKeys, invKey_eq]
 
+omit [AgentKeys] in
 lemma analz_symKeys_Decrypt :
     Msg.Crypt K X ∈ analz H → K ∈ symKeys → Msg.Key K ∈ analz H → X ∈ analz H := by
   simp [symKeys]
@@ -92,11 +131,11 @@ lemma analz_symKeys_Decrypt :
 
 -- "Image" equations that hold for injective functions
 
+omit [AgentKeys] in
 @[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
@@ -117,17 +156,6 @@ 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 :
@@ -139,8 +167,8 @@ lemma analz_shrK_Decrypt :
 by
   intro _ _
   aapply analz.decrypt; rw[invKey_shrK]; assumption
-
-
+  
+omit [AgentKeys] in
 lemma analz_Decrypt' :
     Msg.Crypt K X ∈ analz H → K ∈ symKeys → Msg.Key K ∈ analz H → X ∈ analz H := by
   intro _ _ _
@@ -189,7 +217,6 @@ 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]
@@ -199,7 +226,6 @@ attribute [simp] invKey_K
 variable [Bad]
 open Bad
 -- Fill in definition for Initial States of Agents
-@[simp]
 instance : HasInitState Agent where
   initState
     | Agent.Server =>
@@ -226,7 +252,7 @@ lemma used_parts_subset_parts :
     simp[used]; intro A h₁ X h₂; simp; exists A
     cases A
     all_goals (
-      simp_all[-parts_union]
+      simp_all[-parts_union, initState]
       apply_rules [parts_trans, h₂, Set.singleton_subset_iff.mpr]
     )
   | cons e evs ih =>
@@ -260,6 +286,12 @@ lemma keysFor_parts_initState {C : Agent} :
     keysFor (parts (initState C)) = ∅ := by
   cases C <;>
   simp[initState, keysFor]
+  
+@[simp]
+lemma keysFor_used_empty :
+  keysFor (used []) = ∅
+:= by
+  rw[used, keysFor_iunion]; simp;
 
 lemma Crypt_notin_initState {B : Agent} :
   Msg.Crypt K X ∉ parts ( initState B ) := by
@@ -268,7 +300,7 @@ lemma Crypt_notin_initState {B : Agent} :
 @[simp]
 lemma Crypt_notin_used_empty :
   Msg.Crypt K X ∉ used [] := by
-  simp[used]; intro A; cases A <;> simp
+  simp[used]; intro A; cases A <;> simp[initState]
 
 -- Basic properties of shrK
 
@@ -339,7 +371,7 @@ lemma publicKey_in_initState {b : KeyMode} {A : Agent} {B : Agent} :
 @[simp]
 lemma spies_pubK : Msg.Key (publicKey b A) ∈ spies evs := by
   induction evs with
-  | nil => simp [spies, knows]
+  | nil => simp [spies, knows, initState]
            cases b <;> tauto
   | cons e evs ih =>
     cases e <;> rw [spies] <;> apply knows_subset_knows_Cons <;> assumption
@@ -352,14 +384,14 @@ lemma analz_spies_pubK : Msg.Key (publicKey b A) ∈ analz (spies evs) := by
 @[grind .]
 lemma Spy_spies_bad_privateKey { h : A ∈ bad } : Msg.Key (privateKey b A) ∈ spies evs := by
   induction evs with
-  | nil => simp_all [spies, knows, pubSK, pubEK]; cases b <;> tauto
+  | nil => simp_all [spies, knows, initState]; cases b <;> tauto
   | 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
+  | nil => simp [spies, knows, initState]; exists A
   | cons e evs ih =>
     cases e <;> rw [spies] <;> aapply knows_subset_knows_Cons
 
@@ -374,6 +406,19 @@ lemma privateKey_into_used : Msg.Key (privateKey b A) ∈ used evs := by
   aapply initState_into_used
   apply parts_increasing
   exact priK_in_initState
+  
+@[simp]
+lemma shrK_into_used: Msg.Key (shrK A) ∈ used evs := by
+  aapply initState_into_used
+  apply parts_increasing
+  exact shrK_in_initState
+
+@[grind .]
+lemma analz_priK_Decrypt :
+  Msg.Crypt (priSK A) X ∈ analz (spies evs) → X ∈ analz (spies evs) :=
+by
+  intro h; aapply analz.decrypt
+  simp[priSK, privateKey, invKey_spec]
 
 -- For case analysis on whether or not an agent is compromised
 lemma Crypt_Spy_analz_bad :
@@ -396,6 +441,35 @@ lemma Crypt_synth_analz_pubK :
   (Msg.Crypt (pubEK A) X ∈ (analz (spies evs)) ∨ ( X ∈ synth (analz (spies evs)))) :=
 by simp[Crypt_synth_EK]; 
 
+@[simp]
+lemma Crypt_synth_priK :
+  (Msg.Crypt (priSK A) X ∈ synth (spies evs)) ↔
+  (Msg.Crypt (priSK A) X ∈ spies evs ∨
+  (Msg.Key (priSK A) ∈ spies evs ∧ X ∈ synth (spies evs))) :=
+by simp[Crypt_synth_EK]
+
+@[simp]
+lemma Crypt_synth_analz_priK :
+  (Msg.Crypt (priSK A) X ∈ synth (analz (spies evs))) ↔
+  (Msg.Crypt (priSK A) X ∈ analz (spies evs) ∨
+  (Msg.Key (priSK A) ∈ analz (spies evs) ∧ X ∈ synth (analz (spies evs)))) :=
+by simp[Crypt_synth_EK]; 
+
+@[grind .]
+lemma Crypt_synth_analz_priK_decrypt :
+  (Msg.Crypt (priSK A) X ∈ synth (analz (spies evs))) →
+  (X ∈ analz (spies evs) ∨
+  (Msg.Key (priSK A) ∈ analz (spies evs) ∧ X ∈ synth (analz (spies evs)))) :=
+by simp[Crypt_synth_EK]; grind
+
+@[simp]
+lemma Sign_synth_priK :
+  (Sign (priSK A) X ∈ synth (analz (spies evs))) ↔
+  (Msg.Crypt (priSK A) X ∈ analz (spies evs) ∨ Msg.Key (priSK A) ∈ analz (spies evs)) ∧ 
+  X ∈ synth (analz (spies evs))
+:= by
+  simp[Sign, Crypt_synth_EK]; grind
+
 @[simp]
 lemma Nonce_notin_initState {B : Agent} : Msg.Nonce N ∉ parts (initState B) := by
   cases B <;>
@@ -403,7 +477,7 @@ lemma Nonce_notin_initState {B : Agent} : Msg.Nonce N ∉ parts (initState B) :=
 
 @[simp]
 lemma Nonce_notin_used_empty : Msg.Nonce N ∉ used [] := by
-  simp [used]; intro A; cases A <;> simp
+  simp [used, initState]; intro A; cases A <;> simp
 
 -- Supply fresh nonces for possibility theorems
 lemma Nonce_supply_lemma : ∃ N, ∀ n, N ≤ n → Msg.Nonce n ∉ used evs := by
@@ -429,11 +503,42 @@ lemma Nonce_supply_lemma : ∃ N, ∀ n, N ≤ n → Msg.Nonce n ∉ used evs :=
 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 _)
+  
+lemma symK_supply_lemma : ∀ K, ∃ K' > K,
+  K' ∈ symKeys ∧ Msg.Key K' ∉ used evs ∪ Msg.Key '' keysFor (used evs) :=
+by
+  induction evs with
+  | nil =>
+    intro K
+    have exK := not_surjective_shrK_symK (K := K);
+    rcases exK with ⟨K' , ⟨_, symK, exK⟩⟩;
+    exists K';
+    apply And.intro
+    · assumption
+    · apply And.intro
+      · assumption
+      · simp_all[used]; intro A; cases A <;>
+        simp_all[initState, pubK_neq_symK, priK_neq_symK, symK_neq_priK]
+        rw[Eq.comm]; apply exK
+  | cons e evs ih =>
+    intro K
+    cases e with
+    | Says _ _ m =>
+      simp[used];
+      obtain ⟨K₁, ks⟩ := msg_Key_supply (msg := m); 
+      obtain ⟨K', _, _, _⟩ := ih ( K := Nat.max K₁ K); exists K'; simp_all; grind
+    | Notes A m => 
+      simp[used];
+      obtain ⟨K₁, ks⟩ := msg_Key_supply (msg := m); 
+      obtain ⟨K', _, _, _⟩ := ih ( K := Nat.max K₁ K); exists K';
+      apply ks at K'; by_cases h : A ∈ bad <;> simp_all <;> grind
+    | Gets => exact ih (K := K)
+  
+lemma symK_supply : ∃ K ∈ symKeys,
+  Msg.Key K ∉ used evs ∪ Msg.Key '' keysFor (used evs) :=
+by
+  obtain ⟨K, _, _, _⟩ := symK_supply_lemma (K := 0) (evs := evs)
+  exists K
 
 -- Specialized Rewriting for Theorems About `analz` and Image
 omit [InvKey] [Bad] in
@@ -445,7 +550,7 @@ omit [InvKey] [Bad] in
 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
+omit [Bad] [AgentKeys] in
 lemma Crypt_imp_keysFor :
     Msg.Crypt K X ∈ H → K ∈ symKeys → K ∈ keysFor H := by
   intro h₁ h₂
@@ -455,7 +560,7 @@ lemma Crypt_imp_keysFor :
 
 -- Lemma for the trivial direction of the if-and-only-if of the 
 -- Session Key Compromise Theorem
-omit [Bad] in
+omit [Bad] [AgentKeys] in
 @[simp]
 lemma analz_image_freshK_lemma :
     ((Msg.Key K ∈ analz (Msg.Key '' nE ∪ H)) →