Theory Stateful_Protocol_Model

(*  Title:      Stateful_Protocol_Model.thy
    Author:     Andreas Viktor Hess, DTU
    Author:     Sebastian A. Mödersheim, DTU
    Author:     Achim D. Brucker, University of Exeter
    Author:     Anders Schlichtkrull, DTU
    SPDX-License-Identifier: BSD-3-Clause
*)

section‹Stateful Protocol Model›
theory Stateful_Protocol_Model
  imports Stateful_Protocol_Composition_and_Typing.Stateful_Compositionality
          Transactions Term_Abstraction
begin

subsection ‹Locale Setup›
locale stateful_protocol_model =
  fixes arityf::"'fun ⇒ nat"
    and aritys::"'sets ⇒ nat"
    and publicf::"'fun ⇒ bool"
    and Anaf::"'fun ⇒ ((('fun,'atom::finite,'sets,'lbl) prot_fun, nat) term list × nat list)"
    and Γf::"'fun ⇒ 'atom option"
    and label_witness1::"'lbl"
    and label_witness2::"'lbl"
  assumes Anaf_assm1: "∀f. let (K, M) = Anaf f in (∀k ∈ subtermsset (set K).
      is_Fun k ⟶ (is_Fu (the_Fun k)) ∧ length (args k) = arityf (the_Fu (the_Fun k)))"
    and Anaf_assm2: "∀f. let (K, M) = Anaf f in ∀i ∈ fvset (set K) ∪ set M. i < arityf f"
    and publicf_assm: "∀f. arityf f > (0::nat) ⟶ publicf f"
    and Γf_assm: "∀f. arityf f = (0::nat) ⟶ Γf f ≠ None"
    and label_witness_assm: "label_witness1 ≠ label_witness2"
begin

lemma Anaf_assm1_alt: 
  assumes "Anaf f = (K,M)" "k ∈ subtermsset (set K)"
  shows "(∃x. k = Var x) ∨ (∃h T. k = Fun (Fu h) T ∧ length T = arityf h)"
proof (cases k)
  case (Fun g T)
  let ?P = "λk. is_Fun k ⟶ is_Fu (the_Fun k) ∧ length (args k) = arityf (the_Fu (the_Fun k))"
  let ?Q = "λK M. ∀k ∈ subtermsset (set K). ?P k"

  have "?Q (fst (Anaf f)) (snd (Anaf f))" using Anaf_assm1 split_beta[of ?Q "Anaf f"] by meson
  hence "?Q K M" using assms(1) by simp
  hence "?P k" using assms(2) by blast
  thus ?thesis using Fun by (cases g) auto
qed simp

lemma Anaf_assm2_alt:
  assumes "Anaf f = (K,M)" "i ∈ fvset (set K) ∪ set M"
  shows "i < arityf f"
using Anaf_assm2 assms by fastforce


subsection ‹Definitions›
fun arity where
  "arity (Fu f) = arityf f"
| "arity (Set s) = aritys s"
| "arity (Val _) = 0"
| "arity (Abs _) = 0"
| "arity Pair = 2"
| "arity (Attack _) = 0"
| "arity OccursFact = 2"
| "arity OccursSec = 0"
| "arity (PubConst _ _) = 0"

fun public where
  "public (Fu f) = publicf f"
| "public (Set s) = (aritys s > 0)"
| "public (Val n) = False"
| "public (Abs _) = False"
| "public Pair = True"
| "public (Attack _) = False"
| "public OccursFact = True"
| "public OccursSec = False"
| "public (PubConst _ _) = True"

fun Ana where
  "Ana (Fun (Fu f) T) = (
    if arityf f = length T ∧ arityf f > 0
    then let (K,M) = Anaf f in (K ⋅list (!) T, map ((!) T) M)
    else ([], []))"
| "Ana _ = ([], [])"

definition Γv where
  "Γv v ≡ (
    if (∀t ∈ subterms (fst v).
          case t of (TComp f T) ⇒ arity f > 0 ∧ arity f = length T | _ ⇒ True)
    then fst v
    else TAtom Bottom)"

fun Γ where
  "Γ (Var v) = Γv v"
| "Γ (Fun f T) = (
    if arity f = 0
    then case f of
      (Fu g) ⇒ TAtom (case Γf g of Some a ⇒ Atom a | None ⇒ Bottom)
    | (Val _) ⇒ TAtom Value
    | (Abs _) ⇒ TAtom AbsValue
    | (Set _) ⇒ TAtom SetType
    | (Attack _) ⇒ TAtom AttackType
    | OccursSec ⇒ TAtom OccursSecType
    | (PubConst a _) ⇒ TAtom a
    | _ ⇒ TAtom Bottom
    else TComp f (map Γ T))"

lemma Γ_consts_simps[simp]:
  "arityf g = 0 ⟹ Γ (Fun (Fu g) []::('fun,'atom,'sets,'lbl) prot_term)
                    = TAtom (case Γf g of Some a ⇒ Atom a | None ⇒ Bottom)"
  "Γ (Fun (Val n) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom Value"
  "Γ (Fun (Abs b) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom AbsValue"
  "aritys s = 0 ⟹ Γ (Fun (Set s) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom SetType"
  "Γ (Fun (Attack x) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom AttackType"
  "Γ (Fun OccursSec []::('fun,'atom,'sets,'lbl) prot_term) = TAtom OccursSecType"
  "Γ (Fun (PubConst a t) []::('fun,'atom,'sets,'lbl) prot_term) = TAtom a"
by simp+

lemma Γ_Fu_simps[simp]:
  "arityf f ≠ 0 ⟹ Γ (Fun (Fu f) T) = TComp (Fu f) (map Γ T)" (is "?A1 ⟹ ?A2")
  "arityf f = 0 ⟹ Γf f = Some a ⟹ Γ (Fun (Fu f) T) = TAtom (Atom a)" (is "?B1 ⟹ ?B2 ⟹ ?B3")
  "arityf f = 0 ⟹ Γf f = None ⟹ Γ (Fun (Fu f) T) = TAtom Bottom" (is "?C1 ⟹ ?C2 ⟹ ?C3")
  "Γ (Fun (Fu f) T) ≠ TAtom Value" (is ?D)
  "Γ (Fun (Fu f) T) ≠ TAtom AttackType" (is ?E)
  "Γ (Fun (Fu f) T) ≠ TAtom OccursSecType" (is ?F)
proof -
  show "?A1 ⟹ ?A2" by simp
  show "?B1 ⟹ ?B2 ⟹ ?B3" by simp
  show "?C1 ⟹ ?C2 ⟹ ?C3" by simp
  show ?D by (cases "Γf f") simp_all
  show ?E by (cases "Γf f") simp_all
  show ?F by (cases "Γf f") simp_all
qed

lemma Γ_Set_simps[simp]:
  "aritys s ≠ 0 ⟹ Γ (Fun (Set s) T) = TComp (Set s) (map Γ T)"
  "Γ (Fun (Set s) T) = TAtom SetType ∨ Γ (Fun (Set s) T) = TComp (Set s) (map Γ T)"
  "Γ (Fun (Set s) T) ≠ TAtom Value"
  "Γ (Fun (Set s) T) ≠ TAtom (Atom a)"
  "Γ (Fun (Set s) T) ≠ TAtom AttackType"
  "Γ (Fun (Set s) T) ≠ TAtom OccursSecType"
  "Γ (Fun (Set s) T) ≠ TAtom Bottom"
by auto


subsection ‹Locale Interpretations›
lemma Ana_Fu_cases:
  assumes "Ana (Fun f T) = (K,M)"
    and "f = Fu g"
    and "Anaf g = (K',M')"
  shows "(K,M) = (if arityf g = length T ∧ arityf g > 0
                  then (K' ⋅list (!) T, map ((!) T) M')
                  else ([],[]))" (is ?A)
    and "(K,M) = (K' ⋅list (!) T, map ((!) T) M') ∨ (K,M) = ([],[])" (is ?B)
proof -
  show ?A using assms by (cases "arityf g = length T ∧ arityf g > 0") auto
  thus ?B by metis
qed

lemma Ana_Fu_intro:
  assumes "arityf f = length T" "arityf f > 0"
    and "Anaf f = (K',M')"
  shows "Ana (Fun (Fu f) T) = (K' ⋅list (!) T, map ((!) T) M')"
using assms by simp

lemma Ana_Fu_elim:
  assumes "Ana (Fun f T) = (K,M)"
    and "f = Fu g"
    and "Anaf g = (K',M')"
    and "(K,M) ≠ ([],[])"
  shows "arityf g = length T" (is ?A)
    and "(K,M) = (K' ⋅list (!) T, map ((!) T) M')" (is ?B)
proof -
  show ?A using assms by force
  moreover have "arityf g > 0" using assms by force
  ultimately show ?B using assms by auto
qed

lemma Ana_nonempty_inv:
  assumes "Ana t ≠ ([],[])"
  shows "∃f T. t = Fun (Fu f) T ∧ arityf f = length T ∧ arityf f > 0 ∧
               (∃K M. Anaf f = (K, M) ∧ Ana t = (K ⋅list (!) T, map ((!) T) M))"
using assms
proof (induction t rule: Ana.induct)
  case (1 f T)
  hence *: "arityf f = length T" "0 < arityf f"
           "Ana (Fun (Fu f) T) = (case Anaf f of (K, M) ⇒ (K ⋅list (!) T, map ((!) T) M))"
    using Ana.simps(1)[of f T] unfolding Let_def by metis+

  obtain K M where **: "Anaf f = (K, M)" by (metis surj_pair)
  hence "Ana (Fun (Fu f) T) = (K ⋅list (!) T, map ((!) T) M)" using *(3) by simp
  thus ?case using ** *(1,2) by blast
qed simp_all

lemma assm1:
  assumes "Ana t = (K,M)"
  shows "fvset (set K) ⊆ fv t"
using assms
proof (induction t rule: term.induct)
  case (Fun f T)
  have aux: "fvset (set K ⋅set (!) T) ⊆ fvset (set T)"
    when K: "∀i ∈ fvset (set K). i < length T"
    for K::"(('fun,'atom,'sets,'lbl) prot_fun, nat) term list"
  proof
    fix x assume "x ∈ fvset (set K ⋅set (!) T)"
    then obtain k where k: "k ∈ set K" "x ∈ fv (k ⋅ (!) T)" by auto
    have "∀i ∈ fv k. i < length T" using K k(1) by simp
    thus "x ∈ fvset (set T)"
      by (metis (no_types, lifting) k(2) contra_subsetD fv_set_mono image_subsetI nth_mem
                                    subst_apply_fv_unfold)
  qed

  { fix g assume f: "f = Fu g" and K: "K ≠ []"
    obtain K' M' where *: "Anaf g = (K',M')" by force
    have "(K, M) ≠ ([], [])" using K by simp
    hence "(K, M) = (K' ⋅list (!) T, map ((!) T) M')" "arityf g = length T"
      using Ana_Fu_cases(1)[OF Fun.prems f *]
      by presburger+
    hence ?case using aux[of K'] Anaf_assm2_alt[OF *] by auto
  } thus ?case using Fun by (cases f) fastforce+
qed simp

lemma assm2:
  assumes "Ana t = (K,M)"
  and "⋀g S'. Fun g S' ⊑ t ⟹ length S' = arity g"
  and "k ∈ set K"
  and "Fun f T' ⊑ k"
  shows "length T' = arity f"
using assms
proof (induction t rule: term.induct)
  case (Fun g T)
  obtain h where 2: "g = Fu h"
    using Fun.prems(1,3) by (cases g) auto
  obtain K' M' where 1: "Anaf h = (K',M')" by force
  have "(K,M) ≠ ([],[])" using Fun.prems(3) by auto
  hence "(K,M) = (K' ⋅list (!) T, map ((!) T) M')"
        "⋀i. i ∈ fvset (set K') ∪ set M' ⟹ i < length T"
    using Ana_Fu_cases(1)[OF Fun.prems(1) 2 1] Anaf_assm2_alt[OF 1]
    by presburger+
  hence "K = K' ⋅list (!) T" and 3: "∀i∈fvset (set K'). i < length T" by simp_all
  then obtain k' where k': "k' ∈ set K'" "k = k' ⋅ (!) T" using Fun.prems(3) by force
  hence 4: "Fun f T' ∈ subterms (k' ⋅ (!) T)" "fv k' ⊆ fvset (set K')"
    using Fun.prems(4) by auto
  show ?case
  proof (cases "∃i ∈ fv k'. Fun f T' ∈ subterms (T ! i)")
    case True
    hence "Fun f T' ∈ subtermsset (set T)" using k' Fun.prems(4) 3 by auto
    thus ?thesis using Fun.prems(2) by auto
  next
    case False
    then obtain S where "Fun f S ∈ subterms k'" "Fun f T' = Fun f S ⋅ (!) T"
      using k'(2) Fun.prems(4) subterm_subst_not_img_subterm by force
    thus ?thesis using Anaf_assm1_alt[OF 1, of "Fun f S"] k'(1) by (cases f) auto
  qed
qed simp

lemma assm4:
  assumes "Ana (Fun f T) = (K, M)"
  shows "set M ⊆ set T"
using assms
proof (cases f)
  case (Fu g)
  obtain K' M' where *: "Anaf g = (K',M')" by force
  have "M = [] ∨ (arityf g = length T ∧ M = map ((!) T) M')"
    using Ana_Fu_cases(1)[OF assms Fu *]
    by (meson prod.inject)
  thus ?thesis using Anaf_assm2_alt[OF *] by auto
qed auto

lemma assm5: "Ana t = (K,M) ⟹ K ≠ [] ∨ M ≠ [] ⟹ Ana (t ⋅ δ) = (K ⋅list δ, M ⋅list δ)"
proof (induction t rule: term.induct)
  case (Fun f T) thus ?case
  proof (cases f)
    case (Fu g)
    obtain K' M' where *: "Anaf g = (K',M')" by force
    have **: "K = K' ⋅list (!) T" "M = map ((!) T) M'"
             "arityf g = length T" "∀i ∈ fvset (set K') ∪ set M'. i < arityf g" "0 < arityf g"
      using Fun.prems(2) Ana_Fu_cases(1)[OF Fun.prems(1) Fu *] Anaf_assm2_alt[OF *]
      by (meson prod.inject)+

    have ***: "∀i ∈ fvset (set K'). i < length T" "∀i ∈ set M'. i < length T" using **(3,4) by auto
    
    have "K ⋅list δ = K' ⋅list (!) (map (λt. t ⋅ δ) T)"
         "M ⋅list δ = map ((!) (map (λt. t ⋅ δ) T)) M'"
      using subst_idx_map[OF ***(2), of δ]
            subst_idx_map'[OF ***(1), of δ]
            **(1,2)
      by fast+
    thus ?thesis using Fu * **(3,5) by auto
  qed auto
qed simp

sublocale intruder_model arity public Ana
apply unfold_locales
by (metis assm1, metis assm2, rule Ana.simps, metis assm4, metis assm5)

adhoc_overloading INTRUDER_SYNTH ⇌ intruder_synth
adhoc_overloading INTRUDER_DEDUCT ⇌ intruder_deduct

lemma assm6: "arity c = 0 ⟹ ∃a. ∀X. Γ (Fun c X) = TAtom a" by (cases c) auto

lemma assm7: "0 < arity f ⟹ Γ (Fun f T) = TComp f (map Γ T)" by auto

lemma assm8: "infinite {c. Γ (Fun c []::('fun,'atom,'sets,'lbl) prot_term) = TAtom a ∧ public c}"
  (is "?P a")
proof -
  let ?T = "λf. (range f)::('fun,'atom,'sets,'lbl) prot_fun set"
  let ?A = "λf. ∀x::nat ∈ UNIV. ∀y::nat ∈ UNIV. (f x = f y) = (x = y)"
  let ?B = "λf. ∀x::nat ∈ UNIV. f x ∈ ?T f"
  let ?C = "λf. ∀y::('fun,'atom,'sets,'lbl) prot_fun ∈ ?T f. ∃x ∈ UNIV. y = f x"
  let ?D = "λf b. ?T f ⊆ {c. Γ (Fun c []::('fun,'atom,'sets,'lbl) prot_term) = TAtom b ∧ public c}"

  have sub_lmm: "?P b" when "?A f" "?C f" "?C f" "?D f b" for b f
  proof -
    have "∃g::nat ⇒ ('fun,'atom,'sets,'lbl) prot_fun. bij_betw g UNIV (?T f)"
      using bij_betwI'[of UNIV f "?T f"] that(1,2,3) by blast
    hence "infinite (?T f)" by (metis nat_not_finite bij_betw_finite)
    thus ?thesis using infinite_super[OF that(4)] by blast
  qed

  show ?thesis
  proof (cases a)
    case (Atom b) thus ?thesis using sub_lmm[of "PubConst (Atom b)" a] by force
  next
    case Value thus ?thesis using sub_lmm[of "PubConst Value" a] by force
  next
    case SetType thus ?thesis using sub_lmm[of "PubConst SetType" a] by fastforce
  next
    case AttackType thus ?thesis using sub_lmm[of "PubConst AttackType" a] by fastforce
  next
    case Bottom thus ?thesis using sub_lmm[of "PubConst Bottom" a] by fastforce
  next
    case OccursSecType thus ?thesis using sub_lmm[of "PubConst OccursSecType" a] by fastforce
  next
    case AbsValue thus ?thesis using sub_lmm[of "PubConst AbsValue" a] by force
  qed
qed

lemma assm9: "TComp f T ⊑ Γ t ⟹ arity f > 0"
proof (induction t rule: term.induct)
  case (Var x)
  hence "Γ (Var x) ≠ TAtom Bottom" by force
  hence "∀t ∈ subterms (fst x). case t of
            TComp f T ⇒ arity f > 0 ∧ arity f = length T
          | _ ⇒ True"
    using Var Γ.simps(1)[of x] unfolding Γv_def by meson
  thus ?case using Var by (fastforce simp add: Γv_def)
next
  case (Fun g S)
  have "arity g ≠ 0" using Fun.prems Var_subtermeq assm6 by force
  thus ?case using Fun by (cases "TComp f T = TComp g (map Γ S)") auto
qed

lemma assm10: "wftrm (Γ (Var x))"
unfolding wftrm_def by (auto simp add: Γv_def)

lemma assm11: "arity f > 0 ⟹ public f" using publicf_assm by (cases f) auto

lemma assm12: "Γ (Var (τ, n)) = Γ (Var (τ, m))" by (simp add: Γv_def)

lemma assm13: "arity c = 0 ⟹ Ana (Fun c T) = ([],[])" by (cases c) simp_all

lemma assm14:
  assumes "Ana (Fun f T) = (K,M)"
  shows "Ana (Fun f T ⋅ δ) = (K ⋅list δ, M ⋅list δ)"
proof -
  show ?thesis
  proof (cases "(K, M) = ([],[])")
    case True
    { fix g assume f: "f = Fu g"
      obtain K' M' where "Anaf g = (K',M')" by force
      hence ?thesis using assms f True by auto
    } thus ?thesis using True assms by (cases f) auto
  next
    case False
    then obtain g where **: "f = Fu g" using assms by (cases f) auto
    obtain K' M' where *: "Anaf g = (K',M')" by force
    have ***: "K = K' ⋅list (!) T" "M = map ((!) T) M'" "arityf g = length T"
              "∀i ∈ fvset (set K') ∪ set M'. i < arityf g"
      using Ana_Fu_cases(1)[OF assms ** *] False Anaf_assm2_alt[OF *]
      by (meson prod.inject)+
    have ****: "∀i∈fvset (set K'). i < length T" "∀i∈set M'. i < length T" using ***(3,4) by auto
    have "K ⋅list δ = K' ⋅list (!) (map (λt. t ⋅ δ) T)"
         "M ⋅list δ = map ((!) (map (λt. t ⋅ δ) T)) M'"
      using subst_idx_map[OF ****(2), of δ]
            subst_idx_map'[OF ****(1), of δ]
            ***(1,2)
      by auto
    thus ?thesis using assms * ** ***(3) by auto
  qed
qed

sublocale labeled_stateful_typing' arity public Ana Γ Pair label_witness1 label_witness2
  apply unfold_locales
  subgoal by (metis assm6)
  subgoal by (metis assm7)
  subgoal by (metis assm9)
  subgoal by (rule assm10)
  subgoal by (metis assm12)
  subgoal by (metis assm13)
  subgoal by (metis assm14)
  subgoal by (rule label_witness_assm)
  subgoal by (rule arity.simps(5))
  subgoal by (metis assm14)
  subgoal by (metis assm8)
  subgoal by (metis assm11)
  done


subsection ‹The Protocol Transition System, Defined in Terms of the Reachable Constraints›
definition transaction_decl_subst where
  "transaction_decl_subst (ξ::('fun,'atom,'sets,'lbl) prot_subst) T ≡
    subst_domain ξ = fst ` set (transaction_decl T ()) ∧
    (∀(x,cs) ∈ set (transaction_decl T ()). ∃c ∈ cs.
      ξ x = Fun (Fu c) [] ∧
      arity (Fu c::('fun,'atom,'sets,'lbl) prot_fun) = 0) ∧
    wtsubst ξ"

definition transaction_fresh_subst where
  "transaction_fresh_subst σ T M ≡
    subst_domain σ = set (transaction_fresh T) ∧
    (∀t ∈ subst_range σ. ∃c. t = Fun c [] ∧ ¬public c ∧ arity c = 0) ∧
    (∀t ∈ subst_range σ. t ∉ subtermsset M) ∧
    (∀t ∈ subst_range σ. t ∉ subtermsset (trms_transaction T)) ∧
    wtsubst σ ∧ inj_on σ (subst_domain σ)"

(* NB: We need the protocol P as a parameter for this definition---even though we will only apply α
       to a single transaction T of P---because we have to ensure that α(fv(T)) is disjoint from
       the bound variables of P and 𝒜. *)
definition transaction_renaming_subst where
  "transaction_renaming_subst α P X ≡
    ∃n ≥ max_var_set (⋃(vars_transaction ` set P) ∪ X). α = var_rename n"

definition (in intruder_model) constraint_model where
  "constraint_model ℐ 𝒜 ≡ 
    constr_sem_stateful ℐ (unlabel 𝒜) ∧
    interpretationsubst ℐ ∧
    wftrms (subst_range ℐ)"

definition (in typed_model) welltyped_constraint_model where
  "welltyped_constraint_model ℐ 𝒜 ≡ wtsubst ℐ ∧ constraint_model ℐ 𝒜"

text ‹
  The set of symbolic constraints reachable in any symbolic run of the protocol ‹P›.
  
  ‹ξ› instantiates the "declared variables" of transaction ‹T› with ground terms.
  ‹σ› instantiates the fresh variables of transaction ‹T› with fresh terms.
  ‹α› is a variable-renaming whose range consists of fresh variables.
›
inductive_set reachable_constraints::
  "('fun,'atom,'sets,'lbl) prot ⇒ ('fun,'atom,'sets,'lbl) prot_constr set"
  for P::"('fun,'atom,'sets,'lbl) prot"
where
  init[simp]:
  "[] ∈ reachable_constraints P"
| step:
  "⟦𝒜 ∈ reachable_constraints P;
    T ∈ set P;
    transaction_decl_subst ξ T;
    transaction_fresh_subst σ T (trmslsst 𝒜);
    transaction_renaming_subst α P (varslsst 𝒜)
   ⟧ ⟹ 𝒜@duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α) ∈ reachable_constraints P"


subsection ‹Minor Lemmata›
lemma Γv_TAtom[simp]: "Γv (TAtom a, n) = TAtom a"
unfolding Γv_def by simp

lemma Γv_TAtom':
  assumes "a ≠ Bottom"
  shows "Γv (τ, n) = TAtom a ⟷ τ = TAtom a"
proof
  assume "Γv (τ, n) = TAtom a"
  thus "τ = TAtom a" by (metis (no_types, lifting) assms Γv_def fst_conv term.inject(1)) 
qed simp

lemma Γv_TAtom_inv:
  "Γv x = TAtom (Atom a) ⟹ ∃m. x = (TAtom (Atom a), m)"
  "Γv x = TAtom Value ⟹ ∃m. x = (TAtom Value, m)"
  "Γv x = TAtom SetType ⟹ ∃m. x = (TAtom SetType, m)"
  "Γv x = TAtom AttackType ⟹ ∃m. x = (TAtom AttackType, m)"
  "Γv x = TAtom OccursSecType ⟹ ∃m. x = (TAtom OccursSecType, m)"
by (metis Γv_TAtom' surj_pair prot_atom.distinct(7),
    metis Γv_TAtom' surj_pair prot_atom.distinct(18),
    metis Γv_TAtom' surj_pair prot_atom.distinct(26),
    metis Γv_TAtom' surj_pair prot_atom.distinct(32),
    metis Γv_TAtom' surj_pair prot_atom.distinct(38))

lemma Γv_TAtom'':
  "(fst x = TAtom (Atom a)) = (Γv x = TAtom (Atom a))" (is "?A = ?A'")
  "(fst x = TAtom Value) = (Γv x = TAtom Value)" (is "?B = ?B'")
  "(fst x = TAtom SetType) = (Γv x = TAtom SetType)" (is "?C = ?C'")
  "(fst x = TAtom AttackType) = (Γv x = TAtom AttackType)" (is "?D = ?D'")
  "(fst x = TAtom OccursSecType) = (Γv x = TAtom OccursSecType)" (is "?E = ?E'")
proof -
  have 1: "?A ⟹ ?A'" "?B ⟹ ?B'" "?C ⟹ ?C'" "?D ⟹ ?D'" "?E ⟹ ?E'"
    by (metis Γv_TAtom prod.collapse)+

  have 2: "?A' ⟹ ?A" "?B' ⟹ ?B" "?C' ⟹ ?C" "?D' ⟹ ?D" "?E' ⟹ ?E"
    using Γv_TAtom Γv_TAtom_inv(1) apply fastforce
    using Γv_TAtom Γv_TAtom_inv(2) apply fastforce
    using Γv_TAtom Γv_TAtom_inv(3) apply fastforce
    using Γv_TAtom Γv_TAtom_inv(4) apply fastforce
    using Γv_TAtom Γv_TAtom_inv(5) by fastforce

  show "?A = ?A'" "?B = ?B'" "?C = ?C'" "?D = ?D'" "?E = ?E'"
    using 1 2 by metis+
qed

lemma Γv_Var_image:
  "Γv ` X = Γ ` Var ` X"
by force

lemma Γ_Fu_const:
  assumes "arityf g = 0"
  shows "∃a. Γ (Fun (Fu g) T) = TAtom (Atom a)"
proof -
  have "Γf g ≠ None" using assms Γf_assm by blast
  thus ?thesis using assms by force
qed

lemma Fun_Value_type_inv:
  fixes T::"('fun,'atom,'sets,'lbl) prot_term list"
  assumes "Γ (Fun f T) = TAtom Value"
  shows "(∃n. f = Val n) ∨ (∃bs. f = Abs bs) ∨ (∃n. f = PubConst Value n)"
proof -
  have *: "arity f = 0" by (metis const_type_inv assms) 
  show ?thesis  using assms
  proof (cases f)
    case (Fu g)
    hence "arityf g = 0" using * by simp
    hence False using Fu Γ_Fu_const[of g T] assms by auto
    thus ?thesis by metis
  next
    case (Set s)
    hence "aritys s = 0" using * by simp
    hence False using Set assms by auto
    thus ?thesis by metis
  qed simp_all
qed

lemma Anaf_keys_not_val_terms:
  assumes "Anaf f = (K, T)"
    and "k ∈ set K"
    and "g ∈ funs_term k"
  shows "¬is_Val g"
    and "¬is_PubConstValue g"
    and "¬is_Abs g"
proof -
  { assume "is_Val g"
    then obtain n S where *: "Fun (Val n) S ∈ subtermsset (set K)"
      using assms(2) funs_term_Fun_subterm[OF assms(3)]
      by (cases g) auto
    hence False using Anaf_assm1_alt[OF assms(1) *] by simp
  } moreover {
    assume "is_PubConstValue g"
    then obtain n S where *: "Fun (PubConst Value n) S ∈ subtermsset (set K)"
      using assms(2) funs_term_Fun_subterm[OF assms(3)]
      unfolding is_PubConstValue_def by (cases g) auto
    hence False using Anaf_assm1_alt[OF assms(1) *] by simp
  } moreover {
    assume "is_Abs g"
    then obtain a S where *: "Fun (Abs a) S ∈ subtermsset (set K)"
      using assms(2) funs_term_Fun_subterm[OF assms(3)]
      by (cases g) auto
    hence False using Anaf_assm1_alt[OF assms(1) *] by simp
  } ultimately show "¬is_Val g" "¬is_PubConstValue g" "¬is_Abs g" by metis+
qed

lemma Anaf_keys_not_pairs:
  assumes "Anaf f = (K, T)"
    and "k ∈ set K"
    and "g ∈ funs_term k"
  shows "g ≠ Pair"
proof
  assume "g = Pair"
  then obtain S where *: "Fun Pair S ∈ subtermsset (set K)"
    using assms(2) funs_term_Fun_subterm[OF assms(3)]
    by (cases g) auto
  show False using Anaf_assm1_alt[OF assms(1) *] by simp
qed

lemma Ana_Fu_keys_funs_term_subset:
  fixes K::"('fun,'atom,'sets,'lbl) prot_term list"
  assumes "Ana (Fun (Fu f) S) = (K, T)"
    and "Anaf f = (K', T')"
  shows "⋃(funs_term ` set K) ⊆ ⋃(funs_term ` set K') ∪ funs_term (Fun (Fu f) S)"
proof -
  { fix k assume k: "k ∈ set K"
    then obtain k' where k':
        "k' ∈ set K'" "k = k' ⋅ (!) S" "arityf f = length S"
        "subterms k' ⊆ subtermsset (set K')"
      using assms Ana_Fu_elim[OF assms(1) _ assms(2)] by fastforce

    have 1: "funs_term k' ⊆ ⋃(funs_term ` set K')" using k'(1) by auto

    have "i < length S" when "i ∈ fv k'" for i
      using that Anaf_assm2_alt[OF assms(2), of i] k'(1,3)
      by auto
    hence 2: "funs_term (S ! i) ⊆ funs_term (Fun (Fu f) S)" when "i ∈ fv k'" for i
      using that by force
  
    have "funs_term k ⊆ ⋃(funs_term ` set K') ∪ funs_term (Fun (Fu f) S)"
      using funs_term_subst[of k' "(!) S"] k'(2) 1 2 by fast
  } thus ?thesis by blast
qed

lemma Ana_Fu_keys_not_pubval_terms:
  fixes k::"('fun,'atom,'sets,'lbl) prot_term"
  assumes "Ana (Fun (Fu f) S) = (K, T)"
    and "Anaf f = (K', T')"
    and "k ∈ set K"
    and "∀g ∈ funs_term (Fun (Fu f) S). ¬is_PubConstValue g"
  shows "∀g ∈ funs_term k. ¬is_PubConstValue g"
using assms(3,4) Anaf_keys_not_val_terms(1,2)[OF assms(2)]
      Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
by blast

lemma Ana_Fu_keys_not_abs_terms:
  fixes k::"('fun,'atom,'sets,'lbl) prot_term"
  assumes "Ana (Fun (Fu f) S) = (K, T)"
    and "Anaf f = (K', T')"
    and "k ∈ set K"
    and "∀g ∈ funs_term (Fun (Fu f) S). ¬is_Abs g"
  shows "∀g ∈ funs_term k. ¬is_Abs g"
using assms(3,4) Anaf_keys_not_val_terms(3)[OF assms(2)]
      Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
by blast

lemma Ana_Fu_keys_not_pairs:
  fixes k::"('fun,'atom,'sets,'lbl) prot_term"
  assumes "Ana (Fun (Fu f) S) = (K, T)"
    and "Anaf f = (K', T')"
    and "k ∈ set K"
    and "∀g ∈ funs_term (Fun (Fu f) S). g ≠ Pair"
  shows "∀g ∈ funs_term k. g ≠ Pair"
using assms(3,4) Anaf_keys_not_pairs[OF assms(2)]
      Ana_Fu_keys_funs_term_subset[OF assms(1,2)]
by blast

lemma Ana_Fu_keys_length_eq:
  assumes "length T = length S"
  shows "length (fst (Ana (Fun (Fu f) T))) = length (fst (Ana (Fun (Fu f) S)))"
proof (cases "arityf f = length T ∧ arityf f > 0")
  case True thus ?thesis using assms by (cases "Anaf f") auto
next
  case False thus ?thesis using assms by force
qed

lemma Ana_key_PubConstValue_subterm_in_term: 
  fixes k::"('fun,'atom,'sets,'lbl) prot_term"
  assumes KR: "Ana t = (K, R)"
    and k: "k ∈ set K"
    and n: "Fun (PubConst Value n) [] ⊑ k"
  shows "Fun (PubConst Value n) [] ⊑ t"
proof (cases t)
  case (Var x) thus ?thesis using KR k n by force
next
  case (Fun f ts)
  note t = this
  then obtain g where f: "f = Fu g" using KR k by (cases f) auto
  obtain K' R' where KR': "Anaf g = (K', R')" by fastforce

  have K: "K = K' ⋅list (!) ts"
    using k Ana_Fu_elim(2)[OF KR[unfolded t] f KR'] by force

  obtain k' where k': "k' ∈ set K'" "k = k' ⋅ (!) ts" using k K by auto

  have 0: "¬(Fun (PubConst Value n) [] ⊑ k')"
  proof
    assume *: "Fun (PubConst Value n) [] ⊑ k'"
    have **: "PubConst Value n ∈ funs_term k'"
      using funs_term_Fun_subterm'[OF *] by (cases k') auto
    show False
      using Anaf_keys_not_val_terms(2)[OF KR' k'(1) **]
      unfolding is_PubConstValue_def by force
  qed
  hence "∃i ∈ fv k'. Fun (PubConst Value n) [] ⊑ ts ! i"
    by (metis n const_subterm_subst_var_obtain k'(2))
  then obtain i where i: "i ∈ fv k'" "Fun (PubConst Value n) [] ⊑ ts ! i" by blast

  have "i < length ts"
    using i(1) KR' k'(1) Anaf_assm2_alt[OF KR', of i]
          Ana_Fu_elim(1)[OF KR[unfolded t] f KR'] k
    by fastforce
  thus ?thesis using i(2) unfolding t by force
qed

lemma deduct_occurs_in_ik:
  fixes t::"('fun,'atom,'sets,'lbl) prot_term"
  assumes t: "M ⊢ occurs t"
    and M: "∀s ∈ subtermsset M. OccursFact ∉ ⋃(funs_term ` set (snd (Ana s)))"
           "∀s ∈ subtermsset M. OccursSec ∉ ⋃(funs_term ` set (snd (Ana s)))"
           "Fun OccursSec [] ∉ M"
  shows "occurs t ∈ M"
using private_fun_deduct_in_ik''[of M OccursFact "[Fun OccursSec [], t]" OccursSec] t M 
by fastforce

lemma deduct_val_const_swap:
  fixes θ σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "M ⋅set θ ⊢ t ⋅ θ"
    and "∀x ∈ fvset M ∪ fv t. (∃n. θ x = Fun (Val n) []) ∨ (∃n. θ x = Fun (PubConst Value n) [])"
    and "∀x ∈ fvset M ∪ fv t. (∃n. σ x = Fun (Val n) [])"
    and "∀x ∈ fvset M ∪ fv t. (∃n. θ x = Fun (PubConst Value n) []) ⟶ σ x ∈ M ∪ N"
    and "∀x ∈ fvset M ∪ fv t. (∃n. θ x = Fun (Val n) []) ⟶ θ x = σ x"
    and "∀x ∈ fvset M ∪ fv t. ∀y ∈ fvset M ∪ fv t. θ x = θ y ⟷ σ x = σ y"
    and "∀n. ¬(Fun (PubConst Value n) [] ⊑set insert t M)"
  shows "(M ⋅set σ) ∪ N ⊢ t ⋅ σ"
proof -
  obtain n where n: "intruder_deduct_num (M ⋅set θ) n (t ⋅ θ)"
    using assms(1) deduct_num_if_deduct by blast
  hence "∃m ≤ n. intruder_deduct_num ((M ⋅set σ) ∪ N) m (t ⋅ σ)" using assms(2-)
  proof (induction n arbitrary: t rule: nat_less_induct)
    case (1 n)
    note prems = "1.prems"
    note IH = "1.IH"

    show ?case
    proof (cases "t ⋅ θ ∈ M ⋅set θ")
      case True
      note 2 = this
      have 3: "∀x ∈ fvset M ∪ fv t. ∃c. θ x = Fun c []"
              "∀x ∈ fvset M ∪ fv t. ∃c. σ x = Fun c []"
        using prems(2,3) by (blast, blast)
      have "t ⋅ σ ∈ M ⋅set σ"
        using subst_const_swap_eq_mem[OF 2 _ 3 prems(6)] prems(2,5,7) by metis
      thus ?thesis using intruder_deduct_num.AxiomN by auto
    next
      case False
      then obtain n' where n: "n = Suc n'" using prems(1) deduct_zero_in_ik by (cases n) fast+

      have M_subterms_eq:
          "subtermsset (M ⋅set θ) = subtermsset M ⋅set θ"
          "subtermsset (M ⋅set σ) = subtermsset M ⋅set σ"
        subgoal using prems(2) subterms_subst''[of M θ] by blast
        subgoal using prems(3) subterms_subst''[of M σ] by blast
        done

      from deduct_inv[OF prems(1)] show ?thesis
      proof (elim disjE)
        assume "t ⋅ θ ∈ M ⋅set θ" thus ?thesis using False by argo
      next
        assume "∃f ts. t ⋅ θ = Fun f ts ∧ public f ∧ length ts = arity f ∧
                     (∀t ∈ set ts. ∃l < n. intruder_deduct_num (M ⋅set θ) l t)"
        then obtain f ts where t:
            "t ⋅ θ = Fun f ts" "public f" "length ts = arity f"
            "∀t ∈ set ts. ∃l < n. intruder_deduct_num (M ⋅set θ) l t"
          by blast
  
        show ?thesis
        proof (cases t)
          case (Var x)
          hence ts: "ts = []" and f: "∃c. f = PubConst Value c"
            using t(1,2) prems(2) by (force, auto)
          have "σ x ∈ M ∪ N" using prems(4) Var f ts t(1) by auto
          moreover have "fv (σ x) = {}" using prems(3) Var by auto
          hence "σ x ∈ M ⋅set σ" when "σ x ∈ M" using that subst_ground_ident[of "σ x" σ] by force
          ultimately have "σ x ∈ (M ⋅set σ) ∪ N" by fast
          thus ?thesis using intruder_deduct_num.AxiomN Var by force
        next
          case (Fun g ss)
          hence f: "f = g" and ts: "ts = ss ⋅list θ" using t(1) by auto
  
          have ss: "∃l < n. intruder_deduct_num (M ⋅set θ) l (s ⋅ θ)" when s: "s ∈ set ss" for s
            using t(4) ts s by auto
  
          have IH': "∃l < n. intruder_deduct_num ((M ⋅set σ) ∪ N) l (s ⋅ σ)"
            when s: "s ∈ set ss" for s
          proof -
            obtain l where l: "l < n" "intruder_deduct_num (M ⋅set θ) l (s ⋅ θ)"
              using ss s by blast
            
            have *: "fv s ⊆ fv t" "subtermsset (insert s M) ⊆ subtermsset (insert t M)"
              using s unfolding Fun f ts by auto

            have "∃l' ≤ l. intruder_deduct_num ((M ⋅set σ) ∪ N) l' (s ⋅ σ)"
            proof -
              have "∀x ∈ fvset M ∪ fv s.
                      (∃n. θ x = Fun (Val n) []) ∨ (∃n. θ x = Fun (PubConst Value n) [])"
                   "∀x ∈ fvset M ∪ fv s. ∃n. σ x = Fun (Val n) []"
                   "∀x ∈ fvset M ∪ fv s. (∃n. θ x = Fun (PubConst Value n) []) ⟶ σ x ∈ M ∪ N"
                   "∀x ∈ fvset M ∪ fv s. (∃n. θ x = Fun (Val n) []) ⟶ θ x = σ x"
                   "∀x ∈ fvset M ∪ fv s. ∀y ∈ fvset M ∪ fv s. θ x = θ y ⟷ σ x = σ y"
                   "∀n. Fun (PubConst Value n) [] ∉ subtermsset (insert s M)"
                subgoal using prems(2) *(1) by blast
                subgoal using prems(3) *(1) by blast
                subgoal using prems(4) *(1) by blast
                subgoal using prems(5) *(1) by blast
                subgoal using prems(6) *(1) by blast
                subgoal using prems(7) *(2) by blast
                done
              thus ?thesis using IH l by presburger
            qed
            then obtain l' where l': "l' ≤ l" "intruder_deduct_num ((M ⋅set σ) ∪ N) l' (s ⋅ σ)"
              by blast

            have "l' < n" using l'(1) l(1) by linarith
            thus ?thesis using l'(2) by blast
          qed
  
          have g: "length (ss ⋅list σ) = arity g" "public g"
            using t(2,3) unfolding f ts by auto

          let ?P = "λs l. l < n ∧ intruder_deduct_num ((M ⋅set σ) ∪ N) l s"
          define steps where "steps ≡ λs. SOME l. ?P s l"
  
          have 2: "steps (s ⋅ σ) < n" "intruder_deduct_num ((M ⋅set σ) ∪ N) (steps (s ⋅ σ)) (s ⋅ σ)"
            when s: "s ∈ set ss" for s
            using someI_ex[OF IH'[OF s]] unfolding steps_def by (blast, blast)
  
          have 3: "Suc (Max (insert 0 (steps ` set (ss ⋅list σ)))) ≤ n"
          proof (cases "ss = []")
            case True show ?thesis unfolding True n by simp
          next
            case False thus ?thesis
              using 2 Max_nat_finite_lt[of "set (ss ⋅list σ)" steps n] by (simp add: Suc_leI)
          qed
  
          show ?thesis
            using intruder_deduct_num.ComposeN[OF g, of "(M ⋅set σ) ∪ N" steps] 2(2) 3
            unfolding Fun by auto
        qed
      next
        assume "∃s ∈ subtermsset (M ⋅set θ).
                  (∃l < n. intruder_deduct_num (M ⋅set θ) l s) ∧
                  (∀k ∈ set (fst (Ana s)). ∃l < n. intruder_deduct_num (M ⋅set θ) l k) ∧
                  t ⋅ θ ∈ set (snd (Ana s))"
        then obtain s l
            where s:
              "s ∈ subtermsset M ⋅set θ"
              "∀k ∈ set (fst (Ana s)). ∃l < n. intruder_deduct_num (M ⋅set θ) l k"
              "t ⋅ θ ∈ set (snd (Ana s))"
            and l: "l < n" "intruder_deduct_num (M ⋅set θ) l s"
          by (metis (no_types, lifting) M_subterms_eq(1))

        obtain u where u: "u ⊑set M" "s = u ⋅ θ" using s(1) by blast

        have u_fv: "fv u ⊆ fvset M" by (metis fv_subset_subterms u(1))

        have "∄x. u = Var x"
        proof
          assume "∃x. u = Var x"
          then obtain x where x: "u = Var x" by blast
          then obtain c where c: "s = Fun c []" using u prems(2) u_fv by auto
          thus False using s(3) Ana_subterm by (cases "Ana s") force
        qed
        then obtain f ts where u': "u = Fun f ts" by (cases u) auto

        obtain K R where KR: "Ana u = (K,R)" by (metis surj_pair)

        have KR': "Ana s = (K ⋅list θ, R ⋅list θ)"
          using KR Ana_subst'[OF KR[unfolded u'], of θ] unfolding u(2) u' by blast
        hence s': 
            "∀k ∈ set K. ∃l < n. intruder_deduct_num (M ⋅set θ) l (k ⋅ θ)"
            "t ⋅ θ ∈ set (R ⋅list θ)"
          using s(2,3) by auto

        have IH1: "∃l < n. intruder_deduct_num ((M ⋅set σ) ∪ N) l (u ⋅ σ)"
        proof -
          have "subterms u ⊆ subtermsset M" using u(1) subterms_subset by auto
          hence "subtermsset (insert u M) = subtermsset M" by blast
          hence *: "subtermsset (insert u M) ⊆ subtermsset (insert t M)" by auto

          have "∃l' ≤ l. intruder_deduct_num ((M ⋅set σ) ∪ N) l' (u ⋅ σ)"
          proof -
            have "∀x ∈ fvset M ∪ fv u.
                    (∃n. θ x = Fun (Val n) []) ∨ (∃n. θ x = Fun (PubConst Value n) [])"
                 "∀x ∈ fvset M ∪ fv u. ∃n. σ x = Fun (Val n) []"
                 "∀x ∈ fvset M ∪ fv u. (∃n. θ x = Fun (PubConst Value n) []) ⟶ σ x ∈ M ∪ N"
                 "∀x ∈ fvset M ∪ fv u. (∃n. θ x = Fun (Val n) []) ⟶ θ x = σ x"
                 "∀x ∈ fvset M ∪ fv u. ∀y ∈ fvset M ∪ fv u. θ x = θ y ⟷ σ x = σ y"
                 "∀n. Fun (PubConst Value n) [] ∉ subtermsset (insert u M)"
              subgoal using prems(2) u_fv by blast
              subgoal using prems(3) u_fv by blast
              subgoal using prems(4) u_fv by blast
              subgoal using prems(5) u_fv by blast
              subgoal using prems(6) u_fv by blast
              subgoal using prems(7) * by blast
              done
            thus ?thesis using IH l unfolding u(2) by presburger
          qed
          then obtain l' where l': "l' ≤ l" "intruder_deduct_num ((M ⋅set σ) ∪ N) l' (u ⋅ σ)"
            by blast

          have "l' < n" using l'(1) l(1) by linarith
          thus ?thesis using l'(2) by blast
        qed

        have IH2: "∃l < n. intruder_deduct_num ((M ⋅set σ) ∪ N) l (k ⋅ σ)" when k: "k ∈ set K" for k
          using k IH prems(2-) Anaf_keys_not_val_terms s'(1) KR u(1)
        proof -
          have *: "fv k ⊆ fvset M" using k KR Ana_keys_fv u(1) fv_subset_subterms by blast

          have **: "Fun (PubConst Value n) [] ⊑set M" when "Fun (PubConst Value n) [] ⊑ k" for n
            using in_subterms_subset_Union[OF u(1)]
                  Ana_key_PubConstValue_subterm_in_term[OF KR k that]
            by fast

          obtain lk where lk: "lk < n" "intruder_deduct_num (M ⋅set θ) lk (k ⋅ θ)"
            using s'(1) k by fast

          have "∃l' ≤ lk. intruder_deduct_num ((M ⋅set σ) ∪ N) l' (k ⋅ σ)"
          proof -
            have "∀x ∈ fvset M ∪ fv k.
                    (∃n. θ x = Fun (Val n) []) ∨ (∃n. θ x = Fun (PubConst Value n) [])"
                 "∀x ∈ fvset M ∪ fv k. ∃n. σ x = Fun (Val n) []"
                 "∀x ∈ fvset M ∪ fv k. (∃n. θ x = Fun (PubConst Value n) []) ⟶ σ x ∈ M ∪ N"
                 "∀x ∈ fvset M ∪ fv k. (∃n. θ x = Fun (Val n) []) ⟶ θ x = σ x"
                 "∀x ∈ fvset M ∪ fv k. ∀y ∈ fvset M ∪ fv k. θ x = θ y ⟷ σ x = σ y"
                 "∀n. Fun (PubConst Value n) [] ∉ subtermsset (insert k M)"
              subgoal using prems(2) * by blast
              subgoal using prems(3) * by blast
              subgoal using prems(4) * by blast
              subgoal using prems(5) * by blast
              subgoal using prems(6) * by blast
              subgoal using prems(7) ** by blast
              done
            thus ?thesis using IH lk by presburger
          qed
          then obtain lk' where lk': "lk' ≤ lk" "intruder_deduct_num ((M ⋅set σ) ∪ N) lk' (k ⋅ σ)"
            by blast

          have "lk' < n" using lk'(1) lk(1) by linarith
          thus ?thesis using lk'(2) by blast
        qed

        have KR'': "Ana (u ⋅ σ) = (K ⋅list σ, R ⋅list σ)"
          using Ana_subst' KR unfolding u' by blast

        obtain r where r: "r ∈ set R" "t ⋅ θ = r ⋅ θ"
          using s'(2) by fastforce

        have r': "t ⋅ σ ∈ set (R ⋅list σ)"
        proof -
          have r_subterm_u: "r ⊑ u" using r(1) KR Ana_subterm by blast

          have r_fv: "fv r ⊆ fvset M"
            by (meson r_subterm_u u(1) fv_subset_subterms in_mono in_subterms_subset_Union)

          have t_subterms_M: "subterms t ⊆ subtermsset (insert t M)"
            by blast

          have r_subterm_M: "subterms r ⊆ subtermsset (insert t M)"
            using subterms_subset[OF r_subterm_u] in_subterms_subset_Union[OF u(1)]
            by (auto intro: subtermsset_mono)

          have *: "∀x ∈ fv t ∪ fv r. θ x = σ x ∨ ¬(θ x ⊑ t) ∧ ¬(θ x ⊑ r)"
          proof
            fix x assume "x ∈ fv t ∪ fv r"
            hence "x ∈ fvset M ∪ fv t" using r_fv by blast
            thus "θ x = σ x ∨ ¬(θ x ⊑ t) ∧ ¬(θ x ⊑ r)"
              using prems(2,5,7) r_subterm_M t_subterms_M
              by (metis (no_types, opaque_lifting) in_mono)
          qed

          have **: "∀x ∈ fv t ∪ fv r. ∃c. θ x = Fun c []"
                   "∀x ∈ fv t ∪ fv r. ∃c. σ x = Fun c []"
                   "∀x ∈ fv t ∪ fv r. ∀y ∈ fv t ∪ fv r. θ x = θ y ⟷ σ x = σ y"
            subgoal using prems(2) r_fv by blast
            subgoal using prems(3) r_fv by blast
            subgoal using prems(6) r_fv by blast
            done
          
          have "t ⋅ σ = r ⋅ σ" by (rule subst_const_swap_eq'[OF r(2) * **])
          thus ?thesis using r(1) by simp
        qed

        obtain l1 where l1: "l1 < n" "intruder_deduct_num ((M ⋅set σ) ∪ N) l1 (u ⋅ σ)"
          using IH1 by blast

        let ?P = "λs l. l < n ∧ intruder_deduct_num ((M ⋅set σ) ∪ N) l s"
        define steps where "steps ≡ λs. SOME l. ?P s l"

        have 2: "steps (k ⋅ σ) < n" "intruder_deduct_num ((M ⋅set σ) ∪ N) (steps (k ⋅ σ)) (k ⋅ σ)"
          when k: "k ∈ set K" for k
          using someI_ex[OF IH2[OF k]] unfolding steps_def by (blast, blast)

        have 3: "Suc (Max (insert l1 (steps ` set (K ⋅list σ)))) ≤ n"
        proof (cases "K = []")
          case True show ?thesis using l1(1) unfolding True n by simp
        next
          case False thus ?thesis
            using l1(1) 2 Max_nat_finite_lt[of "set (K ⋅list σ)" steps n] by (simp add: Suc_leI)
        qed

        have IH2': "intruder_deduct_num ((M ⋅set σ) ∪ N) (steps k) k"
          when k: "k ∈ set (K ⋅list σ)" for k
          using IH2 k 2 by auto

        show ?thesis
          using l1(1) intruder_deduct_num.DecomposeN[OF l1(2) KR'' IH2' r'] 3 by fast
      qed
    qed
  qed
  thus ?thesis using deduct_if_deduct_num by blast
qed

lemma constraint_model_Nil:
  assumes I: "interpretationsubst I" "wftrms (subst_range I)"
  shows "constraint_model I []"
using I unfolding constraint_model_def by simp

lemma welltyped_constraint_model_Nil:
  assumes I: "wtsubst I" "interpretationsubst I" "wftrms (subst_range I)"
  shows "welltyped_constraint_model I []"
using I(1) constraint_model_Nil[OF I(2,3)] unfolding welltyped_constraint_model_def by simp

lemma constraint_model_prefix:
  assumes "constraint_model I (A@B)"
  shows "constraint_model I A"
by (metis assms strand_sem_append_stateful unlabel_append constraint_model_def)

lemma welltyped_constraint_model_prefix:
  assumes "welltyped_constraint_model I (A@B)"
  shows "welltyped_constraint_model I A"
by (metis assms constraint_model_prefix welltyped_constraint_model_def)

lemma welltyped_constraint_model_deduct_append:
  assumes "welltyped_constraint_model I A"
    and "iklsst A ⋅set I ⊢ s ⋅ I"
  shows "welltyped_constraint_model I (A@[(l,send⟨[s]⟩)])"
using assms strand_sem_append_stateful[of "{}" "{}" "unlabel A" _ I]
unfolding welltyped_constraint_model_def constraint_model_def by simp

lemma welltyped_constraint_model_deduct_split:
  assumes "welltyped_constraint_model I (A@[(l,send⟨[s]⟩)])"
  shows "welltyped_constraint_model I A"
    and "iklsst A ⋅set I ⊢ s ⋅ I"
using assms strand_sem_append_stateful[of "{}" "{}" "unlabel A" _ I]
unfolding welltyped_constraint_model_def constraint_model_def by simp_all

lemma welltyped_constraint_model_deduct_iff:
  "welltyped_constraint_model I (A@[(l,send⟨[s]⟩)]) ⟷
    welltyped_constraint_model I A ∧ iklsst A ⋅set I ⊢ s ⋅ I"
by (metis welltyped_constraint_model_deduct_append welltyped_constraint_model_deduct_split)  

lemma welltyped_constraint_model_attack_if_receive_attack:
  assumes I: "welltyped_constraint_model ℐ 𝒜"
    and rcv_attack: "receive⟨ts⟩ ∈ set (unlabel 𝒜)" "attack⟨n⟩ ∈ set ts"
  shows "welltyped_constraint_model ℐ (𝒜@[(l, send⟨[attack⟨n⟩]⟩)])"
proof -
  have "iklsst 𝒜 ⋅set ℐ ⊢ attack⟨n⟩"
    using rcv_attack in_iksst_iff[of "attack⟨n⟩" "unlabel 𝒜"]
          ideduct_subst[OF intruder_deduct.Axiom[of "attack⟨n⟩" "iklsst 𝒜"], of ℐ]
    by auto
  thus ?thesis
    using I strand_sem_append_stateful[of "{}" "{}" "unlabel 𝒜" "[send⟨[attack⟨n⟩]⟩]" ℐ]
    unfolding welltyped_constraint_model_def constraint_model_def by auto
qed

lemma constraint_model_Val_is_Value_term:
  assumes "welltyped_constraint_model I A"
    and "t ⋅ I = Fun (Val n) []"
  shows "t = Fun (Val n) [] ∨ (∃m. t = Var (TAtom Value, m))"
proof -
  have "wtsubst I" using assms(1) unfolding welltyped_constraint_model_def by simp
  moreover have "Γ (Fun (Val n) []) = TAtom Value" by auto
  ultimately have *: "Γ t = TAtom Value" by (metis (no_types) assms(2) wt_subst_trm'')

  show ?thesis
  proof (cases t)
    case (Var x)
    obtain τ m where x: "x = (τ, m)" by (metis surj_pair)
    have "Γv x = TAtom Value" using * Var by auto
    hence "τ = TAtom Value" using x Γv_TAtom'[of Value τ m] by simp
    thus ?thesis using x Var by metis
  next
    case (Fun f T) thus ?thesis using assms(2) by auto
  qed
qed

lemma wellformed_transaction_sem_receives:
  fixes T::"('fun,'atom,'sets,'lbl) prot_transaction"
  assumes T_valid: "wellformed_transaction T"
    and ℐ: "strand_sem_stateful IK DB (unlabel (duallsst (transaction_strand T ⋅lsst θ))) ℐ"
    and s: "receive⟨ts⟩ ∈ set (unlabel (transaction_receive T ⋅lsst θ))"
  shows "∀t ∈ set ts. IK ⊢ t ⋅ ℐ"
proof -
  let ?R = "unlabel (duallsst (transaction_receive T ⋅lsst θ))"
  let ?S = "λA. unlabel (duallsst (A ⋅lsst θ))"
  let ?S' = "?S (transaction_receive T)"

  obtain l B s where B:
      "(l,send⟨ts⟩) = duallsstp ((l,s) ⋅lsstp θ)"
      "prefix ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ]) (transaction_receive T ⋅lsst θ)"
    using s duallsst_unlabel_steps_iff(2)[of ts "transaction_receive T ⋅lsst θ"]
          duallsst_in_set_prefix_obtain_subst[of "send⟨ts⟩" "transaction_receive T" θ]
    by blast

  have 1: "unlabel (duallsst ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ])) = unlabel (duallsst (B ⋅lsst θ))@[send⟨ts⟩]"
    using B(1) unlabel_append duallsstp_subst duallsst_subst singleton_lst_proj(4)
          duallsst_subst_snoc subst_lsst_append subst_lsst_singleton
    by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps)

  have "strand_sem_stateful IK DB ?S' ℐ"
    using ℐ strand_sem_append_stateful[of IK DB _ _ ℐ] transaction_dual_subst_unfold[of T θ]
    by fastforce
  hence "strand_sem_stateful IK DB (unlabel (duallsst (B ⋅lsst θ))@[send⟨ts⟩]) ℐ"
    using B 1 unfolding prefix_def unlabel_def
    by (metis duallsst_def map_append strand_sem_append_stateful) 
  hence t_deduct: "∀t ∈ set ts. IK ∪ (iklsst (duallsst (B ⋅lsst θ)) ⋅set ℐ) ⊢ t ⋅ ℐ"
    using strand_sem_append_stateful[of IK DB "unlabel (duallsst (B ⋅lsst θ))" "[send⟨ts⟩]" ℐ]
    by simp

  have "∀s ∈ set (unlabel (transaction_receive T)). ∃t. s = receive⟨t⟩"
    using T_valid wellformed_transaction_unlabel_cases(1)[OF T_valid] by auto
  moreover { fix A::"('fun,'atom,'sets,'lbl) prot_strand" and θ
    assume "∀s ∈ set (unlabel A). ∃t. s = receive⟨t⟩"
    hence "∀s ∈ set (unlabel (A ⋅lsst θ)). ∃t. s = receive⟨t⟩"
    proof (induction A)
      case (Cons a A) thus ?case using subst_lsst_cons[of a A θ] by (cases a) auto
    qed simp
    hence "∀s ∈ set (unlabel (A ⋅lsst θ)). ∃t. s = receive⟨t⟩"
      by (simp add: list.pred_set is_Receive_def)
    hence "∀s ∈ set (unlabel (duallsst (A ⋅lsst θ))). ∃t. s = send⟨t⟩"
      by (metis duallsst_memberD duallsstp_inv(2) unlabel_in unlabel_mem_has_label)
  }
  ultimately have "∀s ∈ set ?R. ∃ts. s = send⟨ts⟩" by simp
  hence "iksst ?R = {}" unfolding unlabel_def iksst_def by fast
  hence "iklsst (duallsst (B ⋅lsst θ)) = {}"
    using B(2) 1 iksst_append duallsst_append
    by (metis (no_types, lifting) Un_empty map_append prefix_def unlabel_def) 
  thus ?thesis using t_deduct by simp
qed

lemma wellformed_transaction_sem_pos_checks:
  assumes T_valid: "wellformed_transaction T"
    and ℐ: "strand_sem_stateful IK DB (unlabel (duallsst (transaction_strand T ⋅lsst θ))) ℐ"
  shows "⟨ac: t ∈ u⟩ ∈ set (unlabel (transaction_checks T ⋅lsst θ)) ⟹ (t ⋅ ℐ, u ⋅ ℐ) ∈ DB"
    and "⟨ac: t ≐ u⟩ ∈ set (unlabel (transaction_checks T ⋅lsst θ)) ⟹ t ⋅ ℐ = u ⋅ ℐ"
proof -
  let ?s = "⟨ac: t ∈ u⟩"
  let ?s' = "⟨ac: t ≐ u⟩"
  let ?C = "set (unlabel (transaction_checks T ⋅lsst θ))"
  let ?R = "transaction_receive T@transaction_checks T"
  let ?R' = "unlabel (duallsst (?R ⋅lsst θ))"
  let ?S = "λA. unlabel (duallsst (A ⋅lsst θ))"
  let ?S' = "?S (transaction_receive T)@?S (transaction_checks T)"
  let ?P = "λa. is_Receive a ∨ is_Check_or_Assignment a"
  let ?Q = "λa. is_Send a ∨ is_Check_or_Assignment a"
  let ?dbupd = "λB. dbupdsst (unlabel (duallsst (B ⋅lsst θ))) ℐ DB"

  have s_in: "?s ∈ ?C ⟹ ?s ∈ set (unlabel (?R ⋅lsst θ))"
             "?s' ∈ ?C ⟹ ?s' ∈ set (unlabel (?R ⋅lsst θ))"
    using subst_lsst_append[of "transaction_receive T"]
          unlabel_append[of "transaction_receive T"]
    by auto

  have 1: "unlabel (duallsst ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ])) = unlabel (duallsst (B ⋅lsst θ))@[s']"
    when B: "(l,s') = duallsstp ((l,s) ⋅lsstp θ)" "s' = ⟨ac: t ∈ u⟩ ∨ s' = ⟨ac: t ≐ u⟩"
    for l s s' and B::"('fun,'atom,'sets,'lbl) prot_strand"
    using B unlabel_append duallsstp_subst duallsst_subst singleton_lst_proj(4)
          duallsst_subst_snoc subst_lsst_append subst_lsst_singleton
    by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps)


  have 2: "strand_sem_stateful IK DB (unlabel (duallsst (B ⋅lsst θ))@[s']) ℐ"
    when B: "(l,s') = duallsstp ((l,s) ⋅lsstp θ)"
            "prefix ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ]) (?R ⋅lsst θ)"
            "s' = ⟨ac: t ∈ u⟩ ∨ s' = ⟨ac: t ≐ u⟩"
    for l s s' and B::"('fun,'atom,'sets,'lbl) prot_strand"
  proof -
    have "strand_sem_stateful IK DB ?S' ℐ"
      using ℐ strand_sem_append_stateful[of IK DB _ _ ℐ] transaction_dual_subst_unfold[of T θ]
      by fastforce
    thus ?thesis
      using B(2) 1[OF B(1,3)] strand_sem_append_stateful subst_lsst_append
      unfolding prefix_def unlabel_def duallsst_def by (metis (no_types) map_append)
  qed

  have s_sem:
      "?s ∈ ?C ⟹ (l,?s) = duallsstp ((l,s) ⋅lsstp θ) ⟹ (t ⋅ ℐ, u ⋅ ℐ) ∈ ?dbupd B"
      "?s' ∈ ?C ⟹ (l,?s') = duallsstp ((l,s) ⋅lsstp θ) ⟹ t ⋅ ℐ = u ⋅ ℐ"
    when B: "prefix ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ]) (?R ⋅lsst θ)"
    for l s and B::"('fun,'atom,'sets,'lbl) prot_strand"
    using 2[OF _ B] strand_sem_append_stateful[of IK DB "unlabel (duallsst (B ⋅lsst θ))" _ ℐ]
    by (fastforce, fastforce)

  have 3: "∀a ∈ set (unlabel (duallsst (B ⋅lsst θ))). ¬is_Insert a ∧ ¬is_Delete a"
    when B: "prefix ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ]) (?R ⋅lsst θ)"
    for l s and B::"('fun,'atom,'sets,'lbl) prot_strand"
  proof -
    have "∀a ∈ set (unlabel (duallsst (B ⋅lsst θ))). ?Q a"
    proof
      fix a assume a: "a ∈ set (unlabel (duallsst (B ⋅lsst θ)))"
  
      have "?P a" when a: "a ∈ set (unlabel ?R)" for a
        using a wellformed_transaction_unlabel_cases(1,2)[OF T_valid]
        unfolding unlabel_def by fastforce
      hence "?P a" when a: "a ∈ set (unlabel (?R ⋅lsst θ))" for a
        using a stateful_strand_step_cases_subst(2,11)[of _ θ] subst_lsst_unlabel[of ?R θ]
        unfolding subst_apply_stateful_strand_def by auto
      hence B_P: "∀a ∈ set (unlabel (B ⋅lsst θ)). ?P a"
        using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B]]]  by blast
  
      obtain l where "(l,a) ∈ set (duallsst (B ⋅lsst θ))"
        using a by (meson unlabel_mem_has_label)
      then obtain b where b: "(l,b) ∈ set (B ⋅lsst θ)" "duallsstp (l,b) = (l,a)"
        using duallsst_memberD by blast
      hence "?P b" using B_P unfolding unlabel_def by fastforce
      thus "?Q a" using duallsstp_inv[OF b(2)] by (cases b) auto
    qed
    thus ?thesis by fastforce
  qed

  show "(t ⋅ ℐ, u ⋅ ℐ) ∈ DB" when s: "?s ∈ ?C"
  proof -
    obtain l B s where B:
        "(l,?s) = duallsstp ((l,s) ⋅lsstp θ)"
        "prefix ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ]) (?R ⋅lsst θ)"
      using s_in(1)[OF s] duallsst_unlabel_steps_iff(6)[of _ t u]
            duallsst_in_set_prefix_obtain_subst[of ?s ?R θ]
      by blast

    show ?thesis
      using 3[OF B(2)] s_sem(1)[OF B(2) s B(1)]
            dbupdsst_no_upd[of "unlabel (duallsst (B ⋅lsst θ))" ℐ DB]
      by simp
  qed

  show "t ⋅ ℐ = u ⋅ ℐ" when s: "?s' ∈ ?C"
  proof -
    obtain l B s where B:
        "(l,?s') = duallsstp ((l,s) ⋅lsstp θ)"
        "prefix ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ]) (?R ⋅lsst θ)"
      using s_in(2)[OF s] duallsst_unlabel_steps_iff(3)[of _ t u]
            duallsst_in_set_prefix_obtain_subst[of ?s' ?R θ]
      by blast

    show ?thesis
      using 3[OF B(2)] s_sem(2)[OF B(2) s B(1)]
            dbupdsst_no_upd[of "unlabel (duallsst (B ⋅lsst θ))" ℐ DB]
      by simp
  qed
qed

lemma wellformed_transaction_sem_neg_checks:
  assumes T_valid: "wellformed_transaction T"
    and ℐ: "strand_sem_stateful IK DB (unlabel (duallsst (transaction_strand T ⋅lsst θ))) ℐ"
    and "NegChecks X F G ∈ set (unlabel (transaction_checks T ⋅lsst θ))"
  shows "negchecks_model ℐ DB X F G"
proof -
  let ?s = "NegChecks X F G"
  let ?R = "transaction_receive T@transaction_checks T"
  let ?R' = "unlabel (duallsst (?R ⋅lsst θ))"
  let ?S = "λA. unlabel (duallsst (A ⋅lsst θ))"
  let ?S' = "?S (transaction_receive T)@?S (transaction_checks T)"
  let ?P = "λa. is_Receive a ∨ is_Check_or_Assignment a"
  let ?Q = "λa. is_Send a ∨ is_Check_or_Assignment a"
  let ?U = "λδ. subst_domain δ = set X ∧ ground (subst_range δ)"

  have s: "?s ∈ set (unlabel (?R ⋅lsst θ))"
    using assms(3) subst_lsst_append[of "transaction_receive T"]
          unlabel_append[of "transaction_receive T"]
    by auto

  obtain l B s where B:
      "(l,?s) = duallsstp ((l,s) ⋅lsstp θ)"
      "prefix ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ]) (?R ⋅lsst θ)"
    using s duallsst_unlabel_steps_iff(7)[of X F G]
          duallsst_in_set_prefix_obtain_subst[of ?s ?R θ]
    by blast

  have 1: "unlabel (duallsst ((B ⋅lsst θ)@[(l,s) ⋅lsstp θ])) = unlabel (duallsst (B ⋅lsst θ))@[?s]"
    using B(1) unlabel_append duallsstp_subst duallsst_subst singleton_lst_proj(4)
          duallsst_subst_snoc subst_lsst_append subst_lsst_singleton
    by (metis (no_types, lifting) subst_apply_labeled_stateful_strand_step.simps)

  have "strand_sem_stateful IK DB ?S' ℐ"
    using ℐ strand_sem_append_stateful[of IK DB _ _ ℐ] transaction_dual_subst_unfold[of T θ]
    by fastforce
  hence "strand_sem_stateful IK DB (unlabel (duallsst (B ⋅lsst θ))@[?s]) ℐ"
    using B 1 strand_sem_append_stateful subst_lsst_append
    unfolding prefix_def unlabel_def duallsst_def
    by (metis (no_types) map_append)
  hence s_sem: "negchecks_model ℐ (dbupdsst (unlabel (duallsst (B ⋅lsst θ))) ℐ DB) X F G"
    using strand_sem_append_stateful[of IK DB "unlabel (duallsst (B ⋅lsst θ))" "[?s]" ℐ]
    by fastforce

  have "∀a ∈ set (unlabel (duallsst (B ⋅lsst θ))). ?Q a"
  proof
    fix a assume a: "a ∈ set (unlabel (duallsst (B ⋅lsst θ)))"

    have "?P a" when a: "a ∈ set (unlabel ?R)" for a
      using a wellformed_transaction_unlabel_cases(1,2,3)[OF T_valid]
      unfolding unlabel_def by fastforce
    hence "?P a" when a: "a ∈ set (unlabel (?R ⋅lsst θ))" for a
      using a stateful_strand_step_cases_subst(2,11)[of _ θ] subst_lsst_unlabel[of ?R θ]
      unfolding subst_apply_stateful_strand_def by auto
    hence B_P: "∀a ∈ set (unlabel (B ⋅lsst θ)). ?P a"
      using unlabel_mono[OF set_mono_prefix[OF append_prefixD[OF B(2)]]]
      by blast

    obtain l where "(l,a) ∈ set (duallsst (B ⋅lsst θ))"
      using a by (meson unlabel_mem_has_label)
    then obtain b where b: "(l,b) ∈ set (B ⋅lsst θ)" "duallsstp (l,b) = (l,a)"
      using duallsst_memberD by blast
    hence "?P b" using B_P unfolding unlabel_def by fastforce
    thus "?Q a" using duallsstp_inv[OF b(2)] by (cases b) auto
  qed
  hence "∀a ∈ set (unlabel (duallsst (B ⋅lsst θ))). ¬is_Insert a ∧ ¬is_Delete a" by fastforce
  thus ?thesis using dbupdsst_no_upd[of "unlabel (duallsst (B ⋅lsst θ))" ℐ DB] s_sem by simp
qed

lemma wellformed_transaction_sem_neg_checks':
  assumes T_valid: "wellformed_transaction T"
    and ℐ: "strand_sem_stateful IK DB (unlabel (duallsst (transaction_strand T ⋅lsst θ))) ℐ"
    and c: "NegChecks X [] [(t,u)] ∈ set (unlabel (transaction_checks T ⋅lsst θ))"
  shows "∀δ. subst_domain δ = set X ∧ ground (subst_range δ) ⟶ (t ⋅ δ ⋅ ℐ, u ⋅ δ ⋅ ℐ) ∉ DB" (is ?A)
    and "X = [] ⟹ (t ⋅ ℐ, u ⋅ ℐ) ∉ DB" (is "?B ⟹ ?B'")
proof -
  show ?A
    using wellformed_transaction_sem_neg_checks[OF T_valid ℐ c]
    unfolding negchecks_model_def by auto
  moreover have "δ = Var" "t ⋅ δ = t"
    when "subst_domain δ = set []" for t and δ::"('fun, 'atom, 'sets, 'lbl) prot_subst"
    using that by auto
  moreover have "subst_domain Var = set []" "range_vars Var = {}"
    by simp_all
  ultimately show "?B ⟹ ?B'" unfolding range_vars_alt_def by metis
qed

lemma wellformed_transaction_sem_iff:
  fixes T θ
  defines "A ≡ unlabel (duallsst (transaction_strand T ⋅lsst θ))"
    and "rm ≡ λX. rm_vars (set X)"
  assumes T: "wellformed_transaction T"
    and I: " interpretationsubst I" "wftrms (subst_range I)"
  shows "strand_sem_stateful M D A I ⟷ (
    (∀l ts. (l,receive⟨ts⟩) ∈ set (transaction_receive T) ⟶ (∀t ∈ set ts. M ⊢ t ⋅ θ ⋅ I)) ∧
    (∀l ac t s. (l,⟨ac: t ≐ s⟩) ∈ set (transaction_checks T) ⟶ t ⋅ θ ⋅ I = s ⋅ θ ⋅ I) ∧
    (∀l ac t s. (l,⟨ac: t ∈ s⟩) ∈ set (transaction_checks T) ⟶ (t ⋅ θ ⋅ I, s ⋅ θ ⋅ I) ∈ D) ∧
    (∀l X F G. (l,∀X⟨∨≠: F ∨∉: G⟩) ∈ set (transaction_checks T) ⟶
      (∀δ. subst_domain δ = set X ∧ ground (subst_range δ) ⟶
            (∃(t,s) ∈ set F. t ⋅ rm X θ ⋅ δ ⋅ I ≠ s ⋅ rm X θ ⋅ δ ⋅ I) ∨
            (∃(t,s) ∈ set G. (t ⋅ rm X θ ⋅ δ ⋅ I, s ⋅ rm X θ ⋅ δ ⋅ I) ∉ D))))"
    (is "?A ⟷ ?B")
proof
  note 0 = A_def transaction_dual_subst_unlabel_unfold
  note 1 = wellformed_transaction_sem_receives[OF T, of M D θ I, unfolded A_def[symmetric]]
           wellformed_transaction_sem_pos_checks[OF T, of M D θ I, unfolded A_def[symmetric]]
           wellformed_transaction_sem_neg_checks[OF T, of M D θ I, unfolded A_def[symmetric]]
  note 2 = stateful_strand_step_subst_inI[OF unlabel_in]
  note 3 = unlabel_subst
  note 4 = strand_sem_append_stateful[of M D _ _ I]

  let ?C = "λT. unlabel (duallsst (T ⋅lsst θ))"
  let ?P = "λX δ. subst_domain δ = set X ∧ ground (subst_range δ)"
  let ?sem = "λM D T. strand_sem_stateful M D (?C T) I"
  let ?negchecks = "λX F G. ∀δ. ?P X δ ⟶
                                 (∃(t,s) ∈ set F. t ⋅ rm X θ ⋅ δ ⋅ I ≠ s ⋅ rm X θ ⋅ δ ⋅ I) ∨
                                 (∃(t,s) ∈ set G. (t ⋅ rm X θ ⋅ δ ⋅ I, s ⋅ rm X θ ⋅ δ ⋅ I) ∉ D)"

  have "list_all is_Receive (unlabel (transaction_receive T))"
       "list_all is_Check_or_Assignment (unlabel (transaction_checks T))"
       "list_all is_Update (unlabel (transaction_updates T))"
       "list_all is_Send (unlabel (transaction_send T))"
    using T unfolding wellformed_transaction_def by (blast, blast, blast, blast)
  hence 5: "list_all is_Send (?C (transaction_receive T))"
           "list_all is_Check_or_Assignment (?C (transaction_checks T))"
           "list_all is_Update (?C (transaction_updates T))"
           "list_all is_Receive (?C (transaction_send T))"
    by (metis (no_types) subst_sst_list_all(2) unlabel_subst duallsst_list_all(1),
        metis (no_types) subst_sst_list_all(11) unlabel_subst duallsst_list_all(11),
        metis (no_types) subst_sst_list_all(10) unlabel_subst duallsst_list_all(10),
        metis (no_types) subst_sst_list_all(1) unlabel_subst duallsst_list_all(2))
  
  have "∀a ∈ set (?C (transaction_receive T)). ¬is_Receive a ∧ ¬is_Insert a ∧ ¬is_Delete a"
       "∀a ∈ set (?C (transaction_checks T)). ¬is_Receive a ∧ ¬is_Insert a ∧ ¬is_Delete a"
    using 5(1,2) unfolding list_all_iff by (blast,blast)
  hence 6:
      "M ∪ (iksst (?C (transaction_receive T)) ⋅set I) = M"
      "dbupdsst (?C (transaction_receive T)) I D = D"
      "M ∪ (iksst (?C (transaction_checks T)) ⋅set I) = M"
      "dbupdsst (?C (transaction_checks T)) I D = D"
    by (metis iksst_snoc_no_receive_empty sup_bot.right_neutral, metis dbupdsst_no_upd,
        metis iksst_snoc_no_receive_empty sup_bot.right_neutral, metis dbupdsst_no_upd)

  have ?B when A: ?A
  proof -
    have "M ⊢ t ⋅ θ ⋅ I"
      when "(l, receive⟨ts⟩) ∈ set (transaction_receive T)" "t ∈ set ts" for l ts t
      using that(2) 1(1)[OF A, of "ts ⋅list θ"] 2(2)[OF that(1)] unfolding 3 by auto
    moreover have "t ⋅ θ ⋅ I = s ⋅ θ ⋅ I"
      when "(l, ⟨ac: t ≐ s⟩) ∈ set (transaction_checks T)" for l ac t s
      using 1(3)[OF A] 2(3)[OF that] unfolding 3 by blast
    moreover have "(t ⋅ θ ⋅ I, s ⋅ θ ⋅ I) ∈ D"
      when "(l, ⟨ac: t ∈ s⟩) ∈ set (transaction_checks T)" for l ac t s
      using 1(2)[OF A] 2(6)[OF that] unfolding 3 by blast
    moreover have "?negchecks X F G"
      when "(l, ∀X⟨∨≠: F ∨∉: G⟩) ∈ set (transaction_checks T)" for l X F G
      using 1(4)[OF A 2(7)[OF that, of θ, unfolded 3]]
      unfolding negchecks_model_def rm_def subst_apply_pairs_def by fastforce
    ultimately show ?B by blast
  qed
  thus "?A ⟹ ?B" by fast

  have ?A when B: ?B
  proof -
    have 7: "∀t ∈ set ts. M ⊢ t ⋅ I" when ts: "send⟨ts⟩ ∈ set (?C (transaction_receive T))" for ts
    proof -
      obtain l ss where "(l,receive⟨ss⟩) ∈ set (transaction_receive T)" "ts = ss ⋅list θ"
        by (metis ts duallsst_unlabel_steps_iff(2) subst_lsst_memD(1) unlabel_mem_has_label)
      thus ?thesis using B by auto
    qed

    have 8: "t ⋅ I = s ⋅ I" when ts: "⟨ac: t ≐ s⟩ ∈ set (?C (transaction_checks T))" for ac t s
    proof -
      obtain l t' s' where "(l,⟨ac: t' ≐ s'⟩) ∈ set (transaction_checks T)" "t = t' ⋅ θ" "s = s' ⋅ θ"
        by (metis ts duallsst_unlabel_steps_iff(3) subst_lsst_memD(3) unlabel_mem_has_label)
      thus ?thesis using B by auto
    qed

    have 9: "(t ⋅ I, s ⋅ I) ∈ D" when ts: "⟨ac: t ∈ s⟩ ∈ set (?C (transaction_checks T))" for ac t s
    proof -
      obtain l t' s' where "(l,⟨ac: t' ∈ s'⟩) ∈ set (transaction_checks T)" "t = t' ⋅ θ" "s = s' ⋅ θ"
        by (metis ts duallsst_unlabel_steps_iff(6) subst_lsst_memD(6) unlabel_mem_has_label)
      thus ?thesis using B by auto
    qed

    have 10: "negchecks_model I D X F G"
      when ts: "∀X⟨∨≠: F ∨∉: G⟩ ∈ set (?C (transaction_checks T))" for X F G
    proof -
      obtain l F' G' where *:
          "(l,∀X⟨∨≠: F' ∨∉: G'⟩) ∈ set (transaction_checks T)"
          "F = F' ⋅pairs rm_vars (set X) θ" "G = G' ⋅pairs rm_vars (set X) θ"
        using unlabel_mem_has_label[OF iffD2[OF duallsst_unlabel_steps_iff(7) ts]]
              subst_lsst_memD(7)[of _ X F G "transaction_checks T" θ]
        by fast

      have "?negchecks X F' G'" using *(1) B by blast
      moreover have "∃(t,s) ∈ set F. t ⋅ δ ∘s I ≠ s ⋅ δ ∘s I"
        when "(t,s) ∈ set F'" "t ⋅ rm X θ ⋅ δ ⋅ I ≠ s ⋅ rm X θ ⋅ δ ⋅ I" for δ t s
        using that unfolding rm_def *(2) subst_apply_pairs_def by force
      moreover have "∃(t,s) ∈ set G. (t,s) ⋅p δ ∘s I ∉ D"
        when "(t,s) ∈ set G'" "(t ⋅ rm X θ ⋅ δ ⋅ I, s ⋅ rm X θ ⋅ δ ⋅ I) ∉ D" for δ t s
        using that unfolding rm_def *(3) subst_apply_pairs_def by force
      ultimately show ?thesis
        unfolding negchecks_model_def by auto
    qed
    
    have "?sem M D (transaction_receive T)"
      using 7 strand_sem_stateful_if_sends_deduct[OF 5(1)] by blast
    moreover have "?sem M D (transaction_checks T)"
      using 8 9 10 strand_sem_stateful_if_checks[OF 5(2)] by blast
    moreover have "?sem M D (transaction_updates T)" for M D
      using 5(3) strand_sem_stateful_if_no_send_or_check unfolding list_all_iff by blast
    moreover have "?sem M D (transaction_send T)" for M D
      using 5(4) strand_sem_stateful_if_no_send_or_check unfolding list_all_iff by blast
    ultimately show ?thesis
      using 4[of "?C (transaction_receive T)"
                 "?C (transaction_checks T)@?C (transaction_updates T)@?C (transaction_send T)"]
            4[of "?C (transaction_checks T)" "?C (transaction_updates T)@?C (transaction_send T)"]
            4[of "?C (transaction_updates T)" "?C (transaction_send T)"]
      unfolding 0 6 by blast
  qed
  thus "?B ⟹ ?A" by fast
qed

lemma wellformed_transaction_unlabel_sem_iff:
  fixes T θ
  defines "A ≡ unlabel (duallsst (transaction_strand T ⋅lsst θ))"
    and "rm ≡ λX. rm_vars (set X)"
  assumes T: "wellformed_transaction T"
    and I: " interpretationsubst I" "wftrms (subst_range I)"
  shows "strand_sem_stateful M D A I ⟷ (
    (∀ts. receive⟨ts⟩ ∈ set (unlabel (transaction_receive T)) ⟶ (∀t ∈ set ts. M ⊢ t ⋅ θ ⋅ I)) ∧
    (∀ac t s. ⟨ac: t ≐ s⟩ ∈ set (unlabel (transaction_checks T)) ⟶ t ⋅ θ ⋅ I = s ⋅ θ ⋅ I) ∧
    (∀ac t s. ⟨ac: t ∈ s⟩ ∈ set (unlabel (transaction_checks T)) ⟶ (t ⋅ θ ⋅ I, s ⋅ θ ⋅ I) ∈ D) ∧
    (∀X F G. ∀X⟨∨≠: F ∨∉: G⟩ ∈ set (unlabel (transaction_checks T)) ⟶
      (∀δ. subst_domain δ = set X ∧ ground (subst_range δ) ⟶
            (∃(t,s) ∈ set F. t ⋅ rm X θ ⋅ δ ⋅ I ≠ s ⋅ rm X θ ⋅ δ ⋅ I) ∨
            (∃(t,s) ∈ set G. (t ⋅ rm X θ ⋅ δ ⋅ I, s ⋅ rm X θ ⋅ δ ⋅ I) ∉ D))))"
using wellformed_transaction_sem_iff[OF T I, of M D θ]
      unlabel_in[of _ _ "transaction_receive T"] unlabel_mem_has_label[of _ "transaction_receive T"]
      unlabel_in[of _ _ "transaction_checks T"] unlabel_mem_has_label[of _ "transaction_checks T"]
unfolding A_def[symmetric] rm_def by meson

lemma dual_transaction_ik_is_transaction_send'':
  fixes δ ℐ::"('a,'b,'c,'d) prot_subst"
  assumes "wellformed_transaction T"
  shows "(iksst (unlabel (duallsst (transaction_strand T ⋅lsst δ))) ⋅set ℐ) ⋅αset a =
         (trmssst (unlabel (transaction_send T)) ⋅set δ ⋅set ℐ) ⋅αset a" (is "?A = ?B")
using dual_transaction_ik_is_transaction_send[OF assms]
      subst_lsst_unlabel[of "duallsst (transaction_strand T)" δ]
      iksst_subst[of "unlabel (duallsst (transaction_strand T))" δ]
      duallsst_subst[of "transaction_strand T" δ]
by (auto simp add: abs_apply_terms_def)

lemma while_prot_terms_fun_mono:
  "mono (λM'. M ∪ ⋃(subterms ` M') ∪ ⋃((set ∘ fst ∘ Ana) ` M'))"
unfolding mono_def by fast

lemma while_prot_terms_SMP_overapprox:
  fixes M::"('fun,'atom,'sets,'lbl) prot_terms"
  assumes N_supset: "M ∪ ⋃(subterms ` N) ∪ ⋃((set ∘ fst ∘ Ana) ` N) ⊆ N"
    and Value_vars_only: "∀x ∈ fvset N. Γv x = TAtom Value"
  shows "SMP M ⊆ {a ⋅ δ | a δ. a ∈ N ∧ wtsubst δ ∧ wftrms (subst_range δ)}"
proof -
  define f where "f ≡ λM'. M ∪ ⋃(subterms ` M') ∪ ⋃((set ∘ fst ∘ Ana) ` M')"
  define S where "S ≡ {a ⋅ δ | a δ. a ∈ N ∧ wtsubst δ ∧ wftrms (subst_range δ)}"

  note 0 = Value_vars_only
  
  have "t ∈ S" when "t ∈ SMP M" for t
  using that
  proof (induction t rule: SMP.induct)
    case (MP t)
    hence "t ∈ N" "wtsubst Var" "wftrms (subst_range Var)" using N_supset by auto
    hence "t ⋅ Var ∈ S" unfolding S_def by blast
    thus ?case by simp
  next
    case (Subterm t t')
    then obtain δ a where a: "a ⋅ δ = t" "a ∈ N" "wtsubst δ" "wftrms (subst_range δ)"
      by (auto simp add: S_def)
    hence "∀x ∈ fv a. ∃τ. Γ (Var x) = TAtom τ" using 0 by auto
    hence *: "∀x ∈ fv a. (∃f. δ x = Fun f []) ∨ (∃y. δ x = Var y)"
      using a(3) TAtom_term_cases[OF wf_trm_subst_rangeD[OF a(4)]]
      by (metis wtsubst_def)
    obtain b where b: "b ⋅ δ = t'" "b ∈ subterms a"
      using subterms_subst_subterm[OF *, of t'] Subterm.hyps(2) a(1)
      by fast
    hence "b ∈ N" using N_supset a(2) by blast
    thus ?case using a b(1) unfolding S_def by blast
  next
    case (Substitution t θ)
    then obtain δ a where a: "a ⋅ δ = t" "a ∈ N" "wtsubst δ" "wftrms (subst_range δ)"
      by (auto simp add: S_def)
    have "wtsubst (δ ∘s θ)" "wftrms (subst_range (δ ∘s θ))"
      by (fact wt_subst_compose[OF a(3) Substitution.hyps(2)],
          fact wf_trms_subst_compose[OF a(4) Substitution.hyps(3)])
    moreover have "t ⋅ θ = a ⋅ δ ∘s θ" using a(1) subst_subst_compose[of a δ θ] by simp
    ultimately show ?case using a(2) unfolding S_def by blast
  next
    case (Ana t K T k)
    then obtain δ a where a: "a ⋅ δ = t" "a ∈ N" "wtsubst δ" "wftrms (subst_range δ)"
      by (auto simp add: S_def)
    obtain Ka Ta where a': "Ana a = (Ka,Ta)" by force
    have *: "K = Ka ⋅list δ"
    proof (cases a)
      case (Var x)
      then obtain g U where gU: "t = Fun g U"
        using a(1) Ana.hyps(2,3) Ana_var
        by (cases t) simp_all
      have "Γ (Var x) = TAtom Value" using Var a(2) 0 by auto
      hence "Γ (Fun g U) = TAtom Value"
        using a(1,3) Var gU wt_subst_trm''[OF a(3), of a]
        by argo
      thus ?thesis using gU Fun_Value_type_inv Ana.hyps(2,3) by fastforce  
    next
      case (Fun g U) thus ?thesis using a(1) a' Ana.hyps(2) Ana_subst'[of g U] by simp
    qed
    then obtain ka where ka: "k = ka ⋅ δ" "ka ∈ set Ka" using Ana.hyps(3) by auto
    have "ka ∈ set ((fst ∘ Ana) a)" using ka(2) a' by simp
    hence "ka ∈ N" using a(2) N_supset by auto
    thus ?case using ka a(3,4) unfolding S_def by blast
  qed
  thus ?thesis unfolding S_def by blast
qed


subsection ‹Admissible Transactions›
definition admissible_transaction_checks where
  "admissible_transaction_checks T ≡
    ∀x ∈ set (unlabel (transaction_checks T)).
      (is_InSet x ⟶
          is_Var (the_elem_term x) ∧ is_Fun_Set (the_set_term x) ∧
          fst (the_Var (the_elem_term x)) = TAtom Value) ∧
      (is_NegChecks x ⟶
          bvarssstp x = [] ∧
          ((the_eqs x = [] ∧ length (the_ins x) = 1) ∨
           (the_ins x = [] ∧ length (the_eqs x) = 1))) ∧
      (is_NegChecks x ∧ the_eqs x = [] ⟶ (let h = hd (the_ins x) in
          is_Var (fst h) ∧ is_Fun_Set (snd h) ∧
          fst (the_Var (fst h)) = TAtom Value))"

definition admissible_transaction_updates where
  "admissible_transaction_updates T ≡
    ∀x ∈ set (unlabel (transaction_updates T)).
      is_Update x ∧ is_Var (the_elem_term x) ∧ is_Fun_Set (the_set_term x) ∧
      fst (the_Var (the_elem_term x)) = TAtom Value"

definition admissible_transaction_terms where
  "admissible_transaction_terms T ≡
    wftrms' arity (trmslsst (transaction_strand T)) ∧
    (∀f ∈ ⋃(funs_term ` trms_transaction T).
      ¬is_Val f ∧ ¬is_Abs f ∧ ¬is_PubConst f ∧ f ≠ Pair) ∧
    (∀r ∈ set (unlabel (transaction_strand T)).
      (∃f ∈ ⋃(funs_term ` (trmssstp r)). is_Attack f) ⟶
        transaction_fresh T = [] ∧
        is_Send r ∧ length (the_msgs r) = 1 ∧ is_Fun_Attack (hd (the_msgs r)))"

definition admissible_transaction_send_occurs_form where
  "admissible_transaction_send_occurs_form T ≡ (
    let snds = transaction_send T;
        frsh = transaction_fresh T
    in ∀t ∈ trmslsst snds. OccursFact ∈ funs_term t ∨ OccursSec ∈ funs_term t ⟶
        (∃x ∈ set frsh. t = occurs (Var x))
)"

definition admissible_transaction_occurs_checks where
  "admissible_transaction_occurs_checks T ≡ (
    let occ_in = λx S. occurs (Var x) ∈ set (the_msgs (hd (unlabel S)));
        rcvs = transaction_receive T;
        snds = transaction_send T;
        frsh = transaction_fresh T;
        fvs = fv_transaction T
    in admissible_transaction_send_occurs_form T ∧
       ((∃x ∈ fvs - set frsh. fst x = TAtom Value) ⟶ (
          rcvs ≠ [] ∧ is_Receive (hd (unlabel rcvs)) ∧
          (∀x ∈ fvs - set frsh. fst x = TAtom Value ⟶ occ_in x rcvs))) ∧
       (frsh ≠ [] ⟶ (
          snds ≠ [] ∧ is_Send (hd (unlabel snds)) ∧
          (∀x ∈ set frsh. occ_in x snds)))
)"

definition admissible_transaction_no_occurs_msgs where
  "admissible_transaction_no_occurs_msgs T ≡ (
    let no_occ = λt. is_Fun t ⟶ the_Fun t ≠ OccursFact;
        rcvs = transaction_receive T;
        snds = transaction_send T
    in list_all (λa. is_Receive (snd a) ⟶ list_all no_occ (the_msgs (snd a))) rcvs ∧
       list_all (λa. is_Send (snd a)    ⟶ list_all no_occ (the_msgs (snd a))) snds
)"

definition admissible_transaction' where
  "admissible_transaction' T ≡ (
    wellformed_transaction T ∧
    transaction_decl T () = [] ∧
    list_all (λx. fst x = TAtom Value) (transaction_fresh T) ∧
    (∀x ∈ vars_transaction T. is_Var (fst x) ∧ (the_Var (fst x) = Value)) ∧
    bvarslsst (transaction_strand T) = {} ∧
    set (transaction_fresh T) ⊆
      fvlsst (filter (is_Insert ∘ snd) (transaction_updates T)) ∪ fvlsst (transaction_send T) ∧
    (∀x ∈ fv_transaction T - set (transaction_fresh T).
     ∀y ∈ fv_transaction T - set (transaction_fresh T).
      x ≠ y ⟶ ⟨Var x != Var y⟩ ∈ set (unlabel (transaction_checks T)) ∨
                ⟨Var y != Var x⟩ ∈ set (unlabel (transaction_checks T))) ∧
    fvlsst (transaction_updates T) ∪ fvlsst (transaction_send T) - set (transaction_fresh T)
      ⊆ fvlsst (transaction_receive T) ∪ fvlsst (transaction_checks T) ∧
    (∀r ∈ set (unlabel (transaction_checks T)).
      is_Equality r ⟶ fv (the_rhs r) ⊆ fvlsst (transaction_receive T)) ∧
    fvlsst (transaction_checks T) ⊆
      fvlsst (transaction_receive T) ∪
      fvlsst (filter (λs. is_InSet (snd s) ∧ the_check (snd s) = Assign) (transaction_checks T)) ∧
    list_all (λa. is_Receive (snd a) ⟶ the_msgs (snd a) ≠ []) (transaction_receive T) ∧
    list_all (λa. is_Send (snd a) ⟶ the_msgs (snd a) ≠ []) (transaction_send T) ∧
    admissible_transaction_checks T ∧
    admissible_transaction_updates T ∧
    admissible_transaction_terms T ∧
    admissible_transaction_send_occurs_form T
)"

definition admissible_transaction where
  "admissible_transaction T ≡
    admissible_transaction' T ∧
    admissible_transaction_no_occurs_msgs T"

definition has_initial_value_producing_transaction where
  "has_initial_value_producing_transaction P ≡
    let f = λs.
      list_all (λT. list_all (λa. ((is_Delete a ∨ is_InSet a) ⟶ the_set_term a ≠ ⟨s⟩s) ∧
                                  (is_NegChecks a ⟶ list_all (λ(_,t). t ≠ ⟨s⟩s) (the_ins a)))
                             (unlabel (transaction_checks T@transaction_updates T)))
               P
    in list_ex (λT.
        length (transaction_fresh T) = 1 ∧ transaction_receive T = [] ∧
        transaction_checks T = [] ∧ length (transaction_send T) = 1 ∧
        (let x = hd (transaction_fresh T); a = hd (transaction_send T); u = transaction_updates T
         in is_Send (snd a) ∧ Var x ∈ set (the_msgs (snd a)) ∧
            fvset (set (the_msgs (snd a))) = {x} ∧
            (u ≠ [] ⟶ (
              let b = hd u; c = snd b
              in tl u = [] ∧ is_Insert c ∧ the_elem_term c = Var x ∧
                 is_Fun_Set (the_set_term c) ∧ f (the_Set (the_Fun (the_set_term c))))))
       ) P"


lemma admissible_transaction_is_wellformed_transaction:
  assumes "admissible_transaction' T"
  shows "wellformed_transaction T"
    and "admissible_transaction_checks T"
    and "admissible_transaction_updates T"
    and "admissible_transaction_terms T"
    and "admissible_transaction_send_occurs_form T"
using assms unfolding admissible_transaction'_def by blast+

lemma admissible_transaction_no_occurs_msgsE:
  assumes T: "admissible_transaction' T" "admissible_transaction_no_occurs_msgs T"
  shows "∀ts. send⟨ts⟩ ∈ set (unlabel (transaction_strand T)) ∨
              receive⟨ts⟩ ∈ set (unlabel (transaction_strand T)) ⟶
                (∀t s. t ∈ set ts ⟶ t ≠ occurs s)"
proof -
  note 1 = admissible_transaction_is_wellformed_transaction(1)[OF T(1)]

  have 2: "send⟨ts⟩ ∈ set (unlabel (transaction_send T))"
    when "send⟨ts⟩ ∈ set (unlabel (transaction_strand T))" for ts
    using wellformed_transaction_strand_unlabel_memberD(8)[OF 1 that] by fast

  have 3: "receive⟨ts⟩ ∈ set (unlabel (transaction_receive T))"
    when "receive⟨ts⟩ ∈ set (unlabel (transaction_strand T))" for ts
    using wellformed_transaction_strand_unlabel_memberD(1)[OF 1 that] by fast

  show ?thesis
    using T(2) 2 3 wellformed_transaction_unlabel_cases(1,4)[OF 1]
    unfolding admissible_transaction_no_occurs_msgs_def Let_def list_all_iff
    by (metis sndI stateful_strand_step.discI(1,2) stateful_strand_step.sel(1,2)
              term.discI(2) term.sel(2) unlabel_mem_has_label)
qed

lemma admissible_transactionE:
  assumes T: "admissible_transaction' T"
  shows "transaction_decl T () = []" (is ?A)
    and "∀x ∈ set (transaction_fresh T). Γv x = TAtom Value" (is ?B)
    and "∀x ∈ varslsst (transaction_strand T). Γv x = TAtom Value" (is ?C)
    and "bvarslsst (transaction_strand T) = {}" (is ?D1)
    and "fv_transaction T ∩ bvars_transaction T = {}" (is ?D2)
    and "set (transaction_fresh T) ⊆
          fvlsst (filter (is_Insert ∘ snd) (transaction_updates T)) ∪ fvlsst (transaction_send T)"
      (is ?E)
    and "set (transaction_fresh T) ⊆ fvlsst (transaction_updates T) ∪ fvlsst (transaction_send T)"
      (is ?F)
    and "∀x ∈ fv_transaction T - set (transaction_fresh T).
         ∀y ∈ fv_transaction T - set (transaction_fresh T).
          x ≠ y ⟶ ⟨Var x != Var y⟩ ∈ set (unlabel (transaction_checks T)) ∨
                    ⟨Var y != Var x⟩ ∈ set (unlabel (transaction_checks T))"
      (is ?G)
    and "∀x ∈ fvlsst (transaction_checks T).
          x ∈ fvlsst (transaction_receive T) ∨
          (∃t s. select⟨t,s⟩ ∈ set (unlabel (transaction_checks T)) ∧ x ∈ fv t ∪ fv s)"
      (is ?H)
    and "fvlsst (transaction_updates T) ∪ fvlsst (transaction_send T) - set (transaction_fresh T) ⊆
          fvlsst (transaction_receive T) ∪ fvlsst (transaction_checks T)"
      (is ?I)
    and "∀x ∈ set (unlabel (transaction_checks T)).
          is_Equality x ⟶ fv (the_rhs x) ⊆ fvlsst (transaction_receive T)"
      (is ?J) (* TODO: why do we need this requirement? *)
    and "set (transaction_fresh T) ∩ fvlsst (transaction_receive T) = {}" (is ?K1)
    and "set (transaction_fresh T) ∩ fvlsst (transaction_checks T) = {}" (is ?K2)
    and "list_all (λx. fst x = Var Value) (transaction_fresh T)" (is ?K3)
    and "∀x ∈ vars_transaction T. ¬TAtom AttackType ⊑ Γv x" (is ?K4)
    and "∀l ts. (l,receive⟨ts⟩) ∈ set (transaction_receive T) ⟶ ts ≠ []" (is ?L1)
    and "∀l ts. (l,send⟨ts⟩) ∈ set (transaction_send T) ⟶ ts ≠ []" (is ?L2)
proof -
  show ?A ?D1 ?D2 ?G ?I ?J ?K3
    using T unfolding admissible_transaction'_def
    by (blast, blast, blast, blast, blast, blast, blast)

  have "list_all (λa. is_Receive (snd a) ⟶ the_msgs (snd a) ≠ []) (transaction_receive T)"
       "list_all (λa. is_Send (snd a) ⟶ the_msgs (snd a) ≠ []) (transaction_send T)"
    using T unfolding admissible_transaction'_def by auto
  thus ?L1 ?L2 unfolding list_all_iff by (force,force)

  have "list_all (λx. fst x = Var Value) (transaction_fresh T)"
       "∀x∈vars_transaction T. is_Var (fst x) ∧ the_Var (fst x) = Value"
    using T unfolding admissible_transaction'_def by (blast, blast)
  thus ?B ?C ?K4 using Γv_TAtom''(2) unfolding list_all_iff by (blast, force, force)

  show ?E using T unfolding admissible_transaction'_def by argo
  thus ?F unfolding unlabel_def by auto

  show ?K1 ?K2
    using T unfolding admissible_transaction'_def wellformed_transaction_def by (argo, argo)

  let ?selects = "filter (λs. is_InSet (snd s) ∧ the_check (snd s) = Assign) (transaction_checks T)"

  show ?H
  proof
    fix x assume "x ∈ fvlsst (transaction_checks T)"
    hence "x ∈ fvlsst (transaction_receive T) ∨ x ∈ fvlsst ?selects"
      using T unfolding admissible_transaction'_def by blast
    thus "x ∈ fvlsst (transaction_receive T) ∨
          (∃t s. select⟨t,s⟩ ∈ set (unlabel (transaction_checks T)) ∧ x ∈ fv t ∪ fv s)"
    proof
      assume "x ∈ fvlsst ?selects"
      then obtain r where r: "x ∈ fvsstp r" "r ∈ set (unlabel (transaction_checks T))"
                             "is_InSet r" "the_check r = Assign"
        unfolding unlabel_def by force
      thus ?thesis by (cases r) auto
    qed simp
  qed
qed

lemma admissible_transactionE':
  assumes T: "admissible_transaction T"
  shows "admissible_transaction' T" (is ?A)
    and "admissible_transaction_no_occurs_msgs T" (is ?B)
    and "∀ts. send⟨ts⟩ ∈ set (unlabel (transaction_strand T)) ∨
              receive⟨ts⟩ ∈ set (unlabel (transaction_strand T)) ⟶
                (∀t s. t ∈ set ts ⟶ t ≠ occurs s)"
      (is ?C)
proof -
  show 0: ?A ?B using T unfolding admissible_transaction_def by (blast, blast)
  show ?C using admissible_transaction_no_occurs_msgsE[OF 0] by blast
qed

lemma transaction_inserts_are_Value_vars:
  assumes T_valid: "wellformed_transaction T"
    and "admissible_transaction_updates T"
    and "insert⟨t,s⟩ ∈ set (unlabel (transaction_strand T))"
  shows "∃n. t = Var (TAtom Value, n)"
    and "∃u. s = Fun (Set u) []"
proof -
  let ?x = "insert⟨t,s⟩"

  have "?x ∈ set (unlabel (transaction_updates T))"
    using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
    by (auto simp add: transaction_strand_def unlabel_def)
  hence *: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
           "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
           "is_Set (the_Fun (the_set_term ?x))"
    using assms(2) unfolding admissible_transaction_updates_def is_Fun_Set_def by fastforce+
  
  show "∃n. t = Var (TAtom Value, n)" using *(1,2) by (cases t) auto
  show "∃u. s = Fun (Set u) []" using *(3,4,5) unfolding is_Set_def by (cases s) auto
qed

lemma transaction_deletes_are_Value_vars:
  assumes T_valid: "wellformed_transaction T"
    and "admissible_transaction_updates T"
    and "delete⟨t,s⟩ ∈ set (unlabel (transaction_strand T))"
  shows "∃n. t = Var (TAtom Value, n)"
    and "∃u. s = Fun (Set u) []"
proof -
  let ?x = "delete⟨t,s⟩"

  have "?x ∈ set (unlabel (transaction_updates T))"
    using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
    by (auto simp add: transaction_strand_def unlabel_def)
  hence *: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
           "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
           "is_Set (the_Fun (the_set_term ?x))"
    using assms(2) unfolding admissible_transaction_updates_def is_Fun_Set_def by fastforce+
  
  show "∃n. t = Var (TAtom Value, n)" using *(1,2) by (cases t) auto
  show "∃u. s = Fun (Set u) []" using *(3,4,5) unfolding is_Set_def by (cases s) auto
qed

lemma transaction_selects_are_Value_vars:
  assumes T_valid: "wellformed_transaction T"
    and "admissible_transaction_checks T"
    and "select⟨t,s⟩ ∈ set (unlabel (transaction_strand T))"
  shows "∃n. t = Var (TAtom Value, n) ∧ (TAtom Value, n) ∉ set (transaction_fresh T)" (is ?A)
    and "∃u. s = Fun (Set u) []" (is ?B)
proof -
  let ?x = "select⟨t,s⟩"

  have *: "?x ∈ set (unlabel (transaction_checks T))"
    using assms(3) wellformed_transaction_unlabel_cases[OF T_valid, of ?x]    
    by (auto simp add: transaction_strand_def unlabel_def)
  
  have **: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
           "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
           "is_Set (the_Fun (the_set_term ?x))"
    using * assms(2) unfolding admissible_transaction_checks_def is_Fun_Set_def by fastforce+

  have "fvsstp ?x ⊆ fvlsst (transaction_checks T)"
    using * by force
  hence ***: "fvsstp ?x ∩ set (transaction_fresh T) = {}"
    using T_valid unfolding wellformed_transaction_def by fast

  show ?A using **(1,2) *** by (cases t) auto
  show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
qed

lemma transaction_inset_checks_are_Value_vars:
  assumes T_valid: "admissible_transaction' T"
    and t: "⟨t in s⟩ ∈ set (unlabel (transaction_strand T))"
  shows "∃n. t = Var (TAtom Value, n) ∧ (TAtom Value, n) ∉ set (transaction_fresh T)" (is ?A)
    and "∃u. s = Fun (Set u) []" (is ?B)
proof -
  let ?x = "⟨t in s⟩"

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_valid]
  note T_adm_checks = admissible_transaction_is_wellformed_transaction(2)[OF T_valid]

  have *: "?x ∈ set (unlabel (transaction_checks T))"
    using t wellformed_transaction_unlabel_cases[OF T_wf, of ?x]
    unfolding transaction_strand_def unlabel_def by fastforce
  
  have **: "is_Var (the_elem_term ?x)" "fst (the_Var (the_elem_term ?x)) = TAtom Value"
           "is_Fun (the_set_term ?x)" "args (the_set_term ?x) = []"
           "is_Set (the_Fun (the_set_term ?x))"
    using * T_adm_checks unfolding admissible_transaction_checks_def is_Fun_Set_def by fastforce+

  have "fvsstp ?x ⊆ fvlsst (transaction_checks T)"
    using * by force
  hence ***: "fvsstp ?x ∩ set (transaction_fresh T) = {}"
    using T_wf unfolding wellformed_transaction_def by fast

  show ?A using **(1,2) *** by (cases t) auto
  show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
qed

lemma transaction_notinset_checks_are_Value_vars:
  assumes T_adm: "admissible_transaction' T"
    and FG: "∀X⟨∨≠: F ∨∉: G⟩ ∈ set (unlabel (transaction_strand T))"
    and t: "(t,s) ∈ set G"
  shows "∃n. t = Var (TAtom Value, n) ∧ (TAtom Value, n) ∉ set (transaction_fresh T)" (is ?A)
    and "∃u. s = Fun (Set u) []" (is ?B)
    and "F = []" (is ?C)
    and "G = [(t,s)]" (is ?D)
proof -
  let ?x = "∀X⟨∨≠: F ∨∉: G⟩"

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
  note T_adm_checks = admissible_transaction_is_wellformed_transaction(2)[OF T_adm]

  have 0: "?x ∈ set (unlabel (transaction_checks T))"
    using FG wellformed_transaction_unlabel_cases[OF T_wf, of ?x]    
    by (auto simp add: transaction_strand_def unlabel_def)
  hence 1: "F = [] ∧ length G = 1"
    using T_adm_checks t unfolding admissible_transaction_checks_def by fastforce
  hence "hd G = (t,s)" using t by (cases "the_ins ?x") auto
  hence **: "is_Var t" "fst (the_Var t) = TAtom Value" "is_Fun s" "args s = []" "is_Set (the_Fun s)"
    using 1 Set.bspec[OF T_adm_checks[unfolded admissible_transaction_checks_def] 0]
    unfolding is_Fun_Set_def by auto

  show ?C using 1 by blast
  show ?D using 1 t by force

  have "fvsstp ?x ⊆ fvlsst (transaction_checks T)"
       "set (bvarssstp ?x) ⊆ bvarslsst (transaction_checks T)"
    using 0 by force+
  moreover have
      "set (transaction_fresh T) ∩ fvlsst (transaction_receive T) = {}"
      "set (transaction_fresh T) ∩ fvlsst (transaction_checks T) = {}"
    using T_wf unfolding wellformed_transaction_def by fast+
  ultimately have
      "fvsstp ?x ∩ set (transaction_fresh T) = {}"
      "set (bvarssstp ?x) ∩ set (transaction_fresh T) = {}"
    using admissible_transactionE(7)[OF T_adm]
          wellformed_transaction_wfsst(2)[OF T_wf]
          fv_transaction_unfold[of T] bvars_transaction_unfold[of T]
    by (blast, blast)
  hence ***: "fv t ∩ set (transaction_fresh T) = {}"
    using t by auto

  show ?A using **(1,2) *** by (cases t) auto
  show ?B using **(3,4,5) unfolding is_Set_def by (cases s) auto
qed

lemma transaction_noteqs_checks_case:
  assumes T_adm: "admissible_transaction' T"
    and FG: "∀X⟨∨≠: F ∨∉: G⟩ ∈ set (unlabel (transaction_strand T))"
    and G: "G = []"
  shows "∃t s. F = [(t,s)]" (is ?A)
proof -
  let ?x = "∀X⟨∨≠: F ∨∉: G⟩"

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
  note T_adm_checks = admissible_transaction_is_wellformed_transaction(2)[OF T_adm]

  have "?x ∈ set (unlabel (transaction_checks T))"
    using FG wellformed_transaction_unlabel_cases[OF T_wf, of ?x]    
    by (auto simp add: transaction_strand_def unlabel_def)
  hence "length F = 1"
    using T_adm_checks unfolding admissible_transaction_checks_def G by fastforce
  thus ?thesis by fast
qed

lemma admissible_transaction_fresh_vars_notin:
  assumes T: "admissible_transaction' T"
    and x: "x ∈ set (transaction_fresh T)"
  shows "x ∉ fvlsst (transaction_receive T)" (is ?A)
    and "x ∉ fvlsst (transaction_checks T)" (is ?B)
    and "x ∉ varslsst (transaction_receive T)" (is ?C)
    and "x ∉ varslsst (transaction_checks T)" (is ?D)
    and "x ∉ bvarslsst (transaction_receive T)" (is ?E)
    and "x ∉ bvarslsst (transaction_checks T)" (is ?F)
proof -
  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]

  have 0:
      "set (transaction_fresh T) ⊆ fvlsst (transaction_updates T) ∪ fvlsst (transaction_send T)"
      "set (transaction_fresh T) ∩ fvlsst (transaction_receive T) = {}"
      "set (transaction_fresh T) ∩ fvlsst (transaction_checks T) = {}"
      "fv_transaction T ∩ bvars_transaction T = {}"
    using admissible_transactionE[OF T] by argo+

  have 1: "set (transaction_fresh T) ∩ bvarslsst (transaction_checks T) = {}"
    using 0(1,4) fv_transaction_unfold[of T] bvars_transaction_unfold[of T] by blast

  have 2:
      "varslsst (transaction_receive T) = fvlsst (transaction_receive T)"
      "bvarslsst (transaction_receive T) = {}"
    using bvars_wellformed_transaction_unfold[OF T_wf]
          varssst_is_fvsst_bvarssst[of "unlabel (transaction_receive T)"]
    by blast+
  
  show ?A ?B ?C ?E ?F using 0 1 2 x by (fast, fast, fast, fast, fast)

  show ?D using 0(3) 1 x varssst_is_fvsst_bvarssst[of "unlabel (transaction_checks T)"] by fast
qed

lemma admissible_transaction_fv_in_receives_or_selects:
  assumes T: "admissible_transaction' T"
    and x: "x ∈ fv_transaction T" "x ∉ set (transaction_fresh T)"
  shows "x ∈ fvlsst (transaction_receive T) ∨
         (x ∈ fvlsst (transaction_checks T) ∧
          (∃t s. select⟨t,s⟩ ∈ set (unlabel (transaction_checks T)) ∧ x ∈ fv t ∪ fv s))"
proof -
  have "x ∈ fvlsst (transaction_receive T) ∪ fvlsst (transaction_checks T) ∪
            fvlsst (transaction_updates T) ∪ fvlsst (transaction_send T)"
    using x(1) fvsst_append unlabel_append 
    by (metis transaction_strand_def append_assoc)
  thus ?thesis using x(2) admissible_transactionE(9,10)[OF T] by blast
qed

lemma admissible_transaction_fv_in_receives_or_selects':
  assumes T: "admissible_transaction' T"
    and x: "x ∈ fv_transaction T" "x ∉ set (transaction_fresh T)"
  shows "(∃ts. receive⟨ts⟩ ∈ set (unlabel (transaction_receive T)) ∧ x ∈ fvset (set ts)) ∨
         (∃s. select⟨Var x, s⟩ ∈ set (unlabel (transaction_checks T)))"
proof (cases "x ∈ fvlsst (transaction_receive T)")
  case True thus ?thesis
    using wellformed_transaction_unlabel_cases(1)[
            OF admissible_transaction_is_wellformed_transaction(1)[OF T]]
    by force
next
  case False
  then obtain t s where t: "select⟨t,s⟩ ∈ set (unlabel (transaction_checks T))" "x ∈ fv t ∪ fv s"
    using admissible_transaction_fv_in_receives_or_selects[OF T x] by blast

  have t': "select⟨t,s⟩ ∈ set (unlabel (transaction_strand T))"
    using t(1) unfolding transaction_strand_def by simp

  show ?thesis
    using t transaction_selects_are_Value_vars[
              OF admissible_transaction_is_wellformed_transaction(1,2)[OF T] t']
    by force
qed

lemma admissible_transaction_fv_in_receives_or_selects_subst:
  assumes T: "admissible_transaction' T"
    and x: "x ∈ fv_transaction T" "x ∉ set (transaction_fresh T)"
  shows "(∃ts. receive⟨ts⟩ ∈ set (unlabel (transaction_receive T ⋅lsst θ)) ∧ θ x ⊑set set ts) ∨
         (∃s. select⟨θ x, s⟩ ∈ set (unlabel (transaction_checks T ⋅lsst θ)))"
proof -
  note 0 = admissible_transaction_fv_in_receives_or_selects'[OF T x]

  have 1: "θ x ⊑set set (ts ⋅list θ)" when ts: "x ∈ fvset (set ts)" for ts
    using that subst_mono_fv[of x _ θ] by auto

  have 2: "receive⟨ts ⋅list θ⟩ ∈ set (A ⋅sst θ)" when "receive⟨ts⟩ ∈ set A" for ts A
    using that by fast

  have 3: "select⟨t ⋅ θ,s ⋅ θ⟩ ∈ set (A ⋅sst θ)" when "select⟨t,s⟩ ∈ set A" for t s A
    using that by fast

  show ?thesis
    using 0 1 2[of _ "unlabel (transaction_receive T)"]
          3[of _ _ "unlabel (transaction_checks T)"]
    unfolding unlabel_subst by (metis eval_term.simps(1)) 
qed

lemma admissible_transaction_fv_in_receives_or_selects_dual_subst:
  defines "f ≡ λS. unlabel (duallsst S)"
  assumes T: "admissible_transaction' T"
    and x: "x ∈ fv_transaction T" "x ∉ set (transaction_fresh T)"
  shows "(∃ts. send⟨ts⟩ ∈ set (f (transaction_receive T ⋅lsst θ)) ∧ θ x ⊑set set ts) ∨
         (∃s. select⟨θ x, s⟩ ∈ set (f (transaction_checks T ⋅lsst θ)))"
using admissible_transaction_fv_in_receives_or_selects_subst[OF T x, of θ]
by (metis (no_types, lifting) f_def duallsst_unlabel_steps_iff(2) duallsst_unlabel_steps_iff(6)) 

lemma admissible_transaction_decl_subst_empty':
  assumes T: "transaction_decl T () = []"
    and ξ: "transaction_decl_subst ξ T"
  shows "ξ = Var"
proof -
  have "subst_domain ξ = {}"
    using ξ T unfolding transaction_decl_subst_def by auto
  thus ?thesis by auto
qed

lemma admissible_transaction_decl_subst_empty:
  assumes T: "admissible_transaction' T"
    and ξ: "transaction_decl_subst ξ T"
  shows "ξ = Var"
by (rule admissible_transaction_decl_subst_empty'[OF admissible_transactionE(1)[OF T] ξ])

lemma admissible_transaction_no_bvars:
  assumes "admissible_transaction' T"
  shows "fv_transaction T = vars_transaction T"
    and "bvars_transaction T = {}"
using admissible_transactionE(4)[OF assms]
      bvars_wellformed_transaction_unfold varssst_is_fvsst_bvarssst
by (fast, fast)

lemma admissible_transactions_fv_bvars_disj:
  assumes "∀T ∈ set P. admissible_transaction' T"
  shows "(⋃T ∈ set P. fv_transaction T) ∩ (⋃T ∈ set P. bvars_transaction T) = {}"
using assms admissible_transaction_no_bvars(2) by fast

lemma admissible_transaction_occurs_fv_types:
  assumes "admissible_transaction' T"
    and "x ∈ vars_transaction T"
  shows "∃a. Γ (Var x) = TAtom a ∧ Γ (Var x) ≠ TAtom OccursSecType"
proof -
  have "is_Var (fst x)" "the_Var (fst x) = Value"
    using assms unfolding admissible_transaction'_def by blast+
  thus ?thesis using Γv_TAtom''(2)[of x] by force
qed

lemma admissible_transaction_Value_vars_are_fv:
  assumes "admissible_transaction' T"
    and "x ∈ vars_transaction T"
    and "Γv x = TAtom Value"
  shows "x ∈ fv_transaction T"
using assms(2,3) Γv_TAtom''(2)[of x] varssst_is_fvsst_bvarssst[of "unlabel (transaction_strand T)"]
      admissible_transactionE(4)[OF assms(1)]
by fast

lemma transaction_receive_deduct:
  assumes T_wf: "wellformed_transaction T"
    and ℐ: "constraint_model ℐ (A@duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))"
    and ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T M"
    and α: "transaction_renaming_subst α P X"
    and t: "receive⟨ts⟩ ∈ set (unlabel (transaction_receive T ⋅lsst ξ ∘s σ ∘s α))"
  shows "∀t ∈ set ts. iklsst A ⋅set ℐ ⊢ t ⋅ ℐ"
proof -
  define θ where "θ ≡ ξ ∘s σ ∘s α"

  have t': "send⟨ts⟩ ∈ set (unlabel (duallsst (transaction_receive T ⋅lsst θ)))"
    using t duallsst_unlabel_steps_iff(2) unfolding θ_def by blast
  then obtain T1 T2 where T: "unlabel (duallsst (transaction_receive T ⋅lsst θ)) = T1@send⟨ts⟩#T2"
    using t' by (meson split_list)

  have "constr_sem_stateful ℐ (unlabel A@unlabel (duallsst (transaction_strand T ⋅lsst θ)))"
    using ℐ unlabel_append[of A] unfolding constraint_model_def θ_def by simp
  hence "constr_sem_stateful ℐ (unlabel A@T1@[send⟨ts⟩])"
    using strand_sem_append_stateful[of "{}" "{}" "unlabel A@T1@[send⟨ts⟩]" _ ℐ]
          transaction_dual_subst_unlabel_unfold[of T θ] T
    by (metis append.assoc append_Cons append_Nil)
  hence "∀t ∈ set ts. iksst (unlabel A@T1) ⋅set ℐ ⊢ t ⋅ ℐ"
    using strand_sem_append_stateful[of "{}" "{}" "unlabel A@T1" "[send⟨ts⟩]" ℐ] T
    by force
  moreover have "¬is_Receive x"
    when x: "x ∈ set (unlabel (duallsst (transaction_receive T ⋅lsst θ)))" for x
  proof -
    have *: "is_Receive a" when "a ∈ set (unlabel (transaction_receive T))" for a
      using T_wf Ball_set[of "unlabel (transaction_receive T)" is_Receive] that
      unfolding wellformed_transaction_def
      by blast

    obtain l where l: "(l,x) ∈ set (duallsst (transaction_receive T ⋅lsst θ))"
      using x unfolding unlabel_def by fastforce
    then obtain ly where ly: "ly ∈ set (transaction_receive T ⋅lsst θ)" "(l,x) = duallsstp ly"
      unfolding duallsst_def by auto

    obtain j y where j: "ly = (j,y)" by (metis surj_pair)
    hence "j = l" using ly(2) by (cases y) auto
    hence y: "(l,y) ∈ set (transaction_receive T ⋅lsst θ)" "(l,x) = duallsstp (l,y)"
      by (metis j ly(1), metis j ly(2))

    obtain z where z:
        "z ∈ set (unlabel (transaction_receive T))"
        "(l,z) ∈ set (transaction_receive T)"
        "(l,y) = (l,z) ⋅lsstp θ"
      using y(1) unfolding subst_apply_labeled_stateful_strand_def unlabel_def by force

    have "is_Receive y" using *[OF z(1)] z(3) by (cases z) auto
    thus "¬is_Receive x" using l y by (cases y) auto
  qed
  hence "¬is_Receive x" when "x ∈ set T1" for x using T that by simp
  hence "iksst T1 = {}" unfolding iksst_def is_Receive_def by fast
  hence "iksst (unlabel A@T1) = iklsst A" using iksst_append[of "unlabel A" T1] by simp
  ultimately show ?thesis by (simp add: θ_def)
qed

lemma transaction_checks_db:
  assumes T: "admissible_transaction' T"
    and ℐ: "constraint_model ℐ (A@duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))"
    and ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T M"
    and α: "transaction_renaming_subst α P X"
  shows "⟨Var (TAtom Value, n) in Fun (Set s) []⟩ ∈ set (unlabel (transaction_checks T))
          ⟹ (α (TAtom Value, n) ⋅ ℐ, Fun (Set s) []) ∈ set (dblsst A ℐ)"
      (is "?A ⟹ ?B")
    and "⟨Var (TAtom Value, n) not in Fun (Set s) []⟩ ∈ set (unlabel (transaction_checks T))
          ⟹ (α (TAtom Value, n) ⋅ ℐ, Fun (Set s) []) ∉ set (dblsst A ℐ)"
      (is "?C ⟹ ?D")
proof -
  let ?x = "λn. (TAtom Value, n)"
  let ?s = "Fun (Set s) []"
  let ?T = "transaction_receive T@transaction_checks T"
  let ?T' = "?T ⋅lsst ξ ∘s σ ∘s α"
  let ?S = "λS. transaction_receive T@S"
  let ?S' = "λS. ?S S ⋅lsst ξ ∘s σ ∘s α"

  note ξ_empty = admissible_transaction_decl_subst_empty[OF T ξ]

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]

  have "constr_sem_stateful ℐ (unlabel (A@duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)))"
    using ℐ unfolding constraint_model_def by simp
  moreover have
      "duallsst (transaction_strand T ⋅lsst δ) =
       duallsst (?S (T1@[c]) ⋅lsst δ)@
       duallsst (T2@transaction_updates T@transaction_send T ⋅lsst δ)"
    when "transaction_checks T = T1@c#T2" for T1 T2 c δ
    using that duallsst_append subst_lsst_append
    unfolding transaction_strand_def
    by (metis append.assoc append_Cons append_Nil)
  ultimately have T'_model: "constr_sem_stateful ℐ (unlabel (A@duallsst (?S' (T1@[(l,c)]))))"
    when "transaction_checks T = T1@(l,c)#T2" for T1 T2 l c
    using strand_sem_append_stateful[of _ _ _ _ ℐ]
    by (simp add: that transaction_strand_def)

  show "?A ⟹ ?B"
  proof -
    assume a: ?A
    hence *: "⟨Var (?x n) in ?s⟩ ∈ set (unlabel ?T)"
      unfolding transaction_strand_def unlabel_def by simp
    then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,⟨Var (?x n) in ?s⟩)#T2"
      by (metis a split_list unlabel_mem_has_label)

    have "?x n ∈ fvlsst (transaction_checks T)"
      using a by force
    hence "?x n ∉ set (transaction_fresh T)"
      using a admissible_transaction_fresh_vars_notin[OF T] by fast
    hence "unlabel (A@duallsst (?S' (T1@[(l,⟨Var (?x n) in ?s⟩)]))) =
           unlabel (A@duallsst (?S' T1))@[⟨α (?x n) in ?s⟩]"
      using T a σ duallsst_append subst_lsst_append unlabel_append ξ_empty
      by (fastforce simp add: transaction_fresh_subst_def unlabel_def duallsst_def
                              subst_apply_labeled_stateful_strand_def subst_compose)
    moreover have "dbsst (unlabel A) = dbsst (unlabel (A@duallsst (?S' T1)))"
      by (simp add: T1 dbsst_transaction_prefix_eq[OF T_wf] del: unlabel_append)
    ultimately have "∃M. strand_sem_stateful M (set (dbsst (unlabel A) ℐ)) [⟨α (?x n) in ?s⟩] ℐ"
      using T'_model[OF T1] dbsst_set_is_dbupdsst[of _ ℐ] strand_sem_append_stateful[of _ _ _ _ ℐ]
      by (simp add: dbsst_def del: unlabel_append)
    thus ?B by simp
  qed

  show "?C ⟹ ?D"
  proof -
    assume a: ?C
    hence *: "⟨Var (?x n) not in ?s⟩ ∈ set (unlabel ?T)"
      unfolding transaction_strand_def unlabel_def by simp
    then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,⟨Var (?x n) not in ?s⟩)#T2"
      by (metis a split_list unlabel_mem_has_label)

    have "?x n ∈ varssstp ⟨Var (?x n) not in ?s⟩"
      using varssstp_cases(9)[of "[]" "Var (?x n)" ?s] by auto
    hence "?x n ∈ varslsst (transaction_checks T)"
      using a unfolding varssst_def by force
    hence "?x n ∉ set (transaction_fresh T)"
      using a admissible_transaction_fresh_vars_notin[OF T] by fast
    hence "unlabel (A@duallsst (?S' (T1@[(l,⟨Var (?x n) not in ?s⟩)]))) =
           unlabel (A@duallsst (?S' T1))@[⟨α (?x n) not in ?s⟩]"
      using T a σ duallsst_append subst_lsst_append unlabel_append ξ_empty
      by (fastforce simp add: transaction_fresh_subst_def unlabel_def duallsst_def
                              subst_apply_labeled_stateful_strand_def subst_compose)
    moreover have "dbsst (unlabel A) = dbsst (unlabel (A@duallsst (?S' T1)))"
      by (simp add: T1 dbsst_transaction_prefix_eq[OF T_wf] del: unlabel_append)
    ultimately have "∃M. strand_sem_stateful M (set (dbsst (unlabel A) ℐ)) [⟨α (?x n) not in ?s⟩] ℐ"
      using T'_model[OF T1] dbsst_set_is_dbupdsst[of _ ℐ] strand_sem_append_stateful[of _ _ _ _ ℐ]
      by (simp add: dbsst_def del: unlabel_append)
    thus ?D using stateful_strand_sem_NegChecks_no_bvars(1)[of _ _ _ ?s ℐ] by simp
  qed
qed

lemma transaction_selects_db:
  assumes T: "admissible_transaction' T"
    and ℐ: "constraint_model ℐ (A@duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))"
    and ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T M"
    and α: "transaction_renaming_subst α P X"
  shows "select⟨Var (TAtom Value, n), Fun (Set s) []⟩ ∈ set (unlabel (transaction_checks T))
          ⟹ (α (TAtom Value, n) ⋅ ℐ, Fun (Set s) []) ∈ set (dblsst A ℐ)"
      (is "?A ⟹ ?B")
proof -
  let ?x = "λn. (TAtom Value, n)"
  let ?s = "Fun (Set s) []"
  let ?T = "transaction_receive T@transaction_checks T"
  let ?T' = "?T ⋅lsst ξ ∘s σ ∘s α"
  let ?S = "λS. transaction_receive T@S"
  let ?S' = "λS. ?S S ⋅lsst ξ ∘s σ ∘s α"

  note ξ_empty = admissible_transaction_decl_subst_empty[OF T ξ]

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]

  have "constr_sem_stateful ℐ (unlabel (A@duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)))"
    using ℐ unfolding constraint_model_def by simp
  moreover have
      "duallsst (transaction_strand T ⋅lsst δ) =
       duallsst (?S (T1@[c]) ⋅lsst δ)@
       duallsst (T2@transaction_updates T@transaction_send T ⋅lsst δ)"
    when "transaction_checks T = T1@c#T2" for T1 T2 c δ
    using that duallsst_append subst_lsst_append
    unfolding transaction_strand_def by (metis append.assoc append_Cons append_Nil)
  ultimately have T'_model: "constr_sem_stateful ℐ (unlabel (A@duallsst (?S' (T1@[(l,c)]))))"
    when "transaction_checks T = T1@(l,c)#T2" for T1 T2 l c
    using strand_sem_append_stateful[of _ _ _ _ ℐ]
    by (simp add: that transaction_strand_def)

  show "?A ⟹ ?B"
  proof -
    assume a: ?A
    hence *: "select⟨Var (?x n), ?s⟩ ∈ set (unlabel ?T)"
      unfolding transaction_strand_def unlabel_def by simp
    then obtain l T1 T2 where T1: "transaction_checks T = T1@(l,select⟨Var (?x n), ?s⟩)#T2"
      by (metis a split_list unlabel_mem_has_label)

    have "?x n ∈ fvlsst (transaction_checks T)"
      using a by force
    hence "?x n ∉ set (transaction_fresh T)"
      using a admissible_transaction_fresh_vars_notin[OF T] by fast
    hence "unlabel (A@duallsst (?S' (T1@[(l,select⟨Var (?x n), ?s⟩)]))) =
           unlabel (A@duallsst (?S' T1))@[select⟨α (?x n), ?s⟩]"
      using T a σ duallsst_append subst_lsst_append unlabel_append ξ_empty
      by (fastforce simp add: transaction_fresh_subst_def unlabel_def duallsst_def
                              subst_apply_labeled_stateful_strand_def subst_compose)
    moreover have "dbsst (unlabel A) = dbsst (unlabel (A@duallsst (?S' T1)))"
      by (simp add: T1 dbsst_transaction_prefix_eq[OF T_wf] del: unlabel_append)
    ultimately have "∃M. strand_sem_stateful M (set (dbsst (unlabel A) ℐ)) [⟨α (?x n) in ?s⟩] ℐ"
      using T'_model[OF T1] dbsst_set_is_dbupdsst[of _ ℐ] strand_sem_append_stateful[of _ _ _ _ ℐ]
      by (simp add: dbsst_def del: unlabel_append)
    thus ?B by simp
  qed
qed

lemma admissible_transaction_terms_no_Value_consts:
  assumes "admissible_transaction_terms T"
    and "t ∈ subtermsset (trmslsst (transaction_strand T))"
  shows "∄a T. t = Fun (Val a) T" (is ?A)
    and "∄a T. t = Fun (Abs a) T" (is ?B)
    and "∄a T. t = Fun (PubConst Value a) T" (is ?C)
proof -
  have "¬is_Val f" "¬is_Abs f" "¬is_PubConstValue f"
    when "f ∈ ⋃(funs_term ` (trms_transaction T))" for f
    using that assms(1)[unfolded admissible_transaction_terms_def]
    unfolding is_PubConstValue_def by (blast,blast,blast)
  moreover have "f ∈ ⋃(funs_term ` (trms_transaction T))"
    when "f ∈ funs_term t" for f
    using that assms(2) funs_term_subterms_eq(2)[of "trms_transaction T"] by blast+
  ultimately have *: "¬is_Val f" "¬is_Abs f" "¬is_PubConstValue f"
    when "f ∈ funs_term t" for f
    using that by presburger+

  show ?A using *(1) by force
  show ?B using *(2) by force
  show ?C using *(3) unfolding is_PubConstValue_def by force
qed

lemma admissible_transactions_no_Value_consts:
  assumes "admissible_transaction' T"
    and "t ∈ subtermsset (trmslsst (transaction_strand T))"
  shows "∄a T. t = Fun (Val a) T" (is ?A)
    and "∄a T. t = Fun (Abs a) T" (is ?B)
    and "∄a T. t = Fun (PubConst Value a) T" (is ?C)
using admissible_transaction_terms_no_Value_consts[OF
        admissible_transaction_is_wellformed_transaction(4)[OF assms(1)] assms(2)]
by auto

lemma admissible_transactions_no_Value_consts':
  assumes "admissible_transaction' T"
    and "t ∈ trmslsst (transaction_strand T)"
  shows "∄a T. Fun (Val a) T ∈ subterms t"
    and "∄a T. Fun (Abs a) T ∈ subterms t"
using admissible_transactions_no_Value_consts[OF assms(1)] assms(2) by fast+

lemma admissible_transactions_no_Value_consts'':
  assumes "admissible_transaction' T"
  shows "∀n. PubConst Value n ∉ ⋃(funs_term ` trms_transaction T)"
    and "∀n. Abs n ∉ ⋃(funs_term ` trms_transaction T)"
using assms
unfolding admissible_transaction'_def admissible_transaction_terms_def
by (meson prot_fun.discI(6), meson prot_fun.discI(4))

lemma admissible_transactions_no_PubConsts:
  assumes "admissible_transaction' T"
    and "t ∈ subtermsset (trmslsst (transaction_strand T))"
  shows "∄a n T. t = Fun (PubConst a n) T"
proof -
  have "¬is_PubConst f"
    when "f ∈ ⋃(funs_term ` (trms_transaction T))" for f
    using that conjunct1[OF conjunct2[OF admissible_transaction_is_wellformed_transaction(4)[
            OF assms(1), unfolded admissible_transaction_terms_def]]]
    by blast
  moreover have "f ∈ ⋃(funs_term ` (trms_transaction T))"
    when "f ∈ funs_term t" for f
    using that assms(2) funs_term_subterms_eq(2)[of "trms_transaction T"] by blast+
  ultimately have *: "¬is_PubConst f"
    when "f ∈ funs_term t" for f
    using that by presburger+

  show ?thesis using * by force
qed

lemma admissible_transactions_no_PubConsts':
  assumes "admissible_transaction' T"
    and "t ∈ trmslsst (transaction_strand T)"
  shows "∄a n T. Fun (PubConst a n) T ∈ subterms t"
using admissible_transactions_no_PubConsts[OF assms(1)] assms(2) by fast+

lemma admissible_transaction_strand_step_cases:
  assumes T_adm: "admissible_transaction' T"
  shows "r ∈ set (unlabel (transaction_receive T)) ⟹ ∃t. r = receive⟨t⟩"
        (is "?A ⟹ ?A'")
    and "r ∈ set (unlabel (transaction_checks T)) ⟹
            (∃x s. (r = ⟨Var x in Fun (Set s) []⟩ ∨ r = select⟨Var x, Fun (Set s) []⟩ ∨
                   r = ⟨Var x not in Fun (Set s) []⟩) ∧
                   fst x = TAtom Value ∧ x ∈ fv_transaction T - set (transaction_fresh T)) ∨
            (∃s t. r = ⟨s == t⟩ ∨ r = ⟨s := t⟩ ∨ r = ⟨s != t⟩)"
        (is "?B ⟹ ?B'")
    and "r ∈ set (unlabel (transaction_updates T)) ⟹
            ∃x s. (r = insert⟨Var x, Fun (Set s) []⟩ ∨ r = delete⟨Var x, Fun (Set s) []⟩) ∧
                  fst x = TAtom Value"
        (is "?C ⟹ ?C'")
    and "r ∈ set (unlabel (transaction_send T)) ⟹ ∃t. r = send⟨t⟩"
        (is "?D ⟹ ?D'")
proof -
  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]

  show "?A ⟹ ?A'"
    using T_wf Ball_set[of "unlabel (transaction_receive T)" is_Receive]
    unfolding wellformed_transaction_def is_Receive_def
    by blast

  show "?D ⟹ ?D'"
    using T_wf Ball_set[of "unlabel (transaction_send T)" is_Send]
    unfolding wellformed_transaction_def is_Send_def
    by blast

  show "?B ⟹ ?B'"
  proof -
    assume r: ?B
    note adm_checks = admissible_transaction_is_wellformed_transaction(1,2)[OF T_adm]

    have fv_r1: "fvsstp r ⊆ fv_transaction T"
      using r fv_transaction_unfold[of T] by auto
  
    have fv_r2: "fvsstp r ∩ set (transaction_fresh T) = {}"
      using r T_wf unfolding wellformed_transaction_def by fastforce

    have "list_all is_Check_or_Assignment (unlabel (transaction_checks T))"
      using adm_checks(1) unfolding wellformed_transaction_def by blast
    hence "is_InSet r ∨ is_Equality r ∨ is_NegChecks r"
      using r unfolding list_all_iff by blast
    thus ?B'
    proof (elim disjE conjE)
      assume *: "is_InSet r"
      hence **: "is_Var (the_elem_term r)" "is_Fun (the_set_term r)"
                "is_Set (the_Fun (the_set_term r))" "args (the_set_term r) = []"
                "fst (the_Var (the_elem_term r)) = TAtom Value"
        using r adm_checks unfolding admissible_transaction_checks_def is_Fun_Set_def
        by fast+
      
      obtain ac rt rs where r': "r = ⟨ac: rt ∈ rs⟩" using * by (cases r) auto
      obtain x where x: "rt = Var x" "fst x = TAtom Value" using **(1,5) r' by auto
      obtain f S where fS: "rs = Fun f S" using **(2) r' by auto
      obtain s where s: "f = Set s" using **(3) fS r' by (cases f) auto
      hence S: "S = []" using **(4) fS r' by auto
  
      show ?B' using r' x fS s S fv_r1 fv_r2 by (cases ac) simp_all
    next
      assume *: "is_NegChecks r"
      hence **: "bvarssstp r = []"
                "(the_eqs r = [] ∧ length (the_ins r) = 1) ∨
                 (the_ins r = [] ∧ length (the_eqs r) = 1)"
        using r adm_checks unfolding admissible_transaction_checks_def by fast+
      show ?B' using **(2)
      proof (elim disjE conjE)
        assume ***: "the_eqs r = []" "length (the_ins r) = 1"
        then obtain t s where ts: "the_ins r = [(t,s)]" by (cases "the_ins r") auto
        hence "hd (the_ins r) = (t,s)" by simp
        hence ****: "is_Var (fst (t,s))" "is_Fun (snd (t,s))"
                    "is_Set (the_Fun (snd (t,s)))" "args (snd (t,s)) = []"
                    "fst (the_Var (fst (t,s))) = TAtom Value"
          using * ***(1) Set.bspec[OF adm_checks(2)[unfolded admissible_transaction_checks_def] r]
          unfolding is_Fun_Set_def by simp_all
        obtain x where x: "t = Var x" "fst x = TAtom Value" using ts ****(1,5) by (cases t) simp_all
        obtain f S where fS: "s = Fun f S" using ts ****(2) by (cases s) simp_all
        obtain ss where ss: "f = Set ss" using fS ****(3) by (cases f) simp_all
        have S: "S = []" using ts fS ss ****(4) by simp
        
        show ?B' using ts x fS ss S *** **(1) * fv_r1 fv_r2 by (cases r) auto
      next
        assume ***: "the_ins r = []" "length (the_eqs r) = 1"
        then obtain t s where "the_eqs r = [(t,s)]" by (cases "the_eqs r") auto
        thus ?B' using *** **(1) * by (cases r) auto
      qed
    qed (auto simp add: is_Equality_def the_check_def intro: poscheckvariant.exhaust)
  qed

  show "?C ⟹ ?C'"
  proof -
    assume r: ?C
    note adm_upds = admissible_transaction_is_wellformed_transaction(3)[OF T_adm]

    have *: "is_Update r" "is_Var (the_elem_term r)" "is_Fun (the_set_term r)"
            "is_Set (the_Fun (the_set_term r))" "args (the_set_term r) = []"
            "fst (the_Var (the_elem_term r)) = TAtom Value"
      using r adm_upds unfolding admissible_transaction_updates_def is_Fun_Set_def by fast+

    obtain t s where ts: "r = insert⟨t,s⟩ ∨ r = delete⟨t,s⟩" using *(1) by (cases r) auto
    obtain x where x: "t = Var x" "fst x = TAtom Value" using ts *(2,6) by (cases t) auto
    obtain f T where fT: "s = Fun f T" using ts *(3) by (cases s) auto
    obtain ss where ss: "f = Set ss" using ts fT *(4) by (cases f) fastforce+
    have T: "T = []" using ts fT *(5) ss by (cases T) auto

    show ?C'
      using ts x fT ss T by blast
  qed
qed

lemma protocol_transaction_vars_TAtom_typed:
  assumes T_adm: "admissible_transaction' T"
  shows "∀x ∈ vars_transaction T. Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    and "∀x ∈ fv_transaction T. Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    and "∀x ∈ set (transaction_fresh T). Γv x = TAtom Value"
proof -
  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]

  show "∀x ∈ vars_transaction T. Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    using admissible_transactionE(3)[OF T_adm] by fast
  thus "∀x ∈ fv_transaction T. Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    using varssst_is_fvsst_bvarssst by fast

  show "∀x ∈ set (transaction_fresh T). Γv x = TAtom Value"
    using admissible_transactionE(2)[OF T_adm] by argo
qed

lemma protocol_transactions_no_pubconsts:
  assumes "admissible_transaction' T"
  shows "Fun (Val n) S ∉ subtermsset (trms_transaction T)"
    and "Fun (PubConst Value n) S ∉ subtermsset (trms_transaction T)"
using assms admissible_transactions_no_Value_consts(1,3) by (blast, blast)

lemma protocol_transactions_no_abss:
  assumes "admissible_transaction' T"
  shows "Fun (Abs n) S ∉ subtermsset (trms_transaction T)"
using assms admissible_transactions_no_Value_consts(2)
by fast

lemma admissible_transaction_strand_sem_fv_ineq:
  assumes T_adm: "admissible_transaction' T"
    and ℐ: "strand_sem_stateful IK DB (unlabel (duallsst (transaction_strand T ⋅lsst θ))) ℐ"
    and x: "x ∈ fv_transaction T - set (transaction_fresh T)"
    and y: "y ∈ fv_transaction T - set (transaction_fresh T)"
    and x_not_y: "x ≠ y"
  shows "θ x ⋅ ℐ ≠ θ y ⋅ ℐ"
proof -
  have "⟨Var x != Var y⟩ ∈ set (unlabel (transaction_checks T)) ∨
        ⟨Var y != Var x⟩ ∈ set (unlabel (transaction_checks T))"
    using x y x_not_y admissible_transactionE(8)[OF T_adm] by auto
  hence "⟨Var x != Var y⟩ ∈ set (unlabel (transaction_strand T)) ∨
         ⟨Var y != Var x⟩ ∈ set (unlabel (transaction_strand T))"
    unfolding transaction_strand_def unlabel_def by auto
  hence "⟨θ x != θ y⟩ ∈ set (unlabel (duallsst (transaction_strand T ⋅lsst θ))) ∨
         ⟨θ y != θ x⟩ ∈ set (unlabel (duallsst (transaction_strand T ⋅lsst θ)))"
    using stateful_strand_step_subst_inI(8)[of _ _ "unlabel (transaction_strand T)" θ]
          subst_lsst_unlabel[of "transaction_strand T" θ]
          duallsst_unlabel_steps_iff(7)[of "[]" _ "[]"]
    by force
  then obtain B where B:
      "prefix (B@[⟨θ x != θ y⟩]) (unlabel (duallsst (transaction_strand T ⋅lsst θ))) ∨
       prefix (B@[⟨θ y != θ x⟩]) (unlabel (duallsst (transaction_strand T ⋅lsst θ)))"
    unfolding prefix_def
    by (metis (no_types, opaque_lifting) append.assoc append_Cons append_Nil split_list)
  thus ?thesis
    using ℐ strand_sem_append_stateful[of IK DB _ _ ℐ]
          stateful_strand_sem_NegChecks_no_bvars(2)
    unfolding prefix_def
    by metis 
qed

lemma admissible_transaction_sem_iff:
  fixes θ and T::"('fun,'atom,'sets,'lbl) prot_transaction"
  defines "A ≡ unlabel (duallsst (transaction_strand T ⋅lsst θ))"
  assumes T: "admissible_transaction' T"
    and I: " interpretationsubst I" "wftrms (subst_range I)"
  shows "strand_sem_stateful M D A I ⟷ (
    (∀l ts. (l,receive⟨ts⟩) ∈ set (transaction_receive T) ⟶ (∀t ∈ set ts. M ⊢ t ⋅ θ ⋅ I)) ∧
    (∀l ac t s. (l,⟨ac: t ≐ s⟩) ∈ set (transaction_checks T) ⟶ t ⋅ θ ⋅ I = s ⋅ θ ⋅ I) ∧
    (∀l ac t s. (l,⟨ac: t ∈ s⟩) ∈ set (transaction_checks T) ⟶ (t ⋅ θ ⋅ I, s ⋅ θ ⋅ I) ∈ D) ∧
    (∀l t s. (l,⟨t != s⟩) ∈ set (transaction_checks T) ⟶ t ⋅ θ ⋅ I ≠ s ⋅ θ ⋅ I) ∧
    (∀l t s. (l,⟨t not in s⟩) ∈ set (transaction_checks T) ⟶ (t ⋅ θ ⋅ I, s ⋅ θ ⋅ I) ∉ D))"
    (is "?A ⟷ ?B")
proof -
  define P where "P ≡
    λX. λδ::('fun,'atom,'sets,'lbl) prot_subst. subst_domain δ = set X ∧ ground (subst_range δ)"
  define rm where "rm ≡ λX. λδ::('fun,'atom,'sets,'lbl) prot_subst. rm_vars (set X) δ"
  define chks where "chks ≡ transaction_checks T"
  define q1 where "q1 ≡ λt X δ. t ⋅ rm X θ ⋅ δ ⋅ I"
  define q2 where "q2 ≡ λt. t ⋅ θ ⋅ I"

  note 0 = admissible_transaction_is_wellformed_transaction[OF T]
  note 1 = wellformed_transaction_sem_iff[OF 0(1) I, of M D θ, unfolded A_def[symmetric]]
  note 2 = admissible_transactionE[OF T]

  have 3: "rm X θ = θ" when "X = []" for X using that unfolding rm_def by auto

  have 4: "P X δ ⟷ δ = Var" when "X = []" for X and δ
    using that unfolding P_def by auto

  have 5: "∃t s. ∀X⟨∨≠: F ∨∉: G⟩ = ⟨t != s⟩ ∨ ∀X⟨∨≠: F ∨∉: G⟩ = ⟨t not in s⟩"
    when X: "(l, ∀X⟨∨≠: F ∨∉: G⟩) ∈ set chks" for l X F G
  proof -
    have *: "∀X⟨∨≠: F ∨∉: G⟩ ∈ set (unlabel (transaction_strand T))"
      using X transaction_strand_subsets(2)[of T] unlabel_in unfolding chks_def by fast
    hence **: "X = []" using 2(4) by auto

    note *** = transaction_notinset_checks_are_Value_vars(3,4)[OF T *]
               transaction_noteqs_checks_case[OF T *]

    show ?thesis
    proof (cases "G = []")
      case True thus ?thesis using ** ***(3) by blast
    next
      case False
      then obtain t s where g: "(t,s) ∈ set G" by (cases G) auto
      show ?thesis using ** ***(1,2)[OF g] by blast
    qed
  qed

  have 6: "q1 t X δ = q2 t" when "P X δ" "X = []" for X δ t
    using that 3 4 unfolding q1_def q2_def by simp

  let ?negcheck_sem = "λX F G. ∀δ. P X δ ⟶
                                (∃(t,s) ∈ set F. q1 t X δ ≠ q1 s X δ) ∨
                                (∃(t,s) ∈ set G. (q1 t X δ, q1 s X δ) ∉ D)"

  have "(∀l X F G. (l,∀X⟨∨≠: F ∨∉: G⟩) ∈ set chks ⟶ ?negcheck_sem X F G) ⟷
        ((∀l t s. (l,⟨t != s⟩) ∈ set chks ⟶ q2 t ≠ q2 s) ∧
         (∀l t s. (l,⟨t not in s⟩) ∈ set chks ⟶ (q2 t, q2 s) ∉ D))"
    (is "?A ⟷ ?B")
  proof
    have "q2 t ≠ q2 s" when t: "(l,⟨t != s⟩) ∈ set chks" ?A for l t s
    proof -
      have "?negcheck_sem [] [(t,s)] []" using t by blast
      thus ?thesis using 4[of "[]"] 6[of "[]"] by force
    qed
    moreover have "(q2 t, q2 s) ∉ D" when t: "(l,⟨t not in s⟩) ∈ set chks" ?A for l t s
    proof -
      have "?negcheck_sem [] [] [(t,s)]" using t by blast
      thus ?thesis using 4[of "[]"] 6[of "[]"] by force
    qed 
    ultimately show "?A ⟹ ?B" by blast

    have "?negcheck_sem X F G"
      when t: "(l,∀X⟨∨≠: F ∨∉: G⟩) ∈ set chks" ?B for l X F G
    proof -
      obtain t s where ts: "(X = [] ∧ F = [(t,s)] ∧ G = []) ∨ (X = [] ∧ F = [] ∧ G = [(t,s)])"
        using 5[OF t(1)] by blast
      hence "(X = [] ∧ F = [(t,s)] ∧ G = [] ∧ q2 t ≠ q2 s) ∨
             (X = [] ∧ F = [] ∧ G = [(t,s)] ∧ (q2 t, q2 s) ∉ D)" using t by blast
      thus ?thesis using 4[of "[]"] 6[of "[]"] by fastforce
    qed
    thus "?B ⟹ ?A" by simp
  qed
  thus ?thesis using 1 unfolding rm_def chks_def P_def q1_def q2_def by simp
qed

lemma admissible_transaction_terms_wftrms:
  assumes "admissible_transaction_terms T"
  shows "wftrms (trms_transaction T)"
by (rule conjunct1[OF assms[unfolded admissible_transaction_terms_def wftrms_code[symmetric]]])

lemma admissible_transactions_wftrms:
  assumes "admissible_transaction' T"
  shows "wftrms (trms_transaction T)" 
proof -
  have "admissible_transaction_terms T" using assms[unfolded admissible_transaction'_def] by fast
  thus ?thesis by (metis admissible_transaction_terms_wftrms)
qed

lemma admissible_transaction_no_Ana_Attack:
  assumes "admissible_transaction_terms T"
    and "t ∈ subtermsset (trms_transaction T)"
  shows "attack⟨n⟩ ∉ set (snd (Ana t))"
proof -
  obtain r where r: "r ∈ set (unlabel (transaction_strand T))" "t ∈ subtermsset (trmssstp r)"
    using assms(2) by force

  obtain K M where t: "Ana t = (K, M)"
    by (metis surj_pair)

  show ?thesis
  proof
    assume n: "attack⟨n⟩ ∈ set (snd (Ana t))"
    hence "attack⟨n⟩ ∈ set M" using t by simp
    hence n': "attack⟨n⟩ ∈ subtermsset (trmssstp r)"
      using Ana_subterm[OF t] r(2) subterms_subset by fast
    hence "∃f ∈ ⋃(funs_term ` trmssstp r). is_Attack f"
      using funs_term_Fun_subterm' unfolding is_Attack_def by fast
    hence "is_Send r" "length (the_msgs r) = 1" "is_Fun (hd (the_msgs r))"
          "is_Attack (the_Fun (hd (the_msgs r)))" "args (hd (the_msgs r)) = []"
      using assms(1) r(1) unfolding admissible_transaction_terms_def is_Fun_Attack_def by metis+
    hence "t = attack⟨n⟩"
      using n' r(2) unfolding is_Send_def is_Attack_def by (cases "the_msgs r") auto
    thus False using n by fastforce
  qed
qed

lemma admissible_transaction_Value_vars:
  assumes T: "admissible_transaction' T"
    and x: "x ∈ fv_transaction T"
  shows "Γv x = TAtom Value"
proof -
  have "x ∈ vars_transaction T"
    using x varssst_is_fvsst_bvarssst[of "unlabel (transaction_strand T)"]
    by blast
  thus "Γv x = TAtom Value"
    using admissible_transactionE(3)[OF T] by simp
qed

lemma admissible_transaction_occurs_checksE1:
  assumes T: "admissible_transaction_occurs_checks T"
    and x: "x ∈ fv_transaction T - set (transaction_fresh T)" "Γv x = TAtom Value"
  obtains l ts S where
    "transaction_receive T = (l,receive⟨ts⟩)#S" "occurs (Var x) ∈ set ts"
proof -
  let ?rcvs = "transaction_receive T"
  let ?frsh = "transaction_fresh T"
  let ?fvs = "fv_transaction T"

  have *: "?rcvs ≠ []" "is_Receive (hd (unlabel ?rcvs))"
          "∀x ∈ ?fvs - set ?frsh. Γv x = TAtom Value ⟶
            occurs (Var x) ∈ set (the_msgs (hd (unlabel ?rcvs)))"
    using T x unfolding admissible_transaction_occurs_checks_def Γv_TAtom''(2) by meson+

  obtain r S where S: "?rcvs = r#S"
    using *(1) by (cases ?rcvs) auto

  obtain l ts where r: "r = (l,receive⟨ts⟩)"
    by (metis *(1,2) S list.map_sel(1) list.sel(1) prod.collapse is_Receive_def unlabel_def) 

  have 0: "occurs (Var x) ∈ set ts" using *(3) x S r by fastforce

  show ?thesis using that[unfolded S r, of l ts S] 0 by blast
qed

lemma admissible_transaction_occurs_checksE2:
  assumes T: "admissible_transaction_occurs_checks T"
    and x: "x ∈ set (transaction_fresh T)"
  obtains l ts S where
    "transaction_send T = (l,send⟨ts⟩)#S" "occurs (Var x) ∈ set ts"
proof -
  let ?snds = "transaction_send T"
  let ?frsh = "transaction_fresh T"
  let ?fvs = "fv_transaction T"
  define ts where "ts ≡ the_msgs (hd (unlabel ?snds))"

  let ?P = "∀x ∈ set ?frsh. occurs (Var x) ∈ set ts"

  have "?frsh ≠ []" using x by auto
  hence *: "?snds ≠ []" "is_Send (hd (unlabel ?snds))" "?P"
    using T x unfolding admissible_transaction_occurs_checks_def ts_def by meson+

  obtain r S where S: "?snds = r#S"
    using *(1) by (cases ?snds) auto

  obtain l where r: "r = (l,send⟨ts⟩)"
    by (metis *(1,2) S list.map_sel(1) list.sel(1) prod.collapse unlabel_def ts_def
              stateful_strand_step.collapse(1)) 

  have ts: "occurs (Var x) ∈ set ts"
    using x *(3) unfolding S by auto

  show ?thesis using that[unfolded S r, of l ts S] ts by blast
qed

lemma admissible_transaction_occurs_checksE3:
  assumes T: "admissible_transaction_occurs_checks T"
    and t: "OccursFact ∈ funs_term t ∨ OccursSec ∈ funs_term t" "t ∈ set ts"
    and ts: "send⟨ts⟩ ∈ set (unlabel (transaction_send T))"
  obtains x where "t = occurs (Var x)" "x ∈ set (transaction_fresh T)"
proof -
  let ?P = "λt. ∃x ∈ set (transaction_fresh T). t = occurs (Var x)"

  have "?P t"
    when "t ∈ trmslsst (transaction_send T)" "OccursFact ∈ funs_term t ∨ OccursSec ∈ funs_term t"
    for t
    using assms that
    unfolding admissible_transaction_occurs_checks_def
              admissible_transaction_send_occurs_form_def
    by metis
  moreover have "t ∈ trmslsst (transaction_send T)"
    using t(2) ts unfolding trmssst_def by fastforce
  ultimately have "?P t" using t(1) by blast
  thus thesis using that by blast
qed

lemma admissible_transaction_occurs_checksE4:
  assumes T: "admissible_transaction_occurs_checks T"
    and ts: "send⟨ts⟩ ∈ set (unlabel (transaction_send T))"
    and t: "occurs t ∈ set ts"
  obtains x where "t = Var x" "x ∈ set (transaction_fresh T)"
using admissible_transaction_occurs_checksE3[OF T _ t ts] by auto

lemma admissible_transaction_occurs_checksE5:
  assumes T: "admissible_transaction_occurs_checks T"
  shows "Fun OccursSec [] ∉ trmslsst (transaction_send T)"
proof -
  have "∃x ∈ set (transaction_fresh T). t = occurs (Var x)"
    when "t ∈ trmslsst (transaction_send T)" "OccursFact ∈ funs_term t ∨ OccursSec ∈ funs_term t"
    for t
    using assms that
    unfolding admissible_transaction_occurs_checks_def
              admissible_transaction_send_occurs_form_def
    by metis
  thus ?thesis by fastforce
qed

lemma admissible_transaction_occurs_checksE6:
  assumes T: "admissible_transaction_occurs_checks T"
    and t: "t ⊑set trmslsst (transaction_send T)"
  shows "Fun OccursSec [] ∉ set (snd (Ana t))" (is ?A)
    and "occurs k ∉ set (snd (Ana t))" (is ?B)
proof -
  obtain t' where t': "t' ∈ trmslsst (transaction_send T)" "t ⊑ t'" using t by blast
  have "?A ∧ ?B"
  proof (rule ccontr)
    assume *: "¬(?A ∧ ?B)"
    hence "OccursSec ∈ funs_term t' ∨ OccursFact ∈ funs_term t'"
      by (meson t'(2) Ana_subterm' funs_term_Fun_subterm' term.order.trans) 
    then obtain x where x: "x ∈ set (transaction_fresh T)" "t' = occurs (Var x)"
      using t'(1) T
      unfolding admissible_transaction_occurs_checks_def
                admissible_transaction_send_occurs_form_def
      by metis
    have "t = occurs (Var x) ∨ t = Var x ∨ t = Fun OccursSec []" using x(2) t'(2) by auto
    thus False using * by fastforce
  qed
  thus ?A ?B by simp_all
qed

lemma has_initial_value_producing_transactionE:
  fixes P::"('fun,'atom,'sets,'lbl) prot"
  assumes P: "has_initial_value_producing_transaction P"
    and P_adm: "∀T ∈ set P. admissible_transaction' T"
  obtains T x s ts upds l l' where
    "Γv x = TAtom Value" "Var x ∈ set ts" "fvset (set ts) = {x}"
    "∀n. ¬(Fun (Val n) [] ⊑set set ts)" "T ∈ set P"
    "T = Transaction (λ(). []) [x] [] [] upds [(l, send⟨ts⟩)]"
    "upds = [] ∨ (upds = [(l', insert⟨Var x, ⟨s⟩s⟩)] ∧
      (∀T ∈ set P. ∀(l,a) ∈ set (transaction_strand T). ∀t.
        a ≠ select⟨t, ⟨s⟩s⟩ ∧ a ≠ ⟨t in ⟨s⟩s⟩ ∧ a ≠ ⟨t not in ⟨s⟩s⟩ ∧ a ≠ delete⟨t, ⟨s⟩s⟩)) ∨
     T = Transaction (λ(). []) [x] [] [] [] [(l, send⟨ts⟩)]"
proof -
  define f where "f ≡ λs.
      list_all (λT. list_all (λa. ((is_Delete a ∨ is_InSet a) ⟶ the_set_term a ≠ ⟨s⟩s) ∧
                                  (is_NegChecks a ⟶ list_all (λ(_,t). t ≠ ⟨s⟩s) (the_ins a)))
                             (unlabel (transaction_checks T@transaction_updates T)))
               P"

  obtain T where T0:
      "T ∈ set P"
      "length (transaction_fresh T) = 1" "transaction_receive T = []"
      "transaction_checks T = []" "length (transaction_send T) = 1"
      "let x = hd (transaction_fresh T); a = hd (transaction_send T); u = transaction_updates T
       in is_Send (snd a) ∧ Var x ∈ set (the_msgs (snd a)) ∧
          fvset (set (the_msgs (snd a))) = {x} ∧
          (u ≠ [] ⟶ (
            let b = hd u; c = snd b
            in tl u = [] ∧ is_Insert c ∧ the_elem_term c = Var x ∧
               is_Fun_Set (the_set_term c) ∧ f (the_Set (the_Fun (the_set_term c)))))"
    using P unfolding has_initial_value_producing_transaction_def Let_def list_ex_iff f_def by blast

  obtain x upds ts h s l l' where T1:
      "T = Transaction h [x] [] [] upds [(l, send⟨ts⟩)]"
      "Var x ∈ set ts" "fvset (set ts) = {x}"
      "upds = [] ∨ (upds = [(l', insert⟨Var x, ⟨s⟩s⟩)] ∧ f s)"
  proof (cases T)
    case T: (Transaction A B C D E F)

    obtain x where B: "B = [x]" using T0(2) unfolding T by (cases B) auto
    have C: "C = []" using T0(3) unfolding T by simp
    have D: "D = []" using T0(4) unfolding T by simp
    obtain l a where F: "F = [(l,a)]" using T0(5) unfolding T by fastforce
    obtain ts where ts: "a = send⟨ts⟩" using T0(6) unfolding T F by (cases a) auto
    obtain k u where E: "E = [] ∨ E = [(k,u)]" using T0(6) unfolding T by (cases E) fastforce+
    have x: "Var x ∈ set ts" "fvset (set ts) = {x}" using T0(6) unfolding T B F ts by auto

    from E show ?thesis
    proof
      assume E': "E = [(k,u)]"
      obtain t t' where u: "u = insert⟨t,t'⟩" using T0(6) unfolding T E' by (cases u) auto
      have t: "t = Var x" using T0(6) unfolding T B E' u Let_def by simp
      obtain s where t': "t' = ⟨s⟩s" and s: "f s" using T0(6) unfolding T B E' u Let_def by auto
      show ?thesis using that[OF T[unfolded B C D F ts E' u t t'] x] s by blast
    qed (use that[OF T[unfolded B C D F ts] x] in blast)
  qed

  note T_adm = bspec[OF P_adm T0(1)]

  have "x ∈ set (transaction_fresh T)" using T1(1) by fastforce
  hence x: "Γv x = TAtom Value" using admissible_transactionE(2)[OF T_adm] by fast

  have "set ts ⊆ trms_transaction T" unfolding T1(1) trms_transaction_unfold by simp
  hence ts: "∀n. ¬(Fun (Val n) [] ⊑set set ts)"
    using admissible_transactions_no_Value_consts[OF T_adm] by blast

  have "a ≠ select⟨t, ⟨s⟩s⟩ ∧ a ≠ ⟨t in ⟨s⟩s⟩ ∧ a ≠ ⟨t not in ⟨s⟩s⟩ ∧ a ≠ delete⟨t, ⟨s⟩s⟩"
    when upds: "upds = [(k, insert⟨Var x,⟨s⟩s⟩)]"
      and T': "T' ∈ set P" and la: "(l,a) ∈ set (transaction_strand T')"
    for T' l k a t
  proof -
    note T'_wf = admissible_transaction_is_wellformed_transaction(1)[OF bspec[OF P_adm T']]

    have "a ∈ set (unlabel (transaction_checks T'@transaction_updates T'))"
      when a': "is_Check_or_Assignment a ∨ is_Update a"
      using that wellformed_transaction_strand_unlabel_memberD[OF T'_wf unlabel_in[OF la]]
      by (cases a) auto
    note 0 = this T1(4) T'

    note 1 = upds f_def list_all_iff

    show ?thesis
    proof (cases a)
      case (Delete t' s') thus ?thesis using 0 unfolding 1 by fastforce
    next
      case (InSet ac t' s') thus ?thesis using 0 unfolding 1 by fastforce
    next
      case (NegChecks X F G) thus ?thesis using 0 unfolding 1 by fastforce
    qed auto
  qed
  hence s: "∀T ∈ set P. ∀(l,a) ∈ set (transaction_strand T). ∀t.
        a ≠ select⟨t, ⟨s⟩s⟩ ∧ a ≠ ⟨t in ⟨s⟩s⟩ ∧ a ≠ ⟨t not in ⟨s⟩s⟩ ∧ a ≠ delete⟨t, ⟨s⟩s⟩"
    when upds: "upds = [(k, insert⟨Var x,⟨s⟩s⟩)]" for k
    using upds by force

  have h: "h = (λ(). [])"
  proof -
    have "transaction_decl T = h" using T1(1) by fastforce
    hence "h a = []" for a using admissible_transactionE(1)[OF T_adm] by simp
    thus ?thesis using ext[of h "λ(). []"] by (metis case_unit_Unity)
  qed

  show ?thesis using that[OF x T1(2,3) ts T0(1)] T1(1,4) s unfolding h by auto
qed

lemma has_initial_value_producing_transaction_update_send_ex_filter:
  fixes P::"('a,'b,'c,'d) prot"
  defines "f ≡ λT. transaction_fresh T = [] ⟶
                      list_ex (λa. is_Update (snd a) ∨ is_Send (snd a)) (transaction_strand T)"
  assumes P: "has_initial_value_producing_transaction P"
  shows "has_initial_value_producing_transaction (filter f P)"
proof -
  define g where "g ≡ λP::('a,'b,'c,'d) prot. λs.
      list_all (λT. list_all (λa. ((is_Delete a ∨ is_InSet a) ⟶ the_set_term a ≠ ⟨s⟩s) ∧
                                  (is_NegChecks a ⟶ list_all (λ(_,t). t ≠ ⟨s⟩s) (the_ins a)))
                             (unlabel (transaction_checks T@transaction_updates T)))
               P"

  let ?Q = "λP T.
     let x = hd (transaction_fresh T); a = hd (transaction_send T); u = transaction_updates T
     in is_Send (snd a) ∧ Var x ∈ set (the_msgs (snd a)) ∧
        fvset (set (the_msgs (snd a))) = {x} ∧
        (u ≠ [] ⟶ (
          let b = hd u; c = snd b
          in tl u = [] ∧ is_Insert c ∧ the_elem_term c = Var x ∧
             is_Fun_Set (the_set_term c) ∧ g P (the_Set (the_Fun (the_set_term c)))))"

  have "set (filter f P) ⊆ set P" by simp
  hence "list_all h P ⟹ list_all h (filter f P)" for h unfolding list_all_iff by blast
  hence g_f_subset: "g P s ⟹ g (filter f P) s" for s unfolding g_def by blast

  obtain T where T:
    "T ∈ set P" "length (transaction_fresh T) = 1" "transaction_receive T = []"
    "transaction_checks T = []" "length (transaction_send T) = 1" "?Q P T"
    using P unfolding has_initial_value_producing_transaction_def Let_def list_ex_iff g_def by blast

  obtain x where x: "transaction_fresh T = [x]" using T(2) by blast
  obtain a where a: "transaction_send T = [a]" using T(5) by blast
  obtain l b where b: "a = (l,b)" by (cases a) auto
  obtain ts where ts: "b = send⟨ts⟩" using T(6) unfolding Let_def a b by (cases b) auto

  have "T ∈ set (filter f P)" using T(1) x a unfolding b ts f_def by auto
  moreover have "?Q (filter f P) T" using T(6) g_f_subset by meson
  ultimately show ?thesis
    using T(2-5)
    unfolding has_initial_value_producing_transaction_def Let_def list_ex_iff g_def
    by blast
qed


subsection ‹Lemmata: Renaming, Declaration, and Fresh Substitutions›
lemma transaction_decl_subst_empty_inv:
  assumes "transaction_decl_subst Var T"
  shows "transaction_decl T () = []"
using assms unfolding transaction_decl_subst_def subst_domain_Var by blast

lemma transaction_decl_subst_domain:
  fixes ξ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_decl_subst ξ T"
  shows "subst_domain ξ = fst ` set (transaction_decl T ())"
using assms unfolding transaction_decl_subst_def by argo

lemma transaction_decl_subst_grounds_domain:
  fixes ξ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_decl_subst ξ T"
    and "x ∈ fst ` set (transaction_decl T ())"
  shows "fv (ξ x) = {}"
proof -
  obtain c where "ξ x = Fun c []"
    using assms unfolding transaction_decl_subst_def by force
  thus ?thesis by simp
qed

lemma transaction_decl_subst_range_vars_empty:
  fixes ξ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_decl_subst ξ T"
  shows "range_vars ξ = {}"
using assms unfolding transaction_decl_subst_def range_vars_def by auto

lemma transaction_decl_subst_wt:
  fixes ξ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_decl_subst ξ T"
  shows "wtsubst ξ"
using assms unfolding transaction_decl_subst_def by blast

lemma transaction_decl_subst_is_wf_trm:
  fixes ξ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_decl_subst ξ P"
  shows "wftrm (ξ v)"
proof (cases "v ∈ subst_domain ξ")
  case True thus ?thesis using assms unfolding transaction_decl_subst_def by fastforce
qed auto

lemma transaction_decl_subst_range_wf_trms:
  fixes ξ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_decl_subst ξ P"
  shows "wftrms (subst_range ξ)"
by (metis transaction_decl_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff)

lemma transaction_renaming_subst_is_renaming:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes α: "transaction_renaming_subst α P A"
  shows "∃m. ∀τ n. α (τ,n) = Var (τ,n+Suc m)" (is ?A)
    and "∃y. α x = Var y" (is ?B)
    and "α x ≠ Var x" (is ?C)
    and "subst_domain α = UNIV" (is ?D)
    and "subst_range α ⊆ range Var" (is ?E)
    and "fv (t ⋅ α) ⊆ range_vars α" (is ?F)
proof -
  show 0: ?A using α unfolding transaction_renaming_subst_def var_rename_def by force
  show ?B using α unfolding transaction_renaming_subst_def var_rename_def by blast
  show ?C using 0 by (cases x) auto
  show 1: ?D using 0 by fastforce
  show ?E using 0 by auto
  show ?F by (induct t) (auto simp add: 1 subst_dom_vars_in_subst subst_fv_imgI)
qed

lemma transaction_renaming_subst_is_injective:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_renaming_subst α P A"
  shows "inj α"
proof (intro injI)
  fix x y::"('fun,'atom,'sets,'lbl) prot_var"
  obtain τx nx where x: "x = (τx,nx)" by (metis surj_pair)
  obtain τy ny where y: "y = (τy,ny)" by (metis surj_pair)

  obtain m where m: "∀τ. ∀n. α (τ, n) = Var (τ, n + Suc m)"
    using transaction_renaming_subst_is_renaming(1)[OF assms] by blast

  assume "α x = α y"
  hence "τx = τy" "nx = ny" using x y m by simp_all
  thus "x = y" using x y by argo
qed

lemma transaction_renaming_subst_vars_disj:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_renaming_subst α P (varslsst A)"
  shows "fvset (α ` (⋃(vars_transaction ` set P))) ∩ (⋃(vars_transaction ` set P)) = {}" (is ?A)
    and "fvset (α ` varslsst A) ∩ varslsst A = {}" (is ?B)
    and "T ∈ set P ⟹ vars_transaction T ∩ range_vars α = {}" (is "T ∈ set P ⟹ ?C1")
    and "T ∈ set P ⟹ bvars_transaction T ∩ range_vars α = {}" (is "T ∈ set P ⟹ ?C2")
    and "T ∈ set P ⟹ fv_transaction T ∩ range_vars α = {}" (is "T ∈ set P ⟹ ?C3")
    and "varslsst A ∩ range_vars α = {}" (is ?D1)
    and "bvarslsst A ∩ range_vars α = {}" (is ?D2)
    and "fvlsst A ∩ range_vars α = {}" (is ?D3)
proof -
  define X where "X ≡ ⋃(vars_transaction ` set P) ∪ varslsst A"

  have 1: "finite X" by (simp add: X_def)

  obtain n where n: "n ≥ max_var_set X" "α = var_rename n"
    using assms unfolding transaction_renaming_subst_def X_def by force
  hence 2: "∀x ∈ X. snd x < Suc n"
    using less_Suc_max_var_set[OF _ 1] unfolding var_rename_def by fastforce
  
  have 3: "x ∉ fvset (α ` X)" "fv (α x) ∩ X = {}" "x ∉ range_vars α" when x: "x ∈ X" for x
    using 2 x n unfolding var_rename_def by force+

  show ?A ?B using 3(1,2) unfolding X_def by auto

  show ?C1 when T: "T ∈ set P" using T 3(3) unfolding X_def by blast
  thus ?C2 ?C3 when T: "T ∈ set P"
    using T by (simp_all add: disjoint_iff_not_equal varssst_is_fvsst_bvarssst)

  show ?D1 using 3(3) unfolding X_def by auto
  thus ?D2 ?D3 by (simp_all add: disjoint_iff_not_equal varssst_is_fvsst_bvarssst)
qed

lemma transaction_renaming_subst_wt:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_renaming_subst α P X"
  shows "wtsubst α"
proof -
  { fix x::"('fun,'atom,'sets,'lbl) prot_var"
    obtain τ n where x: "x = (τ,n)" by force
    then obtain m where m: "α x = Var (τ,m)"
      using assms transaction_renaming_subst_is_renaming(1) by force
    hence "Γ (α x) = Γv x" using x by (simp add: Γv_def)
  } thus ?thesis by (simp add: wtsubst_def)
qed

lemma transaction_renaming_subst_is_wf_trm:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_renaming_subst α P X"
  shows "wftrm (α v)"
proof -
  obtain τ n where "v = (τ, n)" by force
  then obtain m where "α v = Var (τ, n + Suc m)"
    using transaction_renaming_subst_is_renaming(1)[OF assms]
    by force
  thus ?thesis by (metis wf_trm_Var)
qed

lemma transaction_renaming_subst_range_wf_trms:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_renaming_subst α P X"
  shows "wftrms (subst_range α)"
by (metis transaction_renaming_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff)

lemma transaction_renaming_subst_range_notin_vars:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_renaming_subst α P (varslsst A)"
  shows "∃y. α x = Var y ∧ y ∉ ⋃(vars_transaction ` set P) ∪ varslsst A"
proof -
  obtain τ n where x: "x = (τ,n)" by (metis surj_pair)

  define y where "y ≡ λm. (τ,n+Suc m)"

  have "∃m ≥ max_var_set (⋃(vars_transaction ` set P) ∪ varslsst A). α x = Var (y m)"
    using assms x by (auto simp add: y_def transaction_renaming_subst_def var_rename_def)
  moreover have "finite (⋃(vars_transaction ` set P) ∪ varslsst A)" by auto
  ultimately show ?thesis using x unfolding y_def by force
qed

lemma transaction_renaming_subst_var_obtain:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes α: "transaction_renaming_subst α P X"
  shows "x ∈ fvsst (S ⋅sst α) ⟹ ∃y. α y = Var x" (is "?A1 ⟹ ?B1")
    and "x ∈ fv (t ⋅ α) ⟹ ∃y ∈ fv t. α y = Var x" (is "?A2 ⟹ ?B2")
proof -
  assume x: ?A1
  obtain y where y: "y ∈ fvsst S" "x ∈ fv (α y)" using fvsst_subst_obtain_var[OF x] by force
  thus ?B1 using transaction_renaming_subst_is_renaming(2)[OF α, of y] by fastforce
next
  assume x: ?A2
  obtain y where y: "y ∈ fv t" "x ∈ fv (α y)" using fv_subst_obtain_var[OF x] by force
  thus ?B2 using transaction_renaming_subst_is_renaming(2)[OF α, of y] by fastforce
qed

lemma transaction_renaming_subst_set_eq:
  assumes "set P1 = set P2"
  shows "transaction_renaming_subst α P1 X = transaction_renaming_subst α P2 X" (is "?A = ?B")
using assms unfolding transaction_renaming_subst_def by presburger

lemma transaction_renaming_subst_vars_transaction_neq:
  assumes T: "T ∈ set P"
    and α: "transaction_renaming_subst α P vars"
    and vars:"finite vars"
    and x: "x ∈ vars_transaction T"
  shows "α y ≠ Var x"
proof -
  have "∃n. α = var_rename n ∧ n ≥ max_var_set (⋃(vars_transaction ` set P))"
    using T α vars x unfolding transaction_renaming_subst_def by auto
  then obtain n where n_p: "α = var_rename n" "n ≥ max_var_set (⋃(vars_transaction ` set P))"
    by blast
  moreover
  have "⋃(vars_transaction ` set P) ⊇ vars_transaction T"
    using T by blast
  ultimately
  have n_gt: "n ≥ max_var_set (vars_transaction T)"
    by auto
  obtain a b where ab: "x = (a,b)"
    by (cases x) auto
  obtain c d where cd: "y = (c,d)"
    by (cases y) auto

  have nb: "n ≥ b"
    using n_gt x ab
    by auto

  have "α y = α (c, d)"
    using cd by auto
  moreover
  have "... = Var (c, Suc (d + n))"
    unfolding n_p(1) unfolding var_rename_def by simp 
  moreover
  have "... ≠ Var x"
    using nb ab by auto
  ultimately
  show ?thesis
    by auto
qed

lemma transaction_renaming_subst_fv_disj:
  fixes α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_renaming_subst α P (varslsst A)"
  shows "fvset (α ` fvlsst A) ∩ fvlsst  A = {}"
proof -
  have "fvset (α ` varslsst A) ∩ varslsst  A = {}"
    using assms transaction_renaming_subst_vars_disj(2) by blast
  moreover
  have "fvlsst A ⊆ varslsst A"
    by (simp add: varssst_is_fvsst_bvarssst)
  ultimately
  show ?thesis
    by auto
qed

lemma transaction_fresh_subst_is_wf_trm:
  fixes σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_fresh_subst σ T X"
  shows "wftrm (σ v)"
proof (cases "v ∈ subst_domain σ")
  case True
  then obtain c where "σ v = Fun c []" "arity c = 0"
    using assms unfolding transaction_fresh_subst_def
    by force
  thus ?thesis by auto
qed auto

lemma transaction_fresh_subst_wt:
  fixes σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_fresh_subst σ T X"
  shows "wtsubst σ"
using assms unfolding transaction_fresh_subst_def by blast

lemma transaction_fresh_subst_domain:
  fixes σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_fresh_subst σ T X"
  shows "subst_domain σ = set (transaction_fresh T)"
using assms unfolding transaction_fresh_subst_def by fast

lemma transaction_fresh_subst_range_wf_trms:
  fixes σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_fresh_subst σ T X"
  shows "wftrms (subst_range σ)"
by (metis transaction_fresh_subst_is_wf_trm[OF assms] wf_trm_subst_range_iff)

lemma transaction_fresh_subst_range_fresh:
  fixes σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_fresh_subst σ T M"
  shows "∀t ∈ subst_range σ. t ∉ subtermsset M"
    and "∀t ∈ subst_range σ. t ∉ subtermsset (trmslsst (transaction_strand T))"
using assms unfolding transaction_fresh_subst_def by meson+

lemma transaction_fresh_subst_sends_to_val:
  fixes σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes σ: "transaction_fresh_subst σ T X"
    and y: "y ∈ set (transaction_fresh T)" "Γv y = TAtom Value"
  obtains n where "σ y = Fun (Val n) []" "Fun (Val n) [] ∈ subst_range σ"
proof -
  have "σ y ∈ subst_range σ" using assms unfolding transaction_fresh_subst_def by simp

  obtain c where c: "σ y = Fun c []" "¬public c" "arity c = 0"
    using σ y(1) unfolding transaction_fresh_subst_def by fastforce

  have "Γ (σ y) = TAtom Value"
    using σ y(2) Γv_TAtom''(2)[of y] wt_subst_trm''[of σ "Var y"]
    unfolding transaction_fresh_subst_def by simp
  then obtain n where "c = Val n"
    using c by (cases c) (auto split: option.splits)
  thus ?thesis
    using c that unfolding transaction_fresh_subst_def
    by fastforce
qed

lemma transaction_fresh_subst_sends_to_val':
  fixes σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_fresh_subst σ T X"
    and "y ∈ set (transaction_fresh T)" "Γv y = TAtom Value"
  obtains n where "(σ ∘s α) y ⋅ ℐ = Fun (Val n) []" "Fun (Val n) [] ∈ subst_range σ" 
proof -
  obtain n where "σ y = Fun (Val n) []" "Fun (Val n) [] ∈ subst_range σ"
    using transaction_fresh_subst_sends_to_val[OF assms] by force
  thus ?thesis using that by (fastforce simp add: subst_compose_def)
qed

lemma transaction_fresh_subst_grounds_domain:
  fixes σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_fresh_subst σ T X"
    and "y ∈ set (transaction_fresh T)"
  shows "fv (σ y) = {}"
proof -
  obtain c where "σ y = Fun c []"
    using assms unfolding transaction_fresh_subst_def by force
  thus ?thesis by simp
qed

lemma transaction_fresh_subst_range_vars_empty:
  fixes σ::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_fresh_subst σ T X"
  shows "range_vars σ = {}"
proof -
  have "fv t = {}" when "t ∈ subst_range σ" for t
    using assms that unfolding transaction_fresh_subst_def by fastforce
  thus ?thesis unfolding range_vars_def by blast
qed

lemma transaction_decl_fresh_renaming_substs_range:
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T M"
    and α: "transaction_renaming_subst α P X"
  shows "x ∈ fst ` set (transaction_decl T ()) ⟹
          ∃c. (ξ ∘s σ ∘s α) x = Fun c [] ∧ arity c = 0"
    and "x ∉ fst ` set (transaction_decl T ()) ⟹
          x ∈ set (transaction_fresh T) ⟹
            ∃c. (ξ ∘s σ ∘s α) x = Fun c [] ∧ ¬public c ∧ arity c = 0"
    and "x ∉ fst ` set (transaction_decl T ()) ⟹
          x ∈ set (transaction_fresh T) ⟹
          fst x = TAtom Value ⟹
            ∃n. (ξ ∘s σ ∘s α) x = Fun (Val n) []"
    and "x ∉ fst ` set (transaction_decl T ()) ⟹
          x ∉ set (transaction_fresh T) ⟹
            ∃y. (ξ ∘s σ ∘s α) x = Var y"
proof -
  assume "x ∈ fst ` set (transaction_decl T ())"
  then obtain c where c: "ξ x = Fun c []" "arity c = 0"
    using ξ unfolding transaction_decl_subst_def by fastforce
  thus "∃c. (ξ ∘s σ ∘s α) x = Fun c [] ∧ arity c = 0"
    using subst_compose[of "ξ ∘s σ" α x] subst_compose[of ξ σ x] by simp
next
  assume x: "x ∉ fst ` set (transaction_decl T ())"
            "x ∈ set (transaction_fresh T)"

  have *: "(ξ ∘s σ) x = σ x"
    using x(1) ξ unfolding transaction_decl_subst_def
    by (metis (no_types, opaque_lifting) subst_comp_notin_dom_eq)
  then obtain c where c: "(ξ ∘s σ) x = Fun c []" "¬public c" "arity c = 0"
    using σ x(2) unfolding transaction_fresh_subst_def by fastforce
  thus "∃c. (ξ ∘s σ ∘s α) x = Fun c [] ∧ ¬public c ∧ arity c = 0"
    using subst_compose[of "ξ ∘s σ" α x] subst_compose[of ξ σ x] by simp

  assume "fst x = TAtom Value"
  hence "Γ ((ξ ∘s σ) x) = TAtom Value"
    using * σ Γv_TAtom''(2)[of x] wt_subst_trm''[of σ "Var x"]
    unfolding transaction_fresh_subst_def by simp
  then obtain n where "c = Val n"
    using c by (cases c) (auto split: option.splits)
  thus "∃n. (ξ ∘sσ ∘s α) x = Fun (Val n) []"
    using c subst_compose[of "ξ ∘s σ" α x] subst_compose[of ξ σ x] by simp
next
  assume "x ∉ fst ` set (transaction_decl T ())"
         "x ∉ set (transaction_fresh T)"
  hence "(ξ ∘s σ) x = Var x"
    using ξ σ
    unfolding transaction_decl_subst_def transaction_fresh_subst_def
    by (metis (no_types, opaque_lifting) subst_comp_notin_dom_eq subst_domI)
  thus "∃y. (ξ ∘s σ ∘s α) x = Var y"
    using transaction_renaming_subst_is_renaming(1)[OF α]
          subst_compose[of "ξ ∘s σ" α x] subst_compose[of ξ σ x]
    by (cases x) force
qed

lemma transaction_decl_fresh_renaming_substs_range':
  fixes σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T M"
    and α: "transaction_renaming_subst α P X"
    and t: "t ∈ subst_range (ξ ∘s σ ∘s α)"
  shows "(∃c. t = Fun c [] ∧ arity c = 0) ∨ (∃x. t = Var x)"
    and "ξ = Var ⟹ (∃c. t = Fun c [] ∧ ¬public c ∧ arity c = 0) ∨ (∃x. t = Var x)"
    and "ξ = Var ⟹ ∀x ∈ set (transaction_fresh T). Γv x = TAtom Value ⟹
                      (∃n. t = Fun (Val n) []) ∨ (∃x. t = Var x)"
    and "ξ = Var ⟹ is_Fun t ⟹ t ∈ subst_range σ"
proof -
  obtain x where x: "x ∈ subst_domain (ξ ∘s σ ∘s α)" "(ξ ∘s σ ∘s α) x = t"
    using t by auto

  note 0 = x transaction_decl_fresh_renaming_substs_range[OF ξ σ α, of x]

  show "(∃c. t = Fun c [] ∧ arity c = 0) ∨ (∃x. t = Var x)"
    using 0 unfolding Γv_TAtom'' by auto

  assume 1: "ξ = Var"

  note 2 = transaction_decl_subst_empty_inv[OF ξ[unfolded 1]]

  show 3: "(∃c. t = Fun c [] ∧ ¬public c ∧ arity c = 0) ∨ (∃x. t = Var x)"
    using 0 2 unfolding Γv_TAtom'' by auto

  show "(∃n. t = Fun (Val n) []) ∨ (∃x. t = Var x)"
    when "∀x ∈ set (transaction_fresh T). Γv x = TAtom Value"
    using 0 2 that unfolding Γv_TAtom'' by auto

  show "t ∈ subst_range σ" when t': "is_Fun t"
  proof -
    obtain x where x: "(σ ∘s α) x = t" using t 1 by auto
    
    show ?thesis
    proof (cases "x ∈ subst_domain σ")
      case True thus ?thesis
        by (metis subst_dom_vars_in_subst subst_ground_ident_compose(1) subst_imgI x
                  transaction_fresh_subst_grounds_domain[OF σ]
                  transaction_fresh_subst_domain[OF σ]) 
    next
      case False thus ?thesis
        by (metis (no_types, lifting) subst_compose_def subst_domI term.disc(1) that
                  transaction_renaming_subst_is_renaming(5)[OF α] var_renaming_is_Fun_iff x)
    qed
  qed
qed

lemma transaction_decl_fresh_renaming_substs_range'':
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T (trmslsst 𝒜)"
    and α: "transaction_renaming_subst α P (varslsst 𝒜)"
    and y: "y ∈ fv ((ξ ∘s σ ∘s α) x)"
  shows "ξ x = Var x"
    and "σ x = Var x"
    and "α x = Var y"
    and "(ξ ∘s σ ∘s α) x = Var y"
proof -
  have "∃z. z ∈ fv (ξ x)" by (metis y subst_compose_fv')
  hence "x ∉ subst_domain ξ"
    using y transaction_decl_subst_domain[OF ξ]
          transaction_decl_subst_grounds_domain[OF ξ, of x]
    by blast
  thus 0: "ξ x = Var x" by blast
  hence "y ∈ fv ((σ ∘s α) x)" using y by (simp add: subst_compose)
  hence "∃z. z ∈ fv (σ x)" by (metis subst_compose_fv')
  hence "x ∉ subst_domain σ"
    using y transaction_fresh_subst_domain[OF σ]
          transaction_fresh_subst_grounds_domain[OF σ, of x]
    by blast
  thus 1: "σ x = Var x" by blast
  
  show "α x = Var y" "(ξ ∘s σ ∘s α) x = Var y"
    using 0 1 y transaction_renaming_subst_is_renaming(2)[OF α, of x]
    unfolding subst_compose_def by (fastforce,fastforce)
qed

lemma transaction_decl_fresh_renaming_substs_vars_subset:
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T (trmslsst 𝒜)"
    and α: "transaction_renaming_subst α P (varslsst 𝒜)"
  shows "⋃(fv_transaction ` set P) ⊆ subst_domain (ξ ∘s σ ∘s α)" (is ?A)
    and "fvlsst 𝒜 ⊆ subst_domain (ξ ∘s σ ∘s α)" (is ?B)
    and "T' ∈ set P ⟹ fv_transaction T' ⊆ subst_domain (ξ ∘s σ ∘s α)" (is "T' ∈ set P ⟹ ?C")
    and "T' ∈ set P ⟹ fvlsst (transaction_strand T' ⋅lsst (ξ ∘s σ ∘s α)) ⊆ range_vars (ξ ∘s σ ∘s α)"
      (is "T' ∈ set P ⟹ ?D")
proof -
  have *: "x ∈ subst_domain (ξ ∘s σ ∘s α)" for x
  proof (cases "x ∈ subst_domain ξ")
    case True thus ?thesis
      using transaction_decl_subst_domain[OF ξ] transaction_decl_subst_grounds_domain[OF ξ]
      by (simp add: subst_domI subst_dom_vars_in_subst subst_ground_ident_compose(1))
  next
    case False
    hence ξ_x_eq: "(ξ ∘s σ ∘s α) x = (σ ∘s α) x" by (auto simp add: subst_compose)

    show ?thesis
    proof (cases "x ∈ subst_domain σ")
      case True
      hence "x ∉ {x. ∃y. σ x = Var y ∧ α y = Var x}"
        using transaction_fresh_subst_domain[OF σ]
              transaction_fresh_subst_grounds_domain[OF σ, of x]
        by auto
      hence "x ∈ subst_domain (σ ∘s α)" using subst_domain_subst_compose[of σ α] by blast
      thus ?thesis using ξ_x_eq subst_dom_vars_in_subst by fastforce 
    next
      case False
      hence "(σ ∘s α) x = α x" unfolding subst_compose_def by fastforce
      moreover have "α x ≠ Var x"
        using transaction_renaming_subst_is_renaming(1)[OF α] by (cases x) auto
      ultimately show ?thesis using ξ_x_eq by fastforce
    qed
  qed
  
  show ?A ?B using * by blast+

  show ?C when T: "T' ∈ set P" using T * by blast
  hence "fvsst (unlabel (transaction_strand T') ⋅sst ξ ∘s σ ∘s α) ⊆ range_vars (ξ ∘s σ ∘s α)"
    when T: "T' ∈ set P"
    using T fvsst_subst_subset_range_vars_if_subset_domain by blast
  thus ?D when T: "T' ∈ set P" by (metis T unlabel_subst)
qed

lemma transaction_decl_fresh_renaming_substs_vars_disj:
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T (trmslsst 𝒜)"
    and α: "transaction_renaming_subst α P (varslsst 𝒜)"
  shows "fvset ((ξ ∘s σ ∘s α) ` (⋃(vars_transaction ` set P))) ∩ (⋃(vars_transaction ` set P)) = {}"
      (is ?A)
    and "x ∈ ⋃(vars_transaction ` set P) ⟹ fv ((ξ ∘s σ ∘s α) x) ∩ (⋃(vars_transaction ` set P)) = {}"
      (is "?B' ⟹ ?B")
    and "T' ∈ set P ⟹ vars_transaction T' ∩ range_vars (ξ ∘s σ ∘s α) = {}" (is "T' ∈ set P ⟹ ?C1")
    and "T' ∈ set P ⟹ bvars_transaction T' ∩ range_vars (ξ ∘s σ ∘s α) = {}" (is "T' ∈ set P ⟹ ?C2")
    and "T' ∈ set P ⟹ fv_transaction T' ∩ range_vars (ξ ∘s σ ∘s α) = {}" (is "T' ∈ set P ⟹ ?C3")
    and "varslsst 𝒜 ∩ range_vars (ξ ∘s σ ∘s α) = {}" (is ?D1)
    and "bvarslsst 𝒜 ∩ range_vars (ξ ∘s σ ∘s α) = {}" (is ?D2)
    and "fvlsst 𝒜 ∩ range_vars (ξ ∘s σ ∘s α) = {}" (is ?D3)
    and "range_vars ξ = {}" (is ?E1)
    and "range_vars σ = {}" (is ?E2)
    and "range_vars (ξ ∘s σ ∘s α) ⊆ range_vars α" (is ?E3)
proof -
  note 0 = transaction_renaming_subst_vars_disj[OF α]
  define θ where "θ = ξ ∘s σ ∘s α"
  show ?A
  proof (cases "fvset ((ξ ∘s σ ∘s α) ` (⋃(vars_transaction ` set P))) = {}")
    case False
    hence "∀x ∈ (⋃(vars_transaction ` set P)). (ξ ∘s σ ∘s α) x = α x ∨ fv ((ξ ∘s σ ∘s α) x) = {}"
      using transaction_decl_fresh_renaming_substs_range''[OF ξ σ α] by auto
    thus ?thesis using 0(1) unfolding θ_def[symmetric] by force
  qed blast
  thus "?B' ⟹ ?B" by auto

  show ?E1 ?E2
    using transaction_fresh_subst_grounds_domain[OF σ]
          transaction_decl_subst_grounds_domain[OF ξ]
    unfolding transaction_fresh_subst_domain[OF σ, symmetric]
              transaction_decl_subst_domain[OF ξ, symmetric]
    by (fastforce, fastforce)
  thus 1: ?E3
    using range_vars_subst_compose_subset[of ξ σ]
          range_vars_subst_compose_subset[of "ξ ∘s σ" α]
    by blast
  
  show ?C1 ?C2 ?C3 when T: "T' ∈ set P" using T 1 0(3,4,5)[of T'] by blast+

  show ?D1 ?D2 ?D3 using 1 0(6,7,8) by blast+
qed

lemma transaction_decl_fresh_renaming_substs_trms:
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T (trmslsst 𝒜)"
    and α: "transaction_renaming_subst α P (varslsst 𝒜)"
    and "bvarslsst S ∩ subst_domain ξ = {}"
    and "bvarslsst S ∩ subst_domain σ = {}"
    and "bvarslsst S ∩ subst_domain α = {}"
  shows "subtermsset (trmslsst (S ⋅lsst (ξ ∘s σ ∘s α))) = subtermsset (trmslsst S) ⋅set (ξ ∘s σ ∘s α)"
proof -
  have 1: "∀x ∈ fvset (trmslsst S). (∃f. (ξ ∘s σ ∘s α) x = Fun f []) ∨ (∃y. (ξ ∘s σ ∘s α) x = Var y)"
    using transaction_decl_fresh_renaming_substs_range'[OF ξ σ α] by blast

  have 2: "bvarslsst S ∩ subst_domain (ξ ∘s σ ∘s α) = {}"
    using assms(4-6) subst_domain_compose[of ξ σ] subst_domain_compose[of "ξ ∘s σ" α] by blast

  show ?thesis using subterms_subst_lsst[OF 1 2] by simp
qed

lemma transaction_decl_fresh_renaming_substs_wt:
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_decl_subst ξ T" "transaction_fresh_subst σ T M"
          "transaction_renaming_subst α P X"
  shows "wtsubst (ξ ∘s σ ∘s α)"
using transaction_renaming_subst_wt[OF assms(3)]
      transaction_fresh_subst_wt[OF assms(2)]
      transaction_decl_subst_wt[OF assms(1)]
by (metis wt_subst_compose)

lemma transaction_decl_fresh_renaming_substs_range_wf_trms:
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes "transaction_decl_subst ξ T" "transaction_fresh_subst σ T M"
          "transaction_renaming_subst α P X"
  shows "wftrms (subst_range (ξ ∘s σ ∘s α))"
using transaction_renaming_subst_range_wf_trms[OF assms(3)]
      transaction_fresh_subst_range_wf_trms[OF assms(2)]
      transaction_decl_subst_range_wf_trms[OF assms(1)]
      wf_trms_subst_compose[of ξ σ]
      wf_trms_subst_compose[of "ξ ∘s σ" α]
by metis

lemma transaction_decl_fresh_renaming_substs_fv:
  fixes σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T M"
    and α: "transaction_renaming_subst α P X"
    and x: "x ∈ fvlsst (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))"
  shows "∃y ∈ fv_transaction T - set (transaction_fresh T). (ξ ∘s σ ∘s α) y = Var x"
proof -
  have "x ∈ fvsst (unlabel (transaction_strand T) ⋅sst ξ ∘s σ ∘s α)"
    using x fvsst_unlabel_duallsst_eq[of "transaction_strand T ⋅lsst ξ ∘s σ ∘s α"]
          unlabel_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
    by argo
  then obtain y where "y ∈ fv_transaction T" "x ∈ fv ((ξ ∘s σ ∘s α) y)"
    by (metis fvsst_subst_obtain_var)
  thus ?thesis
    using transaction_decl_fresh_renaming_substs_range[OF ξ σ α, of y]
    by (cases "y ∈ set (transaction_fresh T)") force+
qed

lemma transaction_decl_fresh_renaming_substs_range_no_attack_const:
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T M"
    and α: "transaction_renaming_subst α P X"
    and T: "∀x ∈ set (transaction_fresh T). Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    and t: "t ∈ subst_range (ξ ∘s σ ∘s α)"
  shows "∄n. t = attack⟨n⟩"
proof -
  note ξσα_wt = transaction_decl_fresh_renaming_substs_wt[OF ξ σ α]

  obtain x where x: "(ξ ∘s σ ∘s α) x = t" using t by auto

  have x_type: "Γ (Var x) = Γ (Var x ⋅ ξ)" "Γ (Var x) = Γ (Var x ⋅ ξ ∘s σ ∘s α)"
    using ξ wt_subst_trm''[of ξ "Var x"] wt_subst_trm''[OF ξσα_wt, of "Var x"]
    unfolding transaction_decl_subst_def by (blast, blast)

  show ?thesis
  proof (cases t)
    case (Fun f S)
    hence "x ∈ set (transaction_fresh T) ∨ x ∈ fst ` set (transaction_decl T ())"
      using transaction_decl_fresh_renaming_substs_range[OF ξ σ α, of x] x by force
    thus ?thesis
    proof
      assume "x ∈ set (transaction_fresh T)"
      hence "Γ t = TAtom Value ∨ (∃a. Γ t = TAtom (Atom a))"
        using T x_type(2) x by (metis Γ.simps(1) eval_term.simps(1))
      thus ?thesis by auto
    next
      assume "x ∈ fst ` set (transaction_decl T ())"
      then obtain c where c: "ξ x = Fun (Fu c) []" "arityf c = 0"
        using ξ unfolding transaction_decl_subst_def by auto

      have "Γ t = TAtom Bottom ∨ (∃a. Γ t = TAtom (Atom a))"
        using c(1) Γ_consts_simps(1)[OF c(2)] x x_type
              eval_term.simps(1)[of _ x ξ] eval_term.simps(1)[of _ x "ξ ∘s σ ∘s α"]
        by (cases "Γf c") simp_all
      thus ?thesis by auto
    qed
  qed simp
qed

lemma transaction_decl_fresh_renaming_substs_occurs_fact_send_receive:
  fixes t::"('fun,'atom,'sets,'lbl) prot_term"
  assumes ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T M"
    and α: "transaction_renaming_subst α P X"
    and T: "admissible_transaction' T"
    and t: "occurs t ∈ set ts"
  shows "send⟨ts⟩ ∈ set (unlabel (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))
          ⟹ ∃ts' s. send⟨ts'⟩ ∈ set (unlabel (transaction_send T)) ∧
                      occurs s ∈ set ts' ∧ t = s ⋅ ξ ∘s σ ∘s α"
      (is "?A ⟹ ?A'")
    and "receive⟨ts⟩ ∈ set (unlabel (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))
          ⟹ ∃ts' s. receive⟨ts'⟩ ∈ set (unlabel (transaction_receive T)) ∧
                      occurs s ∈ set ts' ∧ t = s ⋅ ξ ∘s σ ∘s α"
      (is "?B ⟹ ?B'")
proof -
  assume ?A
  then obtain s ts' where s:
      "s ∈ set ts'" "send⟨ts'⟩ ∈ set (unlabel (transaction_strand T))" "occurs t = s ⋅ ξ ∘s σ ∘s α"
    using t stateful_strand_step_mem_substD(1)[
            of ts "unlabel (transaction_strand T)" "ξ ∘s σ ∘s α"]
          unlabel_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
    by auto

  note ξ_empty = admissible_transaction_decl_subst_empty[OF T ξ]

  have T_decl_notin: "x ∉ fst ` set (transaction_decl T ())" for x
    using transaction_decl_subst_empty_inv[OF ξ[unfolded ξ_empty]] by simp

  note 0 = s(3) transaction_decl_fresh_renaming_substs_range[OF ξ σ α]

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]
  note T_fresh = admissible_transactionE(14)[OF T]

  have "∃u. s = occurs u"
  proof (cases s)
    case (Var x) 
    hence "(∃c. s ⋅ ξ ∘s σ ∘s α = Fun c []) ∨ (∃y. s ⋅ ξ ∘s σ ∘s α = Var y)"
      using 0(2-5)[of x] ξ_empty by (auto simp del: subst_subst_compose)
    thus ?thesis
      using 0(1) by simp
  next
    case (Fun f T)
    hence 1: "f = OccursFact" "length T = 2" "T ! 0 ⋅ ξ ∘s σ ∘s α = Fun OccursSec []"
             "T ! 1 ⋅ ξ ∘s σ ∘s α = t"
      using 0(1) by auto
    have "T ! 0 = Fun OccursSec []"
    proof (cases "T ! 0")
      case (Var x) thus ?thesis
        using 0(2-5)[of x] 1(3) T_fresh T_decl_notin
        unfolding list_all_iff by (auto simp del: subst_subst_compose)
    qed (use 1(3) in simp)
    thus ?thesis using Fun 1 0(1) by (auto simp del: subst_subst_compose)
  qed
  then obtain u where u: "s = occurs u" by force
  hence "t = u ⋅ ξ ∘s σ ∘s α" using s(3) by fastforce
  thus ?A' using s u wellformed_transaction_strand_unlabel_memberD(8)[OF T_wf] by metis
next
  assume ?B
  then obtain s ts' where s:
      "s ∈ set ts'" "receive⟨ts'⟩ ∈ set (unlabel (transaction_strand T))" "occurs t = s ⋅ ξ ∘s σ ∘s α"
    using t stateful_strand_step_mem_substD(2)[
            of ts "unlabel (transaction_strand T)" "ξ ∘s σ ∘s α"]
          unlabel_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
    by auto

  note ξ_empty = admissible_transaction_decl_subst_empty[OF T ξ]

  have T_decl_notin: "x ∉ fst ` set (transaction_decl T ())" for x
    using transaction_decl_subst_empty_inv[OF ξ[unfolded ξ_empty]] by simp

  note 0 = s(3) transaction_decl_fresh_renaming_substs_range[OF ξ σ α]

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T]
  note T_fresh = admissible_transactionE(14)[OF T]

  have "∃u. s = occurs u"
  proof (cases s)
    case (Var x) 
    hence "(∃c. s ⋅ ξ ∘s σ ∘s α = Fun c []) ∨ (∃y. s ⋅ ξ ∘s σ ∘s α = Var y)"
      using 0(2-5)[of x] ξ_empty by (auto simp del: subst_subst_compose)
    thus ?thesis
      using 0(1) by simp
  next
    case (Fun f T)
    hence 1: "f = OccursFact" "length T = 2" "T ! 0 ⋅ ξ ∘s σ ∘s α = Fun OccursSec []"
              "T ! 1 ⋅ ξ ∘s σ ∘s α = t"
      using 0(1) by auto
    have "T ! 0 = Fun OccursSec []"
    proof (cases "T ! 0")
      case (Var x) thus ?thesis
        using 0(2-5)[of x] 1(3) T_fresh T_decl_notin
        unfolding list_all_iff by (auto simp del: subst_subst_compose)
    qed (use 1(3) in simp)
    thus ?thesis using Fun 1 0(1) by (auto simp del: subst_subst_compose)
  qed
  then obtain u where u: "s = occurs u" by force
  hence "t = u ⋅ ξ ∘s σ ∘s α" using s(3) by fastforce
  thus ?B' using s u wellformed_transaction_strand_unlabel_memberD(1)[OF T_wf] by metis
qed

lemma transaction_decl_subst_proj:
  assumes "transaction_decl_subst ξ T"
  shows "transaction_decl_subst ξ (transaction_proj n T)"
using assms transaction_proj_decl_eq[of n T]
unfolding transaction_decl_subst_def by presburger

lemma transaction_fresh_subst_proj:
  assumes "transaction_fresh_subst σ T (trmslsst A)"
  shows "transaction_fresh_subst σ (transaction_proj n T) (trmslsst (proj n A))"
using assms transaction_proj_fresh_eq[of n T]
      contra_subsetD[OF subtermsset_mono[OF transaction_proj_trms_subset[of n T]]]
      contra_subsetD[OF subtermsset_mono[OF trmssst_proj_subset(1)[of n A]]]
unfolding transaction_fresh_subst_def by metis
  
lemma transaction_renaming_subst_proj:
  assumes "transaction_renaming_subst α P (varslsst A)"
  shows "transaction_renaming_subst α (map (transaction_proj n) P) (varslsst (proj n A))"
proof -
  let ?X = "λP A. ⋃(vars_transaction ` set P) ∪ varslsst A"
  define Y where "Y ≡ ?X (map (transaction_proj n) P) (proj n A)"
  define Z where "Z ≡ ?X P A"

  have "Y ⊆ Z"
    using sst_vars_proj_subset(3)[of n A] transaction_proj_vars_subset[of n]
    unfolding Y_def Z_def by fastforce
  hence "insert 0 (snd ` Y) ⊆ insert 0 (snd ` Z)" by blast
  moreover have "finite (insert 0 (snd ` Z))" "finite (insert 0 (snd ` Y))"
    unfolding Y_def Z_def by auto
  ultimately have 0: "max_var_set Y ≤ max_var_set Z" using Max_mono by blast

  have "∃n≥max_var_set Z. α = var_rename n"
    using assms unfolding transaction_renaming_subst_def Z_def by blast
  hence "∃n≥max_var_set Y. α = var_rename n" using 0 le_trans by fast
  thus ?thesis unfolding transaction_renaming_subst_def Y_def by blast
qed

lemma transaction_decl_fresh_renaming_substs_wf_sst:
  fixes ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  assumes T: "wf'sst (fst ` set (transaction_decl T ()) ∪ set (transaction_fresh T))
                    (unlabel (duallsst (transaction_strand T)))"
    and ξ: "transaction_decl_subst ξ T"
    and σ: "transaction_fresh_subst σ T (trmslsst 𝒜)"
    and α: "transaction_renaming_subst α P (varslsst 𝒜)"
  shows "wf'sst {} (unlabel (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)))"
proof -
  have 0: "range_vars ξ ∩ bvarslsst (duallsst (transaction_strand T)) = {}"
          "range_vars σ ∩ bvarslsst (duallsst (transaction_strand T) ⋅lsst ξ) = {}"
          "ground (ξ ` (fst ` set (transaction_decl T ())))"
          "ground (σ ` set (transaction_fresh T))"
          "ground (α ` {})"
    using transaction_decl_subst_domain[OF ξ]
          transaction_decl_subst_grounds_domain[OF ξ]
          transaction_decl_subst_range_vars_empty[OF ξ]
          transaction_fresh_subst_range_vars_empty[OF σ]
          transaction_fresh_subst_domain[OF σ]
          transaction_fresh_subst_grounds_domain[OF σ]
    by (simp, simp, simp, simp, simp)

  have 1: "fvset (ξ ` set (transaction_fresh T)) ⊆ set (transaction_fresh T)" (is "?A ⊆ ?B")
  proof
    fix x assume x: "x ∈ ?A"
    then obtain y where y: "y ∈ set (transaction_fresh T)" "x ∈ fv (ξ y)" by auto
    hence "y ∉ subst_domain ξ"
      using transaction_decl_subst_domain[OF ξ]
            transaction_decl_subst_grounds_domain[OF ξ]
      by fast
    thus "x ∈ ?B" using x y by auto
  qed

  let ?X = "fst ` set (transaction_decl T ()) ∪ set (transaction_fresh T)"

  have "fvset (α ` fvset (σ ` fvset (ξ ` ?X))) = {}" using 0(3-5) 1 by auto
  hence "wf'sst {} (((unlabel (duallsst (transaction_strand T)) ⋅sst ξ) ⋅sst σ) ⋅sst α)"
    by (metis wfsst_subst_apply[OF wfsst_subst_apply[OF wfsst_subst_apply[OF T]]])
  thus ?thesis
    using duallsst_subst unlabel_subst
          labeled_stateful_strand_subst_comp[OF 0(1), of "σ ∘s α"]
          labeled_stateful_strand_subst_comp[OF 0(2), of α]
          subst_compose_assoc[of ξ σ α]
    by metis
qed

lemma admissible_transaction_decl_fresh_renaming_subst_not_occurs:
  fixes ξ σ α
  defines "θ ≡ ξ ∘s σ ∘s α"
  assumes T_adm: "admissible_transaction' T"
    and ξσα:
      "transaction_decl_subst ξ T"
      "transaction_fresh_subst σ T (trmslsst 𝒜)"
      "transaction_renaming_subst α P (varslsst 𝒜)"
  shows "∄t. θ x = occurs t"
    and "θ x ≠ Fun OccursSec []"
proof -
  note ξ_empty = admissible_transaction_decl_subst_empty[OF T_adm ξσα(1)]
  note T_fresh_val = admissible_transactionE(2)[OF T_adm]

  show "∄t. θ x = occurs t" for x
    using transaction_decl_fresh_renaming_substs_range'(1)[OF ξσα]
    unfolding θ_def[symmetric] by (cases "x ∈ subst_domain θ") (force,force)

  show "θ x ≠ Fun OccursSec []" for x
    using transaction_decl_fresh_renaming_substs_range'(3)[
            OF ξσα _ ξ_empty T_fresh_val, of "θ x"]
    unfolding θ_def[symmetric] by (cases "x ∈ subst_domain θ") auto
qed


subsection ‹Lemmata: Reachable Constraints›
lemma reachable_constraints_as_transaction_lists:
  fixes f
  defines "f ≡ λ(T,ξ,σ,α). duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"
    and "g ≡ concat ∘ map f"
  assumes A: "A ∈ reachable_constraints P"
  obtains Ts where "A = g Ts"
    and "∀B. prefix B Ts ⟶ g B ∈ reachable_constraints P"
    and "∀B T ξ σ α. prefix (B@[(T,ξ,σ,α)]) Ts ⟶
                      T ∈ set P ∧ transaction_decl_subst ξ T ∧
                      transaction_fresh_subst σ T (trmslsst (g B)) ∧
                      transaction_renaming_subst α P (varslsst (g B))"
proof -
  let ?P1 = "λA Ts. A = g Ts"
  let ?P2 = "λTs. ∀B. prefix B Ts ⟶ g B ∈ reachable_constraints P"
  let ?P3 = "λTs. ∀B T ξ σ α. prefix (B@[(T,ξ,σ,α)]) Ts ⟶
                      T ∈ set P ∧ transaction_decl_subst ξ T ∧
                      transaction_fresh_subst σ T (trmslsst (g B)) ∧
                      transaction_renaming_subst α P (varslsst (g B))"

  have "∃Ts. ?P1 A Ts ∧ ?P2 Ts ∧ ?P3 Ts" using A
  proof (induction A rule: reachable_constraints.induct)
    case init
    have "?P1 [] []" "?P2 []" "?P3 []" unfolding g_def f_def by simp_all
    thus ?case by blast
  next
    case (step A T ξ σ α)
    let ?A' = "A@duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"
    obtain Ts where Ts: "?P1 A Ts" "?P2 Ts" "?P3 Ts" using step.IH by blast

    have 1: "?P1 ?A' (Ts@[(T,ξ,σ,α)])"
      using Ts(1) unfolding g_def f_def by simp
    
    have 2: "?P2 (Ts@[(T,ξ,σ,α)])"
    proof (intro allI impI)
      fix B assume "prefix B (Ts@[(T,ξ,σ,α)])"
      hence "prefix B Ts ∨ B = Ts@[(T,ξ,σ,α)]" by fastforce
      thus "g B ∈ reachable_constraints P "
        using Ts(1,2) reachable_constraints.step[OF step.hyps]
        unfolding g_def f_def by auto
    qed

    have 3: "?P3 (Ts@[(T,ξ,σ,α)])"
      using Ts(1,3) step.hyps(2-5) unfolding g_def f_def by auto 

    show ?case using 1 2 3 by blast
  qed
  thus thesis using that by blast
qed

lemma reachable_constraints_transaction_action_obtain:
  assumes A: "A ∈ reachable_constraints P"
    and a: "a ∈ set A"
  obtains T b B α σ ξ
  where "prefix (B@duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)) A"
    and "T ∈ set P" "transaction_decl_subst ξ T" "transaction_fresh_subst σ T (trmslsst B)"
        "transaction_renaming_subst α P (varslsst B)"
    and "b ∈ set (transaction_strand T)" "a = duallsstp b ⋅lsstp ξ ∘s σ ∘s α" "fst a = fst b"
proof -
  define f where "f ≡ λ(T,ξ,σ::('fun,'atom,'sets,'lbl) prot_subst,α).
                          duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"
  define g where "g ≡ concat ∘ map f"

  obtain Ts where Ts:
      "A = g Ts" "∀B. prefix B Ts ⟶ g B ∈ reachable_constraints P"
      "∀B T ξ σ α. prefix (B@[(T,ξ,σ,α)]) Ts ⟶
            T ∈ set P ∧ transaction_decl_subst ξ T ∧
            transaction_fresh_subst σ T (trmslsst (g B)) ∧
            transaction_renaming_subst α P (varslsst (g B))"
    using reachable_constraints_as_transaction_lists[OF A] unfolding g_def f_def by blast

  obtain T α ξ σ where T: "(T,ξ,σ,α) ∈ set Ts" "a ∈ set (f (T,ξ,σ,α))"
    using Ts(1) a unfolding g_def by auto
  
  obtain B where B: "prefix (B@[(T,ξ,σ,α)]) Ts"
    using T(1) by (meson prefix_snoc_in_iff) 

  obtain b where b:
      "b ∈ set (transaction_strand T)" "a = duallsstp b ⋅lsstp ξ ∘s σ ∘s α" "fst a = fst b"
    using T(2) duallsst_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
          duallsst_memberD'[of a "transaction_strand T" "ξ ∘s σ ∘s α" thesis]
    unfolding f_def by simp

  have 0: "prefix (g B@f (T, ξ, σ, α)) A"
    using concat_map_mono_prefix[OF B, of f] unfolding g_def Ts(1) by simp

  have 1: "T ∈ set P" "transaction_decl_subst ξ T" "transaction_fresh_subst σ T (trmslsst (g B))"
          "transaction_renaming_subst α P (varslsst (g B))"
    using B Ts(3) by (blast,blast,blast,blast)

  show thesis using 0[unfolded f_def] that[OF _ 1 b] by fast
qed

lemma reachable_constraints_unlabel_eq:
  defines "transaction_unlabel_eq ≡ λT1 T2.
             transaction_decl T1     =          transaction_decl T2 ∧
             transaction_fresh T1    =          transaction_fresh T2 ∧
    unlabel (transaction_receive T1) = unlabel (transaction_receive T2) ∧
    unlabel (transaction_checks T1)  = unlabel (transaction_checks T2) ∧
    unlabel (transaction_updates T1) = unlabel (transaction_updates T2) ∧
    unlabel (transaction_send T1)    = unlabel (transaction_send T2)"
  assumes Peq: "list_all2 transaction_unlabel_eq P1 P2"
  shows "unlabel ` reachable_constraints P1 = unlabel ` reachable_constraints P2" (is "?A = ?B")
proof (intro antisym subsetI)
  have "transaction_unlabel_eq T2 T1 = transaction_unlabel_eq T1 T2" for T1 T2
    unfolding transaction_unlabel_eq_def by argo
  hence Peq': "list_all2 transaction_unlabel_eq P2 P1"
    using Peq list_all2_sym by metis

  have 0: "unlabel (transaction_strand T1) = unlabel (transaction_strand T2)"
    when "transaction_unlabel_eq T1 T2" for T1 T2
    using that unfolding transaction_unlabel_eq_def transaction_strand_def by force

  have "vars_transaction T1 = vars_transaction T2" when "transaction_unlabel_eq T1 T2" for T1 T2
    using 0[OF that] by simp
  hence "vars_transaction (P1 ! i) = vars_transaction (P2 ! i)" when "i < length P1" for i
    using that Peq list_all2_conv_all_nth by blast
  moreover have "length P1 = length P2" using Peq unfolding list_all2_iff by argo
  ultimately have 1: "⋃(vars_transaction ` set P1) = ⋃(vars_transaction ` set P2)"
    using in_set_conv_nth[of _ P1] in_set_conv_nth[of _ P2] by fastforce

  have 2:
      "transaction_decl_subst ξ T1 ⟹ transaction_decl_subst ξ T2" (is "?A1 ⟹ ?A2")
      "transaction_fresh_subst σ T1 (trmslsst 𝒜) ⟹ transaction_fresh_subst σ T2 (trmslsst ℬ)"
        (is "?B1 ⟹ ?B2")
      "transaction_renaming_subst α P1 (varslsst 𝒜) ⟹ transaction_renaming_subst α P2 (varslsst ℬ)"
        (is "?C1 ⟹ ?C2")
      "transaction_renaming_subst α P2 (varslsst 𝒜) ⟹ transaction_renaming_subst α P1 (varslsst ℬ)"
        (is "?D1 ⟹ ?D2")
    when "transaction_unlabel_eq T1 T2" "unlabel 𝒜 = unlabel ℬ"
    for T1 T2::"('fun,'atom,'sets,'lbl) prot_transaction"
      and 𝒜 ℬ::"('fun,'atom,'sets,'lbl) prot_strand"
      and ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
  proof -
    have *: "transaction_decl T1 = transaction_decl T2"
            "transaction_fresh T1 = transaction_fresh T2"
            "trms_transaction T1 = trms_transaction T2"
      using that unfolding transaction_unlabel_eq_def transaction_strand_def by force+

    show "?A1 ⟹ ?A2" using *(1) unfolding transaction_decl_subst_def by argo
    show "?B1 ⟹ ?B2" using that(2) *(2,3) unfolding transaction_fresh_subst_def by force
    show "?C1 ⟹ ?C2" using that(2) 1 unfolding transaction_renaming_subst_def by metis
    show "?D1 ⟹ ?D2" using that(2) 1 unfolding transaction_renaming_subst_def by metis
  qed

  have 3: "unlabel (duallsst (transaction_strand T1 ⋅lsst θ)) =
           unlabel (duallsst (transaction_strand T2 ⋅lsst θ))"
    when "transaction_unlabel_eq T1 T2" for T1 T2 θ
    using 0[OF that] unlabel_subst[of _ θ] duallsst_unlabel_cong by metis

  have "∃ℬ ∈ reachable_constraints P2. unlabel 𝒜 = unlabel ℬ"
    when "𝒜 ∈ reachable_constraints P1" for 𝒜 using that
  proof (induction 𝒜 rule: reachable_constraints.induct)
    case (step 𝒜 T ξ σ α)
    obtain ℬ where IH: "ℬ ∈ reachable_constraints P2" "unlabel 𝒜 = unlabel ℬ"
      by (meson step.IH)
    
    obtain T' where T': "T' ∈ set P2" "transaction_unlabel_eq T T'"
      using list_all2_in_set_ex[OF Peq step.hyps(2)] by auto

    show ?case
      using 3[OF T'(2), of "ξ ∘s σ ∘s α"] IH(2) reachable_constraints.step[OF IH(1) T'(1)]
            2[OF T'(2) IH(2)] step.hyps(3-5)
      by (metis unlabel_append[of 𝒜] unlabel_append[of ℬ])
  qed (simp add: unlabel_def)
  thus "𝒜 ∈ ?A ⟹ 𝒜 ∈ ?B" for 𝒜 by fast

  have "∃ℬ ∈ reachable_constraints P1. unlabel 𝒜 = unlabel ℬ"
    when "𝒜 ∈ reachable_constraints P2" for 𝒜 using that
  proof (induction 𝒜 rule: reachable_constraints.induct)
    case (step 𝒜 T ξ σ α)
    obtain ℬ where IH: "ℬ ∈ reachable_constraints P1" "unlabel 𝒜 = unlabel ℬ"
      by (meson step.IH)
    
    obtain T' where T': "T' ∈ set P1" "transaction_unlabel_eq T T'"
      using list_all2_in_set_ex[OF Peq' step.hyps(2)] by auto

    show ?case
      using 3[OF T'(2), of "ξ ∘s σ ∘s α"] IH(2) reachable_constraints.step[OF IH(1) T'(1)]
            2[OF T'(2) IH(2)] step.hyps(3-5)
      by (metis unlabel_append[of 𝒜] unlabel_append[of ℬ])
  qed (simp add: unlabel_def)
  thus "𝒜 ∈ ?B ⟹ 𝒜 ∈ ?A" for 𝒜 by fast
qed

lemma reachable_constraints_set_eq:
  assumes "set P1 = set P2"
  shows "reachable_constraints P1 = reachable_constraints P2" (is "?A = ?B")
proof (intro antisym subsetI)
  note 0 = assms transaction_renaming_subst_set_eq[OF assms]
  note 1 = reachable_constraints.intros

  show "𝒜 ∈ ?A ⟹ 𝒜 ∈ ?B" for 𝒜
    by (induct 𝒜 rule: reachable_constraints.induct) (auto simp add: 0 intro: 1)

  show "𝒜 ∈ ?B ⟹ 𝒜 ∈ ?A" for 𝒜
    by (induct 𝒜 rule: reachable_constraints.induct) (auto simp add: 0 intro: 1)
qed

lemma reachable_constraints_set_subst:
  assumes "set P1 = set P2"
    and "Q (reachable_constraints P1)"
  shows "Q (reachable_constraints P2)"
by (rule subst[of _ _ Q, OF reachable_constraints_set_eq[OF assms(1)] assms(2)])

lemma reachable_constraints_wftrms:
  assumes "∀T ∈ set P. wftrms (trms_transaction T)"
    and "𝒜 ∈ reachable_constraints P"
  shows "wftrms (trmslsst 𝒜)"
using assms(2)
proof (induction 𝒜 rule: reachable_constraints.induct)
  case (step 𝒜 T ξ σ α)
  have "wftrms (trms_transaction T)"
    using assms(1) step.hyps(2) by blast
  hence "wftrms (trms_transaction T ⋅set ξ ∘s σ ∘s α)"
    using transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)]
    by (metis wf_trms_subst)
  hence "wftrms (trmslsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))"
    using wftrms_trmssst_subst unlabel_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"] by metis
  hence "wftrms (trmslsst (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)))"
    using trmssst_unlabel_duallsst_eq by blast
  thus ?case using step.IH unlabel_append[of 𝒜] trmssst_append[of "unlabel 𝒜"] by auto
qed simp

lemma reachable_constraints_var_types_in_transactions:
  fixes 𝒜::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. ∀x ∈ set (transaction_fresh T).
              Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
  shows "Γv ` fvlsst 𝒜 ⊆ (⋃T ∈ set P. Γv ` fv_transaction T)" (is "?A 𝒜")
    and "Γv ` bvarslsst 𝒜 ⊆ (⋃T ∈ set P. Γv ` bvars_transaction T)" (is "?B 𝒜")
    and "Γv ` varslsst 𝒜 ⊆ (⋃T ∈ set P. Γv ` vars_transaction T)" (is "?C 𝒜")
using 𝒜
proof (induction 𝒜 rule: reachable_constraints.induct)
  case (step 𝒜 T ξ σ α)
  define T' where "T' ≡ duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"

  note 2 = transaction_decl_fresh_renaming_substs_wt[OF step.hyps(3-5)]

  have 3: "∀t ∈ subst_range (ξ ∘s σ ∘s α). fv t = {} ∨ (∃x. t = Var x)"
    using transaction_decl_fresh_renaming_substs_range'(1)[OF step.hyps(3-5)]
    by fastforce

  have "fvlsst T' = fvlsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"
       "bvarslsst T' = bvarslsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"
       "varslsst T' = varslsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"
    unfolding T'_def
    by (metis fvsst_unlabel_duallsst_eq,
        metis bvarssst_unlabel_duallsst_eq,
        metis varssst_unlabel_duallsst_eq)
  hence "Γ ` Var ` fvlsst T' ⊆ Γ ` Var ` fv_transaction T"
        "Γ ` Var ` bvarslsst T' = Γ ` Var ` bvars_transaction T"
        "Γ ` Var ` varslsst T' ⊆ Γ ` Var ` vars_transaction T"
    using wt_subst_lsst_vars_type_subset[OF 2 3, of "transaction_strand T"]
    by argo+
  hence "Γv ` fvlsst T' ⊆ Γv ` fv_transaction T"
        "Γv ` bvarslsst T' = Γv ` bvars_transaction T"
        "Γv ` varslsst T' ⊆ Γv ` vars_transaction T"
    by (metis Γv_Var_image)+
  hence 4: "Γv ` fvlsst T' ⊆ (⋃T ∈ set P. Γv ` fv_transaction T)"
           "Γv ` bvarslsst T' ⊆ (⋃T ∈ set P. Γv ` bvars_transaction T)"
           "Γv ` varslsst T' ⊆ (⋃T ∈ set P. Γv ` vars_transaction T)"
    using step.hyps(2) by fast+

  have 5: "Γv ` fvlsst (𝒜 @ T') = (Γv ` fvlsst 𝒜) ∪ (Γv ` fvlsst T')"
          "Γv ` bvarslsst (𝒜 @ T') = (Γv ` bvarslsst 𝒜) ∪ (Γv ` bvarslsst T')"
          "Γv ` varslsst (𝒜 @ T') = (Γv ` varslsst 𝒜) ∪ (Γv ` varslsst T')"
    using unlabel_append[of 𝒜 T']
          fvsst_append[of "unlabel 𝒜" "unlabel T'"]
          bvarssst_append[of "unlabel 𝒜" "unlabel T'"]
          varssst_append[of "unlabel 𝒜" "unlabel T'"]
    by auto

  { case 1 thus ?case
      using step.IH(1) 4(1) 5(1)
      unfolding T'_def by (simp del: subst_subst_compose fvsst_def)
  }

  { case 2 thus ?case
      using step.IH(2) 4(2) 5(2)
      unfolding T'_def by (simp del: subst_subst_compose bvarssst_def)
  }

  { case 3 thus ?case
      using step.IH(3) 4(3) 5(3)
      unfolding T'_def by (simp del: subst_subst_compose)
  }
qed simp_all

lemma reachable_constraints_no_bvars:
  assumes 𝒜: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. bvarslsst (transaction_strand T) = {}"
  shows "bvarslsst 𝒜 = {}"
using assms proof (induction)
  case init
  then show ?case 
    unfolding unlabel_def by auto
next
  case (step 𝒜 T ξ σ α)
  then have "bvarslsst 𝒜 = {}"
    by metis
  moreover
  have "bvarslsst (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)) = {}"
    using step by (metis bvarslsst_subst bvarssst_unlabel_duallsst_eq)
  ultimately 
  show ?case
    using bvarssst_append unlabel_append by (metis sup_bot.left_neutral)
qed

lemma reachable_constraints_fv_bvars_disj:
  fixes 𝒜::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "𝒜 ∈ reachable_constraints P"
    and P: "∀S ∈ set P. admissible_transaction' S"
  shows "fvlsst 𝒜 ∩ bvarslsst 𝒜 = {}"
proof -
  let ?X = "⋃T ∈ set P. bvars_transaction T"

  note 0 = admissible_transactions_fv_bvars_disj[OF P]

  have 1: "bvarslsst 𝒜 ⊆ ?X" using 𝒜_reach
  proof (induction 𝒜 rule: reachable_constraints.induct)
    case (step 𝒜 T ξ σ α)
    have "bvarslsst (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)) = bvars_transaction T"
      using bvarssst_subst[of "unlabel (transaction_strand T)" "ξ ∘s σ ∘s α"]
            bvarssst_unlabel_duallsst_eq[of "transaction_strand T ⋅lsst ξ ∘s σ ∘s α"]
            duallsst_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
            unlabel_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
      by argo
    hence "bvarslsst (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)) ⊆ ?X"
      using step.hyps(2)
      by blast
    thus ?case
      using step.IH bvarssst_append
      by auto
  qed (simp add: unlabel_def)

  have 2: "fvlsst 𝒜 ∩ ?X = {}" using 𝒜_reach
  proof (induction 𝒜 rule: reachable_constraints.induct)
    case (step 𝒜 T ξ σ α)
    have "x ≠ y" when x: "x ∈ ?X" and y: "y ∈ fvlsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)" for x y
    proof -
      obtain y' where y': "y' ∈ fv_transaction T" "y ∈ fv ((ξ ∘s σ ∘s α) y')"
        using y unlabel_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
        by (metis fvsst_subst_obtain_var)

      have "y ∉ ⋃(vars_transaction ` set P)"
        using transaction_decl_fresh_renaming_substs_range''[OF step.hyps(3-5) y'(2)]
              transaction_renaming_subst_range_notin_vars[OF step.hyps(5), of y']
        by auto
      thus ?thesis using x varssst_is_fvsst_bvarssst by fast
    qed
    hence "fvlsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α) ∩ ?X = {}"
      by blast
    thus ?case
      using step.IH
            fvsst_unlabel_duallsst_eq[of "transaction_strand T ⋅lsst ξ ∘s σ ∘s α"]
            duallsst_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
            unlabel_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
            fvsst_append[of "unlabel 𝒜" "unlabel (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"]
            unlabel_append[of 𝒜 "transaction_strand T"]
      by force
  qed (simp add: unlabel_def)

  show ?thesis using 0 1 2 by blast
qed

lemma reachable_constraints_vars_TAtom_typed:
  fixes 𝒜::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and x: "x ∈ varslsst 𝒜"
  shows "Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
proof -
  have 𝒜_wftrms: "wftrms (trmslsst 𝒜)"
    by (metis reachable_constraints_wftrms admissible_transactions_wftrms P 𝒜_reach)

  have T_adm: "admissible_transaction' T" when "T ∈ set P" for T
    by (meson that Ball_set P)

  have "∀T∈set P. ∀x∈set (transaction_fresh T). Γv x = TAtom Value"
    using protocol_transaction_vars_TAtom_typed(3) P by blast
  hence *: "Γv ` varslsst 𝒜 ⊆ (⋃T∈set P. Γv ` vars_transaction T)"
    using reachable_constraints_var_types_in_transactions[of 𝒜 P, OF 𝒜_reach] by auto

  have "Γv ` varslsst 𝒜 ⊆ TAtom ` insert Value (range Atom)"
  proof -
    have "Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
      when "T ∈ set P" "x ∈ vars_transaction T" for T x
      using that protocol_transaction_vars_TAtom_typed(1)[of T] P
            admissible_transactionE(5)
      by blast
    hence "(⋃T∈set P. Γv ` vars_transaction T) ⊆ TAtom ` insert Value (range Atom)"
      using P by blast
    thus "Γv ` varslsst 𝒜 ⊆ TAtom ` insert Value (range Atom)"
      using * by auto
  qed
  thus ?thesis using x by auto
qed

lemma reachable_constraints_vars_not_attack_typed:
  fixes 𝒜::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. ∀x ∈ set (transaction_fresh T).
              Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
           "∀T ∈ set P. ∀x ∈ vars_transaction T. ¬TAtom AttackType ⊑ Γv x"
    and x: "x ∈ varslsst 𝒜"
  shows "¬TAtom AttackType ⊑ Γv x"
using reachable_constraints_var_types_in_transactions(3)[OF 𝒜_reach P(1)] P(2) x by fastforce

lemma reachable_constraints_Value_vars_are_fv:
  assumes 𝒜_reach: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and x: "x ∈ varslsst 𝒜"
    and "Γv x = TAtom Value"
  shows "x ∈ fvlsst 𝒜"
proof -
  have "∀T∈set P. bvars_transaction T = {}"
    using P admissible_transactionE(4) by metis
  hence 𝒜_no_bvars: "bvarslsst 𝒜 = {}"
    using reachable_constraints_no_bvars[OF 𝒜_reach] by metis
  thus ?thesis using x varssst_is_fvsst_bvarssst[of "unlabel 𝒜"] by blast
qed

lemma reachable_constraints_subterms_subst:
  assumes 𝒜_reach: "𝒜 ∈ reachable_constraints P"
    and ℐ: "welltyped_constraint_model ℐ 𝒜"
    and P: "∀T ∈ set P. admissible_transaction' T"
  shows "subtermsset (trmslsst (𝒜 ⋅lsst ℐ)) = (subtermsset (trmslsst 𝒜)) ⋅set ℐ"
proof -
  have 𝒜_wftrms: "wftrms (trmslsst 𝒜)"
    by (metis reachable_constraints_wftrms admissible_transactions_wftrms P 𝒜_reach)

  from ℐ have ℐ': "welltyped_constraint_model ℐ 𝒜"
    using welltyped_constraint_model_prefix by auto

  have 1: "∀x ∈ fvset (trmslsst 𝒜). (∃f. ℐ x = Fun f []) ∨ (∃y. ℐ x = Var y)"
  proof
    fix x
    assume xa: "x ∈ fvset (trmslsst 𝒜)"
    have "∃f T. ℐ x = Fun f T"
      using ℐ interpretation_grounds[of ℐ "Var x"]
      unfolding welltyped_constraint_model_def constraint_model_def
      by (cases "ℐ x") auto
    then obtain f T where fT_p: "ℐ x = Fun f T"
      by auto
    hence "wftrm (Fun f T)"
      using ℐ
      unfolding welltyped_constraint_model_def constraint_model_def
      using wf_trm_subst_rangeD
      by metis
    moreover
    have "x ∈ varslsst 𝒜"
      using xa var_subterm_trmssst_is_varssst[of x "unlabel 𝒜"] vars_iff_subtermeq[of x]
      by auto
    hence "∃a. Γv x = TAtom a"
      using reachable_constraints_vars_TAtom_typed[OF 𝒜_reach P] by blast
    hence "∃a. Γ (Var x) = TAtom a"
      by simp
    hence "∃a. Γ (Fun f T) = TAtom a"
      by (metis (no_types, opaque_lifting) ℐ' welltyped_constraint_model_def fT_p wtsubst_def)
    ultimately show "(∃f. ℐ x = Fun f []) ∨ (∃y. ℐ x = Var y)"
      using TAtom_term_cases fT_p by metis
  qed

  have "∀T∈set P. bvars_transaction T = {}"
    using assms admissible_transactionE(4) by metis
  then have "bvarslsst 𝒜 = {}"
    using reachable_constraints_no_bvars assms by metis
  then have 2: "bvarslsst 𝒜 ∩ subst_domain ℐ = {}"
    by auto

  show ?thesis
    using subterms_subst_lsst[OF _ 2] 1
    by simp
qed

lemma reachable_constraints_val_funs_private':
  fixes 𝒜::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. admissible_transaction_terms T"
           "∀T ∈ set P. transaction_decl T () = []"
           "∀T ∈ set P. ∀x ∈ set (transaction_fresh T). Γv x = TAtom Value"
    and f: "f ∈ ⋃(funs_term ` trmslsst 𝒜)"
  shows "¬is_PubConstValue f"
    and "¬is_Abs f"
proof -
  have "¬is_PubConstValue f ∧ ¬is_Abs f" using 𝒜_reach f
  proof (induction 𝒜 rule: reachable_constraints.induct)
    case (step 𝒜 T ξ σ α)
    let ?T' = "unlabel (transaction_strand T) ⋅sst ξ ∘s σ ∘s α"
    let ?T'' = "transaction_strand T ⋅lsst ξ ∘s σ ∘s α"

    note ξ_empty =
      admissible_transaction_decl_subst_empty'[OF bspec[OF P(2) step.hyps(2)] step.hyps(3)]

    have T: "admissible_transaction_terms T"
      using P(1) step.hyps(2) by metis

    have T_fresh: "∀x ∈ set (transaction_fresh T). fst x = TAtom Value" when "T ∈ set P" for T
      using P that admissible_transactionE(14) unfolding list_all_iff Γv_TAtom'' by fast

    show ?thesis using step
    proof (cases "f ∈ ⋃(funs_term ` trmslsst 𝒜)")
      case False
      then obtain t where t: "t ∈ trmssst ?T'" "f ∈ funs_term t"
        using step.prems trmssst_unlabel_duallsst_eq[of ?T'']
              trmssst_append[of "unlabel 𝒜" "unlabel (duallsst ?T'')"]
              unlabel_append[of 𝒜 "duallsst ?T''"] unlabel_subst[of "transaction_strand T"]
        by fastforce
      show ?thesis using trmssst_funs_term_cases[OF t]
      proof
        assume "∃u ∈ trms_transaction T. f ∈ funs_term u"
        thus ?thesis
          using conjunct1[OF conjunct2[OF T[unfolded admissible_transaction_terms_def]]]
          unfolding is_PubConstValue_def by blast
      next
        assume "∃x ∈ fv_transaction T. f ∈ funs_term ((ξ ∘s σ ∘s α) x)"
        then obtain x where "x ∈ fv_transaction T" "f ∈ funs_term ((ξ ∘s σ ∘s α) x)" by force
        thus ?thesis
          using transaction_decl_fresh_renaming_substs_range'(3)[
                  OF step.hyps(3-5) _ ξ_empty T_fresh[OF step.hyps(2), unfolded Γv_TAtom''(2)]]
          unfolding is_PubConstValue_def
          by (metis (no_types, lifting) funs_term_Fun_subterm prot_fun.disc(30,48) subst_imgI
                subtermeq_Var_const(2) term.distinct(1) term.inject(2) term.set_cases(1))
      qed
    qed simp
  qed simp
  thus "¬is_PubConstValue f" "¬is_Abs f" by simp_all
qed

lemma reachable_constraints_val_funs_private:
  fixes 𝒜::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and f: "f ∈ ⋃(funs_term ` trmslsst 𝒜)"
  shows "¬is_PubConstValue f"
    and "¬is_Abs f"
using P reachable_constraints_val_funs_private'[OF 𝒜_reach _ _ _ f]
      admissible_transaction_is_wellformed_transaction(4)
      admissible_transactionE(1,14)
unfolding list_all_iff Γv_TAtom''
by (blast,fast)

lemma reachable_constraints_occurs_fact_ik_case:
  fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "A ∈ reachable_constraints P"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and P_occ: "∀T ∈ set P. admissible_transaction_occurs_checks T"
    and occ: "occurs t ∈ iklsst A"
  shows "∃n. t = Fun (Val n) []"
using 𝒜_reach occ
proof (induction A rule: reachable_constraints.induct)
  case (step A T ξ σ α)
  define θ where "θ ≡ ξ ∘s σ ∘s α"

  have T_adm: "admissible_transaction' T" using P step.hyps(2) by blast
  hence T: "wellformed_transaction T" "admissible_transaction_occurs_checks T"
    using admissible_transaction_is_wellformed_transaction(1) P_occ step.hyps(2) by (blast,blast)

  have T_fresh: "∀x ∈ set (transaction_fresh T). fst x = TAtom Value"
    using admissible_transactionE(14)[OF T_adm] unfolding list_all_iff by fast

  note ξ_empty = admissible_transaction_decl_subst_empty[OF T_adm step.hyps(3)]

  have ξ_dom_empty: "z ∉ fst ` set (transaction_decl T ())" for z
    using transaction_decl_subst_empty_inv[OF step.hyps(3)[unfolded ξ_empty]] by simp

  show ?case
  proof (cases "occurs t ∈ iklsst A")
    case False
    hence "occurs t ∈ iklsst (duallsst (transaction_strand T ⋅lsst θ))"
      using step.prems unfolding θ_def by simp
    hence "∃ts. occurs t ∈ set ts ∧
                receive⟨ts⟩ ∈ set (unlabel (duallsst (transaction_strand T ⋅lsst θ)))"
      unfolding iksst_def by force
    hence "∃ts. occurs t ∈ set ts ∧
                send⟨ts⟩ ∈ set (unlabel (transaction_strand T ⋅lsst θ))"
      using duallsst_unlabel_steps_iff(1) by blast
    then obtain ts s where s:
        "s ∈ set ts" "send⟨ts⟩ ∈ set (unlabel (transaction_strand T))" "s ⋅ θ = occurs t"
      using stateful_strand_step_mem_substD(1)[of _ "unlabel (transaction_strand T)" θ]
            unlabel_subst[of "transaction_strand T" θ]
      by force

    note 0 = transaction_decl_fresh_renaming_substs_range[OF step.hyps(3-5)]

    have 1: "send⟨ts⟩ ∈ set (unlabel (transaction_send T))"
      using s(2) wellformed_transaction_strand_unlabel_memberD(8)[OF T(1)] by blast

    have 2: "is_Send (send⟨ts⟩)"
      unfolding is_Send_def by simp

    have 3: "∃u. s = occurs u"
    proof -
      { fix z
        have "(∃n. θ z = Fun (Val n) []) ∨ (∃y. θ z = Var y)"
          using 0(3,4) T_fresh ξ_dom_empty unfolding θ_def by blast
        hence "∄u. θ z = occurs u" "θ z ≠ Fun OccursSec []" by auto
      } note * = this

      obtain u u' where T: "s = Fun OccursFact [u,u']"
        using *(1) s(3) by (cases s) auto
      thus ?thesis using *(2) s(3) by (cases u) auto
    qed

    obtain x where x: "x ∈ set (transaction_fresh T)" "s = occurs (Var x)"
      using 3 s(1) admissible_transaction_occurs_checksE4[OF T(2) 1] by metis
    
    have "t = θ x"
      using s(3) x(2) by auto
    thus ?thesis
      using 0(3)[OF ξ_dom_empty x(1)] x(1) T_fresh unfolding θ_def by fast
  qed (simp add: step.IH)
qed simp

lemma reachable_constraints_occurs_fact_send_ex:
  fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "A ∈ reachable_constraints P"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and P_occ: "∀T ∈ set P. admissible_transaction_occurs_checks T"
    and x: "Γv x = TAtom Value" "x ∈ fvlsst A"
  shows "∃ts. occurs (Var x) ∈ set ts ∧ send⟨ts⟩ ∈ set (unlabel A)"
using 𝒜_reach x(2)
proof (induction A rule: reachable_constraints.induct)
  case (step A T ξ σ α)
  note ξ_empty = admissible_transaction_decl_subst_empty[OF bspec[OF P step.hyps(2)] step.hyps(3)]
  note T = bspec[OF P_occ step.hyps(2)]
  
  show ?case
  proof (cases "x ∈ fvlsst A")
    case True
    show ?thesis
      using step.IH[OF True] unlabel_append[of A]
      by auto
  next
    case False
    then obtain y where y:
        "y ∈ fv_transaction T - set (transaction_fresh T)" "(ξ ∘s σ ∘s α) y = Var x"
      using transaction_decl_fresh_renaming_substs_fv[OF step.hyps(3-5), of x]
            step.prems(1) fvsst_append[of "unlabel A"] unlabel_append[of A]
      by auto
    
    have "σ y = Var y" using y(1) step.hyps(4) unfolding transaction_fresh_subst_def by auto
    hence "α y = Var x" using y(2) unfolding subst_compose_def ξ_empty by simp
    hence y_val: "fst y = TAtom Value" "Γv y = TAtom Value"
      using x(1) Γv_TAtom''[of x] Γv_TAtom''[of y]
            wt_subst_trm''[OF transaction_renaming_subst_wt[OF step.hyps(5)], of "Var y"]
      by force+

    obtain ts where ts:
        "occurs (Var y) ∈ set ts" "receive⟨ts⟩ ∈ set (unlabel (transaction_receive T))"
      using admissible_transaction_occurs_checksE1[OF T y(1) y_val(2)]
      by (metis list.set_intros(1) unlabel_Cons(1)) 
    hence "receive⟨ts⟩ ∈ set (unlabel (transaction_strand T))" 
      using transaction_strand_subsets(5) by blast
    hence *: "receive⟨ts ⋅list ξ ∘s σ ∘s α⟩ ∈ set (unlabel (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))"
      using unlabel_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
            stateful_strand_step_subst_inI(2)[of _ _ "ξ ∘s σ ∘s α"] 
      by force

    have "occurs (Var y) ⋅ ξ ∘s σ ∘s α = occurs (Var x)"
      using y(2) by (auto simp del: subst_subst_compose)
    hence **: "occurs (Var x) ∈ set ts ⋅set ξ ∘s σ ∘s α" using ts(1) by force

    have "send⟨ts ⋅list ξ ∘s σ ∘s α⟩ ∈ set (unlabel (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)))"
      using * duallsst_unlabel_steps_iff(2) by blast
    thus ?thesis using ** unlabel_append[of A] by force
  qed
qed simp

lemma reachable_constraints_dblsst_set_args_empty:
  assumes 𝒜: "𝒜 ∈ reachable_constraints P"
    and PP: "list_all wellformed_transaction P"
    and admissible_transaction_updates:
      "let f = (λT. ∀x ∈ set (unlabel (transaction_updates T)).
                      is_Update x ∧ is_Var (the_elem_term x) ∧ is_Fun_Set (the_set_term x) ∧
                      fst (the_Var (the_elem_term x)) = TAtom Value)
      in list_all f P"
    and d: "(t, s) ∈ set (dblsst 𝒜 ℐ)"
  shows "∃ss. s = Fun (Set ss) []"
  using 𝒜 d
proof (induction)
  case (step 𝒜 TT ξ σ α)
  let ?TT = "transaction_strand TT ⋅lsst ξ ∘s σ ∘s α"
  let ?TTu = "unlabel ?TT"
  let ?TTd = "duallsst ?TT"
  let ?TTdu = "unlabel ?TTd"

  from step(6) have "(t, s) ∈ set (db'sst ?TTdu ℐ (db'sst (unlabel 𝒜) ℐ []))"
    by (metis dbsst_append dbsst_def step.prems unlabel_append)
  hence "(t, s) ∈ set (db'sst (unlabel 𝒜) ℐ []) ∨
    (∃t' s'. insert⟨t',s'⟩ ∈ set ?TTdu ∧ t = t' ⋅ ℐ ∧ s = s' ⋅ ℐ)"
    using dbsst_in_cases[of t "s" ?TTdu ℐ] by metis 
  thus ?case
  proof
    assume "∃t' s'. insert⟨t',s'⟩ ∈ set ?TTdu ∧ t = t' ⋅ ℐ ∧ s = s' ⋅ ℐ"
    then obtain t' s' where t's'_p: "insert⟨t',s'⟩ ∈ set ?TTdu" "t = t' ⋅ ℐ" "s = s' ⋅ ℐ" by metis
    then obtain lll where "(lll, insert⟨t',s'⟩) ∈ set ?TTd" by (meson unlabel_mem_has_label)
    hence "(lll, insert⟨t',s'⟩) ∈ set (transaction_strand TT ⋅lsst ξ ∘s σ ∘s α)"
      using duallsst_steps_iff(4) by blast
    hence "insert⟨t',s'⟩ ∈ set ?TTu" by (meson unlabel_in)
    hence "insert⟨t',s'⟩ ∈ set ((unlabel (transaction_strand TT)) ⋅sst ξ ∘s σ ∘s α)"
      by (simp add: subst_lsst_unlabel)
    hence "insert⟨t',s'⟩ ∈ (λx. x ⋅sstp ξ ∘s σ ∘s α) ` set (unlabel (transaction_strand TT))"
      unfolding subst_apply_stateful_strand_def by auto
    then obtain u where
        "u ∈ set (unlabel (transaction_strand TT)) ∧ u ⋅sstp ξ ∘s σ ∘s α = insert⟨t',s'⟩"
      by auto
    hence "∃t'' s''. insert⟨t'',s''⟩ ∈ set (unlabel (transaction_strand TT)) ∧
                   t' = t'' ⋅ ξ ∘s σ ∘s α ∧ s' = s'' ⋅ ξ ∘s σ ∘s α"
      by  (cases u) auto
    then obtain t'' s'' where t''s''_p:
        "insert⟨t'',s''⟩ ∈ set (unlabel (transaction_strand TT)) ∧
          t' = t'' ⋅ ξ ∘s σ ∘s α ∧ s' = s'' ⋅ ξ ∘s σ ∘s α"
      by auto
    hence "insert⟨t'',s''⟩ ∈ set (unlabel (transaction_updates TT))"
      using is_Update_in_transaction_updates[of "insert⟨t'',s''⟩" TT]
      using PP step(2) unfolding list_all_iff by auto
    moreover have "∀x∈set (unlabel (transaction_updates TT)). is_Fun_Set (the_set_term x)"
      using step(2) admissible_transaction_updates unfolding is_Fun_Set_def list_all_iff by auto
    ultimately have "is_Fun_Set (the_set_term (insert⟨t'',s''⟩))" by auto
    moreover have "s' = s'' ⋅ ξ ∘s σ ∘s α" using t''s''_p by blast
    ultimately have "is_Fun_Set (the_set_term (insert⟨t',s'⟩))" by (auto simp add: is_Fun_Set_subst)
    hence "is_Fun_Set s" by (simp add: t's'_p(3) is_Fun_Set_subst)
    thus ?case using is_Fun_Set_exi by auto
  qed (auto simp add: step dbsst_def)
qed auto

lemma reachable_constraints_occurs_fact_ik_ground:
  fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "A ∈ reachable_constraints P"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and P_occ: "∀T ∈ set P. admissible_transaction_occurs_checks T"
    and t: "occurs t ∈ iklsst A"
  shows "fv (occurs t) = {}"
proof -
  have 0: "admissible_transaction' T"
    when "T ∈ set P" for T
    using P that unfolding list_all_iff by simp

  note 1 = admissible_transaction_is_wellformed_transaction(1)[OF 0] bspec[OF P_occ]

  have 2: "iklsst (A@duallsst (transaction_strand T ⋅lsst θ)) =
           (iklsst A) ∪ (trmslsst (transaction_send T) ⋅set θ)"
    when "T ∈ set P" for T θ and A::"('fun,'atom,'sets,'lbl) prot_constr"
    using dual_transaction_ik_is_transaction_send'[OF 1(1)[OF that]] by fastforce

  show ?thesis using 𝒜_reach t
  proof (induction A rule: reachable_constraints.induct)
    case (step A T ξ σ α)
    note ξ_empty = admissible_transaction_decl_subst_empty[OF 0[OF step.hyps(2)] step.hyps(3)]

    from step show ?case
    proof (cases "occurs t ∈ iklsst A")
      case False
      hence "occurs t ∈ trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α"
        using 2[OF step.hyps(2)] step.prems ξ_empty by blast
      then obtain ts where ts:
          "occurs t ∈ set ts" "send⟨ts⟩ ∈ set (unlabel (transaction_send T ⋅lsst ξ ∘s σ ∘s α))"
        using wellformed_transaction_send_receive_subst_trm_cases(2)[OF 1(1)[OF step.hyps(2)]]
        by blast
      then obtain ts' s where s:
          "occurs s ∈ set ts'" "send⟨ts'⟩ ∈ set (unlabel (transaction_send T))" "t = s ⋅ ξ ∘s σ ∘s α"
        using transaction_decl_fresh_renaming_substs_occurs_fact_send_receive(1)[
                OF step.hyps(3-5) 0[OF step.hyps(2)] ts(1)]
              transaction_strand_subst_subsets(8)[of T "ξ ∘s σ ∘s α"]
        by blast

      obtain x where x: "x ∈ set (transaction_fresh T)" "s = Var x"
        using admissible_transaction_occurs_checksE4[OF 1(2)[OF step.hyps(2)] s(2,1)] by metis

      have "fv t = {}"
        using transaction_decl_fresh_renaming_substs_range(2)[OF step.hyps(3-5) _ x(1)]
              s(3) x(2) transaction_decl_subst_empty_inv[OF step.hyps(3)[unfolded ξ_empty]]
        by (auto simp del: subst_subst_compose)
      thus ?thesis by simp
    qed simp
  qed simp
qed

lemma reachable_constraints_occurs_fact_ik_funs_terms:
  fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes 𝒜_reach: "A ∈ reachable_constraints P"
    and ℐ: "welltyped_constraint_model I A"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and P_occ: "∀T ∈ set P. admissible_transaction_occurs_checks T"
  shows "∀s ∈ subtermsset (iklsst A ⋅set I). OccursFact ∉ ⋃(funs_term ` set (snd (Ana s)))" (is "?A A")
    and "∀s ∈ subtermsset (iklsst A ⋅set I). OccursSec ∉ ⋃(funs_term ` set (snd (Ana s)))" (is "?B A")
    and "Fun OccursSec [] ∉ iklsst A ⋅set I" (is "?C A")
    and "∀x ∈ varslsst A. I x ≠ Fun OccursSec []" (is "?D A")
proof -
  have T_adm: "admissible_transaction' T" when "T ∈ set P" for T
    using P that unfolding list_all_iff by simp

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]

  note T_occ = bspec[OF P_occ]

  note ξ_empty = admissible_transaction_decl_subst_empty[OF T_adm]

  have ℐ_wt: "wtsubst I" by (metis ℐ welltyped_constraint_model_def)

  have ℐ_wftrms: "wftrms (subst_range I)"
    by (metis ℐ welltyped_constraint_model_def constraint_model_def)

  have ℐ_grounds: "fv (I x) = {}" "∃f T. I x = Fun f T" for x
    using ℐ interpretation_grounds[of I, of "Var x"] empty_fv_exists_fun[of "I x"]
    unfolding welltyped_constraint_model_def constraint_model_def by auto

  have 00: "fvset (trmslsst (transaction_send T)) ⊆ vars_transaction T"
           "fvset (subtermsset (trmslsst (transaction_send T))) = fvset (trmslsst (transaction_send T))"
    for T::"('fun,'atom,'sets,'lbl) prot_transaction"
    using fv_trmssst_subset(1)[of "unlabel (transaction_send T)"] vars_transaction_unfold
          fv_subterms_set[of "trmslsst (transaction_send T)"]
    by blast+

  have 0: "∀x ∈ fvset (trmslsst (transaction_send T)). ∃a. Γ (Var x) = TAtom a"
          "∀x ∈ fvset (trmslsst (transaction_send T)). Γ (Var x) ≠ TAtom OccursSecType"
          "∀x ∈ fvset (subtermsset (trmslsst (transaction_send T))). ∃a. Γ (Var x) = TAtom a"
          "∀x ∈ fvset (subtermsset (trmslsst (transaction_send T))). Γ (Var x) ≠ TAtom OccursSecType"
          "∀x ∈ vars_transaction T. ∃a. Γ (Var x) = TAtom a"
          "∀x ∈ vars_transaction T. Γ (Var x) ≠ TAtom OccursSecType"
    when "T ∈ set P" for T
    using admissible_transaction_occurs_fv_types[OF T_adm[OF that]] 00
    by blast+

  note T_fresh_type = admissible_transactionE(2)[OF T_adm]

  have 1: "iklsst (A@duallsst (transaction_strand T ⋅lsst θ)) ⋅set I =
           (iklsst A ⋅set I) ∪ (trmslsst (transaction_send T) ⋅set θ ⋅set I)"
    when "T ∈ set P" for T θ and A::"('fun,'atom,'sets,'lbl) prot_constr"
    using dual_transaction_ik_is_transaction_send'[OF T_wf[OF that]]
    by fastforce

  have 2: "subtermsset (trmslsst (transaction_send T) ⋅set θ ⋅set I) =
           subtermsset (trmslsst (transaction_send T)) ⋅set θ ⋅set I"
    when "T ∈ set P" and θ: "wtsubst θ" "wftrms (subst_range θ)" for T θ
    using wt_subst_TAtom_subterms_set_subst[OF wt_subst_compose[OF θ(1) ℐ_wt] 0(1)[OF that(1)]]
          wf_trm_subst_rangeD[OF wf_trms_subst_compose[OF θ(2) ℐ_wftrms]]
    by auto

  have 3: "wtsubst (ξ ∘s σ ∘s α)" "wftrms (subst_range (ξ ∘s σ ∘s α))"
    when "T ∈ set P" "transaction_decl_subst ξ T"
         "transaction_fresh_subst σ T (trmslsst A)" "transaction_renaming_subst α P (varslsst A)"
    for ξ σ α and T::"('fun,'atom,'sets,'lbl) prot_transaction"
      and A::"('fun,'atom,'sets,'lbl) prot_constr"
    using protocol_transaction_vars_TAtom_typed(3)[of T] P that(1)
          transaction_decl_fresh_renaming_substs_wt[OF that(2-4)]
          transaction_decl_fresh_renaming_substs_range_wf_trms[OF that(2-4)]
          wf_trms_subst_compose
    by simp_all

  have 4: "∀s ∈ subtermsset (trmslsst (transaction_send T)).
              OccursFact ∉ ⋃(funs_term ` set (snd (Ana s))) ∧
              OccursSec ∉ ⋃(funs_term ` set (snd (Ana s)))"
    when T: "T ∈ set P" for T
  proof
    fix t assume t: "t ∈ subtermsset (trmslsst (transaction_send T))"
    then obtain ts s where s:
        "send⟨ts⟩ ∈ set (unlabel (transaction_send T))" "s ∈ set ts" "t ∈ subterms s"
      using wellformed_transaction_unlabel_cases(4)[OF T_wf[OF T]]
      by fastforce

    have s_occ: "∃x. s = occurs (Var x)" when "OccursFact ∈ funs_term t ∨ OccursSec ∈ funs_term t"
      using that s(1) subtermeq_imp_funs_term_subset[OF s(3)]
            admissible_transaction_occurs_checksE3[OF T_occ[OF T] _ s(2)]
      by blast

    obtain K T' where K: "Ana t = (K,T')" by force

    show "OccursFact ∉ ⋃(funs_term ` set (snd (Ana t))) ∧
          OccursSec ∉ ⋃(funs_term ` set (snd (Ana t)))"
    proof (rule ccontr)
      assume "¬(OccursFact ∉ ⋃(funs_term ` set (snd (Ana t))) ∧
                OccursSec ∉ ⋃(funs_term ` set (snd (Ana t))))"
      hence a: "OccursFact ∈ ⋃(funs_term ` set (snd (Ana t))) ∨
                OccursSec ∈ ⋃(funs_term ` set (snd (Ana t)))"
        by simp
      hence "OccursFact ∈ ⋃(funs_term ` set T') ∨ OccursSec ∈ ⋃(funs_term ` set T')"
        using K by simp
      hence "OccursFact ∈ funs_term t ∨ OccursSec ∈ funs_term t"
        using Ana_subterm[OF K] funs_term_subterms_eq(1)[of t] by blast
      then obtain x where x: "t ∈ subterms (occurs (Var x))"
        using s(3) s_occ by blast
      thus False using a by fastforce
    qed
  qed

  have 5: "OccursFact ∉ ⋃(funs_term ` subst_range (ξ ∘s σ ∘s α))"
          "OccursSec ∉ ⋃(funs_term ` subst_range (ξ ∘s σ ∘s α))"
      when ξσα: "transaction_decl_subst ξ T" "transaction_fresh_subst σ T (trmslsst A)"
                "transaction_renaming_subst α P (varslsst A)"
      and T: "T ∈ set P"
    for ξ σ α and T::"('fun,'atom,'sets,'lbl) prot_transaction"
      and A::"('fun,'atom,'sets,'lbl) prot_constr"
  proof -
    have "OccursFact ∉ funs_term t" "OccursSec ∉ funs_term t"
      when "t ∈ subst_range (ξ ∘s σ ∘s α)" for t 
      using transaction_decl_fresh_renaming_substs_range'(3)[
              OF ξσα that ξ_empty[OF T ξσα(1)] T_fresh_type[OF T]]
      by auto
    thus "OccursFact ∉ ⋃(funs_term ` subst_range (ξ ∘s σ ∘s α))"
         "OccursSec ∉ ⋃(funs_term ` subst_range (ξ ∘s σ ∘s α))"
      by blast+
  qed

  have 6: "I x ≠ Fun OccursSec []" "∄t. I x = occurs t" "∃a. Γ (I x) = TAtom a ∧ a ≠ OccursSecType"
    when T: "T ∈ set P"
      and ξσα: "transaction_decl_subst ξ T" "transaction_fresh_subst σ T (trmslsst A)"
               "transaction_renaming_subst α P (varslsst A)"
      and x: "Var x ∈ trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α"
    for x ξ σ α and T::"('fun,'atom,'sets,'lbl) prot_transaction"
      and A::"('fun,'atom,'sets,'lbl) prot_constr"
  proof -
    obtain t where t: "t ∈ trmslsst (transaction_send T)" "t ⋅ (ξ ∘s σ ∘s α) = Var x"
      using x by force
    then obtain y where y: "t = Var y" by (cases t) auto

    have "∃a. Γ t = TAtom a ∧ a ≠ OccursSecType"
      using 0(1,2)[OF T] t(1) y
      by force
    thus "∃a. Γ (I x) = TAtom a ∧ a ≠ OccursSecType"
      using wt_subst_trm''[OF 3(1)[OF T ξσα]] wt_subst_trm''[OF ℐ_wt] t(2) 
      by (metis eval_term.simps(1))
    thus "I x ≠ Fun OccursSec []" "∄t. I x = occurs t"
      by auto
  qed

  have 7: "I x ≠ Fun OccursSec []" "∄t. I x = occurs t" "∃a. Γ (I x) = TAtom a ∧ a ≠ OccursSecType"
    when T: "T ∈ set P"
      and ξσα: "transaction_decl_subst ξ T" "transaction_fresh_subst σ T (trmslsst A)"
               "transaction_renaming_subst α P (varslsst A)"
      and x: "x ∈ fvset ((ξ ∘s σ ∘s α) ` vars_transaction T)"
    for x ξ σ α and T::"('fun,'atom,'sets,'lbl) prot_transaction"
      and A::"('fun,'atom,'sets,'lbl) prot_constr"
  proof -
    obtain y where y: "y ∈ vars_transaction T" "x ∈ fv ((ξ ∘s σ ∘s α) y)"
      using x by auto
    hence y': "(ξ ∘s σ ∘s α) y = Var x"
      using transaction_decl_fresh_renaming_substs_range'(3)[
              OF ξσα _ ξ_empty[OF T ξσα(1)] T_fresh_type[OF T]]
      by (cases "(ξ ∘s σ ∘s α) y ∈ subst_range (ξ ∘s σ ∘s α)") force+

    have "∃a. Γ (Var y) = TAtom a ∧ a ≠ OccursSecType"
      using 0(5,6)[OF T] y
      by force
    thus "∃a. Γ (I x) = TAtom a ∧ a ≠ OccursSecType"
      using wt_subst_trm''[OF 3(1)[OF T ξσα]] wt_subst_trm''[OF ℐ_wt] y'
      by (metis eval_term.simps(1))
    thus "I x ≠ Fun OccursSec []" "∄t. I x = occurs t"
      by auto
  qed

  have 8: "I x ≠ Fun OccursSec []" "∄t. I x = occurs t" "∃a. Γ (I x) = TAtom a ∧ a ≠ OccursSecType"
    when T: "T ∈ set P"
      and ξσα: "transaction_decl_subst ξ T" "transaction_fresh_subst σ T (trmslsst A)"
               "transaction_renaming_subst α P (varslsst A)"
      and x: "Var x ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α"
    for x ξ σ α and T::"('fun,'atom,'sets,'lbl) prot_transaction"
      and A::"('fun,'atom,'sets,'lbl) prot_constr"
  proof -
    obtain t where t: "t ∈ subtermsset (trmslsst (transaction_send T))" "t ⋅ (ξ ∘s σ ∘s α) = Var x"
      using x by force
    then obtain y where y: "t = Var y" by (cases t) auto

    have "∃a. Γ t = TAtom a ∧ a ≠ OccursSecType"
      using 0(3,4)[OF T] t(1) y
      by force
    thus "∃a. Γ (I x) = TAtom a ∧ a ≠ OccursSecType"
      using wt_subst_trm''[OF 3(1)[OF T ξσα]] wt_subst_trm''[OF ℐ_wt] t(2) 
      by (metis eval_term.simps(1))
    thus "I x ≠ Fun OccursSec []" "∄t. I x = occurs t"
      by auto
  qed

  have s_fv: "fv s ⊆ fvset ((ξ ∘s σ ∘s α) ` vars_transaction T)"
    when s: "s ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α"
      and T: "T ∈ set P"
    for s and ξ σ α::"('fun,'atom,'sets,'lbl) prot_subst"
      and T::"('fun,'atom,'sets,'lbl) prot_transaction"
  proof
    fix x assume "x ∈ fv s"
    hence "x ∈ fvset (subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α)"
      using s by auto
    hence *: "x ∈ fvset (trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α)"
      using fv_subterms_set_subst' by fast
    have **: "list_all is_Send (unlabel (transaction_send T))"
      using T_wf[OF T] unfolding wellformed_transaction_def by blast
    have "x ∈ fvset ((ξ ∘s σ ∘s α) ` varslsst (transaction_send T))"
    proof -
      obtain t where t: "t ∈ trmslsst (transaction_send T)" "x ∈ fv (t ⋅ ξ ∘s σ ∘s α)"
        using * by fastforce
      hence "fv t ⊆ varslsst (transaction_send T)"
        using fv_trmssst_subset(1)[of "unlabel (transaction_send T)"]
        by auto
      thus ?thesis using t(2) subst_apply_fv_subset by fast
    qed
    thus "x ∈ fvset ((ξ ∘s σ ∘s α) ` vars_transaction T)"
      using vars_transaction_unfold[of T] by fastforce
  qed

  show "?A A" using 𝒜_reach
  proof (induction A rule: reachable_constraints.induct)
    case (step A T ξ σ α)
    have *: "∀s ∈ subtermsset (trmslsst (transaction_send T)).
              OccursFact ∉ ⋃(funs_term ` set (snd (Ana s)))"
      using 4[OF step.hyps(2)] by blast

    have "∀s ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α ⋅set I.
            OccursFact ∉ ⋃(funs_term ` set (snd (Ana s)))"
    proof
      fix t assume t: "t ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α ⋅set I"
      then obtain s u where su:
          "s ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α" "s ⋅ I = t"
          "u ∈ subtermsset (trmslsst (transaction_send T))" "u ⋅ ξ ∘s σ ∘s α = s"
        by force

      obtain Ku Tu where KTu: "Ana u = (Ku,Tu)" by force
      
      have *: "OccursFact ∉ ⋃(funs_term ` set Tu)"
              "OccursFact ∉ ⋃(funs_term ` subst_range (ξ ∘s σ ∘s α))"
              "OccursFact ∉ ⋃(funs_term ` ⋃(((set ∘ snd ∘ Ana) ` subst_range (ξ ∘s σ ∘s α))))"
        using transaction_decl_fresh_renaming_substs_range'(3)[
                OF step.hyps(3-5) _ ξ_empty[OF step.hyps(2,3)] T_fresh_type[OF step.hyps(2)]]
              4[OF step.hyps(2)] su(3) KTu
        by (fastforce,fastforce,fastforce)

      have "OccursFact ∉ ⋃(funs_term ` set (Tu ⋅list ξ ∘s σ ∘s α))"
      proof -
        { fix f assume f: "f ∈ ⋃(funs_term ` set (Tu ⋅list ξ ∘s σ ∘s α))"
          then obtain tf where tf: "tf ∈ set Tu" "f ∈ funs_term (tf ⋅ ξ ∘s σ ∘s α)" by force
          hence "f ∈ funs_term tf ∨ f ∈ ⋃(funs_term ` subst_range (ξ ∘s σ ∘s α))"
            using funs_term_subst[of tf "ξ ∘s σ ∘s α"] by force
          hence "f ≠ OccursFact" using *(1,2) tf(1) by blast
        } thus ?thesis by metis
      qed
      hence **: "OccursFact ∉ ⋃(funs_term ` set (snd (Ana s)))"
      proof (cases u)
        case (Var xu)
        hence "s = (ξ ∘s σ ∘s α) xu" using su(4) by (metis eval_term.simps(1))
        thus ?thesis using *(3) by fastforce
      qed (use su(4) KTu Ana_subst'[of _ _ Ku Tu "ξ ∘s σ ∘s α"] in simp)
      
      show "OccursFact ∉ ⋃(funs_term ` set (snd (Ana t)))"
      proof (cases s)
        case (Var sx)
        then obtain a where a: "Γ (I sx) = Var a"
          using su(1) 8(3)[OF step.hyps(2-5), of sx] by fast
        hence "Ana (I sx) = ([],[])" by (metis ℐ_grounds(2) const_type_inv[THEN Ana_const])
        thus ?thesis using Var su(2) by simp
      next
        case (Fun f S)
        hence snd_Ana_t: "snd (Ana t) = snd (Ana s) ⋅list I"
          using su(2) Ana_subst'[of f S _ "snd (Ana s)" I] by (cases "Ana s") simp_all

        { fix g assume "g ∈ ⋃(funs_term ` set (snd (Ana t)))"
          hence "g ∈ ⋃(funs_term ` set (snd (Ana s))) ∨
                 (∃x ∈ fvset (set (snd (Ana s))). g ∈ funs_term (I x))"
            using snd_Ana_t funs_term_subst[of _ I] by auto
          hence "g ≠ OccursFact"
          proof
            assume "∃x ∈ fvset (set (snd (Ana s))). g ∈ funs_term (I x)"
            then obtain x where x: "x ∈ fvset (set (snd (Ana s)))" "g ∈ funs_term (I x)" by force
            have "x ∈ fv s" using x(1) Ana_vars(2)[of s] by (cases "Ana s") auto
            hence "x ∈ fvset ((ξ ∘s σ ∘s α) ` vars_transaction T)"
              using s_fv[OF su(1) step.hyps(2)] by blast
            then obtain a h U where h:
                "I x = Fun h U" "Γ (I x) = Var a" "a ≠ OccursSecType" "arity h = 0"
              using ℐ_grounds(2) 7(3)[OF step.hyps(2-5)] const_type_inv
              by metis
            hence "h ≠ OccursFact" by auto
            moreover have "U = []" using h(1,2,4) const_type_inv_wf[of h U a] ℐ_wftrms by fastforce
            ultimately show ?thesis using h(1) x(2) by auto
          qed (use ** in blast)
        } thus ?thesis by blast
      qed
    qed
    thus ?case
      using step.IH step.prems 1[OF step.hyps(2), of A "ξ ∘s σ ∘s α"]
            2[OF step.hyps(2) 3[OF step.hyps(2-5)]]
      by auto
  qed simp

  show "?B A" using 𝒜_reach
  proof (induction A rule: reachable_constraints.induct)
    case (step A T ξ σ α)
    have "∀s ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α ⋅set I.
            OccursSec ∉ ⋃(funs_term ` set (snd (Ana s)))"
    proof
      fix t assume t: "t ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α ⋅set I"
      then obtain s u where su:
          "s ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α" "s ⋅ I = t"
          "u ∈ subtermsset (trmslsst (transaction_send T))" "u ⋅ ξ ∘s σ ∘s α = s"
        by force

      obtain Ku Tu where KTu: "Ana u = (Ku,Tu)" by force
      
      have *: "OccursSec ∉ ⋃(funs_term ` set Tu)"
              "OccursSec ∉ ⋃(funs_term ` subst_range (ξ ∘s σ ∘s α))"
              "OccursSec ∉ ⋃(funs_term ` ⋃(((set ∘ snd ∘ Ana) ` subst_range (ξ ∘s σ ∘s α))))"
        using transaction_decl_fresh_renaming_substs_range'(3)[
                OF step.hyps(3-5) _ ξ_empty[OF step.hyps(2,3)] T_fresh_type[OF step.hyps(2)]] 
              4[OF step.hyps(2)] su(3) KTu
        by (fastforce,fastforce,fastforce)

      have "OccursSec ∉ ⋃(funs_term ` set (Tu ⋅list ξ ∘s σ ∘s α))"
      proof -
        { fix f assume f: "f ∈ ⋃(funs_term ` set (Tu ⋅list ξ ∘s σ ∘s α))"
          then obtain tf where tf: "tf ∈ set Tu" "f ∈ funs_term (tf ⋅ ξ ∘s σ ∘s α)" by force
          hence "f ∈ funs_term tf ∨ f ∈ ⋃(funs_term ` subst_range (ξ ∘s σ ∘s α))"
            using funs_term_subst[of tf "ξ ∘s σ ∘s α"] by force
          hence "f ≠ OccursSec" using *(1,2) tf(1) by blast
        } thus ?thesis by metis
      qed
      hence **: "OccursSec ∉ ⋃(funs_term ` set (snd (Ana s)))"
      proof (cases u)
        case (Var xu)
        hence "s = (ξ ∘s σ ∘s α) xu" using su(4) by (metis eval_term.simps(1))
        thus ?thesis using *(3) by fastforce
      qed (use su(4) KTu Ana_subst'[of _ _ Ku Tu "ξ ∘s σ ∘s α"] in simp)
      
      show "OccursSec ∉ ⋃(funs_term ` set (snd (Ana t)))"
      proof (cases s)
        case (Var sx)
        then obtain a where a: "Γ (I sx) = Var a"
          using su(1) 8(3)[OF step.hyps(2-5), of sx] by fast
        hence "Ana (I sx) = ([],[])" by (metis ℐ_grounds(2) const_type_inv[THEN Ana_const])
        thus ?thesis using Var su(2) by simp
      next
        case (Fun f S)
        hence snd_Ana_t: "snd (Ana t) = snd (Ana s) ⋅list I"
          using su(2) Ana_subst'[of f S _ "snd (Ana s)" I] by (cases "Ana s") simp_all

        { fix g assume "g ∈ ⋃(funs_term ` set (snd (Ana t)))"
          hence "g ∈ ⋃(funs_term ` set (snd (Ana s))) ∨
                 (∃x ∈ fvset (set (snd (Ana s))). g ∈ funs_term (I x))"
            using snd_Ana_t funs_term_subst[of _ I] by auto
          hence "g ≠ OccursSec"
          proof
            assume "∃x ∈ fvset (set (snd (Ana s))). g ∈ funs_term (I x)"
            then obtain x where x: "x ∈ fvset (set (snd (Ana s)))" "g ∈ funs_term (I x)" by force
            have "x ∈ fv s" using x(1) Ana_vars(2)[of s] by (cases "Ana s") auto
            hence "x ∈ fvset ((ξ ∘s σ ∘s α) ` vars_transaction T)"
              using s_fv[OF su(1) step.hyps(2)] by blast
            then obtain a h U where h:
                "I x = Fun h U" "Γ (I x) = Var a" "a ≠ OccursSecType" "arity h = 0"
              using ℐ_grounds(2) 7(3)[OF step.hyps(2-5)] const_type_inv
              by metis
            hence "h ≠ OccursSec" by auto
            moreover have "U = []" using h(1,2,4) const_type_inv_wf[of h U a] ℐ_wftrms by fastforce
            ultimately show ?thesis using h(1) x(2) by auto
          qed (use ** in blast)
        } thus ?thesis by blast
      qed
    qed
    thus ?case
      using step.IH step.prems 1[OF step.hyps(2), of A "ξ ∘s σ ∘s α"]
            2[OF step.hyps(2) 3[OF step.hyps(2-5)]]
      by auto
  qed simp

  show "?C A" using 𝒜_reach
  proof (induction A rule: reachable_constraints.induct)
    case (step A T ξ σ α)
    have *: "Fun OccursSec [] ∉ trmslsst (transaction_send T)"
      using admissible_transaction_occurs_checksE5[OF T_occ[OF step.hyps(2)]] by blast

    have **: "Fun OccursSec [] ∉ subst_range (ξ ∘s σ ∘s α)"
      using transaction_decl_fresh_renaming_substs_range'(3)[
              OF step.hyps(3-5) _ ξ_empty[OF step.hyps(2,3)] T_fresh_type[OF step.hyps(2)]]
      by auto

    have "Fun OccursSec [] ∉ trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α ⋅set I"
    proof
      assume "Fun OccursSec [] ∈ trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α ⋅set I"
      then obtain s where "s ∈ trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α" "s ⋅ I = Fun OccursSec []"
        by force
      moreover have "Fun OccursSec [] ∉ trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α"
      proof
        assume "Fun OccursSec [] ∈ trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α"
        then obtain u where "u ∈ trmslsst (transaction_send T)" "u ⋅ ξ ∘s σ ∘s α = Fun OccursSec []"
          by force
        thus False using * ** by (cases u) (force simp del: subst_subst_compose)+
      qed
      ultimately show False using 6[OF step.hyps(2-5)] by (cases s) auto
    qed
    thus ?case using step.IH step.prems 1[OF step.hyps(2), of A "ξ ∘s σ ∘s α"] by fast
  qed simp

  show "?D A" using 𝒜_reach
  proof (induction A rule: reachable_constraints.induct)
    case (step A T ξ σ α)
    { fix x assume x: "x ∈ varslsst (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α))"
      hence x': "x ∈ varssst (unlabel (transaction_strand T) ⋅sst ξ ∘s σ ∘s α)"
        by (metis varssst_unlabel_duallsst_eq unlabel_subst)
      hence "x ∈ vars_transaction T ∨ x ∈ fvset ((ξ ∘s σ ∘s α) ` vars_transaction T)"
        using varssst_subst_cases[OF x'] by metis
      moreover have "I x ≠ Fun OccursSec []" when "x ∈ vars_transaction T"
        using that 0(5,6)[OF step.hyps(2)] wt_subst_trm''[OF ℐ_wt, of "Var x"]
        by fastforce
      ultimately have "I x ≠ Fun OccursSec []"
        using 7(1)[OF step.hyps(2-5), of x]
        by blast
    } thus ?case using step.IH by auto
  qed simp
qed

lemma reachable_constraints_occurs_fact_ik_subst_aux:
  assumes 𝒜_reach: "A ∈ reachable_constraints P"
    and ℐ: "welltyped_constraint_model I A"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and P_occ: "∀T ∈ set P. admissible_transaction_occurs_checks T"
    and t: "t ∈ iklsst A" "t ⋅ I = occurs s"
  shows "∃u. t = occurs u"
proof -
  have "wtsubst I"
    using ℐ unfolding welltyped_constraint_model_def constraint_model_def by metis
  hence 0: "Γ t = Γ (occurs s)"
    using t(2) wt_subst_trm'' by metis

  have 1: "Γv ` fvlsst A ⊆ (⋃T ∈ set P. Γv ` fv_transaction T)"
          "∀T ∈ set P. ∀x ∈ fv_transaction T. Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    using reachable_constraints_var_types_in_transactions(1)[OF 𝒜_reach]
          protocol_transaction_vars_TAtom_typed(2,3) P
    by fast+

  show ?thesis
  proof (cases t)
    case (Var x)
    thus ?thesis
      using 0 1 t(1) var_subterm_iksst_is_fvsst[of x "unlabel A"]
      by fastforce
  next
    case (Fun f T)
    hence 2: "f = OccursFact" "length T = Suc (Suc 0)" "T ! 0 ⋅ I = Fun OccursSec []"
      using t(2) by auto

    have "T ! 0 = Fun OccursSec []"
    proof (cases "T ! 0")
      case (Var y)
      hence "I y = Fun OccursSec []" using Fun 2(3) by simp
      moreover have "Var y ∈ set T" using Var 2(2) length_Suc_conv[of T 1] by auto
      hence "y ∈ fvset (iklsst A)" using Fun t(1) by force
      hence "y ∈ varslsst A"
        using fv_ik_subset_fv_sst'[of "unlabel A"] varssst_is_fvsst_bvarssst[of "unlabel A"]
        by blast
      ultimately have False
        using reachable_constraints_occurs_fact_ik_funs_terms(4)[OF 𝒜_reach ℐ P P_occ]
        by blast
      thus ?thesis by simp
    qed (use 2(3) in simp)
    moreover have "∃u u'. T = [u,u']"
      using iffD1[OF length_Suc_conv 2(2)] iffD1[OF length_Suc_conv[of _ 0]] length_0_conv by fast
    ultimately show ?thesis using Fun 2(1,2) by force
  qed
qed

lemma reachable_constraints_occurs_fact_ik_subst:
  assumes 𝒜_reach: "A ∈ reachable_constraints P"
    and ℐ: "welltyped_constraint_model I A"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and P_occ: "∀T ∈ set P. admissible_transaction_occurs_checks T"
    and t: "occurs t ∈ iklsst A ⋅set I"
  shows "occurs t ∈ iklsst A"
proof -
  have ℐ_wt: "wtsubst I"
    using ℐ unfolding welltyped_constraint_model_def constraint_model_def by metis

  obtain s where s: "s ∈ iklsst A" "s ⋅ I = occurs t"
    using t by auto
  hence u: "∃u. s = occurs u"
    using ℐ_wt reachable_constraints_occurs_fact_ik_subst_aux[OF 𝒜_reach ℐ P P_occ]
    by blast
  hence "fv s = {}"
    using reachable_constraints_occurs_fact_ik_ground[OF 𝒜_reach P P_occ] s
    by fast
  thus ?thesis
    using s u subst_ground_ident[of s I] 
    by argo
qed

lemma reachable_constraints_occurs_fact_send_in_ik:
  assumes 𝒜_reach: "A ∈ reachable_constraints P"
    and ℐ: "welltyped_constraint_model I A"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and P_occ: "∀T ∈ set P. admissible_transaction_occurs_checks T"
    and x: "occurs (Var x) ∈ set ts" "send⟨ts⟩ ∈ set (unlabel A)"
  shows "occurs (I x) ∈ iklsst A"
using 𝒜_reach ℐ x
proof (induction A rule: reachable_constraints.induct)
  case (step A T ξ σ α)
  define θ where "θ ≡ ξ ∘s σ ∘s α"
  define T' where "T' ≡ duallsst (transaction_strand T ⋅lsst θ)"

  have T_adm: "admissible_transaction' T"
    using P step.hyps(2) unfolding list_all_iff by blast

  note T_wf = admissible_transaction_is_wellformed_transaction(1)[OF T_adm]
  note T_adm_occ = bspec[OF P_occ]

  have ℐ_is_T_model: "strand_sem_stateful (iklsst A ⋅set I) (set (dblsst A I)) (unlabel T') I"
    using step.prems unlabel_append[of A T'] dbsst_set_is_dbupdsst[of "unlabel A" I "[]"]
          strand_sem_append_stateful[of "{}" "{}" "unlabel A" "unlabel T'" I]
    by (simp add: T'_def θ_def welltyped_constraint_model_def constraint_model_def dbsst_def)

  show ?case
  proof (cases "send⟨ts⟩ ∈ set (unlabel A)")
    case False
    hence "send⟨ts⟩ ∈ set (unlabel T')"
      using step.prems(3) unfolding T'_def θ_def by simp
    hence "receive⟨ts⟩ ∈ set (unlabel (transaction_strand T ⋅lsst θ))"
      using duallsst_unlabel_steps_iff(2) unfolding T'_def by blast
    then obtain y ts' where y:
        "receive⟨ts'⟩ ∈ set (unlabel (transaction_receive T))"
        "θ y = Var x" "occurs (Var y) ∈ set ts'"
      using transaction_decl_fresh_renaming_substs_occurs_fact_send_receive(2)[
              OF step.hyps(3-5) T_adm]
            subst_to_var_is_var[of _ θ x] step.prems(2)
      unfolding θ_def by (metis eval_term.simps(1))
    hence "occurs (Var y) ⋅ θ ∈ set ts' ⋅set θ"
          "receive⟨ts' ⋅list θ⟩ ∈ set (unlabel (transaction_receive T ⋅lsst θ))"
      using subst_lsst_unlabel_member[of "receive⟨ts'⟩" "transaction_receive T" θ]
      by fastforce+
    hence "iklsst A ⋅set I ⊢ occurs (Var y) ⋅ θ ⋅ I"
      using wellformed_transaction_sem_receives[
              OF T_wf, of "iklsst A ⋅set I" "set (dblsst A I)" θ I "ts' ⋅list θ"]
            ℐ_is_T_model
      unfolding T'_def list_all_iff by fastforce
    hence *: "iklsst A ⋅set I ⊢ occurs (θ y ⋅ I)"
      by auto

    have "occurs (θ y ⋅ I) ∈ iklsst A"
      using deduct_occurs_in_ik[OF *]
            reachable_constraints_occurs_fact_ik_subst[
              OF step.hyps(1) welltyped_constraint_model_prefix[OF step.prems(1)] P P_occ,
              of "θ y ⋅ I"]
            reachable_constraints_occurs_fact_ik_funs_terms[
              OF step.hyps(1) welltyped_constraint_model_prefix[OF step.prems(1)] P P_occ]
      by blast
    thus ?thesis using y(2) by simp
  qed (simp add: step.IH[OF welltyped_constraint_model_prefix[OF step.prems(1)]] step.prems(2))
qed simp

lemma reachable_constraints_occurs_fact_deduct_in_ik:
  assumes 𝒜_reach: "A ∈ reachable_constraints P"
    and ℐ: "welltyped_constraint_model I A"
    and P: "∀T ∈ set P. admissible_transaction' T"
    and P_occ: "∀T ∈ set P. admissible_transaction_occurs_checks T"
    and k: "iklsst A ⋅set I ⊢ occurs k"
  shows "occurs k ∈ iklsst A ⋅set I"
    and "occurs k ∈ iklsst A"
using reachable_constraints_occurs_fact_ik_funs_terms(1-3)[OF 𝒜_reach ℐ P P_occ]
      reachable_constraints_occurs_fact_ik_subst[OF 𝒜_reach ℐ P P_occ]
      deduct_occurs_in_ik[OF k]
by (presburger, presburger)

lemma reachable_constraints_fv_bvars_subset:
  assumes A: "A ∈ reachable_constraints P"
  shows "bvarslsst A ⊆ (⋃T ∈ set P. bvars_transaction T)"
using assms
proof (induction A rule: reachable_constraints.induct)
  case (step 𝒜 T ξ σ α)
  let ?T' = "transaction_strand T ⋅lsst ξ ∘s σ ∘s α"

  show ?case
    using step.IH step.hyps(2)
          bvarssst_unlabel_duallsst_eq[of ?T']
          bvarslsst_subst[of "transaction_strand T" "ξ ∘s σ ∘s α"]
          bvarssst_append[of "unlabel 𝒜" "unlabel (duallsst ?T')"]
          unlabel_append[of 𝒜 "duallsst ?T'"]
    by (metis (no_types, lifting) SUP_upper Un_subset_iff)
qed simp

lemma reachable_constraints_fv_disj:
  fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes A: "A ∈ reachable_constraints P"
  shows "fvlsst A ∩ (⋃T ∈ set P. bvars_transaction T) = {}"
using A
proof (induction A rule: reachable_constraints.induct)
  case (step 𝒜 T ξ σ α)
  define T' where "T' ≡ transaction_strand T ⋅lsst ξ ∘s σ ∘s α" 
  define X where "X ≡ ⋃T ∈ set P. bvars_transaction T"
  have "fvlsst T' ∩ X = {}"
    using transaction_decl_fresh_renaming_substs_vars_disj(4)[OF step.hyps(3-5)]
          transaction_decl_fresh_renaming_substs_vars_subset(4)[OF step.hyps(3-5,2)]
    unfolding T'_def X_def by blast
  hence "fvlsst (𝒜@duallsst T') ∩ X = {}"
    using step.IH[unfolded X_def[symmetric]] fvsst_unlabel_duallsst_eq[of T'] by auto
  thus ?case unfolding T'_def X_def by blast
qed simp

(* TODO: this lemma subsumes reachable_constraints_fv_bvars_disj *)
lemma reachable_constraints_fv_bvars_disj':
  fixes A::"('fun,'atom,'sets,'lbl) prot_constr"
  assumes P: "∀T ∈ set P. wellformed_transaction T"
    and A: "A ∈ reachable_constraints P"
  shows "fvlsst A ∩ bvarslsst A = {}"
using A
proof (induction A rule: reachable_constraints.induct)
  case (step 𝒜 T ξ σ α)
  define T' where "T' ≡ duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"

  note 0 = transaction_decl_fresh_renaming_substs_vars_disj[OF step.hyps(3-5)]
  note 1 = transaction_decl_fresh_renaming_substs_vars_subset[OF step.hyps(3-5)]

  have 2: "bvarslsst 𝒜 ∩ fvlsst T' = {}" 
    using 0(7) 1(4)[OF step.hyps(2)] fvsst_unlabel_duallsst_eq
    unfolding T'_def by (metis (no_types) disjoint_iff_not_equal subset_iff)

  have "bvarslsst T' ⊆ ⋃(bvars_transaction ` set P)"
       "fvlsst 𝒜 ∩ ⋃(bvars_transaction ` set P) = {}"
    using reachable_constraints_fv_bvars_subset[OF reachable_constraints.step[OF step.hyps]]
          reachable_constraints_fv_disj[OF reachable_constraints.step[OF step.hyps]]
    unfolding T'_def by auto
  hence 3: "fvlsst 𝒜 ∩ bvarslsst T' = {}" by blast
  
  have "fvlsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α) ∩ bvars_transaction T = {}"
    using 0(4)[OF step.hyps(2)] 1(4)[OF step.hyps(2)] by blast
  hence 4: "fvlsst T' ∩ bvarslsst T' = {}"
    by (metis (no_types) T'_def fvsst_unlabel_duallsst_eq bvarssst_unlabel_duallsst_eq
              unlabel_subst bvarssst_subst)

  have "fvlsst (𝒜@T') ∩ bvarslsst (𝒜@T') = {}"
    using 2 3 4 step.IH
    unfolding unlabel_append[of 𝒜 T']
              fvsst_append[of "unlabel 𝒜" "unlabel T'"]
              bvarssst_append[of "unlabel 𝒜" "unlabel T'"]
    by fast
  thus ?case unfolding T'_def by blast
qed simp

lemma reachable_constraints_wf:
  assumes P:
      "∀T ∈ set P. wellformed_transaction T"
      "∀T ∈ set P. wftrms' arity (trms_transaction T)"
    and A: "A ∈ reachable_constraints P"
  shows "wfsst (unlabel A)"
    and "wftrms (trmslsst A)"
proof -
  let ?X = "λT. fst ` set (transaction_decl T ()) ∪ set (transaction_fresh T)"

  have "wellformed_transaction T"
    when "T ∈ set P" for T
    using P(1) that by fast+
  hence 0: "wf'sst (?X T) (unlabel (duallsst (transaction_strand T)))"
           "fvlsst (duallsst (transaction_strand T)) ∩ bvarslsst (duallsst (transaction_strand T)) = {}"
           "wftrms (trms_transaction T)"
    when T: "T ∈ set P" for T
    unfolding admissible_transaction_terms_def
    by (metis T wellformed_transaction_wfsst(1),
        metis T wellformed_transaction_wfsst(2) fvsst_unlabel_duallsst_eq bvarssst_unlabel_duallsst_eq,
        metis T wftrms_code P(2))

  from A have "wfsst (unlabel A) ∧ wftrms (trmslsst A)"
  proof (induction A rule: reachable_constraints.induct)
    case (step A T ξ σ α)
    let ?T' = "duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)"

    have IH: "wf'sst {} (unlabel A)" "fvlsst A ∩ bvarslsst A = {}" "wftrms (trmslsst A)"
      using step.IH by metis+

    have 1: "wf'sst {} (unlabel (A@?T'))"
      using transaction_decl_fresh_renaming_substs_wf_sst[OF 0(1)[OF step.hyps(2)] step.hyps(3-5)]
            wfsst_vars_mono[of "{}"] wfsst_append[OF IH(1)]
      by simp

    have 2: "fvlsst (A@?T') ∩ bvarslsst (A@?T') = {}"
      using reachable_constraints_fv_bvars_disj'[OF P(1)]
            reachable_constraints.step[OF step.hyps]
      by blast

    have "wftrms (trmslsst ?T')"
      using trmssst_unlabel_duallsst_eq unlabel_subst
            wf_trms_subst[
              OF transaction_decl_fresh_renaming_substs_range_wf_trms[OF step.hyps(3-5)],
              THEN wftrms_trmssst_subst,
              OF 0(3)[OF step.hyps(2)]]
      by metis
    hence 3: "wftrms (trmslsst (A@?T'))"
      using IH(3) by auto

    show ?case using 1 2 3 by force
  qed simp
  thus "wfsst (unlabel A)" "wftrms (trmslsst A)" by metis+
qed

lemma reachable_constraints_no_Ana_attack:
  assumes 𝒜: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. wellformed_transaction T"
           "∀T ∈ set P. admissible_transaction_terms T"
           "∀T ∈ set P. ∀x ∈ set (transaction_fresh T).
              Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    and t: "t ∈ subtermsset (iklsst 𝒜)"
  shows "attack⟨n⟩ ∉ set (snd (Ana t))"
proof -
  have T_adm_term: "admissible_transaction_terms T" when "T ∈ set P" for T
    using P that by blast

  have T_wf: "wellformed_transaction T" when "T ∈ set P" for T
    using P that by blast

  have T_fresh: "∀x ∈ set (transaction_fresh T). Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    when "T ∈ set P" for T
    using P(3) that by fast

  show ?thesis
  using 𝒜 t
  proof (induction 𝒜 rule: reachable_constraints.induct)
    case (step A T ξ σ α) thus ?case
    proof (cases "t ∈ subtermsset (iklsst A)")
      case False
      hence "t ∈ subtermsset (iklsst (duallsst (transaction_strand T ⋅lsst ξ ∘s σ ∘s α)))"
        using step.prems by simp
      hence "t ∈ subtermsset (trmslsst (transaction_send T) ⋅set ξ ∘s σ ∘s α)"
        using dual_transaction_ik_is_transaction_send'[OF T_wf[OF step.hyps(2)]]
        by metis
      hence "t ∈ subtermsset (trmslsst (transaction_send T)) ⋅set ξ ∘s σ ∘s α"
        using transaction_decl_fresh_renaming_substs_trms[
                OF step.hyps(3-5), of "transaction_send T"]
              wellformed_transaction_unlabel_cases(4)[OF T_wf[OF step.hyps(2)]]
        by fastforce
      then obtain s where s: "s ∈ subtermsset (trmslsst (transaction_send T))" "t = s ⋅ ξ ∘s σ ∘s α"
        by force
      hence s': "attack⟨n⟩ ∉ set (snd (Ana s))"
        using admissible_transaction_no_Ana_Attack[OF T_adm_term[OF step.hyps(2)]]
              trms_transaction_unfold[of T]
        by blast

      note * = transaction_decl_fresh_renaming_substs_range'(1-3)[OF step.hyps(3-5)]
               transaction_decl_fresh_renaming_substs_range_no_attack_const[
                 OF step.hyps(3-5) T_fresh[OF step.hyps(2)]]

      show ?thesis
      proof
        assume n: "attack⟨n⟩ ∈ set (snd (Ana t))"
        thus False
        proof (cases s)
          case (Var x)
          hence "(∃c. t = Fun c []) ∨ (∃y. t = Var y)"
            using *(1)[of t] n s(2) by (force simp del: subst_subst_compose)
          thus ?thesis using n Ana_subterm' by fastforce
        next
          case (Fun f S)
          hence "attack⟨n⟩ ∈ set (snd (Ana s)) ⋅set ξ ∘s σ ∘s α"
            using Ana_subst'[of f S _ "snd (Ana s)" "ξ ∘s σ ∘s α"] s(2) s' n
            by (cases "Ana s") auto
          hence "attack⟨n⟩ ∈ set (snd (Ana s)) ∨ attack⟨n⟩ ∈ subst_range (ξ ∘s σ ∘s α)"
            using const_mem_subst_cases' by fast
          thus ?thesis using *(4) s' by fast
        qed
      qed
    qed simp
  qed simp
qed

lemma reachable_constraints_receive_attack_if_attack:
  assumes 𝒜: "𝒜 ∈ reachable_constraints P"
    and P: "∀T ∈ set P. wellformed_transaction T"
           "∀T ∈ set P. admissible_transaction_terms T"
           "∀T ∈ set P. ∀x ∈ set (transaction_fresh T).
              Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
           "∀T ∈ set P. ∀x ∈ vars_transaction T. ¬TAtom AttackType ⊑ Γv x"
    and ℐ: "welltyped_constraint_model ℐ 𝒜"
    and l: "iklsst 𝒜 ⋅set ℐ ⊢ attack⟨l⟩"
  shows "attack⟨l⟩ ∈ iklsst 𝒜 ⋅set ℐ"
    and "receive⟨[attack⟨l⟩]⟩ ∈ set (unlabel 𝒜)"
    and "∀T ∈ set P. ∀s ∈ set (transaction_strand T).
              is_Send (snd s) ∧ length (the_msgs (snd s)) = 1 ∧
              is_Fun_Attack (hd (the_msgs (snd s)))
              ⟶ the_Attack_label (the_Fun (hd (the_msgs (snd s)))) = fst s
         ⟹ (l,receive⟨[attack⟨l⟩]⟩) ∈ set 𝒜" (is "?Q ⟹ (l,receive⟨[attack⟨l⟩]⟩) ∈ set 𝒜")
proof -
  have ℐ': "constr_sem_stateful ℐ (unlabel 𝒜)" "interpretationsubst ℐ"
           "wftrms (subst_range ℐ)" "wtsubst ℐ"
    using ℐ unfolding welltyped_constraint_model_def constraint_model_def by metis+

  have 0: "wftrms (iklsst 𝒜 ⋅set ℐ)"
    when 𝒜: "𝒜 ∈ reachable_constraints P" for 𝒜
    using reachable_constraints_wftrms[OF _ 𝒜] admissible_transaction_terms_wftrms P(2)
          iksst_trmssst_subset[of "unlabel 𝒜"] wf_trms_subst[OF ℐ'(3)]
    by fast

  have 1: "∀x ∈ fvset (iklsst 𝒜). ¬TAtom AttackType ⊑ Γv x"
    when 𝒜: "𝒜 ∈ reachable_constraints P" for 𝒜
    using reachable_constraints_vars_not_attack_typed[OF 𝒜 P(3,4)]
          fv_ik_subset_vars_sst'[of "unlabel 𝒜"]
    by fast

  have 2: "attack⟨l⟩ ∉ set (snd (Ana t)) ⋅set ℐ" when t: "t ∈ subtermsset (iklsst 𝒜)" for t
  proof
    assume "attack⟨l⟩ ∈ set (snd (Ana t)) ⋅set ℐ"
    then obtain s where s: "s ∈ set (snd (Ana t))" "s ⋅ ℐ = attack⟨l⟩" by force

    obtain x where x: "s = Var x"
      by (cases s) (use s reachable_constraints_no_Ana_attack[OF 𝒜 P(1-3) t] in auto)

    have "x ∈ fv t" using x Ana_subterm'[OF s(1)] vars_iff_subtermeq by force
    hence "x ∈ fvset (iklsst 𝒜)" using t fv_subterms by fastforce
    hence "Γv x ≠ TAtom AttackType" using 1[OF 𝒜] by fastforce
    thus False using s(2) x wt_subst_trm''[OF ℐ'(4), of "Var x"] by fastforce
  qed

  have 3: "attack⟨l⟩ ∉ set (snd (Ana t))" when t: "t ∈ subtermsset (iklsst 𝒜 ⋅set ℐ)" for t
  proof
    assume "attack⟨l⟩ ∈ set (snd (Ana t))"
    then obtain s where s:
        "s ∈ subtermsset (ℐ ` fvset (iklsst 𝒜))" "attack⟨l⟩ ∈ set (snd (Ana s))"
      using Ana_subst_subterms_cases[OF t] 2 by fast
    then obtain x where x: "x ∈ fvset (iklsst 𝒜)" "s ⊑ ℐ x" by force
    hence "ℐ x ∈ subtermsset (iklsst 𝒜 ⋅set ℐ)"
      using var_is_subterm[of x] subterms_subst_subset'[of ℐ "iklsst 𝒜"]
      by force
    hence *: "wftrm (ℐ x)" "wftrm s"
      using wf_trms_subterms[OF 0[OF 𝒜]] wf_trm_subtermeq[OF _ x(2)]
      by auto

    show False
      using term.order_trans[
              OF subtermeq_imp_subtermtypeeq[OF *(2) Ana_subterm'[OF s(2)]]
                 subtermeq_imp_subtermtypeeq[OF *(1) x(2)]]
            1[OF 𝒜] x(1) wt_subst_trm''[OF ℐ'(4), of "Var x"]
      by force
  qed

  have 4: "t = attack⟨n⟩"
    when t: "t ⋅ ξ ∘s σ ∘s α = attack⟨n⟩"
      and hyps: "transaction_decl_subst ξ T"
                "transaction_fresh_subst σ T (trmslsst 𝒜)"
                "transaction_renaming_subst α P (varslsst 𝒜)"
      and T: "∀x ∈ set (transaction_fresh T). Γv x = TAtom Value ∨ (∃a. Γv x = TAtom (Atom a))"
    for t n
      and T::"('fun, 'atom, 'sets, 'lbl) prot_transaction"
      and ξ σ α::"('fun, 'atom, 'sets, 'lbl)