Browse Source

Initial commit, based on AFP entry dated 2020-05-22.

tags/afp-Automated_Stateful_Protocol_Verification-Isabelle2020^0
Achim D. Brucker 10 months ago
commit
216e3831c7
47 changed files with 24322 additions and 0 deletions
  1. +110
    -0
      Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy
  2. +54
    -0
      Automated_Stateful_Protocol_Verification/Examples.thy
  3. +53
    -0
      Automated_Stateful_Protocol_Verification/PSPSP.thy
  4. +16
    -0
      Automated_Stateful_Protocol_Verification/ROOT
  5. +4410
    -0
      Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy
  6. +3681
    -0
      Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy
  7. +246
    -0
      Automated_Stateful_Protocol_Verification/Term_Abstraction.thy
  8. +2579
    -0
      Automated_Stateful_Protocol_Verification/Term_Implication.thy
  9. +451
    -0
      Automated_Stateful_Protocol_Verification/Term_Variants.thy
  10. +966
    -0
      Automated_Stateful_Protocol_Verification/Transactions.thy
  11. +72
    -0
      Automated_Stateful_Protocol_Verification/document/root.bib
  12. +166
    -0
      Automated_Stateful_Protocol_Verification/document/root.tex
  13. +133
    -0
      Automated_Stateful_Protocol_Verification/examples/Keyserver.thy
  14. +132
    -0
      Automated_Stateful_Protocol_Verification/examples/Keyserver2.thy
  15. +295
    -0
      Automated_Stateful_Protocol_Verification/examples/Keyserver_Composition.thy
  16. +161
    -0
      Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model03.thy
  17. +221
    -0
      Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model07.thy
  18. +237
    -0
      Automated_Stateful_Protocol_Verification/examples/PKCS/PKCS_Model09.thy
  19. +51
    -0
      Automated_Stateful_Protocol_Verification/trac/Makefile
  20. +13
    -0
      Automated_Stateful_Protocol_Verification/trac/README.md
  21. +42
    -0
      Automated_Stateful_Protocol_Verification/trac/bin/ml-lex-isa
  22. +39
    -0
      Automated_Stateful_Protocol_Verification/trac/bin/ml-yacc-isa
  23. +323
    -0
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/base.sig
  24. +40
    -0
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/copyright
  25. +118
    -0
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/join.sml
  26. +83
    -0
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/lrtable.sml
  27. +567
    -0
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/parser2.sml
  28. +29
    -0
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/root.sml
  29. +43
    -0
      Automated_Stateful_Protocol_Verification/trac/ml-yacc-lib/stream.sml
  30. +101
    -0
      Automated_Stateful_Protocol_Verification/trac/ml_yacc_lib.thy
  31. +1947
    -0
      Automated_Stateful_Protocol_Verification/trac/trac.thy
  32. +127
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_fp_parser.thy
  33. +126
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm
  34. +29
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sig
  35. +678
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.grm.sml
  36. +103
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex
  37. +728
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_fp.lex.sml
  38. +287
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm
  39. +73
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sig
  40. +1720
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.grm.sml
  41. +139
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex
  42. +2131
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_parser/trac_protocol.lex.sml
  43. +118
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_protocol_parser.thy
  44. +565
    -0
      Automated_Stateful_Protocol_Verification/trac/trac_term.thy
  45. +31
    -0
      CITATION
  46. +30
    -0
      LICENSE
  47. +58
    -0
      README.md

+ 110
- 0
Automated_Stateful_Protocol_Verification/Eisbach_Protocol_Verification.thy View File

@@ -0,0 +1,110 @@
(*
(C) Copyright Andreas Viktor Hess, DTU, 2020
(C) Copyright Sebastian A. Mödersheim, DTU, 2020
(C) Copyright Achim D. Brucker, University of Exeter, 2020
(C) Copyright Anders Schlichtkrull, DTU, 2020

All Rights Reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

- Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

- Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

- Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products
derived from this software without specific prior written
permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(* Title: Eisbach_Protocol_Verification.thy
Author: Andreas Viktor Hess, DTU
Author: Sebastian A. Mödersheim, DTU
Author: Achim D. Brucker, University of Exeter
Author: Anders Schlichtkrull, DTU
*)

section \<open>Useful Eisbach Methods for Automating Protocol Verification\<close>
theory Eisbach_Protocol_Verification
imports Main "HOL-Eisbach.Eisbach_Tools"
begin

named_theorems exhausts
named_theorems type_class_instance_lemmata
named_theorems protocol_checks
named_theorems coverage_check_unfold_protocol_lemma
named_theorems coverage_check_unfold_lemmata
named_theorems coverage_check_intro_lemmata
named_theorems transaction_coverage_lemmata

method UNIV_lemma =
(rule UNIV_eq_I; (subst insert_iff)+; subst empty_iff; smt exhausts)+

method type_class_instance =
(intro_classes; auto simp add: type_class_instance_lemmata)

method protocol_model_subgoal =
(((rule allI, case_tac f); (erule forw_subst)+)?; simp_all)

method protocol_model_interpretation =
(unfold_locales; protocol_model_subgoal+)

method check_protocol_intro =
(unfold_locales, unfold protocol_checks[symmetric])

method check_protocol_with methods meth =
(check_protocol_intro, meth)

method check_protocol' =
(check_protocol_with \<open>code_simp+\<close>)

method check_protocol_unsafe' =
(check_protocol_with \<open>eval+\<close>)

method check_protocol =
(check_protocol_with \<open>
code_simp,
code_simp,
code_simp,
code_simp,
code_simp\<close>)

method check_protocol_unsafe =
(check_protocol_with \<open>
eval,
eval,
eval,
eval,
eval\<close>)

method coverage_check_intro =
(((unfold coverage_check_unfold_protocol_lemma)?;
intro coverage_check_intro_lemmata;
simp only: list_all_simps list_all_append list.map concat.simps map_append product_concat_map;
intro conjI TrueI);
(clarsimp+)?;
((rule transaction_coverage_lemmata)+)?)

method coverage_check_unfold =
(unfold coverage_check_unfold_protocol_lemma coverage_check_unfold_lemmata
list_all_iff Let_def case_prod_unfold Product_Type.fst_conv Product_Type.snd_conv)

end

+ 54
- 0
Automated_Stateful_Protocol_Verification/Examples.thy View File

@@ -0,0 +1,54 @@
(*
(C) Copyright Andreas Viktor Hess, DTU, 2020
(C) Copyright Sebastian A. Mödersheim, DTU, 2020
(C) Copyright Achim D. Brucker, University of Exeter, 2020
(C) Copyright Anders Schlichtkrull, DTU, 2020

All Rights Reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

- Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

- Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

- Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products
derived from this software without specific prior written
permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(* Title: Examples.thy
Author: Andreas Viktor Hess, DTU
Author: Sebastian A. Mödersheim, DTU
Author: Achim D. Brucker, University of Exeter
Author: Anders Schlichtkrull, DTU
*)

section\<open>Examples\<close>
theory Examples
imports "examples/Keyserver"
"examples/Keyserver2"
"examples/Keyserver_Composition"
"examples/PKCS/PKCS_Model03"
"examples/PKCS/PKCS_Model07"
"examples/PKCS/PKCS_Model09"
begin
end

+ 53
- 0
Automated_Stateful_Protocol_Verification/PSPSP.thy View File

@@ -0,0 +1,53 @@
(*
(C) Copyright Andreas Viktor Hess, DTU, 2020
(C) Copyright Sebastian A. Mödersheim, DTU, 2020
(C) Copyright Achim D. Brucker, University of Exeter, 2020
(C) Copyright Anders Schlichtkrull, DTU, 2020

All Rights Reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

- Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

- Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

- Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products
derived from this software without specific prior written
permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(* Title: PSPSP.thy
Author: Andreas Viktor Hess, DTU
Author: Sebastian A. Mödersheim, DTU
Author: Achim D. Brucker, University of Exeter
Author: Anders Schlichtkrull, DTU
*)

section\<open>PSPSP\<close>
theory PSPSP
imports "Stateful_Protocol_Verification"
"Eisbach_Protocol_Verification"
"trac/trac"
begin

end


+ 16
- 0
Automated_Stateful_Protocol_Verification/ROOT View File

@@ -0,0 +1,16 @@
chapter AFP

session "Automated_Stateful_Protocol_Verification-devel" (AFP) = "Stateful_Protocol_Composition_and_Typing" +
options [timeout = 2400]
sessions
"HOL-Eisbach"
directories
"trac"
"examples"
"examples/PKCS"
theories
"PSPSP"
"Examples"
document_files
"root.tex"
"root.bib"

+ 4410
- 0
Automated_Stateful_Protocol_Verification/Stateful_Protocol_Model.thy
File diff suppressed because it is too large
View File


+ 3681
- 0
Automated_Stateful_Protocol_Verification/Stateful_Protocol_Verification.thy
File diff suppressed because it is too large
View File


+ 246
- 0
Automated_Stateful_Protocol_Verification/Term_Abstraction.thy View File

@@ -0,0 +1,246 @@
(*
(C) Copyright Andreas Viktor Hess, DTU, 2020
(C) Copyright Sebastian A. Mödersheim, DTU, 2020
(C) Copyright Achim D. Brucker, University of Exeter, 2020
(C) Copyright Anders Schlichtkrull, DTU, 2020

All Rights Reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

- Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

- Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

- Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products
derived from this software without specific prior written
permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(* Title: Term_Abstraction.thy
Author: Andreas Viktor Hess, DTU
Author: Sebastian A. Mödersheim, DTU
Author: Achim D. Brucker, University of Exeter
Author: Anders Schlichtkrull, DTU
*)

section\<open>Term Abstraction\<close>
theory Term_Abstraction
imports Transactions
begin

subsection \<open>Definitions\<close>
fun to_abs ("\<alpha>\<^sub>0") where
"\<alpha>\<^sub>0 [] _ = {}"
| "\<alpha>\<^sub>0 ((Fun (Val m) [],Fun (Set s) S)#D) n =
(if m = n then insert s (\<alpha>\<^sub>0 D n) else \<alpha>\<^sub>0 D n)"
| "\<alpha>\<^sub>0 (_#D) n = \<alpha>\<^sub>0 D n"

fun abs_apply_term (infixl "\<cdot>\<^sub>\<alpha>" 67) where
"Var x \<cdot>\<^sub>\<alpha> \<alpha> = Var x"
| "Fun (Val n) T \<cdot>\<^sub>\<alpha> \<alpha> = Fun (Abs (\<alpha> n)) (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T)"
| "Fun f T \<cdot>\<^sub>\<alpha> \<alpha> = Fun f (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T)"

definition abs_apply_list (infixl "\<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t" 67) where
"M \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> \<equiv> map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) M"

definition abs_apply_terms (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t" 67) where
"M \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> \<equiv> (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) ` M"

definition abs_apply_pairs (infixl "\<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s" 67) where
"F \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha> \<equiv> map (\<lambda>(s,t). (s \<cdot>\<^sub>\<alpha> \<alpha>, t \<cdot>\<^sub>\<alpha> \<alpha>)) F"

definition abs_apply_strand_step (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p" 67) where
"s \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p \<alpha> \<equiv> (case s of
(l,send\<langle>t\<rangle>) \<Rightarrow> (l,send\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
| (l,receive\<langle>t\<rangle>) \<Rightarrow> (l,receive\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
| (l,\<langle>ac: t \<doteq> t'\<rangle>) \<Rightarrow> (l,\<langle>ac: (t \<cdot>\<^sub>\<alpha> \<alpha>) \<doteq> (t' \<cdot>\<^sub>\<alpha> \<alpha>)\<rangle>)
| (l,insert\<langle>t,t'\<rangle>) \<Rightarrow> (l,insert\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>,t' \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
| (l,delete\<langle>t,t'\<rangle>) \<Rightarrow> (l,delete\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>,t' \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
| (l,\<langle>ac: t \<in> t'\<rangle>) \<Rightarrow> (l,\<langle>ac: (t \<cdot>\<^sub>\<alpha> \<alpha>) \<in> (t' \<cdot>\<^sub>\<alpha> \<alpha>)\<rangle>)
| (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>) \<Rightarrow> (l,\<forall>X\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha>) \<or>\<notin>: (F' \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha>)\<rangle>))"

definition abs_apply_strand (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t" 67) where
"S \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t \<alpha> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p \<alpha>) S"


subsection \<open>Lemmata\<close>
lemma to_abs_alt_def:
"\<alpha>\<^sub>0 D n = {s. \<exists>S. (Fun (Val n) [], Fun (Set s) S) \<in> set D}"
by (induct D n rule: to_abs.induct) auto

lemma abs_term_apply_const[simp]:
"is_Val f \<Longrightarrow> Fun f [] \<cdot>\<^sub>\<alpha> a = Fun (Abs (a (the_Val f))) []"
"\<not>is_Val f \<Longrightarrow> Fun f [] \<cdot>\<^sub>\<alpha> a = Fun f []"
by (cases f; auto)+

lemma abs_fv: "fv (t \<cdot>\<^sub>\<alpha> a) = fv t"
by (induct t a rule: abs_apply_term.induct) auto

lemma abs_eq_if_no_Val:
assumes "\<forall>f \<in> funs_term t. \<not>is_Val f"
shows "t \<cdot>\<^sub>\<alpha> a = t \<cdot>\<^sub>\<alpha> b"
using assms
proof (induction t)
case (Fun f T) thus ?case by (cases f) simp_all
qed simp

lemma abs_list_set_is_set_abs_set: "set (M \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>) = (set M) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>"
unfolding abs_apply_list_def abs_apply_terms_def by simp

lemma abs_set_empty[simp]: "{} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = {}"
unfolding abs_apply_terms_def by simp

lemma abs_in:
assumes "t \<in> M"
shows "t \<cdot>\<^sub>\<alpha> \<alpha> \<in> M \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>"
using assms unfolding abs_apply_terms_def
by (induct t \<alpha> rule: abs_apply_term.induct) blast+

lemma abs_set_union: "(A \<union> B) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a = (A \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a) \<union> (B \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a)"
unfolding abs_apply_terms_def
by auto

lemma abs_subterms: "subterms (t \<cdot>\<^sub>\<alpha> \<alpha>) = subterms t \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>"
proof (induction t)
case (Fun f T) thus ?case by (cases f) (auto simp add: abs_apply_terms_def)
qed (simp add: abs_apply_terms_def)

lemma abs_subterms_in: "s \<in> subterms t \<Longrightarrow> s \<cdot>\<^sub>\<alpha> a \<in> subterms (t \<cdot>\<^sub>\<alpha> a)"
proof (induction t)
case (Fun f T) thus ?case by (cases f) auto
qed simp

lemma abs_ik_append: "(ik\<^sub>s\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a = (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a \<union> (ik\<^sub>s\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a"
unfolding abs_apply_terms_def ik\<^sub>s\<^sub>s\<^sub>t_def
by auto

lemma to_abs_in:
assumes "(Fun (Val n) [], Fun (Set s) []) \<in> set D"
shows "s \<in> \<alpha>\<^sub>0 D n"
using assms by (induct rule: to_abs.induct) auto

lemma to_abs_empty_iff_notin_db:
"Fun (Val n) [] \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 D = Fun (Abs {}) [] \<longleftrightarrow> (\<nexists>s S. (Fun (Val n) [], Fun (Set s) S) \<in> set D)"
by (simp add: to_abs_alt_def)

lemma to_abs_list_insert:
assumes "Fun (Val n) [] \<noteq> t"
shows "\<alpha>\<^sub>0 D n = \<alpha>\<^sub>0 (List.insert (t,s) D) n"
using assms to_abs_alt_def[of D n] to_abs_alt_def[of "List.insert (t,s) D" n]
by auto

lemma to_abs_list_insert':
"insert s (\<alpha>\<^sub>0 D n) = \<alpha>\<^sub>0 (List.insert (Fun (Val n) [], Fun (Set s) S) D) n"
using to_abs_alt_def[of D n]
to_abs_alt_def[of "List.insert (Fun (Val n) [], Fun (Set s) S) D" n]
by auto

lemma to_abs_list_remove_all:
assumes "Fun (Val n) [] \<noteq> t"
shows "\<alpha>\<^sub>0 D n = \<alpha>\<^sub>0 (List.removeAll (t,s) D) n"
using assms to_abs_alt_def[of D n] to_abs_alt_def[of "List.removeAll (t,s) D" n]
by auto

lemma to_abs_list_remove_all':
"\<alpha>\<^sub>0 D n - {s} = \<alpha>\<^sub>0 (filter (\<lambda>d. \<nexists>S. d = (Fun (Val n) [], Fun (Set s) S)) D) n"
using to_abs_alt_def[of D n]
to_abs_alt_def[of "filter (\<lambda>d. \<nexists>S. d = (Fun (Val n) [], Fun (Set s) S)) D" n]
by auto

lemma to_abs_db\<^sub>s\<^sub>s\<^sub>t_append:
assumes "\<forall>u s. insert\<langle>u, s\<rangle> \<in> set B \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
and "\<forall>u s. delete\<langle>u, s\<rangle> \<in> set B \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
shows "\<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t A \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D) n"
using assms
proof (induction B rule: List.rev_induct)
case (snoc b B)
hence IH: "\<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t A \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D) n" by auto
have *: "\<forall>u s. b = insert\<langle>u,s\<rangle> \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
"\<forall>u s. b = delete\<langle>u,s\<rangle> \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
using snoc.prems by simp_all
show ?case
proof (cases b)
case (Insert u s)
hence **: "db'\<^sub>s\<^sub>s\<^sub>t (A@B@[b]) \<I> D = List.insert (u \<cdot> \<I>,s \<cdot> \<I>) (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D)"
using db\<^sub>s\<^sub>s\<^sub>t_append[of "A@B" "[b]"] by simp
have "Fun (Val n) [] \<noteq> u \<cdot> \<I>" using *(1) Insert by auto
thus ?thesis using IH ** to_abs_list_insert by metis
next
case (Delete u s)
hence **: "db'\<^sub>s\<^sub>s\<^sub>t (A@B@[b]) \<I> D = List.removeAll (u \<cdot> \<I>,s \<cdot> \<I>) (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D)"
using db\<^sub>s\<^sub>s\<^sub>t_append[of "A@B" "[b]"] by simp
have "Fun (Val n) [] \<noteq> u \<cdot> \<I>" using *(2) Delete by auto
thus ?thesis using IH ** to_abs_list_remove_all by metis
qed (simp_all add: db\<^sub>s\<^sub>s\<^sub>t_no_upd_append[of "[b]" "A@B"] IH)
qed simp

lemma to_abs_neq_imp_db_update:
assumes "\<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t A I) n \<noteq> \<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (A@B) I) n"
shows "\<exists>u s. u \<cdot> I = Fun (Val n) [] \<and> (insert\<langle>u,s\<rangle> \<in> set B \<or> delete\<langle>u,s\<rangle> \<in> set B)"
proof -
{ fix D have ?thesis when "\<alpha>\<^sub>0 D n \<noteq> \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t B I D) n" using that
proof (induction B I D rule: db'\<^sub>s\<^sub>s\<^sub>t.induct)
case 2 thus ?case
by (metis db'\<^sub>s\<^sub>s\<^sub>t.simps(2) list.set_intros(1,2) subst_apply_pair_pair to_abs_list_insert)
next
case 3 thus ?case
by (metis db'\<^sub>s\<^sub>s\<^sub>t.simps(3) list.set_intros(1,2) subst_apply_pair_pair to_abs_list_remove_all)
qed simp_all
} thus ?thesis using assms by (metis db\<^sub>s\<^sub>s\<^sub>t_append db\<^sub>s\<^sub>s\<^sub>t_def)
qed

lemma abs_term_subst_eq:
fixes \<delta> \<theta>::"(('a,'b,'c) prot_fun, ('d,'e prot_atom) term \<times> nat) subst"
assumes "\<forall>x \<in> fv t. \<delta> x \<cdot>\<^sub>\<alpha> a = \<theta> x \<cdot>\<^sub>\<alpha> b"
and "\<nexists>n T. Fun (Val n) T \<in> subterms t"
shows "t \<cdot> \<delta> \<cdot>\<^sub>\<alpha> a = t \<cdot> \<theta> \<cdot>\<^sub>\<alpha> b"
using assms
proof (induction t)
case (Fun f T) thus ?case
proof (cases f)
case (Val n)
hence False using Fun.prems(2) by blast
thus ?thesis by metis
qed auto
qed simp

lemma abs_term_subst_eq':
fixes \<delta> \<theta>::"(('a,'b,'c) prot_fun, ('d,'e prot_atom) term \<times> nat) subst"
assumes "\<forall>x \<in> fv t. \<delta> x \<cdot>\<^sub>\<alpha> a = \<theta> x"
and "\<nexists>n T. Fun (Val n) T \<in> subterms t"
shows "t \<cdot> \<delta> \<cdot>\<^sub>\<alpha> a = t \<cdot> \<theta>"
using assms
proof (induction t)
case (Fun f T) thus ?case
proof (cases f)
case (Val n)
hence False using Fun.prems(2) by blast
thus ?thesis by metis
qed auto
qed simp

lemma abs_val_in_funs_term:
assumes "f \<in> funs_term t" "is_Val f"
shows "Abs (\<alpha> (the_Val f)) \<in> funs_term (t \<cdot>\<^sub>\<alpha> \<alpha>)"
using assms by (induct t \<alpha> rule: abs_apply_term.induct) auto

end

+ 2579
- 0
Automated_Stateful_Protocol_Verification/Term_Implication.thy
File diff suppressed because it is too large
View File


+ 451
- 0
Automated_Stateful_Protocol_Verification/Term_Variants.thy View File

@@ -0,0 +1,451 @@
(*
(C) Copyright Andreas Viktor Hess, DTU, 2020
(C) Copyright Sebastian A. Mödersheim, DTU, 2020
(C) Copyright Achim D. Brucker, University of Exeter, 2020
(C) Copyright Anders Schlichtkrull, DTU, 2020

All Rights Reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

- Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

- Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

- Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products
derived from this software without specific prior written
permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(* Title: Term_Variants.thy
Author: Andreas Viktor Hess, DTU
Author: Sebastian A. Mödersheim, DTU
Author: Achim D. Brucker, University of Exeter
Author: Anders Schlichtkrull, DTU
*)

section\<open>Term Variants\<close>
theory Term_Variants
imports Stateful_Protocol_Composition_and_Typing.Intruder_Deduction
begin

fun term_variants where
"term_variants P (Var x) = [Var x]"
| "term_variants P (Fun f T) = (
let S = product_lists (map (term_variants P) T)
in map (Fun f) S@concat (map (\<lambda>g. map (Fun g) S) (P f)))"

inductive term_variants_pred where
term_variants_Var:
"term_variants_pred P (Var x) (Var x)"
| term_variants_P:
"\<lbrakk>length T = length S; \<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i); g \<in> set (P f)\<rbrakk>
\<Longrightarrow> term_variants_pred P (Fun f T) (Fun g S)"
| term_variants_Fun:
"\<lbrakk>length T = length S; \<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)\<rbrakk>
\<Longrightarrow> term_variants_pred P (Fun f T) (Fun f S)"

lemma term_variants_pred_inv:
assumes "term_variants_pred P (Fun f T) (Fun h S)"
shows "length T = length S"
and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)"
and "f \<noteq> h \<Longrightarrow> h \<in> set (P f)"
using assms by (auto elim: term_variants_pred.cases)

lemma term_variants_pred_inv':
assumes "term_variants_pred P (Fun f T) t"
shows "is_Fun t"
and "length T = length (args t)"
and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (args t ! i)"
and "f \<noteq> the_Fun t \<Longrightarrow> the_Fun t \<in> set (P f)"
and "P \<equiv> (\<lambda>_. [])(g := [h]) \<Longrightarrow> f \<noteq> the_Fun t \<Longrightarrow> f = g \<and> the_Fun t = h"
using assms by (auto elim: term_variants_pred.cases)

lemma term_variants_pred_inv'':
assumes "term_variants_pred P t (Fun f T)"
shows "is_Fun t"
and "length T = length (args t)"
and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (args t ! i) (T ! i)"
and "f \<noteq> the_Fun t \<Longrightarrow> f \<in> set (P (the_Fun t))"
and "P \<equiv> (\<lambda>_. [])(g := [h]) \<Longrightarrow> f \<noteq> the_Fun t \<Longrightarrow> f = h \<and> the_Fun t = g"
using assms by (auto elim: term_variants_pred.cases)

lemma term_variants_pred_inv_Var:
"term_variants_pred P (Var x) t \<longleftrightarrow> t = Var x"
"term_variants_pred P t (Var x) \<longleftrightarrow> t = Var x"
by (auto intro: term_variants_Var elim: term_variants_pred.cases)

lemma term_variants_pred_inv_const:
"term_variants_pred P (Fun c []) t \<longleftrightarrow> ((\<exists>g \<in> set (P c). t = Fun g []) \<or> (t = Fun c []))"
by (auto intro: term_variants_P term_variants_Fun elim: term_variants_pred.cases)

lemma term_variants_pred_refl: "term_variants_pred P t t"
by (induct t) (auto intro: term_variants_pred.intros)

lemma term_variants_pred_refl_inv:
assumes st: "term_variants_pred P s t"
and P: "\<forall>f. \<forall>g \<in> set (P f). f = g"
shows "s = t"
using st P
proof (induction s t rule: term_variants_pred.induct)
case (term_variants_Var P x) thus ?case by blast
next
case (term_variants_P T S P g f)
hence "T ! i = S ! i" when i: "i < length T" for i using i by blast
hence "T = S" using term_variants_P.hyps(1) by (simp add: nth_equalityI)
thus ?case using term_variants_P.prems term_variants_P.hyps(3) by fast
next
case (term_variants_Fun T S P f)
hence "T ! i = S ! i" when i: "i < length T" for i using i by blast
hence "T = S" using term_variants_Fun.hyps(1) by (simp add: nth_equalityI)
thus ?case by fast
qed

lemma term_variants_pred_const:
assumes "b \<in> set (P a)"
shows "term_variants_pred P (Fun a []) (Fun b [])"
using term_variants_P[of "[]" "[]"] assms by simp

lemma term_variants_pred_const_cases:
"P a \<noteq> [] \<Longrightarrow> term_variants_pred P (Fun a []) t \<longleftrightarrow>
(t = Fun a [] \<or> (\<exists>b \<in> set (P a). t = Fun b []))"
"P a = [] \<Longrightarrow> term_variants_pred P (Fun a []) t \<longleftrightarrow> t = Fun a []"
using term_variants_pred_inv_const[of P] by auto

lemma term_variants_pred_param:
assumes "term_variants_pred P t s"
and fg: "f = g \<or> g \<in> set (P f)"
shows "term_variants_pred P (Fun f (S@t#T)) (Fun g (S@s#T))"
proof -
have 1: "length (S@t#T) = length (S@s#T)" by simp
have "term_variants_pred P (T ! i) (T ! i)" "term_variants_pred P (S ! i) (S ! i)" for i
by (metis term_variants_pred_refl)+
hence 2: "term_variants_pred P ((S@t#T) ! i) ((S@s#T) ! i)" for i
by (simp add: assms nth_Cons' nth_append)

show ?thesis by (metis term_variants_Fun[OF 1 2] term_variants_P[OF 1 2] fg)
qed

lemma term_variants_pred_Cons:
assumes t: "term_variants_pred P t s"
and T: "term_variants_pred P (Fun f T) (Fun f S)"
and fg: "f = g \<or> g \<in> set (P f)"
shows "term_variants_pred P (Fun f (t#T)) (Fun g (s#S))"
proof -
have 1: "length (t#T) = length (s#S)"
and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)"
using term_variants_pred_inv[OF T] by simp_all
hence 2: "\<And>i. i < length (t#T) \<Longrightarrow> term_variants_pred P ((t#T) ! i) ((s#S) ! i)"
by (metis t One_nat_def diff_less length_Cons less_Suc_eq less_imp_diff_less nth_Cons'
zero_less_Suc)

show ?thesis using 1 2 fg by (auto intro: term_variants_pred.intros)
qed

lemma term_variants_pred_dense:
fixes P Q::"'a set" and fs gs::"'a list"
defines "P_fs x \<equiv> if x \<in> P then fs else []"
and "P_gs x \<equiv> if x \<in> P then gs else []"
and "Q_fs x \<equiv> if x \<in> Q then fs else []"
assumes ut: "term_variants_pred P_fs u t"
and g: "g \<in> Q" "g \<in> set gs"
shows "\<exists>s. term_variants_pred P_gs u s \<and> term_variants_pred Q_fs s t"
proof -
define F where "F \<equiv> \<lambda>(P::'a set) (fs::'a list) x. if x \<in> P then fs else []"

show ?thesis using ut g P_fs_def unfolding P_gs_def Q_fs_def
proof (induction P_fs u t arbitrary: g gs rule: term_variants_pred.induct)
case (term_variants_Var P h x) thus ?case
by (auto intro: term_variants_pred.term_variants_Var)
next
case (term_variants_P T S P' h' h g gs)
note hyps = term_variants_P.hyps(1,2,4,5,6,7)
note IH = term_variants_P.hyps(3)

have "\<exists>s. term_variants_pred (F P gs) (T ! i) s \<and> term_variants_pred (F Q fs) s (S ! i)"
when i: "i < length T" for i
using IH[OF i hyps(4,5,6)] unfolding F_def by presburger
then obtain U where U:
"length T = length U" "\<And>i. i < length T \<Longrightarrow> term_variants_pred (F P gs) (T ! i) (U ! i)"
"length U = length S" "\<And>i. i < length U \<Longrightarrow> term_variants_pred (F Q fs) (U ! i) (S ! i)"
using hyps(1) Skolem_list_nth[of _ "\<lambda>i s. term_variants_pred (F P gs) (T ! i) s \<and>
term_variants_pred (F Q fs) s (S ! i)"]
by moura

show ?case
using term_variants_pred.term_variants_P[OF U(1,2), of g h]
term_variants_pred.term_variants_P[OF U(3,4), of h' g]
hyps(3)[unfolded hyps(6)] hyps(4,5)
unfolding F_def by force
next
case (term_variants_Fun T S P' h' g gs)
note hyps = term_variants_Fun.hyps(1,2,4,5,6)
note IH = term_variants_Fun.hyps(3)

have "\<exists>s. term_variants_pred (F P gs) (T ! i) s \<and> term_variants_pred (F Q fs) s (S ! i)"
when i: "i < length T" for i
using IH[OF i hyps(3,4,5)] unfolding F_def by presburger
then obtain U where U:
"length T = length U" "\<And>i. i < length T \<Longrightarrow> term_variants_pred (F P gs) (T ! i) (U ! i)"
"length U = length S" "\<And>i. i < length U \<Longrightarrow> term_variants_pred (F Q fs) (U ! i) (S ! i)"
using hyps(1) Skolem_list_nth[of _ "\<lambda>i s. term_variants_pred (F P gs) (T ! i) s \<and>
term_variants_pred (F Q fs) s (S ! i)"]
by moura
thus ?case
using term_variants_pred.term_variants_Fun[OF U(1,2)]
term_variants_pred.term_variants_Fun[OF U(3,4)]
unfolding F_def by meson
qed
qed

lemma term_variants_pred_dense':
assumes ut: "term_variants_pred ((\<lambda>_. [])(a := [b])) u t"
shows "\<exists>s. term_variants_pred ((\<lambda>_. [])(a := [c])) u s \<and>
term_variants_pred ((\<lambda>_. [])(c := [b])) s t"
using ut term_variants_pred_dense[of "{a}" "[b]" u t c "{c}" "[c]"]
unfolding fun_upd_def by simp

lemma term_variants_pred_eq_case:
fixes t s::"('a,'b) term"
assumes "term_variants_pred P t s" "\<forall>f \<in> funs_term t. P f = []"
shows "t = s"
using assms
proof (induction P t s rule: term_variants_pred.induct)
case (term_variants_Fun T S P f) thus ?case
using subtermeq_imp_funs_term_subset[OF Fun_param_in_subterms[OF nth_mem], of _ T f]
nth_equalityI[of T S]
by blast
qed (simp_all add: term_variants_pred_refl)

lemma term_variants_pred_subst:
assumes "term_variants_pred P t s"
shows "term_variants_pred P (t \<cdot> \<delta>) (s \<cdot> \<delta>)"
using assms
proof (induction P t s rule: term_variants_pred.induct)
case (term_variants_P T S P f g)
have 1: "length (map (\<lambda>t. t \<cdot> \<delta>) T) = length (map (\<lambda>t. t \<cdot> \<delta>) S)"
using term_variants_P.hyps
by simp

have 2: "term_variants_pred P ((map (\<lambda>t. t \<cdot> \<delta>) T) ! i) ((map (\<lambda>t. t \<cdot> \<delta>) S) ! i)"
when "i < length (map (\<lambda>t. t \<cdot> \<delta>) T)" for i
using term_variants_P that
by fastforce

show ?case
using term_variants_pred.term_variants_P[OF 1 2 term_variants_P.hyps(3)]
by fastforce
next
case (term_variants_Fun T S P f)
have 1: "length (map (\<lambda>t. t \<cdot> \<delta>) T) = length (map (\<lambda>t. t \<cdot> \<delta>) S)"
using term_variants_Fun.hyps
by simp

have 2: "term_variants_pred P ((map (\<lambda>t. t \<cdot> \<delta>) T) ! i) ((map (\<lambda>t. t \<cdot> \<delta>) S) ! i)"
when "i < length (map (\<lambda>t. t \<cdot> \<delta>) T)" for i
using term_variants_Fun that
by fastforce

show ?case
using term_variants_pred.term_variants_Fun[OF 1 2]
by fastforce
qed (simp add: term_variants_pred_refl)

lemma term_variants_pred_subst':
fixes t s::"('a,'b) term" and \<delta>::"('a,'b) subst"
assumes "term_variants_pred P (t \<cdot> \<delta>) s"
and "\<forall>x \<in> fv t \<union> fv s. (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
shows "\<exists>u. term_variants_pred P t u \<and> s = u \<cdot> \<delta>"
using assms
proof (induction P "t \<cdot> \<delta>" s arbitrary: t rule: term_variants_pred.induct)
case (term_variants_Var P x g) thus ?case using term_variants_pred_refl by fast
next
case (term_variants_P T S P g f) show ?case
proof (cases t)
case (Var x) thus ?thesis
using term_variants_P.hyps(4,5) term_variants_P.prems
by fastforce
next
case (Fun h U)
hence 1: "h = f" "T = map (\<lambda>s. s \<cdot> \<delta>) U" "length U = length T"
using term_variants_P.hyps(5) by simp_all
hence 2: "T ! i = U ! i \<cdot> \<delta>" when "i < length T" for i
using that by simp

have "\<forall>x \<in> fv (U ! i) \<union> fv (S ! i). (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
when "i < length U" for i
using that Fun term_variants_P.prems term_variants_P.hyps(1) 1(3)
by force
hence IH: "\<forall>i < length U. \<exists>u. term_variants_pred P (U ! i) u \<and> S ! i = u \<cdot> \<delta>"
by (metis 1(3) term_variants_P.hyps(3)[OF _ 2])

have "\<exists>V. length U = length V \<and> S = map (\<lambda>v. v \<cdot> \<delta>) V \<and>
(\<forall>i < length U. term_variants_pred P (U ! i) (V ! i))"
using term_variants_P.hyps(1) 1(3) subst_term_list_obtain[OF IH] by metis
then obtain V where V: "length U = length V" "S = map (\<lambda>v. v \<cdot> \<delta>) V"
"\<And>i. i < length U \<Longrightarrow> term_variants_pred P (U ! i) (V ! i)"
by moura

have "term_variants_pred P (Fun f U) (Fun g V)"
by (metis term_variants_pred.term_variants_P[OF V(1,3) term_variants_P.hyps(4)])
moreover have "Fun g S = Fun g V \<cdot> \<delta>" using V(2) by simp
ultimately show ?thesis using term_variants_P.hyps(1,4) Fun 1 by blast
qed
next
case (term_variants_Fun T S P f t) show ?case
proof (cases t)
case (Var x)
hence "T = []" "P f = []" using term_variants_Fun.hyps(4) term_variants_Fun.prems by fastforce+
thus ?thesis using term_variants_pred_refl Var term_variants_Fun.hyps(1,4) by fastforce
next
case (Fun h U)
hence 1: "h = f" "T = map (\<lambda>s. s \<cdot> \<delta>) U" "length U = length T"
using term_variants_Fun.hyps(4) by simp_all
hence 2: "T ! i = U ! i \<cdot> \<delta>" when "i < length T" for i
using that by simp

have "\<forall>x \<in> fv (U ! i) \<union> fv (S ! i). (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
when "i < length U" for i
using that Fun term_variants_Fun.prems term_variants_Fun.hyps(1) 1(3)
by force
hence IH: "\<forall>i < length U. \<exists>u. term_variants_pred P (U ! i) u \<and> S ! i = u \<cdot> \<delta>"
by (metis 1(3) term_variants_Fun.hyps(3)[OF _ 2 ])

have "\<exists>V. length U = length V \<and> S = map (\<lambda>v. v \<cdot> \<delta>) V \<and>
(\<forall>i < length U. term_variants_pred P (U ! i) (V ! i))"
using term_variants_Fun.hyps(1) 1(3) subst_term_list_obtain[OF IH] by metis
then obtain V where V: "length U = length V" "S = map (\<lambda>v. v \<cdot> \<delta>) V"
"\<And>i. i < length U \<Longrightarrow> term_variants_pred P (U ! i) (V ! i)"
by moura

have "term_variants_pred P (Fun f U) (Fun f V)"
by (metis term_variants_pred.term_variants_Fun[OF V(1,3)])
moreover have "Fun f S = Fun f V \<cdot> \<delta>" using V(2) by simp
ultimately show ?thesis using term_variants_Fun.hyps(1) Fun 1 by blast
qed
qed

lemma term_variants_pred_iff_in_term_variants:
fixes t::"('a,'b) term"
shows "term_variants_pred P t s \<longleftrightarrow> s \<in> set (term_variants P t)"
(is "?A t s \<longleftrightarrow> ?B t s")
proof
define U where "U \<equiv> \<lambda>P (T::('a,'b) term list). product_lists (map (term_variants P) T)"

have a:
"g \<in> set (P f) \<Longrightarrow> set (map (Fun g) (U P T)) \<subseteq> set (term_variants P (Fun f T))"
"set (map (Fun f) (U P T)) \<subseteq> set (term_variants P (Fun f T))"
for f P g and T::"('a,'b) term list"
using term_variants.simps(2)[of P f T]
unfolding U_def Let_def by auto

have b: "\<exists>S \<in> set (U P T). s = Fun f S \<or> (\<exists>g \<in> set (P f). s = Fun g S)"
when "s \<in> set (term_variants P (Fun f T))" for P T f s
using that by (cases "P f") (auto simp add: U_def Let_def)

have c: "length T = length S" when "S \<in> set (U P T)" for S P T
using that unfolding U_def
by (simp add: in_set_product_lists_length)

show "?A t s \<Longrightarrow> ?B t s"
proof (induction P t s rule: term_variants_pred.induct)
case (term_variants_P T S P g f)
note hyps = term_variants_P.hyps
note IH = term_variants_P.IH

have "S \<in> set (U P T)"
using IH hyps(1) product_lists_in_set_nth'[of _ S]
unfolding U_def by simp
thus ?case using a(1)[of _ P, OF hyps(3)] by auto
next
case (term_variants_Fun T S P f)
note hyps = term_variants_Fun.hyps
note IH = term_variants_Fun.IH

have "S \<in> set (U P T)"
using IH hyps(1) product_lists_in_set_nth'[of _ S]
unfolding U_def by simp
thus ?case using a(2)[of f P T] by (cases "P f") auto
qed (simp add: term_variants_Var)

show "?B t s \<Longrightarrow> ?A t s"
proof (induction P t arbitrary: s rule: term_variants.induct)
case (2 P f T)
obtain S where S:
"s = Fun f S \<or> (\<exists>g \<in> set (P f). s = Fun g S)"
"S \<in> set (U P T)" "length T = length S"
using c b[OF "2.prems"] by moura

have "\<forall>i < length T. term_variants_pred P (T ! i) (S ! i)"
using "2.IH" S product_lists_in_set_nth by (fastforce simp add: U_def)
thus ?case using S by (auto intro: term_variants_pred.intros)
qed (simp add: term_variants_Var)
qed

lemma term_variants_pred_finite:
"finite {s. term_variants_pred P t s}"
using term_variants_pred_iff_in_term_variants[of P t]
by simp

lemma term_variants_pred_fv_eq:
assumes "term_variants_pred P s t"
shows "fv s = fv t"
using assms
by (induct rule: term_variants_pred.induct)
(metis, metis fv_eq_FunI, metis fv_eq_FunI)

lemma (in intruder_model) term_variants_pred_wf_trms:
assumes "term_variants_pred P s t"
and "\<And>f g. g \<in> set (P f) \<Longrightarrow> arity f = arity g"
and "wf\<^sub>t\<^sub>r\<^sub>m s"
shows "wf\<^sub>t\<^sub>r\<^sub>m t"
using assms
apply (induction rule: term_variants_pred.induct, simp)
by (metis (no_types) wf_trmI wf_trm_arity in_set_conv_nth wf_trm_param_idx)+

lemma term_variants_pred_funs_term:
assumes "term_variants_pred P s t"
and "f \<in> funs_term t"
shows "f \<in> funs_term s \<or> (\<exists>g \<in> funs_term s. f \<in> set (P g))"
using assms
proof (induction rule: term_variants_pred.induct)
case (term_variants_P T S P g h) thus ?case
proof (cases "f = g")
case False
then obtain s where "s \<in> set S" "f \<in> funs_term s"
using funs_term_subterms_eq(1)[of "Fun g S"] term_variants_P.prems by auto
thus ?thesis
using term_variants_P.IH term_variants_P.hyps(1) in_set_conv_nth[of s S] by force
qed simp
next
case (term_variants_Fun T S P h) thus ?case
proof (cases "f = h")
case False
then obtain s where "s \<in> set S" "f \<in> funs_term s"
using funs_term_subterms_eq(1)[of "Fun h S"] term_variants_Fun.prems by auto
thus ?thesis
using term_variants_Fun.IH term_variants_Fun.hyps(1) in_set_conv_nth[of s S] by force
qed simp
qed fast

end

+ 966
- 0
Automated_Stateful_Protocol_Verification/Transactions.thy View File

@@ -0,0 +1,966 @@
(*
(C) Copyright Andreas Viktor Hess, DTU, 2020
(C) Copyright Sebastian A. Mödersheim, DTU, 2020
(C) Copyright Achim D. Brucker, University of Exeter, 2020
(C) Copyright Anders Schlichtkrull, DTU, 2020

All Rights Reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

- Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

- Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

- Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products
derived from this software without specific prior written
permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(* Title: Transactions.thy
Author: Andreas Viktor Hess, DTU
Author: Sebastian A. Mödersheim, DTU
Author: Achim D. Brucker, University of Exeter
Author: Anders Schlichtkrull, DTU
*)

section\<open>Protocol Transactions\<close>
theory Transactions
imports
Stateful_Protocol_Composition_and_Typing.Typed_Model
Stateful_Protocol_Composition_and_Typing.Labeled_Stateful_Strands
begin

subsection \<open>Definitions\<close>
datatype 'b prot_atom =
is_Atom: Atom 'b
| Value
| SetType
| AttackType
| Bottom
| OccursSecType

datatype ('a,'b,'c) prot_fun =
Fu (the_Fu: 'a)
| Set (the_Set: 'c)
| Val (the_Val: "nat \<times> bool")
| Abs (the_Abs: "'c set")
| Pair
| Attack nat
| PubConstAtom 'b nat
| PubConstSetType nat
| PubConstAttackType nat
| PubConstBottom nat
| PubConstOccursSecType nat
| OccursFact
| OccursSec

definition "is_Fun_Set t \<equiv> is_Fun t \<and> args t = [] \<and> is_Set (the_Fun t)"

abbreviation occurs where
"occurs t \<equiv> Fun OccursFact [Fun OccursSec [], t]"

type_synonym ('a,'b,'c) prot_term_type = "(('a,'b,'c) prot_fun,'b prot_atom) term_type"

type_synonym ('a,'b,'c) prot_var = "('a,'b,'c) prot_term_type \<times> nat"

type_synonym ('a,'b,'c) prot_term = "(('a,'b,'c) prot_fun,('a,'b,'c) prot_var) term"
type_synonym ('a,'b,'c) prot_terms = "('a,'b,'c) prot_term set"

type_synonym ('a,'b,'c) prot_subst = "(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var) subst"

type_synonym ('a,'b,'c,'d) prot_strand_step =
"(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var, 'd) labeled_stateful_strand_step"
type_synonym ('a,'b,'c,'d) prot_strand = "('a,'b,'c,'d) prot_strand_step list"
type_synonym ('a,'b,'c,'d) prot_constr = "('a,'b,'c,'d) prot_strand_step list"

datatype ('a,'b,'c,'d) prot_transaction =
Transaction
(transaction_fresh: "('a,'b,'c) prot_var list")
(transaction_receive: "('a,'b,'c,'d) prot_strand")
(transaction_selects: "('a,'b,'c,'d) prot_strand")
(transaction_checks: "('a,'b,'c,'d) prot_strand")
(transaction_updates: "('a,'b,'c,'d) prot_strand")
(transaction_send: "('a,'b,'c,'d) prot_strand")

definition transaction_strand where
"transaction_strand T \<equiv>
transaction_receive T@transaction_selects T@transaction_checks T@
transaction_updates T@transaction_send T"

fun transaction_proj where
"transaction_proj l (Transaction A B C D E F) = (
let f = proj l
in Transaction A (f B) (f C) (f D) (f E) (f F))"

fun transaction_star_proj where
"transaction_star_proj (Transaction A B C D E F) = (
let f = filter is_LabelS
in Transaction A (f B) (f C) (f D) (f E) (f F))"

abbreviation fv_transaction where
"fv_transaction T \<equiv> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"

abbreviation bvars_transaction where
"bvars_transaction T \<equiv> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"

abbreviation vars_transaction where
"vars_transaction T \<equiv> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"

abbreviation trms_transaction where
"trms_transaction T \<equiv> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)"

abbreviation setops_transaction where
"setops_transaction T \<equiv> setops\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_strand T))"

definition wellformed_transaction where
"wellformed_transaction T \<equiv>
list_all is_Receive (unlabel (transaction_receive T)) \<and>
list_all is_Assignment (unlabel (transaction_selects T)) \<and>
list_all is_Check (unlabel (transaction_checks T)) \<and>
list_all is_Update (unlabel (transaction_updates T)) \<and>
list_all is_Send (unlabel (transaction_send T)) \<and>
set (transaction_fresh T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<and>
set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {} \<and>
set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {} \<and>
fv_transaction T \<inter> bvars_transaction T = {} \<and>
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<and>
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) - set (transaction_fresh T)
\<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<and>
(\<forall>x \<in> set (unlabel (transaction_selects T)).
is_Equality x \<longrightarrow> fv (the_rhs x) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T))"

type_synonym ('a,'b,'c,'d) prot = "('a,'b,'c,'d) prot_transaction list"

abbreviation Var_Value_term ("\<langle>_\<rangle>\<^sub>v") where
"\<langle>n\<rangle>\<^sub>v \<equiv> Var (Var Value, n)::('a,'b,'c) prot_term"

abbreviation Fun_Fu_term ("\<langle>_ _\<rangle>\<^sub>t") where
"\<langle>f T\<rangle>\<^sub>t \<equiv> Fun (Fu f) T::('a,'b,'c) prot_term"

abbreviation Fun_Fu_const_term ("\<langle>_\<rangle>\<^sub>c") where
"\<langle>c\<rangle>\<^sub>c \<equiv> Fun (Fu c) []::('a,'b,'c) prot_term"

abbreviation Fun_Set_const_term ("\<langle>_\<rangle>\<^sub>s") where
"\<langle>f\<rangle>\<^sub>s \<equiv> Fun (Set f) []::('a,'b,'c) prot_term"

abbreviation Fun_Abs_const_term ("\<langle>_\<rangle>\<^sub>a") where
"\<langle>a\<rangle>\<^sub>a \<equiv> Fun (Abs a) []::('a,'b,'c) prot_term"

abbreviation Fun_Attack_const_term ("attack\<langle>_\<rangle>") where
"attack\<langle>n\<rangle> \<equiv> Fun (Attack n) []::('a,'b,'c) prot_term"

abbreviation prot_transaction1 ("transaction\<^sub>1 _ _ new _ _ _") where
"transaction\<^sub>1 (S1::('a,'b,'c,'d) prot_strand) S2 new (B::('a,'b,'c) prot_term list) S3 S4
\<equiv> Transaction (map the_Var B) S1 [] S2 S3 S4"

abbreviation prot_transaction2 ("transaction\<^sub>2 _ _ _ _") where
"transaction\<^sub>2 (S1::('a,'b,'c,'d) prot_strand) S2 S3 S4
\<equiv> Transaction [] S1 [] S2 S3 S4"


subsection \<open>Lemmata\<close>

lemma prot_atom_UNIV:
"(UNIV::'b prot_atom set) = range Atom \<union> {Value, SetType, AttackType, Bottom, OccursSecType}"
proof -
have "a \<in> range Atom \<or> a = Value \<or> a = SetType \<or> a = AttackType \<or> a = Bottom \<or> a = OccursSecType"
for a::"'b prot_atom"
by (cases a) auto
thus ?thesis by auto
qed

instance prot_atom::(finite) finite
by intro_classes (simp add: prot_atom_UNIV)

instantiation prot_atom::(enum) enum
begin
definition "enum_prot_atom == map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType]"
definition "enum_all_prot_atom P == list_all P (map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType])"
definition "enum_ex_prot_atom P == list_ex P (map Atom enum_class.enum@[Value, SetType, AttackType, Bottom, OccursSecType])"

instance
proof intro_classes
have *: "set (map Atom (enum_class.enum::'a list)) = range Atom"
"distinct (enum_class.enum::'a list)"
using UNIV_enum enum_distinct by auto

show "(UNIV::'a prot_atom set) = set enum_class.enum"
using *(1) by (simp add: prot_atom_UNIV enum_prot_atom_def)

have "set (map Atom enum_class.enum) \<inter> set [Value, SetType, AttackType, Bottom, OccursSecType] = {}" by auto
moreover have "inj_on Atom (set (enum_class.enum::'a list))" unfolding inj_on_def by auto
hence "distinct (map Atom (enum_class.enum::'a list))" by (metis *(2) distinct_map)
ultimately show "distinct (enum_class.enum::'a prot_atom list)" by (simp add: enum_prot_atom_def)

have "Ball UNIV P \<longleftrightarrow> Ball (range Atom) P \<and> Ball {Value, SetType, AttackType, Bottom, OccursSecType} P"
for P::"'a prot_atom \<Rightarrow> bool"
by (metis prot_atom_UNIV UNIV_I UnE)
thus "enum_class.enum_all P = Ball (UNIV::'a prot_atom set) P" for P
using *(1) Ball_set[of "map Atom enum_class.enum" P]
by (auto simp add: enum_all_prot_atom_def)

have "Bex UNIV P \<longleftrightarrow> Bex (range Atom) P \<or> Bex {Value, SetType, AttackType, Bottom, OccursSecType} P"
for P::"'a prot_atom \<Rightarrow> bool"
by (metis prot_atom_UNIV UNIV_I UnE)
thus "enum_class.enum_ex P = Bex (UNIV::'a prot_atom set) P" for P
using *(1) Bex_set[of "map Atom enum_class.enum" P]
by (auto simp add: enum_ex_prot_atom_def)
qed
end

lemma wellformed_transaction_cases:
assumes "wellformed_transaction T"
shows
"(l,x) \<in> set (transaction_receive T) \<Longrightarrow> \<exists>t. x = receive\<langle>t\<rangle>" (is "?A \<Longrightarrow> ?A'")
"(l,x) \<in> set (transaction_selects T) \<Longrightarrow>
(\<exists>t s. x = \<langle>t := s\<rangle>) \<or> (\<exists>t s. x = select\<langle>t,s\<rangle>)" (is "?B \<Longrightarrow> ?B'")
"(l,x) \<in> set (transaction_checks T) \<Longrightarrow>
(\<exists>t s. x = \<langle>t == s\<rangle>) \<or> (\<exists>t s. x = \<langle>t in s\<rangle>) \<or> (\<exists>X F G. x = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)" (is "?C \<Longrightarrow> ?C'")
"(l,x) \<in> set (transaction_updates T) \<Longrightarrow>
(\<exists>t s. x = insert\<langle>t,s\<rangle>) \<or> (\<exists>t s. x = delete\<langle>t,s\<rangle>)" (is "?D \<Longrightarrow> ?D'")
"(l,x) \<in> set (transaction_send T) \<Longrightarrow> \<exists>t. x = send\<langle>t\<rangle>" (is "?E \<Longrightarrow> ?E'")
proof -
have a:
"list_all is_Receive (unlabel (transaction_receive T))"
"list_all is_Assignment (unlabel (transaction_selects T))"
"list_all is_Check (unlabel (transaction_checks T))"
"list_all is_Update (unlabel (transaction_updates T))"
"list_all is_Send (unlabel (transaction_send T))"
using assms unfolding wellformed_transaction_def by metis+

note b = Ball_set unlabel_in
note c = stateful_strand_step.collapse

show "?A \<Longrightarrow> ?A'" by (metis (mono_tags, lifting) a(1) b c(2))
show "?B \<Longrightarrow> ?B'" by (metis (mono_tags, lifting) a(2) b c(3,6))
show "?C \<Longrightarrow> ?C'" by (metis (mono_tags, lifting) a(3) b c(3,6,7))
show "?D \<Longrightarrow> ?D'" by (metis (mono_tags, lifting) a(4) b c(4,5))
show "?E \<Longrightarrow> ?E'" by (metis (mono_tags, lifting) a(5) b c(1))
qed

lemma wellformed_transaction_unlabel_cases:
assumes "wellformed_transaction T"
shows
"x \<in> set (unlabel (transaction_receive T)) \<Longrightarrow> \<exists>t. x = receive\<langle>t\<rangle>" (is "?A \<Longrightarrow> ?A'")
"x \<in> set (unlabel (transaction_selects T)) \<Longrightarrow>
(\<exists>t s. x = \<langle>t := s\<rangle>) \<or> (\<exists>t s. x = select\<langle>t,s\<rangle>)" (is "?B \<Longrightarrow> ?B'")
"x \<in> set (unlabel (transaction_checks T)) \<Longrightarrow>
(\<exists>t s. x = \<langle>t == s\<rangle>) \<or> (\<exists>t s. x = \<langle>t in s\<rangle>) \<or> (\<exists>X F G. x = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle>)"
(is "?C \<Longrightarrow> ?C'")
"x \<in> set (unlabel (transaction_updates T)) \<Longrightarrow>
(\<exists>t s. x = insert\<langle>t,s\<rangle>) \<or> (\<exists>t s. x = delete\<langle>t,s\<rangle>)" (is "?D \<Longrightarrow> ?D'")
"x \<in> set (unlabel (transaction_send T)) \<Longrightarrow> \<exists>t. x = send\<langle>t\<rangle>" (is "?E \<Longrightarrow> ?E'")
proof -
have a:
"list_all is_Receive (unlabel (transaction_receive T))"
"list_all is_Assignment (unlabel (transaction_selects T))"
"list_all is_Check (unlabel (transaction_checks T))"
"list_all is_Update (unlabel (transaction_updates T))"
"list_all is_Send (unlabel (transaction_send T))"
using assms unfolding wellformed_transaction_def by metis+

note b = Ball_set
note c = stateful_strand_step.collapse

show "?A \<Longrightarrow> ?A'" by (metis (mono_tags, lifting) a(1) b c(2))
show "?B \<Longrightarrow> ?B'" by (metis (mono_tags, lifting) a(2) b c(3,6))
show "?C \<Longrightarrow> ?C'" by (metis (mono_tags, lifting) a(3) b c(3,6,7))
show "?D \<Longrightarrow> ?D'" by (metis (mono_tags, lifting) a(4) b c(4,5))
show "?E \<Longrightarrow> ?E'" by (metis (mono_tags, lifting) a(5) b c(1))
qed

lemma transaction_strand_subsets[simp]:
"set (transaction_receive T) \<subseteq> set (transaction_strand T)"
"set (transaction_selects T) \<subseteq> set (transaction_strand T)"
"set (transaction_checks T) \<subseteq> set (transaction_strand T)"
"set (transaction_updates T) \<subseteq> set (transaction_strand T)"
"set (transaction_send T) \<subseteq> set (transaction_strand T)"
"set (unlabel (transaction_receive T)) \<subseteq> set (unlabel (transaction_strand T))"
"set (unlabel (transaction_selects T)) \<subseteq> set (unlabel (transaction_strand T))"
"set (unlabel (transaction_checks T)) \<subseteq> set (unlabel (transaction_strand T))"
"set (unlabel (transaction_updates T)) \<subseteq> set (unlabel (transaction_strand T))"
"set (unlabel (transaction_send T)) \<subseteq> set (unlabel (transaction_strand T))"
unfolding transaction_strand_def unlabel_def by force+

lemma transaction_strand_subst_subsets[simp]:
"set (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
"set (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
"set (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
"set (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
"set (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<subseteq> set (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
"set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
"set (unlabel (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
"set (unlabel (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
"set (unlabel (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
"set (unlabel (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) \<subseteq> set (unlabel (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
unfolding transaction_strand_def unlabel_def subst_apply_labeled_stateful_strand_def by force+

lemma transaction_dual_subst_unfold:
"unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)) =
unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@
unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@
unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@
unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))@
unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
by (simp add: transaction_strand_def unlabel_append dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append subst_lsst_append)

lemma trms_transaction_unfold:
"trms_transaction T =
trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
by (metis trms\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def)

lemma trms_transaction_subst_unfold:
"trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
by (metis trms\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append)

lemma vars_transaction_unfold:
"vars_transaction T =
vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
by (metis vars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def)

lemma vars_transaction_subst_unfold:
"vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
by (metis vars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append)

lemma fv_transaction_unfold:
"fv_transaction T =
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
by (metis fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def)

lemma fv_transaction_subst_unfold:
"fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
by (metis fv\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append)

lemma fv_wellformed_transaction_unfold:
assumes "wellformed_transaction T"
shows "fv_transaction T =
fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union> set (transaction_fresh T)"
proof -
let ?A = "set (transaction_fresh T)"
let ?B = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T)"
let ?C = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
let ?D = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
let ?E = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
let ?F = "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)"

have "?A \<subseteq> ?B \<union> ?C" "?A \<inter> ?D = {}" "?A \<inter> ?E = {}" "?F \<subseteq> ?D \<union> ?E" "?B \<union> ?C - ?A \<subseteq> ?D \<union> ?E"
using assms unfolding wellformed_transaction_def by fast+
thus ?thesis using fv_transaction_unfold by blast
qed

lemma bvars_transaction_unfold:
"bvars_transaction T =
bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) \<union>
bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union>
bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
by (metis bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def)

lemma bvars_transaction_subst_unfold:
"bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) =
bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<union>
bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
by (metis bvars\<^sub>s\<^sub>s\<^sub>t_append unlabel_append append_assoc transaction_strand_def subst_lsst_append)

lemma bvars_wellformed_transaction_unfold:
assumes "wellformed_transaction T"
shows "bvars_transaction T = bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?A)
and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}" (is ?B)
and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}" (is ?C)
and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) = {}" (is ?D)
and "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) = {}" (is ?E)
proof -
have 0: "list_all is_Receive (unlabel (transaction_receive T))"
"list_all is_Assignment (unlabel (transaction_selects T))"
"list_all is_Update (unlabel (transaction_updates T))"
"list_all is_Send (unlabel (transaction_send T))"
using assms unfolding wellformed_transaction_def by metis+

have "filter is_NegChecks (unlabel (transaction_receive T)) = []"
"filter is_NegChecks (unlabel (transaction_selects T)) = []"
"filter is_NegChecks (unlabel (transaction_updates T)) = []"
"filter is_NegChecks (unlabel (transaction_send T)) = []"
using list_all_filter_nil[OF 0(1), of is_NegChecks]
list_all_filter_nil[OF 0(2), of is_NegChecks]
list_all_filter_nil[OF 0(3), of is_NegChecks]
list_all_filter_nil[OF 0(4), of is_NegChecks]
stateful_strand_step.distinct_disc(11,21,29,35,39,41)
by blast+
thus ?A ?B ?C ?D ?E
using bvars_transaction_unfold[of T]
bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_receive T)"]
bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_selects T)"]
bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_updates T)"]
bvars\<^sub>s\<^sub>s\<^sub>t_NegChecks[of "unlabel (transaction_send T)"]
by (metis bvars\<^sub>s\<^sub>s\<^sub>t_def UnionE emptyE list.set(1) list.simps(8) subsetI subset_Un_eq sup_commute)+
qed

lemma transaction_strand_memberD[dest]:
assumes "x \<in> set (transaction_strand T)"
shows "x \<in> set (transaction_receive T) \<or> x \<in> set (transaction_selects T) \<or>
x \<in> set (transaction_checks T) \<or> x \<in> set (transaction_updates T) \<or>
x \<in> set (transaction_send T)"
using assms by (simp add: transaction_strand_def)

lemma transaction_strand_unlabel_memberD[dest]:
assumes "x \<in> set (unlabel (transaction_strand T))"
shows "x \<in> set (unlabel (transaction_receive T)) \<or> x \<in> set (unlabel (transaction_selects T)) \<or>
x \<in> set (unlabel (transaction_checks T)) \<or> x \<in> set (unlabel (transaction_updates T)) \<or>
x \<in> set (unlabel (transaction_send T))"
using assms by (simp add: unlabel_def transaction_strand_def)

lemma wellformed_transaction_strand_memberD[dest]:
assumes "wellformed_transaction T" and "(l,x) \<in> set (transaction_strand T)"
shows
"x = receive\<langle>t\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_receive T)" (is "?A \<Longrightarrow> ?A'")
"x = select\<langle>t,s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_selects T)" (is "?B \<Longrightarrow> ?B'")
"x = \<langle>t == s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_checks T)" (is "?C \<Longrightarrow> ?C'")
"x = \<langle>t in s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_checks T)" (is "?D \<Longrightarrow> ?D'")
"x = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_checks T)" (is "?E \<Longrightarrow> ?E'")
"x = insert\<langle>t,s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_updates T)" (is "?F \<Longrightarrow> ?F'")
"x = delete\<langle>t,s\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_updates T)" (is "?G \<Longrightarrow> ?G'")
"x = send\<langle>t\<rangle> \<Longrightarrow> (l,x) \<in> set (transaction_send T)" (is "?H \<Longrightarrow> ?H'")
proof -
have "(l,x) \<in> set (transaction_receive T) \<or> (l,x) \<in> set (transaction_selects T) \<or>
(l,x) \<in> set (transaction_checks T) \<or> (l,x) \<in> set (transaction_updates T) \<or>
(l,x) \<in> set (transaction_send T)"
using assms(2) by auto
thus "?A \<Longrightarrow> ?A'" "?B \<Longrightarrow> ?B'" "?C \<Longrightarrow> ?C'" "?D \<Longrightarrow> ?D'"
"?E \<Longrightarrow> ?E'" "?F \<Longrightarrow> ?F'" "?G \<Longrightarrow> ?G'" "?H \<Longrightarrow> ?H'"
using wellformed_transaction_cases[OF assms(1)] by fast+
qed

lemma wellformed_transaction_strand_unlabel_memberD[dest]:
assumes "wellformed_transaction T" and "x \<in> set (unlabel (transaction_strand T))"
shows
"x = receive\<langle>t\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_receive T))" (is "?A \<Longrightarrow> ?A'")
"x = select\<langle>t,s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_selects T))" (is "?B \<Longrightarrow> ?B'")
"x = \<langle>t == s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_checks T))" (is "?C \<Longrightarrow> ?C'")
"x = \<langle>t in s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_checks T))" (is "?D \<Longrightarrow> ?D'")
"x = \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: G\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_checks T))" (is "?E \<Longrightarrow> ?E'")
"x = insert\<langle>t,s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_updates T))" (is "?F \<Longrightarrow> ?F'")
"x = delete\<langle>t,s\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_updates T))" (is "?G \<Longrightarrow> ?G'")
"x = send\<langle>t\<rangle> \<Longrightarrow> x \<in> set (unlabel (transaction_send T))" (is "?H \<Longrightarrow> ?H'")
proof -
have "x \<in> set (unlabel (transaction_receive T)) \<or> x \<in> set (unlabel (transaction_selects T)) \<or>
x \<in> set (unlabel (transaction_checks T)) \<or> x \<in> set (unlabel (transaction_updates T)) \<or>
x \<in> set (unlabel (transaction_send T))"
using assms(2) by auto
thus "?A \<Longrightarrow> ?A'" "?B \<Longrightarrow> ?B'" "?C \<Longrightarrow> ?C'" "?D \<Longrightarrow> ?D'"
"?E \<Longrightarrow> ?E'" "?F \<Longrightarrow> ?F'" "?G \<Longrightarrow> ?G'" "?H \<Longrightarrow> ?H'"
using wellformed_transaction_unlabel_cases[OF assms(1)] by fast+
qed

lemma wellformed_transaction_send_receive_trm_cases:
assumes T: "wellformed_transaction T"
shows "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<Longrightarrow> receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T))"
and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<Longrightarrow> send\<langle>t\<rangle> \<in> set (unlabel (transaction_send T))"
using wellformed_transaction_unlabel_cases(1,5)[OF T]
trms\<^sub>s\<^sub>s\<^sub>t_in[of t "unlabel (transaction_receive T)"]
trms\<^sub>s\<^sub>s\<^sub>t_in[of t "unlabel (transaction_send T)"]
by fastforce+

lemma wellformed_transaction_send_receive_subst_trm_cases:
assumes T: "wellformed_transaction T"
shows "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<Longrightarrow> receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<Longrightarrow> send\<langle>t\<rangle> \<in> set (unlabel (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
proof -
assume "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
then obtain s where s: "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" "t = s \<cdot> \<theta>"
by blast
hence "receive\<langle>s\<rangle> \<in> set (unlabel (transaction_receive T))"
using wellformed_transaction_send_receive_trm_cases(1)[OF T] by simp
thus "receive\<langle>t\<rangle> \<in> set (unlabel (transaction_receive T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
by (metis s(2) unlabel_subst[of _ \<theta>] stateful_strand_step_subst_inI(2))
next
assume "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
then obtain s where s: "s \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)" "t = s \<cdot> \<theta>"
by blast
hence "send\<langle>s\<rangle> \<in> set (unlabel (transaction_send T))"
using wellformed_transaction_send_receive_trm_cases(2)[OF T] by simp
thus "send\<langle>t\<rangle> \<in> set (unlabel (transaction_send T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>))"
by (metis s(2) unlabel_subst[of _ \<theta>] stateful_strand_step_subst_inI(1))
qed

lemma wellformed_transaction_send_receive_fv_subset:
assumes T: "wellformed_transaction T"
shows "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<Longrightarrow> fv t \<subseteq> fv_transaction T" (is "?A \<Longrightarrow> ?A'")
and "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<Longrightarrow> fv t \<subseteq> fv_transaction T" (is "?B \<Longrightarrow> ?B'")
proof -
have "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<Longrightarrow> receive\<langle>t\<rangle> \<in> set (unlabel (transaction_strand T))"
"t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T) \<Longrightarrow> send\<langle>t\<rangle> \<in> set (unlabel (transaction_strand T))"
using wellformed_transaction_send_receive_trm_cases[OF T, of t]
unfolding transaction_strand_def by force+
thus "?A \<Longrightarrow> ?A'" "?B \<Longrightarrow> ?B'" by (induct "transaction_strand T") auto
qed

lemma dual_wellformed_transaction_ident_cases[dest]:
"list_all is_Assignment (unlabel S) \<Longrightarrow> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S"
"list_all is_Check (unlabel S) \<Longrightarrow> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S"
"list_all is_Update (unlabel S) \<Longrightarrow> dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S = S"
proof (induction S)
case (Cons s S)
obtain l x where s: "s = (l,x)" by moura
{ case 1 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto }
{ case 2 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto }
{ case 3 thus ?case using Cons s unfolding unlabel_def dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by (cases x) auto }
qed simp_all

lemma wellformed_transaction_wf\<^sub>s\<^sub>s\<^sub>t:
fixes T::"('a, 'b, 'c, 'd) prot_transaction"
assumes T: "wellformed_transaction T"
shows "wf'\<^sub>s\<^sub>s\<^sub>t (set (transaction_fresh T)) (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" (is ?A)
and "fv_transaction T \<inter> bvars_transaction T = {}" (is ?B)
and "set (transaction_fresh T) \<inter> bvars_transaction T = {}" (is ?C)
proof -
define T1 where "T1 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T))"
define T2 where "T2 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T))"
define T3 where "T3 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T))"
define T4 where "T4 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T))"
define T5 where "T5 \<equiv> unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T))"

define X where "X \<equiv> set (transaction_fresh T)"
define Y where "Y \<equiv> X \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1"
define Z where "Z \<equiv> Y \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2"

define f where "f \<equiv> \<lambda>S::(('a,'b,'c) prot_fun, ('a,'b,'c) prot_var) stateful_strand.
\<Union>((\<lambda>x. case x of
Receive t \<Rightarrow> fv t
| Equality Assign _ t' \<Rightarrow> fv t'
| Insert t t' \<Rightarrow> fv t \<union> fv t'
| _ \<Rightarrow> {}) ` set S)"

note defs1 = T1_def T2_def T3_def T4_def T5_def
note defs2 = X_def Y_def Z_def
note defs3 = f_def

have 0: "wf'\<^sub>s\<^sub>s\<^sub>t V (S @ S')"
when "wf'\<^sub>s\<^sub>s\<^sub>t V S" "f S' \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t S \<union> V" for V S S'
by (metis that wf\<^sub>s\<^sub>s\<^sub>t_append_suffix' f_def)

have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) = T1@T2@T3@T4@T5"
using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append unlabel_append unfolding transaction_strand_def defs1 by simp

have 2:
"\<forall>x \<in> set T1. is_Send x" "\<forall>x \<in> set T2. is_Assignment x" "\<forall>x \<in> set T3. is_Check x"
"\<forall>x \<in> set T4. is_Update x" "\<forall>x \<in> set T5. is_Receive x"
"fv\<^sub>s\<^sub>s\<^sub>t T3 \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t T1 \<union> fv\<^sub>s\<^sub>s\<^sub>t T2" "fv\<^sub>s\<^sub>s\<^sub>t T4 \<union> fv\<^sub>s\<^sub>s\<^sub>t T5 \<subseteq> X \<union> fv\<^sub>s\<^sub>s\<^sub>t T1 \<union> fv\<^sub>s\<^sub>s\<^sub>t T2"
"X \<inter> fv\<^sub>s\<^sub>s\<^sub>t T1 = {}" "X \<inter> fv\<^sub>s\<^sub>s\<^sub>t T2 = {}"
"\<forall>x \<in> set T2. is_Equality x \<longrightarrow> fv (the_rhs x) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t T1"
using T unfolding defs1 defs2 wellformed_transaction_def
by (auto simp add: Ball_set dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_list_all fv\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq simp del: fv\<^sub>s\<^sub>s\<^sub>t_def)

have 3: "wf'\<^sub>s\<^sub>s\<^sub>t X T1" using 2(1)
proof (induction T1 arbitrary: X)
case (Cons s T)
obtain t where "s = send\<langle>t\<rangle>" using Cons.prems by (cases s) moura+
thus ?case using Cons by auto
qed simp

have 4: "f T1 = {}" "fv\<^sub>s\<^sub>s\<^sub>t T1 = wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1" using 2(1)
proof (induction T1)
case (Cons s T)
{ case 1 thus ?case using Cons unfolding defs3 by (cases s) auto }
{ case 2 thus ?case using Cons unfolding defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by (cases s) auto }
qed (simp_all add: defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def)

have 5: "f T2 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1" "fv\<^sub>s\<^sub>s\<^sub>t T2 = f T2 \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2" using 2(2,10)
proof (induction T2)
case (Cons s T)
{ case 1 thus ?case using Cons
proof (cases s)
case (Equality ac t t') thus ?thesis using 1 Cons 4(2) unfolding defs3 by (cases ac) auto
qed (simp_all add: defs3)
}
{ case 2 thus ?case using Cons
proof (cases s)
case (Equality ac t t')
hence "ac = Assign" "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s = fv t' \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "f (s#T) = fv t' \<union> f T"
using 2 unfolding defs3 by auto
moreover have "fv\<^sub>s\<^sub>s\<^sub>t T = f T \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T" using Cons.IH(2) 2 by auto
ultimately show ?thesis unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by auto
next
case (InSet ac t t')
hence "ac = Assign" "fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p s = wfvarsoccs\<^sub>s\<^sub>s\<^sub>t\<^sub>p s" "f (s#T) = f T"
using 2 unfolding defs3 by auto
moreover have "fv\<^sub>s\<^sub>s\<^sub>t T = f T \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T" using Cons.IH(2) 2 by auto
ultimately show ?thesis unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def by auto
qed (simp_all add: defs3)
}
qed (simp_all add: defs3 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def fv\<^sub>s\<^sub>s\<^sub>t_def)

have "f T \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t T" for T
proof
fix x show "x \<in> f T \<Longrightarrow> x \<in> fv\<^sub>s\<^sub>s\<^sub>t T"
proof (induction T)
case (Cons s T) thus ?case
proof (cases "x \<in> f T")
case False thus ?thesis
using Cons.prems unfolding defs3 fv\<^sub>s\<^sub>s\<^sub>t_def
by (auto split: stateful_strand_step.splits poscheckvariant.splits)
qed auto
qed (simp add: defs3 fv\<^sub>s\<^sub>s\<^sub>t_def)
qed
hence 6:
"f T3 \<subseteq> X \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2"
"f T4 \<subseteq> X \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2"
"f T5 \<subseteq> X \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \<union> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T2"
using 2(6,7) 4 5 by blast+

have 7:
"wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T3 = {}"
"wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T4 = {}"
"wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T5 = {}"
using 2(3,4,5) unfolding wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_def
by (auto split: stateful_strand_step.splits)

have 8:
"f T2 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t T1 \<union> X"
"f T3 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (T1@T2) \<union> X"
"f T4 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t ((T1@T2)@T3) \<union> X"
"f T5 \<subseteq> wfvarsoccs\<^sub>s\<^sub>s\<^sub>t (((T1@T2)@T3)@T4) \<union> X"
using 4(1) 5(1) 6 7 wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of T1 T2]
wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of "T1@T2" T3]
wfvarsoccs\<^sub>s\<^sub>s\<^sub>t_append[of "(T1@T2)@T3" T4]
by blast+
have "wf'\<^sub>s\<^sub>s\<^sub>t X (T1@T2@T3@T4@T5)"
using 0[OF 0[OF 0[OF 0[OF 3 8(1)] 8(2)] 8(3)] 8(4)]
unfolding Y_def Z_def by simp
thus ?A using 1 unfolding defs1 defs2 by simp

have "set (transaction_fresh T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
"fv_transaction T \<inter> bvars_transaction T = {}"
using T unfolding wellformed_transaction_def by fast+
thus ?B ?C using fv_transaction_unfold[of T] bvars_transaction_unfold[of T] by blast+
qed

lemma dual_wellformed_transaction_ident_cases'[dest]:
assumes "wellformed_transaction T"
shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = transaction_selects T"
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = transaction_checks T"
"dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) = transaction_updates T"
using assms unfolding wellformed_transaction_def by auto

lemma dual_transaction_strand:
assumes "wellformed_transaction T"
shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) =
dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)@transaction_selects T@transaction_checks T@
transaction_updates T@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
using dual_wellformed_transaction_ident_cases'[OF assms] dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_append
unfolding transaction_strand_def by metis

lemma dual_unlabel_transaction_strand:
assumes "wellformed_transaction T"
shows "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)) =
(unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)))@(unlabel (transaction_selects T))@
(unlabel (transaction_checks T))@(unlabel (transaction_updates T))@
(unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)))"
using dual_transaction_strand[OF assms] by (simp add: unlabel_def)

lemma dual_transaction_strand_subst:
assumes "wellformed_transaction T"
shows "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
(dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)@transaction_selects T@transaction_checks T@
transaction_updates T@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"
proof -
have "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"
using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst by metis
thus ?thesis using dual_transaction_strand[OF assms] by argo
qed

lemma dual_transaction_ik_is_transaction_send:
assumes "wellformed_transaction T"
shows "ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))) = trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T))"
(is "?A = ?B")
proof -
{ fix t assume "t \<in> ?A"
hence "receive\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))" by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
hence "send\<langle>t\<rangle> \<in> set (unlabel (transaction_strand T))"
using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by metis
hence "t \<in> ?B" using wellformed_transaction_strand_unlabel_memberD(8)[OF assms] by force
} moreover {
fix t assume "t \<in> ?B"
hence "send\<langle>t\<rangle> \<in> set (unlabel (transaction_send T))"
using wellformed_transaction_unlabel_cases(5)[OF assms] by fastforce
hence "receive\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)))"
using dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_unlabel_steps_iff(1) by metis
hence "receive\<langle>t\<rangle> \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)))"
using dual_unlabel_transaction_strand[OF assms] by simp
hence "t \<in> ?A" by (simp add: ik\<^sub>s\<^sub>s\<^sub>t_def)
} ultimately show "?A = ?B" by auto
qed

lemma dual_transaction_ik_is_transaction_send':
fixes \<delta>::"('a,'b,'c) prot_subst"
assumes "wellformed_transaction T"
shows "ik\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))) =
trms\<^sub>s\<^sub>s\<^sub>t (unlabel (transaction_send T)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>" (is "?A = ?B")
using dual_transaction_ik_is_transaction_send[OF assms]
subst_lsst_unlabel[of "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T)" \<delta>]
ik\<^sub>s\<^sub>s\<^sub>t_subst[of "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_strand T))" \<delta>]
dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst[of "transaction_strand T" \<delta>]
by auto

lemma db\<^sub>s\<^sub>s\<^sub>t_transaction_prefix_eq:
assumes T: "wellformed_transaction T"
and S: "prefix S (transaction_receive T@transaction_selects T@transaction_checks T)"
shows "db\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = db\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))"
proof -
let ?T1 = "transaction_receive T"
let ?T2 = "transaction_selects T"
let ?T3 = "transaction_checks T"

have *: "prefix (unlabel S) (unlabel (?T1@?T2@?T3))" using S prefix_proj(1) by blast

have "list_all is_Receive (unlabel ?T1)"
"list_all is_Assignment (unlabel ?T2)"
"list_all is_Check (unlabel ?T3)"
using T by (simp_all add: wellformed_transaction_def)
hence "\<forall>b \<in> set (unlabel ?T1). \<not>is_Insert b \<and> \<not>is_Delete b"
"\<forall>b \<in> set (unlabel ?T2). \<not>is_Insert b \<and> \<not>is_Delete b"
"\<forall>b \<in> set (unlabel ?T3). \<not>is_Insert b \<and> \<not>is_Delete b"
by (metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(16,18),
metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(24,26,33,37),
metis (mono_tags, lifting) Ball_set stateful_strand_step.distinct_disc(24,26,33,35,37,39))
hence "\<forall>b \<in> set (unlabel (?T1@?T2@?T3)). \<not>is_Insert b \<and> \<not>is_Delete b"
by (auto simp add: unlabel_def)
hence "\<forall>b \<in> set (unlabel S). \<not>is_Insert b \<and> \<not>is_Delete b"
using * unfolding prefix_def by fastforce
hence "\<forall>b \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S) \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>). \<not>is_Insert b \<and> \<not>is_Delete b"
proof (induction S)
case (Cons a S)
then obtain l b where "a = (l,b)" by (metis surj_pair)
thus ?case
using Cons unfolding dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def unlabel_def subst_apply_stateful_strand_def
by (cases b) auto
qed simp
hence **: "\<forall>b \<in> set (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (S \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>))). \<not>is_Insert b \<and> \<not>is_Delete b"
by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst_unlabel)

show ?thesis
using db\<^sub>s\<^sub>s\<^sub>t_no_upd_append[OF **] unlabel_append
unfolding db\<^sub>s\<^sub>s\<^sub>t_def by metis
qed

lemma db\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_set_ex:
assumes "d \<in> set (db'\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) \<I> D)"
"\<forall>t u. insert\<langle>t,u\<rangle> \<in> set (unlabel A) \<longrightarrow> (\<exists>s. u = Fun (Set s) [])"
"\<forall>t u. delete\<langle>t,u\<rangle> \<in> set (unlabel A) \<longrightarrow> (\<exists>s. u = Fun (Set s) [])"
"\<forall>d \<in> set D. \<exists>s. snd d = Fun (Set s) []"
shows "\<exists>s. snd d = Fun (Set s) []"
using assms
proof (induction A arbitrary: D)
case (Cons a A)
obtain l b where a: "a = (l,b)" by (metis surj_pair)

have 1: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = receive\<langle>t \<cdot> \<theta>\<rangle>#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
when "b = send\<langle>t\<rangle>" for t
by (simp add: a that subst_lsst_unlabel_cons)

have 2: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = send\<langle>t \<cdot> \<theta>\<rangle>#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
when "b = receive\<langle>t\<rangle>" for t
by (simp add: a that subst_lsst_unlabel_cons)

have 3: "unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>) = (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<theta>)#unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<theta>)"
when "\<nexists>t. b = send\<langle>t\<rangle> \<or> b = receive\<langle>t\<rangle>"
using a that dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons subst_lsst_unlabel_cons[of l b]
by (cases b) auto

show ?case using 1 2 3 a Cons by (cases b) fastforce+
qed simp

lemma is_Fun_SetE[elim]:
assumes t: "is_Fun_Set t"
obtains s where "t = Fun (Set s) []"
proof (cases t)
case (Fun f T)
then obtain s where "f = Set s" using t unfolding is_Fun_Set_def by (cases f) moura+
moreover have "T = []" using Fun t unfolding is_Fun_Set_def by (cases T) auto
ultimately show ?thesis using Fun that by fast
qed (use t is_Fun_Set_def in fast)

lemma Fun_Set_InSet_iff:
"(u = \<langle>a: Var x \<in> Fun (Set s) []\<rangle>) \<longleftrightarrow>
(is_InSet u \<and> is_Var (the_elem_term u) \<and> is_Fun_Set (the_set_term u) \<and>
the_Set (the_Fun (the_set_term u)) = s \<and> the_Var (the_elem_term u) = x \<and> the_check u = a)"
(is "?A \<longleftrightarrow> ?B")
proof
show "?A \<Longrightarrow> ?B" unfolding is_Fun_Set_def by auto

assume B: ?B
thus ?A
proof (cases u)
case (InSet b t t')
hence "b = a" "t = Var x" "t' = Fun (Set s) []"
using B by (simp, fastforce, fastforce)
thus ?thesis using InSet by fast
qed auto
qed

lemma Fun_Set_NotInSet_iff:
"(u = \<langle>Var x not in Fun (Set s) []\<rangle>) \<longleftrightarrow>
(is_NegChecks u \<and> bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p u = [] \<and> the_eqs u = [] \<and> length (the_ins u) = 1 \<and>
is_Var (fst (hd (the_ins u))) \<and> is_Fun_Set (snd (hd (the_ins u)))) \<and>
the_Set (the_Fun (snd (hd (the_ins u)))) = s \<and> the_Var (fst (hd (the_ins u))) = x"
(is "?A \<longleftrightarrow> ?B")
proof
show "?A \<Longrightarrow> ?B" unfolding is_Fun_Set_def by auto

assume B: ?B
show ?A
proof (cases u)
case (NegChecks X F F')
hence "X = []" "F = []"
using B by auto
moreover have "fst (hd (the_ins u)) = Var x" "snd (hd (the_ins u)) = Fun (Set s) []"
using B is_Fun_SetE[of "snd (hd (the_ins u))"]
by (force, fastforce)
hence "F' = [(Var x, Fun (Set s) [])]"
using NegChecks B by (cases "the_ins u") auto
ultimately show ?thesis using NegChecks by fast
qed (use B in auto)
qed

lemma is_Fun_Set_exi: "is_Fun_Set x \<longleftrightarrow> (\<exists>s. x = Fun (Set s) [])"
by (metis prot_fun.collapse(2) term.collapse(2) prot_fun.disc(15) term.disc(2)
term.sel(2,4) is_Fun_Set_def un_Fun1_def)

lemma is_Fun_Set_subst:
assumes "is_Fun_Set S'"
shows "is_Fun_Set (S' \<cdot> \<sigma>)"
using assms by (fastforce simp add: is_Fun_Set_def)

lemma is_Update_in_transaction_updates:
assumes tu: "is_Update t"
assumes t: "t \<in> set (unlabel (transaction_strand TT))"
assumes vt: "wellformed_transaction TT"
shows "t \<in> set (unlabel (transaction_updates TT))"
using t tu vt unfolding transaction_strand_def wellformed_transaction_def list_all_iff
by (auto simp add: unlabel_append)

lemma transaction_fresh_vars_subset:
assumes "wellformed_transaction T"
shows "set (transaction_fresh T) \<subseteq> fv_transaction T"
using assms fv_transaction_unfold[of T]
unfolding wellformed_transaction_def
by auto

lemma transaction_fresh_vars_notin:
assumes T: "wellformed_transaction T"
and x: "x \<in> set (transaction_fresh T)"
shows "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?A)
and "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?B)
and "x \<notin> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?C)
and "x \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?D)
and "x \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?E)
and "x \<notin> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?F)
and "x \<notin> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)" (is ?G)
and "x \<notin> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)" (is ?H)
and "x \<notin> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T)" (is ?I)
proof -
have 0:
"set (transaction_fresh T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_updates T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_send T)"
"set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
"set (transaction_fresh T) \<inter> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}"
"fv_transaction T \<inter> bvars_transaction T = {}"
"fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) \<subseteq> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
using T unfolding wellformed_transaction_def
by fast+
have 1: "set (transaction_fresh T) \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_checks T) = {}"
using 0(1,4) fv_transaction_unfold[of T] bvars_transaction_unfold[of T] by blast

have 2:
"vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T)"
"vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T)"
"bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_receive T) = {}"
"bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (transaction_selects T) = {}"
using bvars_wellformed_transaction_unfold[OF T] bvars_transaction_unfold[of T]
vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_receive T)"]
vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_selects T)"]
by blast+
show ?A ?B ?C ?D ?E ?G ?H ?I using 0 1 2 x by fast+

show ?F using 0(2,3,5) 1 x vars\<^sub>s\<^sub>s\<^sub>t_is_fv\<^sub>s\<^sub>s\<^sub>t_bvars\<^sub>s\<^sub>s\<^sub>t[of "unlabel (transaction_checks T)"] by fast
qed


lemma transaction_proj_member:
assumes "T \<in> set P"
shows "transaction_proj n T \<in> set (map (transaction_proj n) P)"
using assms by simp

lemma transaction_strand_proj:
"transaction_strand (transaction_proj n T) = proj n (transaction_strand T)"
proof -
obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp
thus ?thesis
using transaction_proj.simps[of n A B C D E F]
unfolding transaction_strand_def proj_def Let_def by auto
qed

lemma transaction_proj_fresh_eq:
"transaction_fresh (transaction_proj n T) = transaction_fresh T"
proof -
obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp
thus ?thesis
using transaction_proj.simps[of n A B C D E F]
unfolding transaction_fresh_def proj_def Let_def by auto
qed

lemma transaction_proj_trms_subset:
"trms_transaction (transaction_proj n T) \<subseteq> trms_transaction T"
proof -
obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp
thus ?thesis
using transaction_proj.simps[of n A B C D E F] trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of n]
unfolding transaction_fresh_def Let_def transaction_strand_def by auto
qed

lemma transaction_proj_vars_subset:
"vars_transaction (transaction_proj n T) \<subseteq> vars_transaction T"
proof -
obtain A B C D E F where "T = Transaction A B C D E F" by (cases T) simp
thus ?thesis
using transaction_proj.simps[of n A B C D E F]
sst_vars_proj_subset(3)[of n "transaction_strand T"]
unfolding transaction_fresh_def Let_def transaction_strand_def by simp
qed

end

+ 72
- 0
Automated_Stateful_Protocol_Verification/document/root.bib View File

@@ -0,0 +1,72 @@

@InProceedings{ brucker.ea:integrating:2009,
author = {Achim D. Brucker and Sebastian M{\"{o}}dersheim},
editor = {Pierpaolo Degano and Joshua D. Guttman},
title = {{Integrating Automated and Interactive Protocol Verification}},
booktitle = {Formal Aspects in Security and Trust, 6th International Workshop, {FAST} 2009, Eindhoven, The
Netherlands, November 5-6, 2009, Revised Selected Papers},
series = {Lecture Notes in Computer Science},
volume = 5983,
pages = {248--262},
publisher = {Springer},
year = 2009,
doi = {10.1007/978-3-642-12459-4_18}
}


@InProceedings{ hess.ea:formalizing:2017,
author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim},
title = {{Formalizing and Proving a Typing Result for Security Protocols in Isabelle/HOL}},
booktitle = {30th {IEEE} Computer Security Foundations Symposium, {CSF} 2017, Santa Barbara, CA, USA, August
21-25, 2017},
pages = {451--463},
publisher = {{IEEE} Computer Society},
year = 2017,
doi = {10.1109/CSF.2017.27}
}

@InProceedings{ hess.ea:typing:2018,
author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim},
title = {{A Typing Result for Stateful Protocols}},
booktitle = {31st {IEEE} Computer Security Foundations Symposium, {CSF} 2018, Oxford, United Kingdom, July 9-12,
2018},
pages = {374--388},
publisher = {{IEEE} Computer Society},
year = 2018,
doi = {10.1109/CSF.2018.00034}
}

@InProceedings{ hess.ea:stateful:2018,
author = {Andreas V. Hess and Sebastian M{\"{o}}dersheim and Achim D. Brucker},
editor = {Javier L{\'{o}}pez and Jianying Zhou and Miguel Soriano},
title = {{Stateful Protocol Composition}},
booktitle = {Computer Security - 23rd European Symposium on Research in Computer Security, {ESORICS} 2018,
Barcelona, Spain, September 3-7, 2018, Proceedings, Part {I}},
series = {Lecture Notes in Computer Science},
volume = 11098,
pages = {427--446},
publisher = {Springer},
year = 2018,
doi = {10.1007/978-3-319-99073-6_21}
}

@PhDThesis{ hess:typing:2018,
author = {Andreas Viktor Hess},
title = {Typing and Compositionality for Stateful Security Protocols},
year = {2019},
url = {https://orbit.dtu.dk/en/publications/typing-and-compositionality-for-stateful-security-protocols},
language = {English},
series = {TU Compute PHD-2018},
publisher = {DTU Compute}
}

@Article{ hess.ea:stateful:2020,
author = {Andreas V. Hess and Sebastian~M{\"o}dersheim and Achim~D.~Brucker},
title = {{Stateful Protocol Composition and Typing}},
journal = {Archive of Formal Proofs},
month = apr,
year = 2020,
note = {\url{http://isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html}, Formal proof
development},
issn = {2150-914x}
}

+ 166
- 0
Automated_Stateful_Protocol_Verification/document/root.tex View File

@@ -0,0 +1,166 @@
\documentclass[10pt,DIV16,a4paper,abstract=true,twoside=semi,openright]
{scrreprt}
\usepackage[USenglish]{babel}
\usepackage[numbers, sort&compress]{natbib}