(*  Title:      HOL/HOLCF/IOA/CompoTraces.thy
    Author:     Olaf Müller
*)

section \<open>Compositionality on Trace level\<close>

theory CompoTraces
imports CompoScheds ShortExecutions
begin

definition mksch ::
    "('a, 's) ioa \<Rightarrow> ('a, 't) ioa \<Rightarrow> 'a Seq \<rightarrow> 'a Seq \<rightarrow> 'a Seq \<rightarrow> 'a Seq"
  where "mksch A B =
    (fix \<cdot>
      (LAM h tr schA schB.
        case tr of
          nil \<Rightarrow> nil
        | x ## xs \<Rightarrow>
            (case x of
              UU \<Rightarrow> UU
            | Def y \<Rightarrow>
                (if y \<in> act A then
                  (if y \<in> act B then
                    ((Takewhile (\<lambda>a. a \<in> int A) \<cdot> schA) @@
                     (Takewhile (\<lambda>a. a \<in> int B) \<cdot> schB) @@
                     (y \<leadsto> (h \<cdot> xs \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int A) \<cdot> schA))
                                   \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int B) \<cdot> schB)))))
                   else
                    ((Takewhile (\<lambda>a. a \<in> int A) \<cdot> schA) @@
                     (y \<leadsto> (h \<cdot> xs \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int A) \<cdot> schA)) \<cdot> schB))))
                 else
                  (if y \<in> act B then
                    ((Takewhile (\<lambda>a. a \<in> int B) \<cdot> schB) @@
                     (y \<leadsto> (h \<cdot> xs \<cdot> schA \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int B) \<cdot> schB)))))
                   else UU)))))"

definition par_traces :: "'a trace_module \<Rightarrow> 'a trace_module \<Rightarrow> 'a trace_module"
  where "par_traces TracesA TracesB =
    (let
      trA = fst TracesA; sigA = snd TracesA;
      trB = fst TracesB; sigB = snd TracesB
     in
       ({tr. Filter (\<lambda>a. a \<in> actions sigA) \<cdot> tr \<in> trA} \<inter>
        {tr. Filter (\<lambda>a. a \<in> actions sigB) \<cdot> tr \<in> trB} \<inter>
        {tr. Forall (\<lambda>x. x \<in> externals sigA \<union> externals sigB) tr},
        asig_comp sigA sigB))"

axiomatization where
  finiteR_mksch: "Finite (mksch A B \<cdot> tr \<cdot> x \<cdot> y) \<Longrightarrow> Finite tr"

lemma finiteR_mksch': "\<not> Finite tr \<Longrightarrow> \<not> Finite (mksch A B \<cdot> tr \<cdot> x \<cdot> y)"
  by (blast intro: finiteR_mksch)

declaration \<open>fn _ => Simplifier.map_ss (Simplifier.set_mksym (K (K NONE)))\<close>

subsection "mksch rewrite rules"

lemma mksch_unfold:
  "mksch A B =
    (LAM tr schA schB.
      case tr of
        nil \<Rightarrow> nil
      | x ## xs \<Rightarrow>
          (case x of
            UU \<Rightarrow> UU
          | Def y \<Rightarrow>
              (if y \<in> act A then
                (if y \<in> act B then
                  ((Takewhile (\<lambda>a. a \<in> int A) \<cdot> schA) @@
                   (Takewhile (\<lambda>a. a \<in> int B) \<cdot> schB) @@
                   (y \<leadsto> (mksch A B \<cdot> xs \<cdot>(TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int A) \<cdot> schA))
                                         \<cdot>(TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int B) \<cdot> schB)))))
                 else
                  ((Takewhile (\<lambda>a. a \<in> int A) \<cdot> schA) @@
                   (y \<leadsto> (mksch A B \<cdot> xs \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int A) \<cdot> schA)) \<cdot> schB))))
               else
                (if y \<in> act B then
                  ((Takewhile (\<lambda>a. a \<in> int B) \<cdot> schB) @@
                   (y \<leadsto> (mksch A B \<cdot> xs \<cdot> schA \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int B) \<cdot> schB)))))
                 else UU))))"
  apply (rule trans)
  apply (rule fix_eq4)
  apply (rule mksch_def)
  apply (rule beta_cfun)
  apply simp
  done

lemma mksch_UU: "mksch A B \<cdot> UU \<cdot> schA \<cdot> schB = UU"
  apply (subst mksch_unfold)
  apply simp
  done

lemma mksch_nil: "mksch A B \<cdot> nil \<cdot> schA \<cdot> schB = nil"
  apply (subst mksch_unfold)
  apply simp
  done

lemma mksch_cons1:
  "x \<in> act A \<Longrightarrow> x \<notin> act B \<Longrightarrow>
    mksch A B \<cdot> (x \<leadsto> tr) \<cdot> schA \<cdot> schB =
      (Takewhile (\<lambda>a. a \<in> int A) \<cdot> schA) @@
      (x \<leadsto> (mksch A B \<cdot> tr \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int A) \<cdot> schA)) \<cdot> schB))"
  apply (rule trans)
  apply (subst mksch_unfold)
  apply (simp add: Consq_def If_and_if)
  apply (simp add: Consq_def)
  done

lemma mksch_cons2:
  "x \<notin> act A \<Longrightarrow> x \<in> act B \<Longrightarrow>
    mksch A B \<cdot> (x \<leadsto> tr) \<cdot> schA \<cdot> schB =
      (Takewhile (\<lambda>a. a \<in> int B) \<cdot> schB) @@
      (x \<leadsto> (mksch A B \<cdot> tr \<cdot> schA \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int B) \<cdot> schB))))"
  apply (rule trans)
  apply (subst mksch_unfold)
  apply (simp add: Consq_def If_and_if)
  apply (simp add: Consq_def)
  done

lemma mksch_cons3:
  "x \<in> act A \<Longrightarrow> x \<in> act B \<Longrightarrow>
    mksch A B \<cdot> (x \<leadsto> tr) \<cdot> schA \<cdot> schB =
      (Takewhile (\<lambda>a. a \<in> int A) \<cdot> schA) @@
      ((Takewhile (\<lambda>a. a \<in> int B) \<cdot> schB) @@
      (x \<leadsto> (mksch A B \<cdot> tr \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int A) \<cdot> schA))
                            \<cdot> (TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int B) \<cdot> schB)))))"
  apply (rule trans)
  apply (subst mksch_unfold)
  apply (simp add: Consq_def If_and_if)
  apply (simp add: Consq_def)
  done

lemmas compotr_simps = mksch_UU mksch_nil mksch_cons1 mksch_cons2 mksch_cons3

declare compotr_simps [simp]

subsection \<open>COMPOSITIONALITY on TRACE Level\<close>

subsubsection "Lemmata for \<open>\<Longrightarrow>\<close>"

text \<open>
  Consequence out of \<open>ext1_ext2_is_not_act1(2)\<close>, which in turn are
  consequences out of the compatibility of IOA, in particular out of the
  condition that internals are really hidden.
\<close>

lemma compatibility_consequence1: "(eB \<and> \<not> eA \<longrightarrow> \<not> A) \<longrightarrow> A \<and> (eA \<or> eB) \<longleftrightarrow> eA \<and> A"
  by fast

(* very similar to above, only the commutativity of | is used to make a slight change *)
lemma compatibility_consequence2: "(eB \<and> \<not> eA \<longrightarrow> \<not> A) \<longrightarrow> A \<and> (eB \<or> eA) \<longleftrightarrow> eA \<and> A"
  by fast

subsubsection \<open>Lemmata for \<open>\<Longleftarrow>\<close>\<close>

(* Lemma for substitution of looping assumption in another specific assumption *)
lemma subst_lemma1: "f \<sqsubseteq> g x \<Longrightarrow> x = h x \<Longrightarrow> f \<sqsubseteq> g (h x)"
  by (erule subst)

(* Lemma for substitution of looping assumption in another specific assumption *)
lemma subst_lemma2: "(f x) = y \<leadsto> g \<Longrightarrow> x = h x \<Longrightarrow> f (h x) = y \<leadsto> g"
  by (erule subst)

lemma ForallAorB_mksch [rule_format]:
  "compatible A B \<Longrightarrow>
    \<forall>schA schB. Forall (\<lambda>x. x \<in> act (A \<parallel> B)) tr \<longrightarrow>
      Forall (\<lambda>x. x \<in> act (A \<parallel> B)) (mksch A B \<cdot> tr \<cdot> schA \<cdot> schB)"
  apply (Seq_induct tr simp: Forall_def sforall_def mksch_def)
  apply auto
  apply (simp add: actions_of_par)
  apply (case_tac "a \<in> act A")
  apply (case_tac "a \<in> act B")
  text \<open>\<open>a \<in> A\<close>, \<open>a \<in> B\<close>\<close>
  apply simp
  apply (rule Forall_Conc_impl [THEN mp])
  apply (simp add: intA_is_not_actB int_is_act)
  apply (rule Forall_Conc_impl [THEN mp])
  apply (simp add: intA_is_not_actB int_is_act)
  text \<open>\<open>a \<in> A\<close>, \<open>a \<notin> B\<close>\<close>
  apply simp
  apply (rule Forall_Conc_impl [THEN mp])
  apply (simp add: intA_is_not_actB int_is_act)
  apply (case_tac "a\<in>act B")
  text \<open>\<open>a \<notin> A\<close>, \<open>a \<in> B\<close>\<close>
  apply simp
  apply (rule Forall_Conc_impl [THEN mp])
  apply (simp add: intA_is_not_actB int_is_act)
  text \<open>\<open>a \<notin> A\<close>, \<open>a \<notin> B\<close>\<close>
  apply auto
  done

lemma ForallBnAmksch [rule_format]:
  "compatible B A \<Longrightarrow>
    \<forall>schA schB. Forall (\<lambda>x. x \<in> act B \<and> x \<notin> act A) tr \<longrightarrow>
      Forall (\<lambda>x. x \<in> act B \<and> x \<notin> act A) (mksch A B \<cdot> tr \<cdot> schA \<cdot> schB)"
  apply (Seq_induct tr simp: Forall_def sforall_def mksch_def)
  apply auto
  apply (rule Forall_Conc_impl [THEN mp])
  apply (simp add: intA_is_not_actB int_is_act)
  done

lemma ForallAnBmksch [rule_format]:
  "compatible A B \<Longrightarrow>
    \<forall>schA schB. Forall (\<lambda>x. x \<in> act A \<and> x \<notin> act B) tr \<longrightarrow>
      Forall (\<lambda>x. x \<in> act A \<and> x \<notin> act B) (mksch A B \<cdot> tr \<cdot> schA \<cdot> schB)"
  apply (Seq_induct tr simp: Forall_def sforall_def mksch_def)
  apply auto
  apply (rule Forall_Conc_impl [THEN mp])
  apply (simp add: intA_is_not_actB int_is_act)
  done

(* safe_tac makes too many case distinctions with this lemma in the next proof *)
declare FiniteConc [simp del]

lemma FiniteL_mksch [rule_format]:
  "Finite tr \<Longrightarrow> is_asig (asig_of A) \<Longrightarrow> is_asig (asig_of B) \<Longrightarrow>
    \<forall>x y.
      Forall (\<lambda>x. x \<in> act A) x \<and> Forall (\<lambda>x. x \<in> act B) y \<and>
      Filter (\<lambda>a. a \<in> ext A) \<cdot> x = Filter (\<lambda>a. a \<in> act A) \<cdot> tr \<and>
      Filter (\<lambda>a. a \<in> ext B) \<cdot> y = Filter (\<lambda>a. a \<in> act B) \<cdot> tr \<and>
      Forall (\<lambda>x. x \<in> ext (A \<parallel> B)) tr \<longrightarrow> Finite (mksch A B \<cdot> tr \<cdot> x \<cdot> y)"
  apply (erule Seq_Finite_ind)
  apply simp
  text \<open>main case\<close>
  apply simp
  apply auto

  text \<open>\<open>a \<in> act A\<close>; \<open>a \<in> act B\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])
  back
  apply (erule conjE)+
  text \<open>\<open>Finite (tw iA x)\<close> and \<open>Finite (tw iB y)\<close>\<close>
  apply (simp add: not_ext_is_int_or_not_act FiniteConc)
  text \<open>now for conclusion IH applicable, but assumptions have to be transformed\<close>
  apply (drule_tac x = "x" and g = "Filter (\<lambda>a. a \<in> act A) \<cdot> s" in subst_lemma2)
  apply assumption
  apply (drule_tac x = "y" and g = "Filter (\<lambda>a. a \<in> act B) \<cdot> s" in subst_lemma2)
  apply assumption
  text \<open>IH\<close>
  apply (simp add: not_ext_is_int_or_not_act ForallTL ForallDropwhile)

  text \<open>\<open>a \<in> act B\<close>; \<open>a \<notin> act A\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])

  apply (erule conjE)+
  text \<open>\<open>Finite (tw iB y)\<close>\<close>
  apply (simp add: not_ext_is_int_or_not_act FiniteConc)
  text \<open>now for conclusion IH applicable, but assumptions have to be transformed\<close>
  apply (drule_tac x = "y" and g = "Filter (\<lambda>a. a \<in> act B) \<cdot> s" in subst_lemma2)
  apply assumption
  text \<open>IH\<close>
  apply (simp add: not_ext_is_int_or_not_act ForallTL ForallDropwhile)

  text \<open>\<open>a \<notin> act B\<close>; \<open>a \<in> act A\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])

  apply (erule conjE)+
  text \<open>\<open>Finite (tw iA x)\<close>\<close>
  apply (simp add: not_ext_is_int_or_not_act FiniteConc)
  text \<open>now for conclusion IH applicable, but assumptions have to be transformed\<close>
  apply (drule_tac x = "x" and g = "Filter (\<lambda>a. a \<in> act A) \<cdot> s" in subst_lemma2)
  apply assumption
  text \<open>IH\<close>
  apply (simp add: not_ext_is_int_or_not_act ForallTL ForallDropwhile)

  text \<open>\<open>a \<notin> act B\<close>; \<open>a \<notin> act A\<close>\<close>
  apply (fastforce intro!: ext_is_act simp: externals_of_par)
  done

declare FiniteConc [simp]

declare FilterConc [simp del]

lemma reduceA_mksch1 [rule_format]:
  "Finite bs \<Longrightarrow> is_asig (asig_of A) \<Longrightarrow> is_asig (asig_of B) \<Longrightarrow> compatible A B \<Longrightarrow>
    \<forall>y. Forall (\<lambda>x. x \<in> act B) y \<and> Forall (\<lambda>x. x \<in> act B \<and> x \<notin> act A) bs \<and>
      Filter (\<lambda>a. a \<in> ext B) \<cdot> y = Filter (\<lambda>a. a \<in> act B) \<cdot> (bs @@ z) \<longrightarrow>
      (\<exists>y1 y2.
        (mksch A B \<cdot> (bs @@ z) \<cdot> x \<cdot> y) = (y1 @@ (mksch A B \<cdot> z \<cdot> x \<cdot> y2)) \<and>
        Forall (\<lambda>x. x \<in> act B \<and> x \<notin> act A) y1 \<and>
        Finite y1 \<and> y = (y1 @@ y2) \<and>
        Filter (\<lambda>a. a \<in> ext B) \<cdot> y1 = bs)"
  apply (frule_tac A1 = "A" in compat_commute [THEN iffD1])
  apply (erule Seq_Finite_ind)
  apply (rule allI)+
  apply (rule impI)
  apply (rule_tac x = "nil" in exI)
  apply (rule_tac x = "y" in exI)
  apply simp
  text \<open>main case\<close>
  apply (rule allI)+
  apply (rule impI)
  apply simp
  apply (erule conjE)+
  apply simp
  text \<open>\<open>divide_Seq\<close> on \<open>s\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])
  apply (erule conjE)+
  text \<open>transform assumption \<open>f eB y = f B (s @ z)\<close>\<close>
  apply (drule_tac x = "y" and g = "Filter (\<lambda>a. a \<in> act B) \<cdot> (s @@ z) " in subst_lemma2)
  apply assumption
  apply (simp add: not_ext_is_int_or_not_act FilterConc)
  text \<open>apply IH\<close>
  apply (erule_tac x = "TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int B) \<cdot> y)" in allE)
  apply (simp add: ForallTL ForallDropwhile FilterConc)
  apply (erule exE)+
  apply (erule conjE)+
  apply (simp add: FilterConc)
  text \<open>for replacing IH in conclusion\<close>
  apply (rotate_tac -2)
  text \<open>instantiate \<open>y1a\<close> and \<open>y2a\<close>\<close>
  apply (rule_tac x = "Takewhile (\<lambda>a. a \<in> int B) \<cdot> y @@ a \<leadsto> y1" in exI)
  apply (rule_tac x = "y2" in exI)
  text \<open>elminate all obligations up to two depending on \<open>Conc_assoc\<close>\<close>
  apply (simp add: intA_is_not_actB int_is_act int_is_not_ext FilterConc)
  apply (simp add: Conc_assoc FilterConc)
  done

lemmas reduceA_mksch = conjI [THEN [6] conjI [THEN [5] reduceA_mksch1]]

lemma reduceB_mksch1 [rule_format]:
  "Finite a_s \<Longrightarrow> is_asig (asig_of A) \<Longrightarrow> is_asig (asig_of B) \<Longrightarrow> compatible A B \<Longrightarrow>
    \<forall>x. Forall (\<lambda>x. x \<in> act A) x \<and> Forall (\<lambda>x. x \<in> act A \<and> x \<notin> act B) a_s \<and>
      Filter (\<lambda>a. a \<in> ext A) \<cdot> x = Filter (\<lambda>a. a \<in> act A) \<cdot> (a_s @@ z) \<longrightarrow>
      (\<exists>x1 x2.
        (mksch A B \<cdot> (a_s @@ z) \<cdot> x \<cdot> y) = (x1 @@ (mksch A B \<cdot> z \<cdot> x2 \<cdot> y)) \<and>
        Forall (\<lambda>x. x \<in> act A \<and> x \<notin> act B) x1 \<and>
        Finite x1 \<and> x = (x1 @@ x2) \<and>
        Filter (\<lambda>a. a \<in> ext A) \<cdot> x1 = a_s)"
  apply (frule_tac A1 = "A" in compat_commute [THEN iffD1])
  apply (erule Seq_Finite_ind)
  apply (rule allI)+
  apply (rule impI)
  apply (rule_tac x = "nil" in exI)
  apply (rule_tac x = "x" in exI)
  apply simp
  text \<open>main case\<close>
  apply (rule allI)+
  apply (rule impI)
  apply simp
  apply (erule conjE)+
  apply simp
  text \<open>\<open>divide_Seq\<close> on \<open>s\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])
  apply (erule conjE)+
  text \<open>transform assumption \<open>f eA x = f A (s @ z)\<close>\<close>
  apply (drule_tac x = "x" and g = "Filter (\<lambda>a. a \<in> act A) \<cdot> (s @@ z)" in subst_lemma2)
  apply assumption
  apply (simp add: not_ext_is_int_or_not_act FilterConc)
  text \<open>apply IH\<close>
  apply (erule_tac x = "TL \<cdot> (Dropwhile (\<lambda>a. a \<in> int A) \<cdot> x)" in allE)
  apply (simp add: ForallTL ForallDropwhile FilterConc)
  apply (erule exE)+
  apply (erule conjE)+
  apply (simp add: FilterConc)
  text \<open>for replacing IH in conclusion\<close>
  apply (rotate_tac -2)
  text \<open>instantiate \<open>y1a\<close> and \<open>y2a\<close>\<close>
  apply (rule_tac x = "Takewhile (\<lambda>a. a \<in> int A) \<cdot> x @@ a \<leadsto> x1" in exI)
  apply (rule_tac x = "x2" in exI)
  text \<open>eliminate all obligations up to two depending on \<open>Conc_assoc\<close>\<close>
  apply (simp add: intA_is_not_actB int_is_act int_is_not_ext FilterConc)
  apply (simp add: Conc_assoc FilterConc)
  done

lemmas reduceB_mksch = conjI [THEN [6] conjI [THEN [5] reduceB_mksch1]]

declare FilterConc [simp]

subsection \<open>Filtering external actions out of \<open>mksch (tr, schA, schB)\<close> yields the oracle \<open>tr\<close>\<close>

lemma FilterA_mksch_is_tr:
  "compatible A B \<Longrightarrow> compatible B A \<Longrightarrow> is_asig (asig_of A) \<Longrightarrow> is_asig (asig_of B) \<Longrightarrow>
    \<forall>schA schB.
      Forall (\<lambda>x. x \<in> act A) schA \<and>
      Forall (\<lambda>x. x \<in> act B) schB \<and>
      Forall (\<lambda>x. x \<in> ext (A \<parallel> B)) tr \<and>
      Filter (\<lambda>a. a \<in> act A) \<cdot> tr \<sqsubseteq> Filter (\<lambda>a. a \<in> ext A) \<cdot> schA \<and>
      Filter (\<lambda>a. a \<in> act B) \<cdot> tr \<sqsubseteq> Filter (\<lambda>a. a \<in> ext B) \<cdot> schB
      \<longrightarrow> Filter (\<lambda>a. a \<in> ext (A \<parallel> B)) \<cdot> (mksch A B \<cdot> tr \<cdot> schA \<cdot> schB) = tr"
  apply (Seq_induct tr simp: Forall_def sforall_def mksch_def)
  text \<open>main case\<close>
  text \<open>splitting into 4 cases according to \<open>a \<in> A\<close>, \<open>a \<in> B\<close>\<close>
  apply auto

  text \<open>Case \<open>a \<in> A\<close>, \<open>a \<in> B\<close>\<close>
  apply (frule divide_Seq)
  apply (frule divide_Seq)
  back
  apply (erule conjE)+
  text \<open>filtering internals of \<open>A\<close> in \<open>schA\<close> and of \<open>B\<close> in \<open>schB\<close> is \<open>nil\<close>\<close>
  apply (simp add: not_ext_is_int_or_not_act externals_of_par intA_is_not_extB int_is_not_ext)
  text \<open>conclusion of IH ok, but assumptions of IH have to be transformed\<close>
  apply (drule_tac x = "schA" in subst_lemma1)
  apply assumption
  apply (drule_tac x = "schB" in subst_lemma1)
  apply assumption
  text \<open>IH\<close>
  apply (simp add: not_ext_is_int_or_not_act ForallTL ForallDropwhile)

  text \<open>Case \<open>a \<in> A\<close>, \<open>a \<notin> B\<close>\<close>
  apply (frule divide_Seq)
  apply (erule conjE)+
  text \<open>filtering internals of \<open>A\<close> is \<open>nil\<close>\<close>
  apply (simp add: not_ext_is_int_or_not_act externals_of_par intA_is_not_extB int_is_not_ext)
  apply (drule_tac x = "schA" in subst_lemma1)
  apply assumption
  apply (simp add: not_ext_is_int_or_not_act ForallTL ForallDropwhile)

  text \<open>Case \<open>a \<in> B\<close>, \<open>a \<notin> A\<close>\<close>
  apply (frule divide_Seq)
  apply (erule conjE)+
  text \<open>filtering internals of \<open>A\<close> is \<open>nil\<close>\<close>
  apply (simp add: not_ext_is_int_or_not_act externals_of_par intA_is_not_extB int_is_not_ext)
  apply (drule_tac x = "schB" in subst_lemma1)
  back
  apply assumption
  apply (simp add: not_ext_is_int_or_not_act ForallTL ForallDropwhile)

  text \<open>Case \<open>a \<notin> A\<close>, \<open>a \<notin> B\<close>\<close>
  apply (fastforce intro!: ext_is_act simp: externals_of_par)
  done

subsection" Filter of mksch(tr,schA,schB) to A is schA -- take lemma proof"

lemma FilterAmksch_is_schA:
  "compatible A B \<Longrightarrow> compatible B A \<Longrightarrow> is_asig (asig_of A) \<Longrightarrow> is_asig (asig_of B) \<Longrightarrow>
    Forall (\<lambda>x. x \<in> ext (A \<parallel> B)) tr \<and>
    Forall (\<lambda>x. x \<in> act A) schA \<and>
    Forall (\<lambda>x. x \<in> act B) schB \<and>
    Filter (\<lambda>a. a \<in> ext A) \<cdot> schA = Filter (\<lambda>a. a \<in> act A) \<cdot> tr \<and>
    Filter (\<lambda>a. a \<in> ext B) \<cdot> schB = Filter (\<lambda>a. a \<in> act B) \<cdot> tr \<and>
    LastActExtsch A schA \<and> LastActExtsch B schB
    \<longrightarrow> Filter (\<lambda>a. a \<in> act A) \<cdot> (mksch A B \<cdot> tr \<cdot> schA \<cdot> schB) = schA"
  apply (intro strip)
  apply (rule seq.take_lemma)
  apply (rule mp)
  prefer 2 apply assumption
  back back back back
  apply (rule_tac x = "schA" in spec)
  apply (rule_tac x = "schB" in spec)
  apply (rule_tac x = "tr" in spec)
  apply (tactic "thin_tac' \<^context> 5 1")
  apply (rule nat_less_induct)
  apply (rule allI)+
  apply (rename_tac tr schB schA)
  apply (intro strip)
  apply (erule conjE)+

  apply (case_tac "Forall (\<lambda>x. x \<in> act B \<and> x \<notin> act A) tr")

  apply (rule seq_take_lemma [THEN iffD2, THEN spec])
  apply (tactic "thin_tac' \<^context> 5 1")

  apply (case_tac "Finite tr")

  text \<open>both sides of this equation are \<open>nil\<close>\<close>
  apply (subgoal_tac "schA = nil")
  apply simp
  text \<open>first side: \<open>mksch = nil\<close>\<close>
  apply (auto intro!: ForallQFilterPnil ForallBnAmksch FiniteL_mksch)[1]
  text \<open>second side: \<open>schA = nil\<close>\<close>
  apply (erule_tac A = "A" in LastActExtimplnil)
  apply simp
  apply (erule_tac Q = "\<lambda>x. x \<in> act B \<and> x \<notin> act A" in ForallQFilterPnil)
  apply assumption
  apply fast

  text \<open>case \<open>\<not> Finite s\<close>\<close>

  text \<open>both sides of this equation are \<open>UU\<close>\<close>
  apply (subgoal_tac "schA = UU")
  apply simp
  text \<open>first side: \<open>mksch = UU\<close>\<close>
  apply (auto intro!: ForallQFilterPUU finiteR_mksch' ForallBnAmksch)[1]
  text \<open>\<open>schA = UU\<close>\<close>
  apply (erule_tac A = "A" in LastActExtimplUU)
  apply simp
  apply (erule_tac Q = "\<lambda>x. x \<in> act B \<and> x \<notin> act A" in ForallQFilterPUU)
  apply assumption
  apply fast

  text \<open>case \<open>\<not> Forall (\<lambda>x. x \<in> act B \<and> x \<notin> act A) s\<close>\<close>

  apply (drule divide_Seq3)

  apply (erule exE)+
  apply (erule conjE)+
  apply hypsubst

  text \<open>bring in lemma \<open>reduceA_mksch\<close>\<close>
  apply (frule_tac x = "schA" and y = "schB" and A = "A" and B = "B" in reduceA_mksch)
  apply assumption+
  apply (erule exE)+
  apply (erule conjE)+

  text \<open>use \<open>reduceA_mksch\<close> to rewrite conclusion\<close>
  apply hypsubst
  apply simp

  text \<open>eliminate the \<open>B\<close>-only prefix\<close>

  apply (subgoal_tac "(Filter (\<lambda>a. a \<in> act A) \<cdot> y1) = nil")
  apply (erule_tac [2] ForallQFilterPnil)
  prefer 2 apply assumption
  prefer 2 apply fast

  text \<open>Now real recursive step follows (in \<open>y\<close>)\<close>

  apply simp
  apply (case_tac "x \<in> act A")
  apply (case_tac "x \<notin> act B")
  apply (rotate_tac -2)
  apply simp

  apply (subgoal_tac "Filter (\<lambda>a. a \<in> act A \<and> a \<in> ext B) \<cdot> y1 = nil")
  apply (rotate_tac -1)
  apply simp
  text \<open>eliminate introduced subgoal 2\<close>
  apply (erule_tac [2] ForallQFilterPnil)
  prefer 2 apply assumption
  prefer 2 apply fast

  text \<open>bring in \<open>divide_Seq\<close> for \<open>s\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])
  apply (erule conjE)+

  text \<open>subst \<open>divide_Seq\<close> in conclusion, but only at the rightest occurrence\<close>
  apply (rule_tac t = "schA" in ssubst)
  back
  back
  back
  apply assumption

  text \<open>reduce trace_takes from \<open>n\<close> to strictly smaller \<open>k\<close>\<close>
  apply (rule take_reduction)

  text \<open>\<open>f A (tw iA) = tw \<not> eA\<close>\<close>
  apply (simp add: int_is_act not_ext_is_int_or_not_act)
  apply (rule refl)
  apply (simp add: int_is_act not_ext_is_int_or_not_act)
  apply (rotate_tac -11)

  text \<open>now conclusion fulfills induction hypothesis, but assumptions are not ready\<close>

  text \<open>assumption \<open>Forall tr\<close>\<close>
  text \<open>assumption \<open>schB\<close>\<close>
  apply (simp add: ext_and_act)
  text \<open>assumption \<open>schA\<close>\<close>
  apply (drule_tac x = "schA" and g = "Filter (\<lambda>a. a \<in> act A) \<cdot> rs" in subst_lemma2)
  apply assumption
  apply (simp add: int_is_not_ext)
  text \<open>assumptions concerning \<open>LastActExtsch\<close>, cannot be rewritten, as \<open>LastActExtsmalli\<close> are looping\<close>
  apply (drule_tac sch = "schA" and P = "\<lambda>a. a \<in> int A" in LastActExtsmall1)
  apply (frule_tac ?sch1.0 = "y1" in LastActExtsmall2)
  apply assumption

  text \<open>assumption \<open>Forall schA\<close>\<close>
  apply (drule_tac s = "schA" and P = "Forall (\<lambda>x. x \<in> act A) " in subst)
  apply assumption
  apply (simp add: int_is_act)

  text \<open>case \<open>x \<in> actions (asig_of A) \<and> x \<in> actions (asig_of B)\<close>\<close>

  apply (rotate_tac -2)
  apply simp

  apply (subgoal_tac "Filter (\<lambda>a. a \<in> act A \<and> a \<in> ext B) \<cdot> y1 = nil")
  apply (rotate_tac -1)
  apply simp
  text \<open>eliminate introduced subgoal 2\<close>
  apply (erule_tac [2] ForallQFilterPnil)
  prefer 2 apply assumption
  prefer 2 apply fast

  text \<open>bring in \<open>divide_Seq\<close> for \<open>s\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])
  apply (erule conjE)+

  text \<open>subst \<open>divide_Seq\<close> in conclusion, but only at the rightmost occurrence\<close>
  apply (rule_tac t = "schA" in ssubst)
  back
  back
  back
  apply assumption

  text \<open>\<open>f A (tw iA) = tw \<not> eA\<close>\<close>
  apply (simp add: int_is_act not_ext_is_int_or_not_act)

  text \<open>rewrite assumption forall and \<open>schB\<close>\<close>
  apply (rotate_tac 13)
  apply (simp add: ext_and_act)

  text \<open>\<open>divide_Seq\<close> for \<open>schB2\<close>\<close>
  apply (frule_tac y = "y2" in sym [THEN eq_imp_below, THEN divide_Seq])
  apply (erule conjE)+
  text \<open>assumption \<open>schA\<close>\<close>
  apply (drule_tac x = "schA" and g = "Filter (\<lambda>a. a\<in>act A) \<cdot>rs" in subst_lemma2)
  apply assumption
  apply (simp add: int_is_not_ext)

  text \<open>\<open>f A (tw iB schB2) = nil\<close>\<close>
  apply (simp add: int_is_not_ext not_ext_is_int_or_not_act intA_is_not_actB)

  text \<open>reduce trace_takes from \<open>n\<close> to strictly smaller \<open>k\<close>\<close>
  apply (rule take_reduction)
  apply (rule refl)
  apply (rule refl)

  text \<open>now conclusion fulfills induction hypothesis, but assumptions are not all ready\<close>

  text \<open>assumption \<open>schB\<close>\<close>
  apply (drule_tac x = "y2" and g = "Filter (\<lambda>a. a \<in> act B) \<cdot> rs" in subst_lemma2)
  apply assumption
  apply (simp add: intA_is_not_actB int_is_not_ext)

  text \<open>conclusions concerning \<open>LastActExtsch\<close>, cannot be rewritten, as \<open>LastActExtsmalli\<close> are looping\<close>
  apply (drule_tac sch = "schA" and P = "\<lambda>a. a \<in> int A" in LastActExtsmall1)
  apply (frule_tac ?sch1.0 = "y1" in LastActExtsmall2)
  apply assumption
  apply (drule_tac sch = "y2" and P = "\<lambda>a. a \<in> int B" in LastActExtsmall1)

  text \<open>assumption \<open>Forall schA\<close>, and \<open>Forall schA\<close> are performed by \<open>ForallTL\<close>, \<open>ForallDropwhile\<close>\<close>
  apply (simp add: ForallTL ForallDropwhile)

  text \<open>case \<open>x \<notin> A \<and> x \<in> B\<close>\<close>
  text \<open>cannot occur, as just this case has been scheduled out before as the \<open>B\<close>-only prefix\<close>
  apply (case_tac "x \<in> act B")
  apply fast

  text \<open>case \<open>x \<notin> A \<and> x \<notin> B\<close>\<close>
  text \<open>cannot occur because of assumption: \<open>Forall (a \<in> ext A \<or> a \<in> ext B)\<close>\<close>
  apply (rotate_tac -9)
  text \<open>reduce forall assumption from \<open>tr\<close> to \<open>x \<leadsto> rs\<close>\<close>
  apply (simp add: externals_of_par)
  apply (fast intro!: ext_is_act)
  done

subsection \<open>Filter of \<open>mksch (tr, schA, schB)\<close> to \<open>B\<close> is \<open>schB\<close> -- take lemma proof\<close>

lemma FilterBmksch_is_schB:
  "compatible A B \<Longrightarrow> compatible B A \<Longrightarrow> is_asig (asig_of A) \<Longrightarrow> is_asig (asig_of B) \<Longrightarrow>
    Forall (\<lambda>x. x \<in> ext (A \<parallel> B)) tr \<and>
    Forall (\<lambda>x. x \<in> act A) schA \<and>
    Forall (\<lambda>x. x \<in> act B) schB \<and>
    Filter (\<lambda>a. a \<in> ext A) \<cdot> schA = Filter (\<lambda>a. a \<in> act A) \<cdot> tr \<and>
    Filter (\<lambda>a. a \<in> ext B) \<cdot> schB = Filter (\<lambda>a. a \<in> act B) \<cdot> tr \<and>
    LastActExtsch A schA \<and> LastActExtsch B schB
    \<longrightarrow> Filter (\<lambda>a. a \<in> act B) \<cdot> (mksch A B \<cdot> tr \<cdot> schA \<cdot> schB) = schB"
  apply (intro strip)
  apply (rule seq.take_lemma)
  apply (rule mp)
  prefer 2 apply assumption
  back back back back
  apply (rule_tac x = "schA" in spec)
  apply (rule_tac x = "schB" in spec)
  apply (rule_tac x = "tr" in spec)
  apply (tactic "thin_tac' \<^context> 5 1")
  apply (rule nat_less_induct)
  apply (rule allI)+
  apply (rename_tac tr schB schA)
  apply (intro strip)
  apply (erule conjE)+

  apply (case_tac "Forall (\<lambda>x. x \<in> act A \<and> x \<notin> act B) tr")

  apply (rule seq_take_lemma [THEN iffD2, THEN spec])
  apply (tactic "thin_tac' \<^context> 5 1")

  apply (case_tac "Finite tr")

  text \<open>both sides of this equation are \<open>nil\<close>\<close>
  apply (subgoal_tac "schB = nil")
  apply simp
  text \<open>first side: \<open>mksch = nil\<close>\<close>
  apply (auto intro!: ForallQFilterPnil ForallAnBmksch FiniteL_mksch)[1]
  text \<open>second side: \<open>schA = nil\<close>\<close>
  apply (erule_tac A = "B" in LastActExtimplnil)
  apply (simp (no_asm_simp))
  apply (erule_tac Q = "\<lambda>x. x \<in> act A \<and> x \<notin> act B" in ForallQFilterPnil)
  apply assumption
  apply fast

  text \<open>case \<open>\<not> Finite tr\<close>\<close>

  text \<open>both sides of this equation are \<open>UU\<close>\<close>
  apply (subgoal_tac "schB = UU")
  apply simp
  text \<open>first side: \<open>mksch = UU\<close>\<close>
  apply (force intro!: ForallQFilterPUU finiteR_mksch' ForallAnBmksch)
  text \<open>\<open>schA = UU\<close>\<close>
  apply (erule_tac A = "B" in LastActExtimplUU)
  apply simp
  apply (erule_tac Q = "\<lambda>x. x \<in> act A \<and> x \<notin> act B" in ForallQFilterPUU)
  apply assumption
  apply fast

  text \<open>case \<open>\<not> Forall (\<lambda>x. x \<in> act B \<and> x \<notin> act A) s\<close>\<close>

  apply (drule divide_Seq3)

  apply (erule exE)+
  apply (erule conjE)+
  apply hypsubst

  text \<open>bring in lemma \<open>reduceB_mksch\<close>\<close>
  apply (frule_tac y = "schB" and x = "schA" and A = "A" and B = "B" in reduceB_mksch)
  apply assumption+
  apply (erule exE)+
  apply (erule conjE)+

  text \<open>use \<open>reduceB_mksch\<close> to rewrite conclusion\<close>
  apply hypsubst
  apply simp

  text \<open>eliminate the \<open>A\<close>-only prefix\<close>

  apply (subgoal_tac "(Filter (\<lambda>a. a \<in> act B) \<cdot> x1) = nil")
  apply (erule_tac [2] ForallQFilterPnil)
  prefer 2 apply (assumption)
  prefer 2 apply (fast)

  text \<open>Now real recursive step follows (in \<open>x\<close>)\<close>

  apply simp
  apply (case_tac "x \<in> act B")
  apply (case_tac "x \<notin> act A")
  apply (rotate_tac -2)
  apply simp

  apply (subgoal_tac "Filter (\<lambda>a. a \<in> act B \<and> a \<in> ext A) \<cdot> x1 = nil")
  apply (rotate_tac -1)
  apply simp
  text \<open>eliminate introduced subgoal 2\<close>
  apply (erule_tac [2] ForallQFilterPnil)
  prefer 2 apply assumption
  prefer 2 apply fast

  text \<open>bring in \<open>divide_Seq\<close> for \<open>s\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])
  apply (erule conjE)+

  text \<open>subst \<open>divide_Seq\<close> in conclusion, but only at the rightmost occurrence\<close>
  apply (rule_tac t = "schB" in ssubst)
  back
  back
  back
  apply assumption

  text \<open>reduce \<open>trace_takes\<close> from \<open>n\<close> to strictly smaller \<open>k\<close>\<close>
  apply (rule take_reduction)

  text \<open>\<open>f B (tw iB) = tw \<not> eB\<close>\<close>
  apply (simp add: int_is_act not_ext_is_int_or_not_act)
  apply (rule refl)
  apply (simp add: int_is_act not_ext_is_int_or_not_act)
  apply (rotate_tac -11)

  text \<open>now conclusion fulfills induction hypothesis, but assumptions are not ready\<close>

  text \<open>assumption \<open>schA\<close>\<close>
  apply (simp add: ext_and_act)
  text \<open>assumption \<open>schB\<close>\<close>
  apply (drule_tac x = "schB" and g = "Filter (\<lambda>a. a \<in> act B) \<cdot> rs" in subst_lemma2)
  apply assumption
  apply (simp add: int_is_not_ext)
  text \<open>assumptions concerning \<open>LastActExtsch\<close>, cannot be rewritten, as \<open>LastActExtsmalli\<close> are looping\<close>
  apply (drule_tac sch = "schB" and P = "\<lambda>a. a \<in> int B" in LastActExtsmall1)
  apply (frule_tac ?sch1.0 = "x1" in LastActExtsmall2)
  apply assumption

  text \<open>assumption \<open>Forall schB\<close>\<close>
  apply (drule_tac s = "schB" and P = "Forall (\<lambda>x. x \<in> act B)" in subst)
  apply assumption
  apply (simp add: int_is_act)

  text \<open>case \<open>x \<in> actions (asig_of A) \<and> x \<in> actions (asig_of B)\<close>\<close>

  apply (rotate_tac -2)
  apply simp

  apply (subgoal_tac "Filter (\<lambda>a. a \<in> act B \<and> a \<in> ext A) \<cdot> x1 = nil")
  apply (rotate_tac -1)
  apply simp
  text \<open>eliminate introduced subgoal 2\<close>
  apply (erule_tac [2] ForallQFilterPnil)
  prefer 2 apply assumption
  prefer 2 apply fast

  text \<open>bring in \<open>divide_Seq\<close> for \<open>s\<close>\<close>
  apply (frule sym [THEN eq_imp_below, THEN divide_Seq])
  apply (erule conjE)+

  text \<open>subst \<open>divide_Seq\<close> in conclusion, but only at the rightmost occurrence\<close>
  apply (rule_tac t = "schB" in ssubst)
  back
  back
  back
  apply assumption

  text \<open>\<open>f B (tw iB) = tw \<not> eB\<close>\<close>
  apply (simp add: int_is_act not_ext_is_int_or_not_act)

  text \<open>rewrite assumption forall and \<open>schB\<close>\<close>
  apply (rotate_tac 13)
  apply (simp add: ext_and_act)

  text \<open>\<open>divide_Seq\<close> for \<open>schB2\<close>\<close>
  apply (frule_tac y = "x2" in sym [THEN eq_imp_below, THEN divide_Seq])
  apply (erule conjE)+
  text \<open>assumption \<open>schA\<close>\<close>
  apply (drule_tac x = "schB" and g = "Filter (\<lambda>a. a \<in> act B) \<cdot> rs" in subst_lemma2)
  apply assumption
  apply (simp add: int_is_not_ext)

  text \<open>\<open>f B (tw iA schA2) = nil\<close>\<close>
  apply (simp add: int_is_not_ext not_ext_is_int_or_not_act intA_is_not_actB)

  text \<open>reduce \<open>trace_takes from \<open>n\<close> to strictly smaller \<open>k\<close>\<close>\<close>
  apply (rule take_reduction)
  apply (rule refl)
  apply (rule refl)

  text \<open>now conclusion fulfills induction hypothesis, but assumptions are not all ready\<close>

  text \<open>assumption \<open>schA\<close>\<close>
  apply (drule_tac x = "x2" and g = "Filter (\<lambda>a. a \<in> act A) \<cdot> rs" in subst_lemma2)
  apply assumption
  apply (simp add: intA_is_not_actB int_is_not_ext)

  text \<open>conclusions concerning \<open>LastActExtsch\<close>, cannot be rewritten, as \<open>LastActExtsmalli\<close> are looping\<close>
  apply (drule_tac sch = "schB" and P = "\<lambda>a. a\<in>int B" in LastActExtsmall1)
  apply (frule_tac ?sch1.0 = "x1" in LastActExtsmall2)
  apply assumption
  apply (drule_tac sch = "x2" and P = "\<lambda>a. a\<in>int A" in LastActExtsmall1)

  text \<open>assumption \<open>Forall schA\<close>, and \<open>Forall schA\<close> are performed by \<open>ForallTL\<close>, \<open>ForallDropwhile\<close>\<close>
  apply (simp add: ForallTL ForallDropwhile)

  text \<open>case \<open>x \<notin> B \<and> x \<in> A\<close>\<close>
  text \<open>cannot occur, as just this case has been scheduled out before as the \<open>B\<close>-only prefix\<close>
  apply (case_tac "x \<in> act A")
  apply fast

  text \<open>case \<open>x \<notin> B \<and> x \<notin> A\<close>\<close>
  text \<open>cannot occur because of assumption: \<open>Forall (a \<in> ext A \<or> a \<in> ext B)\<close>\<close>
  apply (rotate_tac -9)
  text \<open>reduce forall assumption from \<open>tr\<close> to \<open>x \<leadsto> rs\<close>\<close>
  apply (simp add: externals_of_par)
  apply (fast intro!: ext_is_act)
  done

subsection "COMPOSITIONALITY on TRACE Level -- Main Theorem"

theorem compositionality_tr:
  "is_trans_of A \<Longrightarrow> is_trans_of B \<Longrightarrow> compatible A B \<Longrightarrow> compatible B A \<Longrightarrow>
    is_asig (asig_of A) \<Longrightarrow> is_asig (asig_of B) \<Longrightarrow>
    tr \<in> traces (A \<parallel> B) \<longleftrightarrow>
      Filter (\<lambda>a. a \<in> act A) \<cdot> tr \<in> traces A \<and>
      Filter (\<lambda>a. a \<in> act B) \<cdot> tr \<in> traces B \<and>
      Forall (\<lambda>x. x \<in> ext(A \<parallel> B)) tr"
  apply (simp add: traces_def has_trace_def)
  apply auto

  text \<open>\<open>\<Longrightarrow>\<close>\<close>
  text \<open>There is a schedule of \<open>A\<close>\<close>
  apply (rule_tac x = "Filter (\<lambda>a. a \<in> act A) \<cdot> sch" in bexI)
  prefer 2
  apply (simp add: compositionality_sch)
  apply (simp add: compatibility_consequence1 externals_of_par ext1_ext2_is_not_act1)
  text \<open>There is a schedule of \<open>B\<close>\<close>
  apply (rule_tac x = "Filter (\<lambda>a. a \<in> act B) \<cdot> sch" in bexI)
  prefer 2
  apply (simp add: compositionality_sch)
  apply (simp add: compatibility_consequence2 externals_of_par ext1_ext2_is_not_act2)
  text \<open>Traces of \<open>A \<parallel> B\<close> have only external actions from \<open>A\<close> or \<open>B\<close>\<close>
  apply (rule ForallPFilterP)

  text \<open>\<open>\<Longleftarrow>\<close>\<close>

  text \<open>replace \<open>schA\<close> and \<open>schB\<close> by \<open>Cut schA\<close> and \<open>Cut schB\<close>\<close>
  apply (drule exists_LastActExtsch)
  apply assumption
  apply (drule exists_LastActExtsch)
  apply assumption
  apply (erule exE)+
  apply (erule conjE)+
  text \<open>Schedules of A(B) have only actions of A(B)\<close>
  apply (drule scheds_in_sig)
  apply assumption
  apply (drule scheds_in_sig)
  apply assumption

  apply (rename_tac h1 h2 schA schB)
  text \<open>\<open>mksch\<close> is exactly the construction of \<open>trA\<parallel>B\<close> out of \<open>schA\<close>, \<open>schB\<close>, and the oracle \<open>tr\<close>,
     we need here\<close>
  apply (rule_tac x = "mksch A B \<cdot> tr \<cdot> schA \<cdot> schB" in bexI)

  text \<open>External actions of mksch are just the oracle\<close>
  apply (simp add: FilterA_mksch_is_tr)

  text \<open>\<open>mksch\<close> is a schedule -- use compositionality on sch-level\<close>
  apply (simp add: compositionality_sch)
  apply (simp add: FilterAmksch_is_schA FilterBmksch_is_schB)
  apply (erule ForallAorB_mksch)
  apply (erule ForallPForallQ)
  apply (erule ext_is_act)
  done

subsection \<open>COMPOSITIONALITY on TRACE Level -- for Modules\<close>

lemma compositionality_tr_modules:
  "is_trans_of A \<Longrightarrow> is_trans_of B \<Longrightarrow> compatible A B \<Longrightarrow> compatible B A \<Longrightarrow>
    is_asig(asig_of A) \<Longrightarrow> is_asig(asig_of B) \<Longrightarrow>
    Traces (A\<parallel>B) = par_traces (Traces A) (Traces B)"
  apply (unfold Traces_def par_traces_def)
  apply (simp add: asig_of_par)
  apply (rule set_eqI)
  apply (simp add: compositionality_tr externals_of_par)
  done

declaration \<open>fn _ => Simplifier.map_ss (Simplifier.set_mksym Simplifier.default_mk_sym)\<close>

end


(*******************************************************************************

  Project: IsaNet

  Author:  Tobias Klenze, ETH Zurich <tobias.klenze@inf.ethz.ch>
  Version: JCSPaper.1.0
  Isabelle Version: Isabelle2021-1

  Copyright (c) 2022 Tobias Klenze
  Licence: Mozilla Public License 2.0 (MPL) / BSD-3-Clause (dual license)

*******************************************************************************)

section \<open>EPIC Level 2 in the Strong Attacker Model\<close>
theory EPIC_L2_SA
  imports
    "../Parametrized_Dataplane_3_directed"
    "../infrastructure/Keys"
begin

type_synonym EPIC_HF = "(unit, msgterm) HF"
type_synonym UINFO = "nat"

locale epic_l2_defs = network_assums_direct _ _ _ auth_seg0
  for auth_seg0 :: "(msgterm \<times> ahi list) set" +
  fixes no_oracle :: "msgterm \<Rightarrow> UINFO \<Rightarrow> bool"
begin

(******************************************************************************)
subsection \<open>Hop validation check and extract functions\<close>
(******************************************************************************)

text\<open>We model the host key, i.e., the DRKey shared between an AS and an end host as a pair of AS
identifier and source identifier. Note that this "key" is not necessarily secret.
Because the source identifier is not directly embedded, we extract it from the uinfo field.
The uinfo (i.e., the token) is derived from the source address. We thus assume
that there is some function that extracts the source identifier from the uinfo field.\<close>
definition source_extract :: "msgterm \<Rightarrow> msgterm" where "source_extract = undefined"

definition K_i :: "as \<Rightarrow> msgterm \<Rightarrow> msgterm" where
  "K_i asid uinfo = \<langle>AS asid, source_extract uinfo\<rangle>"

text\<open>The predicate @{term "hf_valid"} is given to the concrete parametrized model as a parameter.
It ensures the authenticity of the hop authenticator in the hop field. The predicate takes an authenticated
info field (in this model always a numeric value, hence the matching on Num ts), an unauthenticated
info field uinfo, the hop field to be validated and in some cases the next hop field.

We distinguish if there is a next hop field (this yields the two cases below). If there is not, then
the hop authenticator @{text "\<sigma>"} simply consists of a MAC over the authenticated info field and the local
routing information of the hop, using the key of the hop to which the hop field belongs. If on the
other hand, there is a subsequent hop field, then the uhi field of that hop field is also included
in the MAC computation.

The hop authenticator @{text "\<sigma>"} is used to compute both the hop validation field and the uhi field.
The first is computed as a MAC over the path origin (pair of absolute timestamp ts and the relative
timestamp given in uinfo), using the hop authenticator as a key to the MAC. The hop authenticator
is not secret, and any end host can use it to create a valid hvf. The uhi field, according to the
protocol description, is @{text "\<sigma>"} shortened to a few bytes. We model this as applying the hash on @{text "\<sigma>"}.

The predicate @{term "hf_valid"} checks if the hop authenticator, hvf and uhi field are computed
correctly.\<close>
fun hf_valid :: "msgterm \<Rightarrow> UINFO
    \<Rightarrow> EPIC_HF
    \<Rightarrow> EPIC_HF option \<Rightarrow> bool" where
  "hf_valid (Num ts) uinfo \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> (Some \<lparr>AHI = ahi2, UHI = uhi2, HVF = x2\<rparr>) \<longleftrightarrow>
    (\<exists>\<sigma> upif downif. \<sigma> = Mac[macKey (ASID ahi)] (L [Num ts, upif, downif, uhi2]) \<and>
          ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and> uhi = Hash \<sigma> \<and>
          x = Mac[K_i (ASID ahi) (Num uinfo)] \<langle>Num ts, Num uinfo, \<sigma>\<rangle>)"
| "hf_valid (Num ts) uinfo \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> None \<longleftrightarrow>
    (\<exists>\<sigma> upif downif. \<sigma> = Mac[macKey (ASID ahi)] (L [Num ts, upif, downif]) \<and>
          ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and> uhi = Hash \<sigma> \<and>
          x = Mac[K_i (ASID ahi) (Num uinfo)] \<langle>Num ts, Num uinfo, \<sigma>\<rangle>)"
| "hf_valid _ _ _ _ = False"

abbreviation upd_uinfo :: "nat \<Rightarrow> EPIC_HF \<Rightarrow> nat" where
  "upd_uinfo uinfo hf \<equiv> uinfo"

text\<open>We can extract the entire path from the uhi field, since it includes the hop authenticator,
which includes the local forwarding information as well as, recursively, all upstream hop
authenticators and their hop information.
However, the parametrized model defines the extract function to operate on the hop validation field,
not the uhi field. We therefore define a separate function that extracts the path from a hvf.
We can do so, as both hvf and uhi contain the hop authenticator.
Internally, that function uses @{term "extrUhi"}.\<close>
fun extrUhi :: "msgterm \<Rightarrow> ahi list" where
  "extrUhi (Hash (Mac[macKey asid] (L [ts, upif, downif, uhi2])))
 = \<lparr>UpIF = term2if upif, DownIF = term2if downif, ASID = asid\<rparr> # extrUhi uhi2"
| "extrUhi (Hash (Mac[macKey asid] (L [ts, upif, downif])))
 = [\<lparr>UpIF = term2if upif, DownIF = term2if downif, ASID = asid\<rparr>]"
| "extrUhi _ = []"

text\<open>This function extracts from a hop validation field (HVF hf) the entire path.\<close>
fun extr :: "msgterm \<Rightarrow> ahi list" where
  "extr (Mac[_] \<langle>_, _, \<sigma>\<rangle>) = extrUhi (Hash \<sigma>)"
   | "extr _ = []"

text\<open>Extract the authenticated info field from a hop validation field.\<close>
fun extr_ainfo :: "msgterm \<Rightarrow> msgterm" where
  "extr_ainfo (Mac[_] \<langle>Num ts, _, _\<rangle>) = Num ts"
| "extr_ainfo _ = \<epsilon>"

abbreviation term_ainfo :: "msgterm \<Rightarrow> msgterm" where
  "term_ainfo \<equiv> id"

text\<open>When observing a hop field, an attacker learns the HVF and the UHI. The AHI only contains
public information that are not terms.\<close>
fun terms_hf :: "EPIC_HF \<Rightarrow> msgterm set" where
  "terms_hf hf = {HVF hf, UHI hf}"

abbreviation terms_uinfo :: "UINFO \<Rightarrow> msgterm set" where
  "terms_uinfo x \<equiv> {}"

text\<open>An authenticated info field is always a number (corresponding to a timestamp). The
     unauthenticated info field is as well a number, representing combination of timestamp offset
     and SRC address.\<close>
definition auth_restrict where
  "auth_restrict ainfo uinfo l \<equiv> (\<exists>ts. ainfo = Num ts)"

text\<open>We now define useful properties of the above definition.\<close>
lemma hf_valid_invert:
  "hf_valid tsn uinfo hf mo \<longleftrightarrow>
   ((\<exists>ahi ahi2 \<sigma> ts upif downif asid x upif2 downif2 asid2 uhi uhi2 x2.
     hf = \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> \<and>
     ASID ahi = asid \<and> ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and>
     mo = Some \<lparr>AHI = ahi2, UHI = uhi2, HVF = x2\<rparr> \<and>
     ASID ahi2 = asid2 \<and> ASIF (DownIF ahi2) downif2 \<and> ASIF (UpIF ahi2) upif2 \<and>
     \<sigma> = Mac[macKey asid] (L [tsn, upif, downif, uhi2]) \<and>
     tsn = Num ts \<and>
     uhi = Hash \<sigma> \<and>
     x = Mac[K_i (ASID ahi) (Num uinfo)] \<langle>tsn, Num uinfo, \<sigma>\<rangle>)
 \<or> (\<exists>ahi \<sigma> ts upif downif asid uhi x.
     hf = \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> \<and>
     ASID ahi = asid \<and> ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and>
     mo = None \<and>
     \<sigma> = Mac[macKey asid] (L [tsn, upif, downif]) \<and>
     tsn = Num ts \<and>
     uhi = Hash \<sigma> \<and>
     x = Mac[K_i (ASID ahi) (Num uinfo)] \<langle>tsn, Num uinfo, \<sigma>\<rangle>)
    )"
  apply(auto elim!: hf_valid.elims) using option.exhaust ASIF.simps by metis+

lemma hf_valid_auth_restrict[dest]: "hf_valid ainfo uinfo hf z \<Longrightarrow> auth_restrict ainfo uinfo l"
  by(auto simp add: hf_valid_invert auth_restrict_def)

lemma auth_restrict_ainfo[dest]: "auth_restrict ainfo uinfo l \<Longrightarrow> \<exists>ts. ainfo = Num ts"
  by(auto simp add: auth_restrict_def)

lemma info_hvf:
  assumes "hf_valid ainfo uinfo m z" "HVF m = Mac[k_i] \<langle>ainfo', Num uinfo', \<sigma>\<rangle> \<or> hf_valid ainfo' uinfo' m z'"
  shows "uinfo = uinfo'" "ainfo' = ainfo"
  using assms by(auto simp add: hf_valid_invert)

(******************************************************************************)
subsection\<open>Definitions and properties of the added intruder knowledge\<close>
(******************************************************************************)
text\<open>Here we define two sets which are added to the intruder knowledge: @{text "ik_add"}, which contains hop
authenticators. And @{text "ik_oracle"}, which contains the oracle's output to the strong attacker.\<close>
text\<open>Here we define two sets which are added to the intruder knowledge: @{text "ik_add"}, which contains hop
authenticators. And @{text "ik_oracle"}, which contains the oracle's output to the strong attacker.\<close>
print_locale dataplane_3_directed_defs
sublocale dataplane_3_directed_defs _ _ _ auth_seg0 hf_valid auth_restrict extr extr_ainfo term_ainfo
                 terms_hf terms_uinfo upd_uinfo no_oracle
  by unfold_locales

abbreviation is_oracle where "is_oracle ainfo t \<equiv> \<not> no_oracle ainfo t "

declare TWu.holds_set_list[dest]
declare TWu.holds_takeW_is_identity[simp]
declare parts_singleton[dest]

text\<open>This additional Intruder Knowledge allows us to model the attacker's access not only to the
hop validation fields and segment identifiers of authorized segments (which are already given in
@{text "ik_hfs"}), but to the underlying hop authenticators that are used to create them.\<close>

definition ik_add :: "msgterm set" where
  "ik_add \<equiv> { \<sigma> | ainfo uinfo l hf \<sigma> k_i.
                 (ainfo, l) \<in> auth_seg2 uinfo
                  \<and> hf \<in> set l \<and> HVF hf = Mac[k_i] \<langle>ainfo, Num uinfo, \<sigma>\<rangle> }"

lemma ik_addI:
  "\<lbrakk>(ainfo, l) \<in> auth_seg2 uinfo; hf \<in> set l; HVF hf = Mac[k_i] \<langle>ainfo, Num uinfo, \<sigma>\<rangle>\<rbrakk> \<Longrightarrow> \<sigma> \<in> ik_add"
  apply(auto simp add: ik_add_def)
  by blast

lemma ik_add_form: "t \<in> ik_add \<Longrightarrow> \<exists> asid l . t = Mac[macKey asid] l"
(*  using [[unify_trace_failure]]*)
  by(auto simp add: ik_add_def auth_seg2_def dest!: TWu.holds_set_list)
    (auto simp add: hf_valid_invert)

lemma parts_ik_add[simp]: "parts ik_add = ik_add"
  by (auto intro!: parts_Hash dest: ik_add_form)

text\<open>This is the oracle output provided to the adversary. Only those hop validation fields and
segment identifiers whose path origin (combination of ainfo uinfo) is not contained in
@{term "no_oracle"} appears here.\<close>
definition ik_oracle :: "msgterm set" where
  "ik_oracle = {t | t ainfo hf l uinfo . hf \<in> set l \<and> hfs_valid_None ainfo uinfo l \<and>
                    is_oracle ainfo uinfo \<and> (ainfo, l) \<notin> auth_seg2 uinfo \<and> (t = HVF hf \<or> t = UHI hf) }"

lemma ik_oracle_parts_form:
"t \<in> ik_oracle \<Longrightarrow>
  (\<exists> asid l ainfo uinfo k_i . t = Mac[k_i] \<langle>ainfo, Num uinfo, Mac[macKey asid] l\<rangle>) \<or>
  (\<exists> asid l . t = Hash (Mac[macKey asid] l))"
  by(auto simp add: ik_oracle_def hf_valid_invert dest!: TWu.holds_set_list)

lemma parts_ik_oracle[simp]: "parts ik_oracle = ik_oracle"
  by (auto intro!: parts_Hash dest: ik_oracle_parts_form)

lemma ik_oracle_simp: "t \<in> ik_oracle \<longleftrightarrow>
      (\<exists>ainfo hf l uinfo. hf \<in> set l \<and> hfs_valid_None ainfo uinfo l \<and> is_oracle ainfo uinfo
                       \<and> (ainfo, l) \<notin> auth_seg2 uinfo \<and> (t = HVF hf \<or> t = UHI hf))"
  by(rule iffI, frule ik_oracle_parts_form)
    (auto simp add: ik_oracle_def hf_valid_invert)

(******************************************************************************)
subsection\<open>Properties of the intruder knowledge, including @{text "ik_add"} and  @{text "ik_oracle"}\<close>
(******************************************************************************)
text\<open>We now instantiate the parametrized model's definition of the intruder knowledge, using the
definitions of @{text "ik_add"} and  @{text "ik_oracle"} from above. We then prove the properties
that we need to instantiate the @{text "dataplane_3_directed"} locale.\<close>
sublocale
  dataplane_3_directed_ik_defs _ _ _ auth_seg0 terms_uinfo no_oracle hf_valid auth_restrict extr extr_ainfo term_ainfo
                  terms_hf upd_uinfo ik_add ik_oracle
  by unfold_locales

lemma ik_hfs_form: "t \<in> parts ik_hfs \<Longrightarrow> \<exists> t' . t = Hash t'"
  by(auto 3 4 simp add: auth_seg2_def hf_valid_invert)

declare ik_hfs_def[simp del]

lemma parts_ik_hfs[simp]: "parts ik_hfs = ik_hfs"
  by (auto intro!: parts_Hash ik_hfs_form)

text\<open>This lemma allows us not only to expand the definition of @{term "ik_hfs"}, but also
to obtain useful properties, such as a term being a Hash, and it being part of a valid hop field.\<close>
lemma ik_hfs_simp:
  "t \<in> ik_hfs \<longleftrightarrow> (\<exists>t' . t = Hash t') \<and> (\<exists>hf . (t = HVF hf \<or> t = UHI hf)
                    \<and> (\<exists>hfs. hf \<in> set hfs \<and> (\<exists>ainfo uinfo . (ainfo, hfs) \<in> auth_seg2 uinfo
                    \<and> (\<exists> nxt. hf_valid ainfo uinfo hf nxt))))" (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume asm: "?lhs"
  then obtain ainfo uinfo hf hfs where
    dfs: "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo" "t = HVF hf \<or> t = UHI hf"
    by(auto simp add: ik_hfs_def)
  then have "hfs_valid_None ainfo uinfo hfs"  "(ainfo, AHIS hfs) \<in> auth_seg0"
    by(auto simp add: auth_seg2_def)
  then show "?rhs" using asm dfs
    by (auto 3 4 simp add: auth_seg2_def intro!: ik_hfs_form exI[of _ hf] exI[of _ hfs]
                     dest: TWu.holds_set_list_no_update)
qed(auto simp add: ik_hfs_def)

(******************************************************************************)
subsubsection \<open>Properties of Intruder Knowledge\<close>
(******************************************************************************)
lemma auth_ainfo[dest]: "\<lbrakk>(ainfo, hfs) \<in> auth_seg2 uinfo\<rbrakk> \<Longrightarrow> \<exists> ts . ainfo = Num ts"
  by(auto simp add: auth_seg2_def)

text \<open>There are no ciphertexts (or signatures) in @{term "parts ik"}. Thus, @{term "analz ik"}
and @{term "parts ik"} are identical.\<close>
lemma analz_parts_ik[simp]: "analz ik = parts ik"
  apply(rule no_crypt_analz_is_parts)
  by(auto simp add: ik_def auth_seg2_def auth_restrict_def ik_hfs_simp)
    (auto simp add: ik_add_def ik_oracle_def auth_seg2_def hf_valid_invert hfs_valid_prefix_generic_def
          dest!: TWu.holds_set_list)

lemma parts_ik[simp]: "parts ik = ik"
  by(auto 3 4 simp add: ik_def auth_seg2_def auth_restrict_def dest!: parts_singleton_set)

lemma key_ik_bad: "Key (macK asid) \<in> ik \<Longrightarrow> asid \<in> bad"
  by(auto simp add: ik_def hf_valid_invert ik_oracle_simp)
    (auto 3 4 simp add: auth_seg2_def ik_hfs_simp ik_add_def hf_valid_invert)

(******************************************************************************)
subsubsection\<open>Hop authenticators are agnostic to uinfo field\<close>
(******************************************************************************)

fun K_i_upd :: "msgterm \<Rightarrow> msgterm \<Rightarrow> msgterm" where
  "K_i_upd \<langle>AS asid, _\<rangle> uinfo' = \<langle>AS asid, source_extract uinfo'\<rangle>"
| "K_i_upd _ _ = \<epsilon>"

text\<open>Those hop validation fields contained in @{term "auth_seg2"} or that can be generated from the hop
authenticators in @{text "ik_add"} have the property that they are agnostic about the uinfo field. If a
hop validation field is contained in @{term "auth_seg2"} (resp. derivable from @{text "ik_add"}),
then a field with a different uinfo is also contained (resp. derivable).
To show this, we first define a function that updates uinfo in a hop validation field.\<close>
fun uinfo_change_hf :: "UINFO \<Rightarrow> EPIC_HF \<Rightarrow> EPIC_HF" where
  "uinfo_change_hf new_uinfo hf =
    (case HVF hf of Mac[k_i] \<langle>ainfo, Num uinfo, \<sigma>\<rangle>
  \<Rightarrow> hf\<lparr>HVF := Mac[K_i_upd k_i (Num new_uinfo)] \<langle>ainfo, Num new_uinfo, \<sigma>\<rangle>\<rparr> | _ \<Rightarrow> hf)"

fun uinfo_change :: "UINFO \<Rightarrow> EPIC_HF list \<Rightarrow> EPIC_HF list" where
  "uinfo_change new_uinfo hfs = map (uinfo_change_hf new_uinfo) hfs"

lemma uinfo_change_valid:
  "hfs_valid ainfo uinfo l nxt \<Longrightarrow> hfs_valid ainfo new_uinfo (uinfo_change new_uinfo l) nxt"
  apply(induction l nxt rule: TWu.holds.induct[where ?upd=upd_uinfo])
  apply auto
  subgoal for info x y ys nxt
    by(cases "map (uinfo_change_hf new_uinfo) ys") (*takes a few seconds*)
      (cases info, auto 3 4 simp add: K_i_def TWu.holds_split_tail hf_valid_invert)+
  by(auto 3 4 simp add: K_i_def TWu.holds_split_tail hf_valid_invert TWu.holds.simps)

lemma uinfo_change_hf_AHI: "AHI (uinfo_change_hf new_uinfo hf) = AHI hf"
  apply(cases "HVF hf") apply auto
  subgoal for k_i apply(cases k_i) apply auto
    subgoal for as uinfo apply(cases uinfo) apply auto
      subgoal for x1 x2 apply(cases x2) apply auto
      subgoal for x3 apply(cases x3) by auto
    done
  done
  done
  done

lemma uinfo_change_hf_AHIS[simp]: "AHIS (map (uinfo_change_hf new_uinfo) l) = AHIS l"
  apply(induction l) using uinfo_change_hf_AHI by auto

lemma uinfo_change_auth_seg2:
  assumes "hf_valid ainfo uinfo m z" "\<sigma> = Mac[Key (macK asid)] j"
          "HVF m = Mac[k_i] \<langle>ainfo, uinfo', \<sigma>\<rangle>" "\<sigma> \<in> ik_add" "no_oracle ainfo uinfo"
  shows "\<exists>hfs. m \<in> set hfs \<and> (\<exists>uinfo''. (ainfo, hfs) \<in> auth_seg2 uinfo'')"
proof-
  from assms(4) obtain ainfo_add uinfo_add l_add hf_add k_i_add where
    "(ainfo_add, l_add) \<in> auth_seg2 uinfo_add" "hf_add \<in> set l_add"
    "HVF hf_add = Mac[k_i_add] \<langle>ainfo_add, Num uinfo_add, \<sigma>\<rangle>"
    by(auto simp add: ik_add_def)
  then have add: "m \<in> set (uinfo_change uinfo l_add)" "(ainfo_add, (uinfo_change uinfo l_add)) \<in> auth_seg2 uinfo"
    using assms(1-3,5) apply(auto simp add: auth_seg2_def simp del: AHIS_def)
       apply(auto simp add: hf_valid_invert intro!: image_eqI dest!: TWu.holds_set_list)[1]
       apply(auto simp add: auth_restrict_def intro!: exI elim: ahi_eq dest: uinfo_change_valid simp del: AHIS_def)
    by(auto simp add: hf_valid_invert K_i_def dest!: TWu.holds_set_list_no_update)
  then have "ainfo_add = ainfo"
    using assms(1) by(auto simp add: auth_seg2_def dest!: TWu.holds_set_list dest: info_hvf)
  then show ?thesis using add by fastforce
qed

lemma MAC_synth_oracle:
  assumes "hf_valid ainfo uinfo m z" "HVF m \<in> ik_oracle"
  shows "is_oracle ainfo uinfo"
  using assms
  by(auto simp add: ik_oracle_def assms(1) hf_valid_invert dest!: TWu.holds_set_list_no_update)

lemma ik_oracle_is_oracle:
  "\<lbrakk>Mac[\<sigma>] \<langle>ainfo, Num uinfo\<rangle> \<in> ik_oracle\<rbrakk> \<Longrightarrow> is_oracle ainfo uinfo"
  by (auto simp add: ik_oracle_def dest: info_hvf)
     (auto dest!: TWu.holds_set_list_no_update simp add: hf_valid_invert)

lemma MAC_synth_helper:
"\<lbrakk>hf_valid ainfo uinfo m z; no_oracle ainfo uinfo;
  HVF m = Mac[k_i] \<langle>ainfo, Num uinfo, \<sigma>\<rangle>; \<sigma> = Mac[Key (macK asid)] j; \<sigma> \<in> ik \<or> HVF m \<in> ik\<rbrakk>
       \<Longrightarrow> \<exists>hfs. m \<in> set hfs \<and> (\<exists>uinfo'. (ainfo, hfs) \<in> auth_seg2 uinfo')"
  apply(auto simp add: ik_def ik_hfs_simp
                 dest: MAC_synth_oracle ik_add_form ik_oracle_parts_form[simplified])
  subgoal by(auto simp add: hf_valid_invert simp add: K_i_def)
  subgoal by(auto simp add: hf_valid_invert simp add: K_i_def)
  subgoal by(auto elim!: uinfo_change_auth_seg2 simp add: K_i_def)
  subgoal apply(auto simp add: hf_valid_invert simp add: K_i_def)
    using ik_oracle_parts_form by blast+
  subgoal apply(auto simp add: hf_valid_invert simp add: K_i_def)
    using ahi_eq by blast+
  subgoal by(auto simp add: hf_valid_invert simp add: K_i_def)
  subgoal apply(auto simp add: hf_valid_invert simp add: K_i_def)
    using ik_add_form by blast+
  done

text\<open>This definition helps with the limiting the number of cases generated. We don't require it,
but it is convenient. Given a hop validation field and an asid, return if the hvf has the expected
format.\<close>
definition mac_format :: "msgterm \<Rightarrow> as \<Rightarrow> bool" where
  "mac_format m asid \<equiv> \<exists> j ts uinfo k_i . m = Mac[k_i] \<langle>Num ts, uinfo, Mac[macKey asid] j\<rangle>"

text\<open>If a valid hop field is derivable by the attacker, but does not belong to the attacker, and is
over a path origin that does not belong to an oracle query, then the hop field is already
contained in the set of authorized segments.\<close>
lemma MAC_synth:
  assumes "hf_valid ainfo uinfo m z" "HVF m \<in> synth ik" "mac_format (HVF m) asid"
    "asid \<notin> bad" "checkInfo ainfo" "no_oracle ainfo uinfo"
  shows "\<exists>hfs . m \<in> set hfs \<and> (\<exists>uinfo'. (ainfo, hfs) \<in> auth_seg2 uinfo')"
  using assms
  apply(auto simp add: mac_format_def elim!: MAC_synth_helper dest!: key_ik_bad)
  apply(auto simp add: ik_def ik_hfs_simp dest: ik_add_form dest!: ik_oracle_parts_form) (* takes a few seconds *)
  using assms(1) by(auto dest: info_hvf simp add: hf_valid_invert)

(******************************************************************************)
subsection\<open>Direct proof goals for interpretation of @{text "dataplane_3_directed"}\<close>
(******************************************************************************)

lemma COND_honest_hf_analz:
  assumes "ASID (AHI hf) \<notin> bad" "hf_valid ainfo uinfo hf nxt" "terms_hf hf \<subseteq> synth (analz ik)"
    "no_oracle ainfo uinfo"
    shows "terms_hf hf \<subseteq> analz ik"
proof-
  let ?asid = "ASID (AHI hf)"
  from assms(3) have hf_synth_ik: "HVF hf \<in> synth ik" "UHI hf \<in> synth ik" by auto
  from assms(2) have "mac_format (HVF hf) ?asid"
    by(auto simp add: mac_format_def hf_valid_invert)
  then obtain hfs uinfo where "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo"
    using assms(1,2,4) hf_synth_ik by(auto dest!: MAC_synth)
  then have "HVF hf \<in> ik" "UHI hf \<in> ik"
    using assms(2)
    by(auto simp add: ik_hfs_def intro!: ik_ik_hfs intro!: exI)
  then show ?thesis by auto
qed

lemma COND_terms_hf:
  assumes "hf_valid ainfo uinfo hf z" and "HVF hf \<in> ik" and "no_oracle ainfo uinfo"
  shows "\<exists>hfs. hf \<in> set hfs \<and> (\<exists>uinfo . (ainfo, hfs) \<in> auth_seg2 uinfo)"
proof-
  obtain hfs ainfo where hfs_def: "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo"
    using assms apply(auto 3 4 simp add: K_i_def hf_valid_invert ik_hfs_simp ik_def dest: ahi_eq
                             dest!: ik_oracle_is_oracle ik_add_form)
    using MAC_synth_oracle assms(1) by force+
  then obtain hfs ainfo where hfs_def: "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo" by auto
  show ?thesis
    using hfs_def apply (auto simp add: auth_seg2_def dest!: TWu.holds_set_list)
    using hfs_def assms(1) by (auto simp add: auth_seg2_def dest: info_hvf)
qed

lemma COND_extr_prefix_path:
  "\<lbrakk>hfs_valid ainfo uinfo l nxt; nxt = None\<rbrakk> \<Longrightarrow> prefix (extr_from_hd l) (AHIS l)"
  by(induction l nxt rule: TWu.holds.induct[where ?upd=upd_uinfo])
    (auto simp add: K_i_def TWu.holds_split_tail TWu.holds.simps(1) hf_valid_invert,
     auto split: list.split_asm simp add: hf_valid_invert intro!: ahi_eq elim: ASIF.elims)

lemma COND_path_prefix_extr:
  "prefix (AHIS (hfs_valid_prefix ainfo uinfo l nxt))
          (extr_from_hd l)"
  apply(induction l nxt rule: TWu.takeW.induct[where ?Pa="hf_valid ainfo",where ?upd=upd_uinfo])
  by(auto simp add: TWu.takeW_split_tail TWu.takeW.simps(1))
    (auto 3 4 simp add: hf_valid_invert intro!: ahi_eq elim: ASIF.elims)

lemma COND_hf_valid_uinfo:
  "\<lbrakk>hf_valid ainfo uinfo hf nxt; hf_valid ainfo' uinfo' hf nxt'\<rbrakk> \<Longrightarrow> uinfo' = uinfo"
  by(auto dest: info_hvf)

lemma COND_upd_uinfo_ik:
    "\<lbrakk>terms_uinfo uinfo \<subseteq> synth (analz ik); terms_hf hf \<subseteq> synth (analz ik)\<rbrakk>
    \<Longrightarrow> terms_uinfo (upd_uinfo uinfo hf) \<subseteq> synth (analz ik)"
  by (auto)

lemma COND_upd_uinfo_no_oracle:
  "no_oracle ainfo uinfo \<Longrightarrow> no_oracle ainfo (upd_uinfo uinfo fld)"
  by (auto)

lemma COND_auth_restrict_upd:
      "auth_restrict ainfo uinfo (x#y#hfs)
   \<Longrightarrow> auth_restrict ainfo (upd_uinfo uinfo y) (y#hfs)"
  by (auto simp add: auth_restrict_def)

(******************************************************************************)
subsection\<open>Instantiation of @{text "dataplane_3_directed"} locale\<close>
(******************************************************************************)
print_locale dataplane_3_directed
sublocale
  dataplane_3_directed _ _ _ auth_seg0 terms_uinfo terms_hf hf_valid auth_restrict extr extr_ainfo term_ainfo
            upd_uinfo ik_add
            ik_oracle no_oracle
  apply unfold_locales
  using COND_terms_hf COND_honest_hf_analz COND_extr_prefix_path
  COND_path_prefix_extr COND_hf_valid_uinfo COND_upd_uinfo_ik COND_upd_uinfo_no_oracle
  COND_auth_restrict_upd by auto

end
end


(*  Title:       OAodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The `open' AODV model"

theory OAodv
imports Aodv AWN.OAWN_SOS_Labels AWN.OAWN_Convert
begin

text \<open>Definitions for stating and proving global network properties over individual processes.\<close>

definition \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V' :: "((ip \<Rightarrow> state) \<times> ((state, msg, pseqp, pseqp label) seqp)) set"
where "\<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V' \<equiv> {(\<lambda>i. aodv_init i, \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V PAodv)}"

abbreviation opaodv
  :: "ip \<Rightarrow> ((ip \<Rightarrow> state) \<times> (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "opaodv i \<equiv> \<lparr> init = \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V', trans = oseqp_sos \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V i \<rparr>"

lemma initiali_aodv [intro!, simp]: "initiali i (init (opaodv i)) (init (paodv i))"
  unfolding \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V_def \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V'_def by rule simp_all

lemma oaodv_control_within [simp]: "control_within \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (init (opaodv i))"
  unfolding \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V'_def by (rule control_withinI) (auto simp del: \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V_simps)

lemma \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V'_labels [simp]: "(\<sigma>, p) \<in> \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V' \<Longrightarrow>  labels \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V p = {PAodv-:0}"
  unfolding \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V'_def by simp

lemma oaodv_init_kD_empty [simp]:
  "(\<sigma>, p) \<in> \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V' \<Longrightarrow> kD (rt (\<sigma> i)) = {}"
  unfolding \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V'_def kD_def by simp

lemma oaodv_init_vD_empty [simp]:
  "(\<sigma>, p) \<in> \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V' \<Longrightarrow> vD (rt (\<sigma> i)) = {}"
  unfolding \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V'_def vD_def by simp

lemma oaodv_trans: "trans (opaodv i) = oseqp_sos \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V i"
  by simp

declare
  oseq_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]
  oseq_step_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]

end


section \<open>Static Weak Control Dependence\<close>

theory WeakControlDependence imports
  "../Basic/Postdomination"
  "../Basic/DynWeakControlDependence"
begin

context StrongPostdomination begin

definition
  weak_control_dependence :: "'node \<Rightarrow> 'node \<Rightarrow> bool"
  ("_ weakly controls _" [51,0])
where weak_control_dependences_eq:
    "n weakly controls n' \<equiv> \<exists>as. n weakly controls n' via as"

lemma
  weak_control_dependence_def:"n weakly controls n' =
    (\<exists>a a' as. (n' \<notin> set(sourcenodes (a#as))) \<and> (n -a#as\<rightarrow>* n') \<and>
                   (n' strongly-postdominates (targetnode a)) \<and>
                   (valid_edge a') \<and> (sourcenode a' = n) \<and>
                   (\<not> n' strongly-postdominates (targetnode a')))"
by(auto simp:weak_control_dependences_eq dyn_weak_control_dependence_def)

lemma Exit_not_weak_control_dependent:
  "n weakly controls (_Exit_) \<Longrightarrow> False"
by(auto simp:weak_control_dependences_eq
        intro:Exit_not_dyn_weak_control_dependent)

end

end