src/HOL/Auth/Event.thy

--- a/src/HOL/Auth/Event.thy	Sat Apr 26 12:38:17 2003 +0200
+++ b/src/HOL/Auth/Event.thy	Sat Apr 26 12:38:42 2003 +0200
@@ -11,8 +11,7 @@
     stores are visible to him
 *)
 
-theory Event = Message
-files ("Event_lemmas.ML"):
+theory Event = Message:
 
 consts  (*Initial states of agents -- parameter of the construction*)
   initState :: "agent => msg set"
@@ -74,43 +73,234 @@
   used_Nil:   "used []         = (UN B. parts (initState B))"
   used_Cons:  "used (ev # evs) =
 		     (case ev of
-			Says A B X => parts {X} Un (used evs)
+			Says A B X => parts {X} \<union> (used evs)
 		      | Gets A X   => used evs
-		      | Notes A X  => parts {X} Un (used evs))"
+		      | Notes A X  => parts {X} \<union> (used evs))"
 
 
-lemma Notes_imp_used [rule_format]: "Notes A X : set evs --> X : used evs"
-apply (induct_tac evs);
+lemma Notes_imp_used [rule_format]: "Notes A X \<in> set evs --> X \<in> used evs"
+apply (induct_tac evs)
 apply (auto split: event.split) 
 done
 
-lemma Says_imp_used [rule_format]: "Says A B X : set evs --> X : used evs"
-apply (induct_tac evs);
+lemma Says_imp_used [rule_format]: "Says A B X \<in> set evs --> X \<in> used evs"
+apply (induct_tac evs)
 apply (auto split: event.split) 
 done
 
 lemma MPair_used [rule_format]:
-     "MPair X Y : used evs --> X : used evs & Y : used evs"
-apply (induct_tac evs);
+     "MPair X Y \<in> used evs --> X \<in> used evs & Y \<in> used evs"
+apply (induct_tac evs)
 apply (auto split: event.split) 
 done
 
-use "Event_lemmas.ML"
+
+subsection{*Function @{term knows}*}
+
+text{*Simplifying   @term{"parts (insert X (knows Spy evs))
+      = parts {X} \<union> parts (knows Spy evs)"}.  The general case loops.*)
+
+text{*This version won't loop with the simplifier.*}
+lemmas parts_insert_knows_Spy = parts_insert [of _ "knows Spy evs", standard]
+
+lemma knows_Spy_Says [simp]:
+     "knows Spy (Says A B X # evs) = insert X (knows Spy evs)"
+by simp
+
+text{*The point of letting the Spy see "bad" agents' notes is to prevent
+  redundant case-splits on whether A=Spy and whether A:bad*}
+lemma knows_Spy_Notes [simp]:
+     "knows Spy (Notes A X # evs) =  
+          (if A:bad then insert X (knows Spy evs) else knows Spy evs)"
+by simp
+
+lemma knows_Spy_Gets [simp]: "knows Spy (Gets A X # evs) = knows Spy evs"
+by simp
+
+lemma knows_Spy_subset_knows_Spy_Says:
+     "knows Spy evs <= knows Spy (Says A B X # evs)"
+by (simp add: subset_insertI)
+
+lemma knows_Spy_subset_knows_Spy_Notes:
+     "knows Spy evs <= knows Spy (Notes A X # evs)"
+by force
+
+lemma knows_Spy_subset_knows_Spy_Gets:
+     "knows Spy evs <= knows Spy (Gets A X # evs)"
+by (simp add: subset_insertI)
+
+text{*Spy sees what is sent on the traffic*}
+lemma Says_imp_knows_Spy [rule_format]:
+     "Says A B X \<in> set evs --> X \<in> knows Spy evs"
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) split add: event.split)
+done
+
+lemma Notes_imp_knows_Spy [rule_format]:
+     "Notes A X \<in> set evs --> A: bad --> X \<in> knows Spy evs"
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) split add: event.split)
+done
+
+
+text{*Elimination rules: derive contradictions from old Says events containing
+  items known to be fresh*}
+lemmas knows_Spy_partsEs =
+     Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
+     parts.Body [THEN revcut_rl, standard]
+
+text{*Compatibility for the old "spies" function*}
+lemmas spies_partsEs = knows_Spy_partsEs
+lemmas Says_imp_spies = Says_imp_knows_Spy
+lemmas parts_insert_spies = parts_insert_knows_Spy
+
+
+subsection{*Knowledge of Agents*}
+
+lemma knows_Says: "knows A (Says A B X # evs) = insert X (knows A evs)"
+by simp
+
+lemma knows_Notes: "knows A (Notes A X # evs) = insert X (knows A evs)"
+by simp
+
+lemma knows_Gets:
+     "A \<noteq> Spy --> knows A (Gets A X # evs) = insert X (knows A evs)"
+by simp
+
+
+lemma knows_subset_knows_Says: "knows A evs <= knows A (Says A' B X # evs)"
+apply (simp add: subset_insertI)
+done
+
+lemma knows_subset_knows_Notes: "knows A evs <= knows A (Notes A' X # evs)"
+apply (simp add: subset_insertI)
+done
+
+lemma knows_subset_knows_Gets: "knows A evs <= knows A (Gets A' X # evs)"
+apply (simp add: subset_insertI)
+done
+
+text{*Agents know what they say*}
+lemma Says_imp_knows [rule_format]: "Says A B X \<in> set evs --> X \<in> knows A evs"
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) split add: event.split)
+apply blast
+done
+
+text{*Agents know what they note*}
+lemma Notes_imp_knows [rule_format]: "Notes A X \<in> set evs --> X \<in> knows A evs"
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) split add: event.split)
+apply blast
+done
+
+text{*Agents know what they receive*}
+lemma Gets_imp_knows_agents [rule_format]:
+     "A \<noteq> Spy --> Gets A X \<in> set evs --> X \<in> knows A evs"
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) split add: event.split)
+done
+
+
+text{*What agents DIFFERENT FROM Spy know 
+  was either said, or noted, or got, or known initially*}
+lemma knows_imp_Says_Gets_Notes_initState [rule_format]:
+     "[| X \<in> knows A evs; A \<noteq> Spy |] ==> EX B.  
+  Says A B X \<in> set evs | Gets A X \<in> set evs | Notes A X \<in> set evs | X \<in> initState A"
+apply (erule rev_mp)
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) split add: event.split)
+apply blast
+done
+
+text{*What the Spy knows -- for the time being --
+  was either said or noted, or known initially*}
+lemma knows_Spy_imp_Says_Notes_initState [rule_format]:
+     "[| X \<in> knows Spy evs |] ==> EX A B.  
+  Says A B X \<in> set evs | Notes A X \<in> set evs | X \<in> initState Spy"
+apply (erule rev_mp)
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) split add: event.split)
+apply blast
+done
+
+
+
+
+text{*NOTE REMOVAL--laws above are cleaner, as they don't involve "case"*}
+declare knows_Cons [simp del]
+
+
+subsection{*Fresh Nonces*}
+
+lemma parts_knows_Spy_subset_used: "parts (knows Spy evs) <= used evs"
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) add: parts_insert_knows_Spy split add: event.split)
+apply blast+
+done
+
+lemmas usedI = parts_knows_Spy_subset_used [THEN subsetD, intro]
+
+lemma initState_into_used: "X \<in> parts (initState B) ==> X \<in> used evs"
+apply (induct_tac "evs")
+apply (simp_all (no_asm_simp) add: parts_insert_knows_Spy split add: event.split)
+apply blast
+done
+
+lemma used_Says [simp]: "used (Says A B X # evs) = parts{X} \<union> used evs"
+by simp
+
+lemma used_Notes [simp]: "used (Notes A X # evs) = parts{X} \<union> used evs"
+by simp
+
+lemma used_Gets [simp]: "used (Gets A X # evs) = used evs"
+by simp
+
+lemma used_nil_subset: "used [] <= used evs"
+apply (simp)
+apply (blast intro: initState_into_used)
+done
+
+text{*NOTE REMOVAL--laws above are cleaner, as they don't involve "case"*}
+declare used_Nil [simp del] used_Cons [simp del]
+
+
+text{*For proving theorems of the form @{term "X \<notin> analz (knows Spy evs) --> P"}
+  New events added by induction to "evs" are discarded.  Provided 
+  this information isn't needed, the proof will be much shorter, since
+  it will omit complicated reasoning about @{term analz}.*}
+
+lemmas analz_mono_contra =
+       knows_Spy_subset_knows_Spy_Says [THEN analz_mono, THEN contra_subsetD]
+       knows_Spy_subset_knows_Spy_Notes [THEN analz_mono, THEN contra_subsetD]
+       knows_Spy_subset_knows_Spy_Gets [THEN analz_mono, THEN contra_subsetD]
+
+ML
+{*
+val analz_mono_contra_tac = 
+  let val analz_impI = inst "P" "?Y \<notin> analz (knows Spy ?evs)" impI
+  in
+    rtac analz_impI THEN' 
+    REPEAT1 o 
+      (dresolve_tac (thms"analz_mono_contra"))
+    THEN' mp_tac
+  end
+*}
+
 
 lemma knows_subset_knows_Cons: "knows A evs \<subseteq> knows A (e # evs)"
 by (induct e, auto simp: knows_Cons)
 
 lemma initState_subset_knows: "initState A <= knows A evs"
-apply (induct_tac evs)
-apply (simp add: ); 
+apply (induct_tac evs, simp) 
 apply (blast intro: knows_subset_knows_Cons [THEN subsetD])
 done
 
 
-(*For proving new_keys_not_used*)
+text{*For proving @{text new_keys_not_used}*}
 lemma keysFor_parts_insert:
-     "[| K \<in> keysFor (parts (insert X G));  X \<in> synth (analz H) |] \
-\     ==> K \<in> keysFor (parts (G Un H)) | Key (invKey K) \<in> parts H"; 
+     "[| K \<in> keysFor (parts (insert X G));  X \<in> synth (analz H) |] 
+      ==> K \<in> keysFor (parts (G \<union> H)) | Key (invKey K) \<in> parts H"; 
 by (force 
     dest!: parts_insert_subset_Un [THEN keysFor_mono, THEN [2] rev_subsetD]
            analz_subset_parts [THEN keysFor_mono, THEN [2] rev_subsetD]
@@ -125,10 +315,54 @@
 
 ML
 {*
+val knows_Cons     = thm "knows_Cons"
+val used_Nil       = thm "used_Nil"
+val used_Cons      = thm "used_Cons"
+
+val Notes_imp_used = thm "Notes_imp_used";
+val Says_imp_used = thm "Says_imp_used";
+val MPair_used = thm "MPair_used";
+val parts_insert_knows_Spy = thm "parts_insert_knows_Spy";
+val knows_Spy_Says = thm "knows_Spy_Says";
+val knows_Spy_Notes = thm "knows_Spy_Notes";
+val knows_Spy_Gets = thm "knows_Spy_Gets";
+val knows_Spy_subset_knows_Spy_Says = thm "knows_Spy_subset_knows_Spy_Says";
+val knows_Spy_subset_knows_Spy_Notes = thm "knows_Spy_subset_knows_Spy_Notes";
+val knows_Spy_subset_knows_Spy_Gets = thm "knows_Spy_subset_knows_Spy_Gets";
+val Says_imp_knows_Spy = thm "Says_imp_knows_Spy";
+val Notes_imp_knows_Spy = thm "Notes_imp_knows_Spy";
+val knows_Spy_partsEs = thms "knows_Spy_partsEs";
+val spies_partsEs = thms "spies_partsEs";
+val Says_imp_spies = thm "Says_imp_spies";
+val parts_insert_spies = thm "parts_insert_spies";
+val knows_Says = thm "knows_Says";
+val knows_Notes = thm "knows_Notes";
+val knows_Gets = thm "knows_Gets";
+val knows_subset_knows_Says = thm "knows_subset_knows_Says";
+val knows_subset_knows_Notes = thm "knows_subset_knows_Notes";
+val knows_subset_knows_Gets = thm "knows_subset_knows_Gets";
+val Says_imp_knows = thm "Says_imp_knows";
+val Notes_imp_knows = thm "Notes_imp_knows";
+val Gets_imp_knows_agents = thm "Gets_imp_knows_agents";
+val knows_imp_Says_Gets_Notes_initState = thm "knows_imp_Says_Gets_Notes_initState";
+val knows_Spy_imp_Says_Notes_initState = thm "knows_Spy_imp_Says_Notes_initState";
+val parts_knows_Spy_subset_used = thm "parts_knows_Spy_subset_used";
+val usedI = thm "usedI";
+val initState_into_used = thm "initState_into_used";
+val used_Says = thm "used_Says";
+val used_Notes = thm "used_Notes";
+val used_Gets = thm "used_Gets";
+val used_nil_subset = thm "used_nil_subset";
+val analz_mono_contra = thms "analz_mono_contra";
+val knows_subset_knows_Cons = thm "knows_subset_knows_Cons";
+val initState_subset_knows = thm "initState_subset_knows";
+val keysFor_parts_insert = thm "keysFor_parts_insert";
+
+
 val synth_analz_mono = thm "synth_analz_mono";
 
 val synth_analz_mono_contra_tac = 
-  let val syan_impI = inst "P" "?Y ~: synth (analz (knows Spy ?evs))" impI
+  let val syan_impI = inst "P" "?Y \<notin> synth (analz (knows Spy ?evs))" impI
   in
     rtac syan_impI THEN' 
     REPEAT1 o