--- 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