theory Lib
  imports "Timed_Automata.Timed_Automata"
          "Timed_Automata.Approx_Beta"
          "MDP_Aux"
          "Finiteness"
          "Sequence_LTL"
          "Instantiate_Existentials"
          "Graphs"
begin

section \<open>Misc\<close>

lemma measurable_pred_stream[measurable]:
  fixes P shows "Measurable.pred (stream_space (count_space UNIV)) (pred_stream P)"
proof -
  have [measurable]: "Measurable.pred (count_space UNIV) P"
    by measurable
  then show ?thesis
    unfolding stream.pred_set sset_range by simp
qed

lemma pmf_map_pmf_cong:
  fixes f g and \<mu> :: "'a pmf"
  assumes "\<And> x. x \<in> \<mu> \<Longrightarrow> f x = y1 \<longleftrightarrow> g x = y2"
  shows "pmf (map_pmf f \<mu>) y1 = pmf (map_pmf g \<mu>) y2"
  unfolding pmf_map
  by (rule measure_pmf.finite_measure_eq_AE;
      simp add: AE_measure_pmf_iff assms split: split_indicator
     )

lemma collect_pair_finite[intro]:
  notes finite_subset[intro]
  assumes "finite {x. P x}" "finite {x. Q x}"
  shows "finite {(x, y) . P x \<and> Q y \<and> R x y}"
using assms
proof -
  from assms have "finite {(x, y) . P x \<and> Q y}" by auto
  moreover have "{(x, y) . P x \<and> (Q y \<and> R x y)} \<subseteq> {(x, y) . P x \<and> Q y}" by auto
  ultimately show ?thesis by blast
qed

lemma collect_pair_finite'[intro]:
  notes finite_subset[intro]
  assumes "finite {(x, y). P x y}"
  shows "finite {(x, y) . P x y \<and> R x y}"
using assms
proof -
  from assms have "finite {(x, y) . P x y}" by auto
  moreover have "{(x, y) . P x y \<and> R x y} \<subseteq> {(x, y) . P x y}" by auto
  ultimately show ?thesis by blast
qed

text \<open>This is what we actually need in this theory\<close>
lemma collect_pair_finite''[intro]:
  notes finite_subset[intro]
  assumes "finite {(x, y). P x \<and> Q y}"
  shows "finite {(x, y) . P x \<and> Q y \<and> R x y}"
using assms
proof -
  from assms have "finite {(x, y) . P x \<and> Q y}" by auto
  moreover have "{(x, y) . P x \<and> Q y \<and> R x y} \<subseteq> {(x, y) . P x \<and> Q y}" by auto
  ultimately show ?thesis by blast
qed

lemma finite_imageI'[intro]:
  assumes "finite {(x, y). P x y}"
  shows "finite {f x y | x y. P x y}"
proof -
  from assms have "finite ((\<lambda> (x, y). f x y) ` {(x, y). P x y})" by auto
  moreover have "((\<lambda> (x, y). f x y) ` {(x, y). P x y}) = {f x y | x y. P x y}" by auto
  ultimately show ?thesis by auto
qed

lemma finite_imageI''[intro]:
  assumes "finite (A \<times> B)"
  shows "finite {f x y | x y. x \<in> A \<and> y \<in> B \<and> R x y}"
proof -
  from assms have "finite {f x y | x y. x \<in> A \<and> y \<in> B}" by auto
  moreover have "{f x y | x y. x \<in> A \<and> y \<in> B \<and> R x y} \<subseteq> {f x y | x y. x \<in> A \<and> y \<in> B}" by auto
  ultimately show ?thesis by (blast intro: finite_subset)
qed

(* TODO: Move/should be somewhere already *)
lemma pred_stream_stl: "pred_stream \<phi> xs \<longrightarrow> pred_stream \<phi> (stl xs)"
  by (cases xs) auto

(* TODO: Should be somewhere already *)
lemma stream_all_pred_stream:
  "stream_all = pred_stream"
  by (intro ext) (simp add: stream.pred_set)

lemma pred_stream_iff: "pred_stream P s \<longleftrightarrow> Ball (sset s) P"
  using stream_all_iff[unfolded stream_all_pred_stream] .

(* TODO: Move *)
lemma measure_pmf_eq_1_iff:
  "emeasure (measure_pmf \<mu>) {x} = 1 \<longleftrightarrow> \<mu> = return_pmf x"
  using measure_pmf.prob_eq_1[of "{x}" \<mu>] set_pmf_subset_singleton[of \<mu> x]
  by (auto simp: measure_pmf.emeasure_eq_measure AE_measure_pmf_iff)

lemma HLD_mono:
  "HLD S \<omega>" if "HLD R \<omega>" "R \<subseteq> S"
  using that unfolding HLD_iff by auto

lemma alw_HLD_smap:
  "alw (HLD (f ` S)) (smap f \<omega>)" if "alw (HLD S) \<omega>"
  using that by (auto 4 3 elim: HLD_mono alw_mono)

lemma alw_disjoint_ccontr:
  assumes "alw (HLD S) \<omega>" "ev (alw (HLD R)) \<omega>" "R \<inter> S = {}"
  shows False
proof -
  from assms(1,2) obtain \<omega> where "alw (HLD S) \<omega>" "alw (HLD R) \<omega>"
    by (auto intro: alw_sdrop sdrop_wait)
  with \<open>R \<inter> S = {}\<close> show False
    by (auto 4 3 simp: HLD_iff dest: alwD)
qed

(* TODO: Move *)
lemma stream_all2_refl: "stream_all2 P x x = pred_stream (\<lambda> x. P x x) x"
  by (simp add: stream.pred_rel eq_onp_def) (standard; coinduction arbitrary: x; auto)

lemma AE_all_imp_countable:
  assumes "countable {x. Q x}"
  shows "(AE x in M. \<forall>y. Q y \<longrightarrow> P x y) = (\<forall>y. Q y \<longrightarrow> (AE x in M. P x y))"
  using assms by (auto dest: AE_ball_countable)

lemma AE_conj:
  "almost_everywhere M P = almost_everywhere M (\<lambda> x. P x \<and> Q x)" if "almost_everywhere M Q"
  by (auto intro: AE_mp[OF that])

(* TODO: move *)
lemma list_hd_lastD:
  assumes "length xs > 1"
  obtains x y ys where "xs = x # ys @ [y]"
  using assms by atomize_elim (cases xs; simp; metis rev_exhaust)

(* TODO: Move *)
lemma SUP_eq_and_INF_eq:
  assumes "\<And>i. i \<in> A \<Longrightarrow> \<exists>j\<in>B. f i = g j"
      and "\<And>j. j \<in> B \<Longrightarrow> \<exists>i\<in>A. g j = f i"
    shows "\<Squnion>((f :: _ \<Rightarrow> _ :: complete_lattice) ` A) = \<Squnion>(g ` B) \<and> \<Sqinter>(f ` A) = \<Sqinter>(g ` B)"
  by (auto 4 3 intro!: INF_eq SUP_eq dest: assms)

(* TODO: Move *)
lemma measurable_alw_stream[measurable]:
  fixes P assumes [measurable]: "Measurable.pred (stream_space (count_space UNIV)) P"
  shows "Measurable.pred (stream_space (count_space UNIV)) (alw P)"
  unfolding alw_iff_sdrop by measurable

(* TODO: Move *)
lemma ev_neq_start_implies_ev_neq:
  assumes "ev (Not o HLD {y}) (y ## xs)"
  shows "ev (\<lambda> xs. shd xs \<noteq> shd (stl xs)) (y ## xs)"
  using assms
  apply (induction "y ## xs" arbitrary: xs rule: ev.induct)
   apply (simp; fail)
  subgoal for xs
    apply (cases "shd xs = y")
    subgoal
      apply safe
      apply (rule ev.step)
      apply simp
      using stream.collapse[of xs, symmetric]
      by blast
    subgoal
      by auto
    done
  done

(* TODO: Move *)

(* TODO: Move *)
lemma pred_stream_sconst:
  "pred_stream ((=) x) (sconst x)"
  by coinduction simp

(* TODO: Move *)
lemma alw_Stream: "alw P (x ## s) \<longleftrightarrow> P (x ## s) \<and> alw P s"
  by (subst alw.simps) simp

(* TODO: Move *)
lemma alw_True: "alw (\<lambda>x. True) \<omega>"
  by (auto intro: all_imp_alw)

(* TODO: Move *)
lemma alw_conjI:
  "alw (P aand Q) xs" if "alw P xs" "alw Q xs"
  using that by (simp add: alw_aand)

(* TODO: Move *)
lemma alw_ev_cong:
  "alw (ev S) xs = alw (ev R) xs" if "alw P xs" "\<And> x. P x \<Longrightarrow> S x \<longleftrightarrow> R x"
  by (rule alw_cong[where P = "alw P"]) (auto simp: HLD_iff that elim!: ev_cong)

lemma alw_ev_HLD_cong:
  "alw (ev (HLD S)) xs = alw (ev (HLD R)) xs" if "alw (HLD P) xs" "\<And> x. x \<in> P \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> R"
  by (rule alw_ev_cong, rule that; simp add: HLD_iff that)

(* TODO: Move *)
lemma measurable_eq_stream_space[measurable (raw)]:
  assumes [measurable]: "f \<in> M \<rightarrow>\<^sub>M stream_space (count_space UNIV)"
  shows "Measurable.pred M (\<lambda>x. f x = c)"
proof -
  have *: "(\<lambda>x. f x = c) = (\<lambda>x. \<forall>i. f x !! i = c !! i)"
    by (auto intro: eqI_snth simp: fun_eq_iff)
  show ?thesis
    unfolding * by measurable
qed

(* TODO: rename, and change to LTL constants i.e. HLD, aand, nxt etc. *)
lemma prop_nth_sdrop:
  assumes "\<forall> i\<ge>j. P (\<omega> !! i)"
  shows "\<forall> i. P (sdrop j \<omega> !! i)"
using assms by (induction j arbitrary: \<omega>) fastforce+

lemma prop_nth_sdrop_pair:
  assumes "\<forall> i. P (\<omega> !! i) (\<omega>' !! i)"
  shows "\<forall> i. P (sdrop j \<omega> !! i) (sdrop j \<omega>' !! i)"
  using assms by (induction j arbitrary: \<omega> \<omega>') (auto, metis snth.simps(2))

lemma prop_nth_stl:
  "\<forall> i. P (xs !! i) \<Longrightarrow> \<forall> i. P (stl xs !! i)"
  by (metis snth.simps(2))

context Graph_Defs
begin

lemma steps_SCons_iff:
  "steps (x # y # xs) \<longleftrightarrow> E x y \<and> steps (y # xs)"
  by (auto elim: steps.cases)

lemma steps_Single_True:
  "steps [x] = True"
  by auto

lemma add_step_iff:
  "(\<forall> xs y. steps (x # xs @ [y]) \<and> length xs = Suc n \<longrightarrow> P xs y)
  \<longleftrightarrow> (\<forall> z xs y. steps (x # z # xs @ [y]) \<and> length xs = n \<longrightarrow> P (z # xs) y)"
  apply safe
   apply fastforce
  subgoal for xs y
    by (cases xs) auto
  done

lemma compower_stepsD:
  assumes "(E ^^ n) s s'"
  obtains xs where "steps xs" "hd xs = s" "last xs = s'" "length xs = n + 1"
  using assms
  apply atomize_elim
proof (induction n arbitrary: s')
  case 0
  then show ?case
    by auto
next
  case (Suc n)
  from Suc.prems show ?case
    by (auto 4 4 intro: steps_append_single dest: Suc.IH)
qed

lemma compower_stepsD':
  assumes "(E ^^ n) s s'" "n > 0"
  obtains xs where "steps (s # xs @ [s'])" "length xs + 1 = n"
  apply (rule compower_stepsD[OF assms(1)])
  subgoal for xs
    by (auto simp: \<open>n > 0\<close> intro: list_hd_lastD[of xs])
  done

end

context MC_syntax
begin

theorem AE_T_iff_n:
  fixes P :: "'s stream \<Rightarrow> bool"
    and x :: "'s"
  assumes "Measurable.pred (stream_space (count_space UNIV)) P" "n > 0"
  shows "almost_everywhere (T x) P =
    (\<forall>xs y. Graph_Defs.steps (\<lambda> a b. b \<in> K a) (x # xs @ [y]) \<and> length xs + 1 = n
      \<longrightarrow> (AE \<omega> in T y. P (xs @- y ## \<omega>)))"
  using assms
  apply (induction n arbitrary: x P)
   apply (simp; fail)
  subgoal for n x P
    apply (cases n)
    subgoal
      by (subst AE_T_iff) (auto simp: Graph_Defs.steps_SCons_iff Graph_Defs.steps_Single_True)
    subgoal premises prems for n'
    proof -
      have *: "Measurable.pred (stream_space (count_space UNIV)) (\<lambda> \<omega>. P (y ## \<omega>))" for y
        using prems(2) by measurable
      with prems(1)[OF *] prems(3-) show ?thesis
        by (auto simp: AE_T_iff[OF prems(2)] Graph_Defs.steps_SCons_iff Graph_Defs.add_step_iff)
    qed
    done
  done

lemma AE_alw_accD:
  fixes P assumes P: "Measurable.pred (stream_space (count_space UNIV)) P"
  assumes *: "almost_everywhere (T s) (alw P)" "(s, s') \<in> acc"
  shows "almost_everywhere (T s') (alw P)"
  using *(2,1)
proof induction
  case (step y z)
  then have "almost_everywhere (T y) (alw P)" "z \<in> K y" by auto
  then have "AE \<omega> in T z. alw P (z ## \<omega>)"
    unfolding AE_T_iff[OF measurable_alw_stream[OF P], of y] by auto
  then show ?case
    by eventually_elim auto
qed

lemma acc_relfunD:
  assumes "(s, s') \<in> acc"
  obtains n where "((\<lambda> a b. b \<in> K a) ^^ n) s s'"
  using assms
  apply atomize_elim
  apply (drule rtrancl_imp_relpow)
  apply (erule exE)
  subgoal for n
    by (inst_existentials n) (induction n arbitrary: s'; auto)
  done

(* TODO: If we can show measurable_alw_stream, then this subsumed by the lemma above *)
lemma AE_all_accD:
  assumes "almost_everywhere (T s) (pred_stream P)" "(s, s') \<in> acc"
  shows "almost_everywhere (T s') (pred_stream P)"
proof -
  from acc_relfunD[OF \<open>_ \<in> acc\<close>] obtain n where *: "((\<lambda> a b. b \<in> K a) ^^ n) s s'" .
  show ?thesis
  proof (cases "n = 0")
    case True
    with * assms(1) show ?thesis
      by auto
  next
    case False
    then have "n > 0"
      by simp
    with * obtain xs where
      "Graph_Defs.steps (\<lambda>a b. b \<in> set_pmf (K a)) (s # xs @ [s'])" "Suc (length xs) = n"
      by (auto elim: Graph_Defs.compower_stepsD')
    with assms(1)[unfolded AE_T_iff_n[OF measurable_pred_stream \<open>n > 0\<close>, of P s]] show ?thesis
      by auto
  qed
qed

lemma AE_T_ev_HLD_infinite_strong':
  assumes "0 \<le> r" "r < 1"
    and r: "\<And>x. x \<in> X \<inter> Y \<Longrightarrow> measure_pmf.prob (K x) Y \<le> r"
    and ae: "AE \<omega> in T x. alw (\<lambda> \<omega>. HLD Y \<omega> \<longrightarrow> ev (HLD X) \<omega>) \<omega>"
  shows "AE \<omega> in T x. ev (HLD (- Y)) \<omega>"
proof -
  define run where "run F = (HLD (Y - X)) suntil ((X \<inter> Y) \<cdot> Y \<cdot> F)" for F

  have le_gfp: "alw (HLD Y) aand alw (\<lambda> \<omega>. HLD Y \<omega> \<longrightarrow> ev (HLD X) \<omega>) \<le> gfp run"
  proof (rule gfp_upperbound; clarsimp)
    fix \<omega> assume "alw (HLD Y) \<omega>" "alw (\<lambda>\<omega>. HLD Y \<omega> \<longrightarrow> ev (HLD X) \<omega>) \<omega>"
    then have "ev (HLD X) \<omega>" "alw (HLD Y) \<omega>" "alw (\<lambda>\<omega>. HLD Y \<omega> \<longrightarrow> ev (HLD X) \<omega>) \<omega>"
      by auto
    then show "run (\<lambda>xs. alw (HLD Y) xs \<and> alw (\<lambda>\<omega>. HLD Y \<omega> \<longrightarrow> ev (HLD X) \<omega>) xs) \<omega>"
    proof (induction \<omega> rule: ev_induct_strong)
      case (base \<omega>) then show ?case by (cases \<omega>) (auto intro!: suntil.base simp: alw_Stream run_def)
    next
      case (step \<omega>)
      show ?case
        unfolding run_def
        using \<open>\<not> HLD X \<omega>\<close> \<open>alw (HLD Y) \<omega>\<close> step(3)[unfolded run_def] step(4,5)
        by (auto 0 4 simp: HLD_def intro: suntil.step)
    qed
  qed

  have cont_run: "inf_continuous run"
    apply (auto simp: inf_continuous_def fun_eq_iff run_def)
    subgoal premises that for M x f
      by (rule suntil_mono[OF _ _ that(2) alw_True]) auto
    subgoal premises that for M x
      using that(2)[THEN spec, of 0] that(2)
      proof (induction rule: suntil_induct_strong)
        case (base \<omega>) then show ?case
          by (cases \<omega>) (simp add: suntil_Stream)
      next
        case (step \<omega>) then show ?case
          by (cases \<omega>) (simp add: suntil_Stream)
      qed
      done
  have [measurable]: "Measurable.pred (stream_space (count_space UNIV)) (gfp run)"
    apply measurable
    apply (rule measurable_gfp[OF cont_run])
    apply (auto simp: run_def)
    done

  have "emeasure (T x) {\<omega> \<in> space (T x). alw (HLD Y) \<omega>} \<le>
    emeasure (T x) {\<omega> \<in> space (T x). ((alw (HLD Y)) aand (alw (\<lambda> \<omega>. HLD Y \<omega> \<longrightarrow> ev (HLD X) \<omega>))) \<omega>}"
    apply (rule emeasure_mono_AE)
    subgoal using ae by eventually_elim auto
    by measurable
  also have "\<dots> \<le> emeasure (T x) {\<omega> \<in> space (T x). gfp run \<omega>}"
    apply (rule emeasure_mono)
    subgoal using le_gfp by auto
    by measurable
  also have "\<dots> \<le> r ^ n" for n
  proof (induction n arbitrary: x)
    case 0 then show ?case by (simp add: T.emeasure_le_1)
  next
    case (Suc n)
    { fix x
      have "(\<integral>\<^sup>+ t. \<integral>\<^sup>+ t'. emeasure (T t') {x\<in>space S. t\<in>X \<and> t\<in>Y \<and> t'\<in>Y \<and> gfp run x} \<partial>K t \<partial>K x) \<le>
        (\<integral>\<^sup>+ t. indicator (X \<inter> Y) t * \<integral>\<^sup>+ t'. indicator Y t' * ennreal (r ^ n) \<partial>K t \<partial>K x)"
        using Suc by (auto intro!: nn_integral_mono split: split_indicator)
      also have "\<dots> \<le> (\<integral>\<^sup>+ t. indicator (X \<inter> Y) t * r \<partial>K x) * ennreal (r^n)"
        by (auto intro!: nn_integral_mono mult_right_mono r ennreal_leI split: split_indicator
                 simp: nn_integral_multc mult.assoc[symmetric] measure_pmf.emeasure_eq_measure)
      also have "\<dots> = emeasure (K x) (X \<inter> Y) * r^(Suc n)"
        by (simp add: ennreal_mult \<open>0 \<le> r\<close> nn_integral_multc ennreal_indicator mult.assoc)
      finally have *: "(\<integral>\<^sup>+ t. \<integral>\<^sup>+ t'. emeasure (T t') {x\<in>space S. t \<in> X \<and> t \<in> Y \<and> t' \<in> Y \<and> gfp run x} \<partial>K t \<partial>K x) \<le>
        emeasure (K x) (X \<inter> Y) * r^Suc n" .

      have "(\<integral>\<^sup>+ t. \<integral>\<^sup>+ t'. emeasure (T t') {x \<in> space S. t \<in> X \<and> t \<in> Y \<and> t' \<in> Y \<and> gfp run x} \<partial>K t \<partial>K x) +
           ennreal (r^Suc n) * emeasure (measure_pmf (K x)) (Y - X) \<le>
        emeasure (K x) (X \<inter> Y) * ennreal (r^Suc n) + ennreal (r^Suc n) * emeasure (measure_pmf (K x)) (Y - X)"
        by (intro add_mono_left *)
      also have "\<dots> = emeasure (K x) ((X \<inter> Y) \<union> (Y - X)) * ennreal (r^Suc n)"
        by (subst plus_emeasure[symmetric]) (auto simp: field_simps)
      also have "\<dots> \<le> 1 * ennreal (r^Suc n)"
        by (intro mult_right_mono measure_pmf.emeasure_le_1) simp
      finally have "(\<integral>\<^sup>+ t. \<integral>\<^sup>+ t'. emeasure (T t') {x \<in> space MC_syntax.S. t \<in> X \<and> t \<in> Y \<and> t' \<in> Y \<and> gfp run x} \<partial>K t \<partial>K x) +
           ennreal (r^Suc n) * emeasure (measure_pmf (K x)) (Y - X) \<le> 1 * ennreal (r^Suc n)" by simp }
    note * = this

    show ?case
      apply (subst gfp_unfold[OF inf_continuous_mono[OF cont_run]])
      apply (subst run_def)
      apply (subst emeasure_suntil_disj)
        apply measurable []
      subgoal for s
        by (rule AE_I2) (auto simp: HLD_iff)
      apply (rule le_funD[of _ _ x])
      apply (rule lfp_lowerbound)
      apply (rule le_funI)
      apply (subst emeasure_Collect_T)
       apply measurable []
      apply (subst emeasure_Collect_T)
      apply simp
      apply (simp add: nn_integral_cmult)
      using * by simp
  qed
  finally have "emeasure (T x) {\<omega> \<in> space (T x). alw (HLD Y) \<omega>} \<le> r^n" for n .
  then have "emeasure (T x) {\<omega> \<in> space (T x). alw (HLD Y) \<omega>} \<le> ennreal 0"
    using \<open>0 \<le> r\<close> \<open>r < 1\<close>
    by (intro LIMSEQ_le_const[OF tendsto_ennrealI[OF LIMSEQ_power_zero[of r]]]) auto
  then have *: "emeasure (T x) {\<omega> \<in> space (T x). alw (HLD Y) \<omega>} = 0"
    by simp
  show ?thesis
    by (rule AE_I[OF _ *]) (auto simp: not_ev_iff not_HLD[symmetric])
qed

end

context Markov_Decision_Process
begin

lemma cfg_on_inv:
  "pred_stream (\<lambda> cfg. cfg \<in> cfg_on (state cfg)) \<omega>" if
  "MC.enabled cfg \<omega>" "cfg \<in> cfg_on s"
  using that proof (coinduction arbitrary: \<omega> cfg s)
  case prems: stream_pred
  note [simp] = \<open>_ = \<omega>\<close>[symmetric]
  from prems(2) have "a \<in> set_pmf (K_cfg cfg)" "MC.enabled a w"
    by (auto simp: MC.enabled_Stream)
  moreover from \<open>a \<in> _\<close> have "a \<in> cont cfg ` set_pmf (action cfg)"
    by (simp add: set_K_cfg)
  ultimately show ?case
    using \<open>cfg \<in> _\<close> by auto
qed

lemma MC_T_not_sconst_strong:
  assumes
    "\<forall> l. \<forall> cfg \<in> (\<Union> x \<in> f -` {u}. cfg_on x) \<inter> Y \<inter> X. measure_pmf (action cfg) (f -` {u}) \<le> r"
    "r < 1" "cfg \<in> cfg_on x"
    "AE \<omega> in MC.T cfg. pred_stream (\<lambda> x. x \<in> X) \<omega>"
    "AE \<omega> in MC.T cfg. alw (\<lambda> \<omega>. HLD (f -` {u}) (smap state \<omega>) \<longrightarrow> ev (HLD Y) \<omega>) \<omega>"
  shows "AE \<omega> in MC.T cfg. smap (f o state) \<omega> \<noteq> sconst u"
proof -
  let ?U = "f -` {u}"
  let ?S = "(\<Union> x \<in> f -` {u}. cfg_on x) \<inter> X"
  let ?T = "Y \<inter> ((\<Union> x \<in> f -` {u}. cfg_on x) \<inter> X)"
  have *: "emeasure (K_cfg cfg) ?S \<le> r" if "cfg \<in> ?T" for cfg
  proof -
    have "emeasure (K_cfg cfg) ?S \<le> emeasure (measure_pmf (action cfg)) ?U"
      unfolding K_cfg_def by (auto dest: cfg_onD_state intro!: emeasure_mono)
    also from assms(1) \<open>cfg \<in> ?T\<close> have "\<dots> \<le> r"
      by auto
    finally show ?thesis .
  qed
  have "AE \<omega> in MC.T cfg. ev (HLD (- ?S)) \<omega>"
    apply (rule MC.AE_T_ev_HLD_infinite_strong'[where r = "enn2real r" and ?X = Y])
    apply (simp; fail)
    subgoal
      using \<open>r < 1\<close>
      by (metis ennreal_enn2real_if ennreal_less_one_iff zero_less_one)
    subgoal for x
     by (drule *)
        (metis Sigma_Algebra.measure_def assms(2) enn2real_mono ennreal_one_less_top less_trans)
    subgoal
      using assms(5)
      by (rule AE_mp) (rule AE_I2, intro impI, auto simp: HLD_iff elim: alw_mono)
    done
  then show ?thesis
    apply (rule AE_mp)
  proof (rule AE_mp[OF assms(4)], rule AE_mp[OF MC.AE_T_enabled], rule AE_I2, safe)
    fix \<omega> assume
      "\<omega> \<in> space (MC.T cfg)" "pred_stream (\<lambda>\<omega>. \<omega> \<in> X) \<omega>"
      "MC.enabled cfg \<omega>" "ev (HLD (- ?S)) \<omega>" "smap (f \<circ> state) \<omega> = sconst u"
    from this(2,3) \<open>cfg \<in> _\<close>
    have "pred_stream (\<lambda> x. x \<in> cfg_on (state x)) \<omega>"
      by (auto dest: cfg_onD_state intro!: cfg_on_inv)
    from \<open>smap _ \<omega> = _\<close> have "pred_stream (\<lambda> y. y \<in> (\<Union> x \<in> ?U. cfg_on x)) \<omega>"
    proof -
      have "(f o state) cfg = u" if "cfg \<in> sset \<omega>" for cfg
        using stream.set_map[of "f o state" \<omega>] that \<open>smap _ \<omega> = _\<close> by fastforce
      with \<open>pred_stream (\<lambda> x. x \<in> cfg_on (state x)) \<omega>\<close> show ?thesis
        by (auto elim!: stream.pred_mono_strong)
    qed
    with \<open>pred_stream (\<lambda>\<omega>. \<omega> \<in> X) \<omega>\<close> have "pred_stream (\<lambda> x. x \<in> ?S) \<omega>"
      by (coinduction arbitrary: \<omega>) auto
    then have "alw (HLD ?S) \<omega>"
      by (simp add: alw_holds_pred_stream_iff HLD_def)
    with \<open>ev (HLD (- ?S)) \<omega>\<close> show False
      unfolding not_ev_not[symmetric] not_HLD by simp
  qed
qed

lemma MC_T_not_sconst:
  assumes
    "\<forall> l. \<forall> cfg \<in> (\<Union> x \<in> f -` {u}. cfg_on x) \<inter> X. measure_pmf (action cfg) (f -` {u}) \<le> r"
    "r < 1" "cfg \<in> cfg_on x"
    "AE \<omega> in MC.T cfg. pred_stream (\<lambda> x. x \<in> X) \<omega>"
  shows "AE \<omega> in MC.T cfg. smap (f o state) \<omega> \<noteq> sconst u"
proof -
  let ?U = "f -` {u}"
  let ?S = "(\<Union> x \<in> f -` {u}. cfg_on x) \<inter> X"
  have *: "emeasure (K_cfg cfg) ?S \<le> r" if "cfg \<in> ?S" for cfg
  proof -
    have "emeasure (K_cfg cfg) ?S \<le> emeasure (measure_pmf (action cfg)) ?U"
      unfolding K_cfg_def by (auto dest: cfg_onD_state intro!: emeasure_mono)
    also from assms(1) \<open>cfg \<in> ?S\<close> have "\<dots> \<le> r"
      by auto
    finally show ?thesis .
  qed
  have "AE \<omega> in MC.T cfg. ev (HLD (- ?S)) \<omega>"
    apply (rule MC.AE_T_ev_HLD_infinite[where r = "enn2real r"])
    subgoal
      using \<open>r < 1\<close>
      by (metis ennreal_enn2real_if ennreal_less_one_iff zero_less_one)
    apply (drule *)
    by (metis Sigma_Algebra.measure_def assms(2) enn2real_mono ennreal_one_less_top less_trans)
  then show ?thesis
    apply (rule AE_mp)
  proof (rule AE_mp[OF assms(4)], rule AE_mp[OF MC.AE_T_enabled], rule AE_I2, safe)
    fix \<omega> assume
      "\<omega> \<in> space (MC.T cfg)" "pred_stream (\<lambda>\<omega>. \<omega> \<in> X) \<omega>"
      "MC.enabled cfg \<omega>" "ev (HLD (- ?S)) \<omega>" "smap (f \<circ> state) \<omega> = sconst u"
    from this(2,3) \<open>cfg \<in> _\<close>
    have "pred_stream (\<lambda> x. x \<in> cfg_on (state x)) \<omega>"
      by (auto dest: cfg_onD_state intro!: cfg_on_inv)
    from \<open>smap _ \<omega> = _\<close> have "pred_stream (\<lambda> y. y \<in> (\<Union> x \<in> ?U. cfg_on x)) \<omega>"
    proof -
      have "(f o state) cfg = u" if "cfg \<in> sset \<omega>" for cfg
        using stream.set_map[of "f o state" \<omega>] that \<open>smap _ \<omega> = _\<close> by fastforce
      with \<open>pred_stream (\<lambda> x. x \<in> cfg_on (state x)) \<omega>\<close> show ?thesis
        by (auto elim!: stream.pred_mono_strong)
    qed
    with \<open>pred_stream (\<lambda>\<omega>. \<omega> \<in> X) \<omega>\<close> have "pred_stream (\<lambda> x. x \<in> ?S) \<omega>"
      by (coinduction arbitrary: \<omega>) auto
    then have "alw (HLD ?S) \<omega>"
      by (simp add: alw_holds_pred_stream_iff HLD_def)
    with \<open>ev (HLD (- ?S)) \<omega>\<close> show False
      unfolding not_ev_not[symmetric] not_HLD by simp
  qed
qed

lemma MC_T_not_sconst':
  assumes
    "\<forall> cfg \<in> cfg_on x \<inter> X. measure_pmf (action cfg) {x} \<le> r" "r < 1" "cfg \<in> cfg_on x'"
    "AE \<omega> in MC.T cfg. pred_stream (\<lambda> x. x \<in> X) \<omega>"
  shows "AE \<omega> in MC.T cfg. smap state \<omega> \<noteq> sconst x"
  using assms by (rule MC_T_not_sconst[where f = id, simplified])

lemma K_cfg_cfg_onI:
  "cfg' \<in> cfg_on (state cfg')" if "cfg \<in> cfg_on x" "cfg' \<in> K_cfg cfg"
  using that by (force simp: set_K_cfg)

lemma MC_acc_cfg_onI:
  "cfg' \<in> cfg_on (state cfg')" if "(cfg, cfg') \<in> MC.acc" "cfg \<in> cfg_on x"
proof -
  from that(1) obtain n where "((\<lambda> a b. b \<in> K_cfg a) ^^ n) cfg cfg'"
    by (erule MC.acc_relfunD)
  with \<open>cfg \<in> cfg_on x\<close> show ?thesis
    by (induction n arbitrary: cfg') (auto intro: K_cfg_cfg_onI)
qed

lemma non_loop_tail_strong:
  assumes
    "\<forall> l. \<forall> cfg \<in> (\<Union> x \<in> f -` {u}. cfg_on x) \<inter> Y \<inter> X. measure_pmf (action cfg) (f -` {u}) \<le> r"
    "r < 1" "cfg \<in> cfg_on x"
    "AE \<omega> in MC.T cfg. pred_stream (\<lambda> x. x \<in> X) \<omega>"
    "AE \<omega> in MC.T cfg. alw (\<lambda> \<omega>. HLD (f -` {u}) (smap state \<omega>) \<longrightarrow> ev (HLD Y) \<omega>) \<omega>"
  shows "AE \<omega> in MC.T cfg. \<not> (ev (alw (\<lambda> xs. shd xs = u))) (smap (f o state) \<omega>)"
    (is "AE \<omega> in ?M. ?P \<omega>")
proof -
  have *: "?P \<omega> \<longleftrightarrow> alw (\<lambda> xs. smap (f o state) xs \<noteq> sconst u) \<omega>" for \<omega>
    apply (simp add: not_ev_iff)
    apply (rule arg_cong2[where f = alw])
     apply (rule ext)
    subgoal for xs
      using MC.alw_HLD_iff_sconst[of u "smap (f o state) xs"] by (simp add: HLD_iff)
    by (rule HOL.refl)
  have "AE \<omega> in ?M. alw (\<lambda> xs. smap (f o state) xs \<noteq> sconst u) \<omega>"
    apply (rule MC.AE_T_alw)
    subgoal by (intro pred_intros_logic measurable_eq_stream_space) measurable
    using assms
    by - (erule MC_T_not_sconst_strong,
        auto intro: MC.AE_all_accD MC.AE_alw_accD elim: MC_acc_cfg_onI
        )
  with * show ?thesis
    by simp
qed

lemma non_loop_tail:
  assumes
    "\<forall> l. \<forall> cfg \<in> (\<Union> x \<in> f -` {u}. cfg_on x) \<inter> X. measure_pmf (action cfg) (f -` {u}) \<le> r"
    "r < 1" "cfg \<in> cfg_on x"
    "AE \<omega> in MC.T cfg. pred_stream (\<lambda> x. x \<in> X) \<omega>"
  shows "AE \<omega> in MC.T cfg. \<not> (ev (alw (\<lambda> xs. shd xs = u))) (smap (f o state) \<omega>)"
    (is "AE \<omega> in ?M. ?P \<omega>")
proof -
  have *: "?P \<omega> \<longleftrightarrow> alw (\<lambda> xs. smap (f o state) xs \<noteq> sconst u) \<omega>" for \<omega>
    apply (simp add: not_ev_iff)
    apply (rule arg_cong2[where f = alw])
     apply (rule ext)
    subgoal for xs
      using MC.alw_HLD_iff_sconst[of u "smap (f o state) xs"] by (simp add: HLD_iff)
    by (rule HOL.refl)
  have "AE \<omega> in ?M. alw (\<lambda> xs. smap (f o state) xs \<noteq> sconst u) \<omega>"
    apply (rule MC.AE_T_alw)
    subgoal by (intro pred_intros_logic measurable_eq_stream_space) measurable
    using assms by - (erule MC_T_not_sconst, auto intro: MC.AE_all_accD elim: MC_acc_cfg_onI)
  with * show ?thesis
    by simp
qed

lemma non_loop_tail':
  assumes
    "\<forall> cfg \<in> cfg_on x \<inter> X. measure_pmf (action cfg) {x} \<le> r" "r < 1"
    "cfg \<in> cfg_on y"
    "AE \<omega> in MC.T cfg. pred_stream (\<lambda> x. x \<in> X) \<omega>"
  shows "AE \<omega> in MC.T cfg. \<not> (ev (alw (\<lambda> xs. shd xs = x))) (smap state \<omega>)"
  using assms by simp (erule non_loop_tail[where f = id, simplified])

end

lemma (in Regions) intv_const_mono:
  assumes "u \<in> region X I r" "c1 \<in> X" "c2 \<in> X" "u c1 \<le> u c2" "\<not> isGreater (I c2)"
  shows "intv_const (I c1) \<le> intv_const (I c2)"
proof -
  from assms have "intv_elem c1 u (I c1)" "intv_elem c2 u (I c2)" by auto
  with \<open>u c1 \<le> u c2\<close> \<open>\<not> _\<close> show ?thesis by (cases "I c1"; cases "I c2"; auto)
qed

lemma sset_sdrop:
  assumes "x \<in> sset (sdrop i xs)"
  shows "x \<in> sset xs"
using assms by (auto simp: sset_range)

lemma holds_untilD:
  assumes "(holds P until holds Q) xs" "\<forall> i \<le> j. \<not> Q (xs !! i)"
  shows "P (xs !! j)"
using assms
proof (induction j arbitrary: xs)
  case 0
  then show ?case by cases auto
next
  case (Suc j)
  from Suc.prems show ?case by cases (auto dest!: Suc.IH)
qed

(* TODO: Move *)
lemma frac_le_self:
  assumes "x \<ge> 0"
  shows "frac x \<le> x"
  using assms less_trans [of "frac x" 1 x]
  by (auto simp add: le_less frac_eq not_less frac_lt_1)

lemma frac_le_1I:
  assumes "0 \<le> x" "x \<le> 1" "x \<le> y"
  shows "frac x \<le> y"
  using assms dual_order.trans frac_le_self by auto

lemma frac_le_1I':
  assumes "0 \<le> x" "x \<le> y" "y < 1"
  shows "frac x \<le> frac y"
proof -
  from assms have "frac y = y" by (simp add: frac_eq)
  moreover from assms have "frac x \<le> y" by (auto intro: frac_le_1I)
  ultimately show ?thesis by simp
qed

(* XXX Move *)
lemmas [intro] = order.strict_implies_order[OF frac_lt_1]

lemma nat_eventually_critical_path:
  fixes i :: nat
  assumes "P i" "\<not> P j" "i < j"
  shows "\<exists> k > i. k \<le> j \<and> \<not> P k \<and> (\<forall> m \<ge> i. m < k \<longrightarrow> P m)"
proof -
  let ?S = "{k. i < k \<and> k \<le> j \<and> \<not> P k}"
  let ?k = "Min ?S"
  from assms have "j \<in> ?S" by auto
  moreover have "finite ?S" by auto
  ultimately have "i < ?k" "?k \<le> j" "\<not> P ?k" using Min_in[of ?S] by blast+
  moreover have "P m" if "i \<le> m" "m < ?k" for m
  proof (cases "i = m")
    case True with \<open>P i\<close> show ?thesis by simp
  next
    case False
    with \<open>i \<le> m\<close> have "i < m" by simp
    with Min_le[OF \<open>finite _\<close>] \<open>m < ?k\<close> \<open>?k \<le> j\<close> show ?thesis by fastforce
  qed
  ultimately show ?thesis using \<open>P i\<close> by - (rule exI[where x = ?k]; blast)
qed

subsection \<open>MDP Invariant\<close>

locale Markov_Decision_Process_Invariant =
  Markov_Decision_Process K for K :: "'s \<Rightarrow> 's pmf set"+
fixes S :: "'s set"
assumes invariant: "\<And> s D. s \<in> S \<Longrightarrow> D \<in> K s \<Longrightarrow> (\<forall>s' \<in> D. s' \<in> S)"
begin

lemma E_invariant:
  "{s'. (s, s') \<in> E} \<subseteq> S" if "s \<in> S"
  using that by (auto dest: invariant simp: E_def)

definition "valid_cfg = (\<Union>s\<in>S. cfg_on s)"

lemma valid_cfgI: "s \<in> S \<Longrightarrow> cfg \<in> cfg_on s \<Longrightarrow> cfg \<in> valid_cfg"
  by (auto simp: valid_cfg_def)

lemma valid_cfgD: "cfg \<in> valid_cfg \<Longrightarrow> cfg \<in> cfg_on (state cfg)"
  by (auto simp: valid_cfg_def)

lemma action_closed: "s \<in> S \<Longrightarrow> cfg \<in> cfg_on s \<Longrightarrow> t \<in> action cfg \<Longrightarrow> t \<in> S"
  using cfg_onD_action[of cfg s] invariant[of s] by auto

lemma
  shows valid_cfg_state_in_S: "cfg \<in> valid_cfg \<Longrightarrow> state cfg \<in> S"
    and valid_cfg_action: "cfg \<in> valid_cfg \<Longrightarrow> s \<in> action cfg \<Longrightarrow> s \<in> S"
    and valid_cfg_cont: "cfg \<in> valid_cfg \<Longrightarrow> s \<in> action cfg \<Longrightarrow> cont cfg s \<in> valid_cfg"
  by (auto simp: valid_cfg_def intro!: bexI[of _ s] intro: action_closed)

lemma valid_K_cfg[intro]: "cfg \<in> valid_cfg \<Longrightarrow> cfg' \<in> K_cfg cfg \<Longrightarrow> cfg' \<in> valid_cfg"
  by (auto simp add: K_cfg_def valid_cfg_cont)

lemma pred_stream_valid_cfg:
  assumes valid: "cfg \<in> valid_cfg"
  assumes enabled: "MC.enabled cfg xs"
  shows "pred_stream (\<lambda> cfg. cfg \<in> valid_cfg) xs"
  using assms by (coinduction arbitrary: cfg xs) (subst (asm) MC.enabled_iff; auto)

lemma pred_stream_cfg_on:
  assumes valid: "cfg \<in> valid_cfg"
  assumes enabled: "MC.enabled cfg xs"
  shows "pred_stream (\<lambda> cfg. state cfg \<in> S \<and> cfg \<in> cfg_on (state cfg)) xs"
  using valid pred_stream_valid_cfg[OF _ enabled] unfolding stream.pred_set
  by (auto intro: valid_cfgI dest: valid_cfgD valid_cfg_state_in_S)

lemma alw_S: "almost_everywhere (T cfg) (pred_stream (\<lambda>s. s \<in> S))" if "cfg \<in> valid_cfg"
  unfolding T_def using pred_stream_cfg_on \<open>cfg \<in> valid_cfg\<close>
  by (subst AE_distr_iff) (measurable, auto simp: stream.pred_set intro: AE_mp[OF MC.AE_T_enabled])

end

context Finite_Markov_Decision_Process
begin

sublocale Invariant: Markov_Decision_Process_Invariant
  rewrites "Invariant.valid_cfg = valid_cfg"
proof -
  show "Markov_Decision_Process_Invariant K S"
    by standard (auto dest: set_pmf_closed)
  then show "Markov_Decision_Process_Invariant.valid_cfg K S = valid_cfg"
    by (subst Markov_Decision_Process_Invariant.valid_cfg_def; simp add: valid_cfg_def)
qed

lemmas pred_stream_cfg_on = Invariant.pred_stream_cfg_on
   and pred_stream_valid_cfg = Invariant.pred_stream_valid_cfg
   and alw_S = Invariant.alw_S
   and valid_cfg_state_in_S = Invariant.valid_cfg_state_in_S

end

end


(*  Title:       The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols
    Author:      Pasquale Noce
                 Software Engineer at HID Global, Italy
                 pasquale dot noce dot lavoro at gmail dot com
                 pasquale dot noce at hidglobal dot com
*)

section "The relational method and message anonymity"

theory Definitions
  imports Main
begin

text \<open>
\null

\emph{This paper is dedicated to my mother, my favourite chess opponent -- in addition to being many
other wonderful things!}
\<close>

subsection "Introduction"

text \<open>
As Bertrand Russell says in the last pages of \emph{A History of Western Philosophy}, a distinctive
feature of science is that "we can make successive approximations to the truth, in which each new
stage results from an improvement, not a rejection, of what has gone before". When dealing with a
formal verification method for information processing systems, such as Paulson's inductive method
for the verification of cryptographic protocols (cf. \<^cite>\<open>"Paulson98"\<close>, \<^cite>\<open>"Paulson20"\<close>), a
more modest goal for this iterative improvement process, yet of significant practical importance, is
to streamline the definitions and proofs needed to model such a system and verify its properties.

With this aim, specially when it comes to verifying protocols using public key cryptography, this
paper proposes an enhancement of the inductive method, named \emph{relational method} for reasons
clarified in what follows, and puts it into practice by verifying a sample protocol. This new method
is the result of some changes to the way how events, states, spy's capabilities, and the protocol
itself are formalized in the inductive method. Here below is a description of these changes, along
with a rationale for them.

  \<^descr>[Events.] In the inductive method, the fundamental building blocks of cryptographic protocols are
events of the form @{text "Says A B X"}, where @{text X} is a message being exchanged, @{text A} is
the agent that sends it, and @{text B} is the agent to which it is addressed.
\\However, any exchanged message can be intercepted by the spy and forwarded to any other agent, so
its intended recipient is not relevant for the protocol \emph{security} correctness -- though of
course being relevant for the protocol \emph{functional} correctness. Moreover, a legitimate agent
may also generate messages, e.g. ephemeral private keys, that she will never exchange with any other
agent. To model such an event, a datatype constructor other than @{text Says} should be used. How to
make things simpler?
\\The solution adopted in the relational method is to model events just as ordered pairs of the form
@{text "(A, X)"}, where @{text A} is an agent and @{text X} is a message. If event @{text "(A, X)"}
stands for @{text A}'s sending of @{text X} to another agent, where @{text A} is a legitimate agent,
then this event will be accompanied by event @{text "(Spy, X)"}, representing the spy's interception
of @{text X}. If event @{text "(A, X)"} rather stands for @{text A}'s generation of private message
@{text X}, e.g. an ephemeral private key, for her own exclusive use -- and if the spy has not hacked
@{text A} so as to steal her private messages as well --, then no companion event @{text "(Spy, X)"}
will occur instead.

  \<^descr>[States.] In the inductive method, the possible states of a cryptographic protocol are modeled as
event \emph{traces}, i.e. lists, and the protocol itself is formalized as a set of such traces.
Consequently, the protocol rules and security properties are expressed as formulae satisfied by any
event trace @{text evs} belonging to this set.
\\However, these formulae are such that their truth values depend only on the events contained in
@{text evs}, rather than on the actual order in which they occur -- in fact, robust protocol rules
and security properties cannot depend on the exact sequence of message exchanges in a scenario where
the spy can freely intercept and forward messages, or even generate and send her own ones. Thus, one
library function, @{const set}, and two custom recursive functions, @{text used} and @{text knows},
are needed to convert event traces into event sets and message sets, respectively.
\\In the relational method, protocol states are simply modeled as event sets, so that the occurrence
of event @{text "(A, X)"} in state @{text s} can be expressed as the transition to the augmented
state @{term "insert (A, X) s"}. Hence, states consist of relations between agents and messages. As
a result, function @{const set} need not be used any longer, whereas functions @{text used} and
@{text spied} -- the latter one being a replacement for @{text "knows Spy"} --, which take a state
@{text s} as input, are mere abbreviations for @{term "Range s"} and @{term "s `` {Spy}"}.

  \<^descr>[Spy's capabilities.] In the inductive method, the spy's attack capabilities are formalized via
two inductively defined functions, @{text analz} and @{text synth}, used to construct the sets of
all the messages that the spy can learn -- @{text "analz (knows Spy evs)"} -- and send to legitimate
agents -- @{text "synth (analz (knows Spy evs))"} -- downstream of event trace @{text evs}.
\\Indeed, the introduction of these functions goes in the direction of decoupling the formalization
of the spy's capabilities from that of the protocol itself, consistently with the fact that what the
spy can do is independent of how the protocol works -- which only matters when it comes to verifying
protocol security.
\\In principle, this promises to provide a relevant benefit: these functions need to be defined, and
their properties to be proven, just once, whereupon such definitions and properties can be reused in
the formalization and verification of whatever protocol.
\\In practice, since both functions are of type @{text "msg set \<Rightarrow> msg set"}, where @{text msg} is
the datatype defining all possible message formats, this benefit only applies as long as message
formats remain unchanged. However, when it comes to verifying a protocol making use of public key
cryptography, some new message format, and consequently some new related spy's capability as well,
are likely to be required. An example of this will be provided right away by the protocol considered
in this paper.
\\In the relational method, the representation of events as agent-message pairs offers a simpler way
to model the spy's capabilities, namely as supplementary protocol rules, analogous to the inductive
method's @{text Fake} rule, augmenting a state by one or more events of the form @{text "(Spy, X)"}.
In addition to eliminating the need for functions @{text analz} and @{text synth} -- which, in light
of the above considerations, does not significantly harm reusability --, this choice also abolishes
any distinction between what the spy can learn and what she can send. In fact, a state containing
event @{text "(Spy, X)"} is interpreted as one where the spy both knows message @{text X} and may
have sent it to whatever legitimate agent. Actually, this formalizes the facts that a real-world
attacker is free to send any message she has learned to any other party, and conversely to use any
message she has generated to further augment her knowledge.
\\In the inductive method, the former fact is modeled by property @{term "H \<subseteq> synth H"} of function
@{text synth}, but the latter one has no formal counterpart, as in general @{term "H \<subset> synth H"}.
This limitation on the spy's capabilities is not significant as long as the protocol makes use of
static keys only, but it is if session keys or ephemeral key pairs are generated -- as happens in
key establishment protocols, even in those using symmetric cryptography alone. In any such case, a
realistic spy must also be able to learn from anything she herself has generated, such as a nonce or
an ephemeral private key -- a result achieved without effort in the relational method.
\\An additional, nontrivial problem for the inductive method is that many protocols, including key
establishment ones, require the spy to be able to generate \emph{fresh} ephemeral messages only, as
otherwise the spy could succeed in breaking the protocol by just guessing the ephemeral messages
already generated at random by some legitimate agent -- a quite unrealistic attack pattern, provided
that such messages vary in a sufficiently wide range. At first glance, this need could be addressed
by extending the inductive definition of function @{text synth} with introduction rules of the form
@{term "Nonce n \<notin> H \<Longrightarrow> Nonce n \<in> synth H"} or @{term "PriKey A \<notin> H \<Longrightarrow> PriKey A \<in> synth H"}.
However, private ephemeral messages are not in general included in @{text "analz (knows Spy evs)"},
since nonces may be encrypted with uncompromised keys when exchanged and private keys are usually
not exchanged at all, so this approach would not work. The only satisfactory alternative would be to
change the signature of function @{text synth}, e.g. by adding a second input message set @{text H'}
standing for @{text "used evs"}, or else by replacing @{text H} with event trace @{text evs} itself,
but this would render the function definition much more convoluted -- a problem easily bypassed in
the relational method.

  \<^descr>[Protocol.] In the inductive method, a cryptographic protocol consists of an inductively defined
set of event traces. This enables to prove the protocol security properties by induction using the
induction rule automatically generated as a result of such an inductive definition, i.e. by means of
\emph{rule induction}. Actually, this feature is exactly what gives the method its very name. Hence,
a consistent way to name a protocol verification method using some other form of induction would be
to replace adjective "inductive" with another one referring to that form of induction.
\\The relational method owes its name to this consideration. In this method, the introduction rules
defining \emph{protocol rules}, i.e. the possible transitions between protocol states, are replaced
with \emph{relations} between states, henceforth named \emph{protocol relations}. That is, for any
two states @{text s} and @{text s'}, there exists a transition leading from @{text s} to @{text s'}
just in case the ordered pair @{term "(s, s')"} is contained in at least one protocol relation --
a state of affairs denoted using infix notation @{text "s \<turnstile> s'"}. Then, the inductively defined set
itself is replaced with the \emph{reflexive transitive closure} of the union of protocol relations.
Namely, any state @{text s} may be reached from \emph{initial state} @{text s\<^sub>0}, viz. is a possible
protocol state, just in case pair @{term "(s\<^sub>0, s)"} lies within this reflexive transitive closure --
a state of affairs denoted using infix notation @{text "s\<^sub>0 \<Turnstile> s"}. As a result, rule induction is
replaced with induction over reflexive transitive closures via rule @{thm [source] rtrancl_induct},
which is the circumstance that originates the method name.
\\These changes provide the following important benefits.

    \<^item> Inserting and modifying the formal definition of a protocol is much more comfortable. In fact,
any change even to a single introduction rule within a monolithic inductive set definition entails a
re-evaluation of the whole definition, whereas each protocol relation will have its own stand-alone
definition, which also makes it easier to find errors. This advantage may go almost unnoticed for a
very simple protocol providing for just a few protocol rules, but gets evident in case of a complex
protocol. An example of this will be provided by the protocol considered in this paper: when looking
at the self-contained abbreviations used to define protocol relations, the reader will easily grasp
how much more convoluted an equivalent inductive set definition would have been.

    \<^item> In addition to induction via rule @{thm [source] rtrancl_induct}, a further powerful reasoning
pattern turns out to be available. It is based on the following general rule applying to reflexive
transitive closures (indeed, a rule so general and useful that it could rightfully become part of
the standard library), later on proven and assigned the name @{text rtrancl_start}:
@{prop [display] "\<lbrakk>(x, y) \<in> r\<^sup>*; P y; \<not> P x\<rbrakk> \<Longrightarrow>
\<exists>u v. (x, u) \<in> r\<^sup>* \<and> (u, v) \<in> r \<and> (v, y) \<in> r\<^sup>* \<and> \<not> P u \<and> P v"}
In natural language, this rule states that for any chain of elements linked by a relation, if some
predicate is false for the first element of the chain and true for the last one, there must exist a
link in the chain where the predicate becomes true.
\\This rule can be used to prove propositions of the form @{text "\<lbrakk>s \<Turnstile> s'; P s'[; Q]\<rbrakk> \<Longrightarrow> R s'"} for
any state @{text s} and predicate @{text P} such that @{term "\<not> P s"}, with an optional additional
assumption @{text Q}, without resorting to induction. Notably, \emph{regularity lemmas} have exactly
this form, where @{term "s = s\<^sub>0"}, @{term "P = (\<lambda>s. X \<in> parts (used s))"} for some term @{text X} of
type @{text msg}, and @{text Q}, if present, puts some constraint on @{text X} or its components.
\\Such a proof consists of two steps. First, lemma @{text "\<lbrakk>s \<turnstile> s'; P s'; \<not> P s[; Q]\<rbrakk> \<Longrightarrow> R s'"} is
proven by simplification, using the definitions of protocol relations. Then, the target proposition
is proven by applying rule @{text rtrancl_start} as a destruction rule (cf. \<^cite>\<open>"Paulson20"\<close>) and
proving @{term "P s'"} by assumption, @{term "\<not> P s"} by simplification, and the residual subgoal
by means of the previous lemma.

In addition to the relational method, this paper is aimed at introducing still another enhancement:
besides message confidentiality and authenticity, it takes into consideration a further important
security property, \emph{message anonymity}. Being legitimate agents identified via natural numbers,
the fact that in state @{text s} the spy ignores that message @{text X\<^sub>n} is associated with agent
@{text n}, viz. @{text X\<^sub>n}'s property of being \emph{anonymous} in state @{text s}, can be expressed
as @{text "\<langle>n, X\<^sub>n\<rangle> \<notin> spied s"}, where notation @{text "\<langle>n, X\<^sub>n\<rangle>"} refers to a new constructor added to
datatype @{text msg} precisely for this purpose.

A basic constraint upon any protocol relation augmenting the spy's knowledge with @{text "\<langle>n, X\<rangle>"}
is that the spy must know message @{text X} in the current state, as it is impossible to identify
the agent associated with an unknown message. There is also an additional, more subtle constraint.
Any such protocol relation either augments a state in which the spy knows @{text "\<langle>n, C X\<^sub>1 \<dots> X\<^sub>m\<rangle>"},
i.e. containing event @{text "(Spy, \<langle>n, C X\<^sub>1 \<dots> X\<^sub>m\<rangle>)"}, with event @{text "(Spy, \<langle>n, X\<^sub>i\<rangle>)"}, where
$1 \leq i \leq m$ and @{text C} is some constructor of datatype @{text msg}, or conversely augments
a state containing event @{text "(Spy, \<langle>n, X\<^sub>i\<rangle>)"} with @{text "(Spy, \<langle>n, C X\<^sub>1 \<dots> X\<^sub>m\<rangle>)"}. However, the
latter spy's inference is justified only if the compound message @{text "C X\<^sub>1 \<dots> X\<^sub>m"} is part of a
message generated or accepted by some legitimate agent according to the protocol rules. Otherwise,
that is, if @{text "C X\<^sub>1 \<dots> X\<^sub>m"} were just a message generated at random by the spy, her inference
would be as sound as those of most politicians and all advertisements: even if the conclusion were
true, it would be so by pure chance.

This problem can be solved as follows.

  \<^item> A further constructor @{text Log}, taking a message as input, is added to datatype @{text msg},
and every protocol relation modeling the generation or acceptance of a message @{text X} by some
legitimate agent must augment the current state with event @{term "(Spy, Log X)"}.
\\In this way, the set of all the messages that have been generated or accepted by some legitimate
agent in state @{text s} matches @{term "Log -` spied s"}.

  \<^item> A function @{text crypts} is defined inductively. It takes a message set @{text H} as input, and
returns the least message set @{text H'} such that @{term "H \<subseteq> H'"} and for any (even empty) list
of keys @{text KS}, if the encryption of @{text "\<lbrace>X, Y\<rbrace>"}, @{text "\<lbrace>Y, X\<rbrace>"}, or @{text "Hash X"}
with @{text KS} is contained in @{text H'}, then the encryption of @{text X} with @{text KS} is
contained in @{text H'} as well.
\\In this way, the set of all the messages that are part of messages exchanged by legitimate agents,
viz. that may be mapped to agents, in state @{text s} matches @{term "crypts (Log -` spied s)"}.

  \<^item> Another function @{text key_sets} is defined, too. It takes two inputs, a message @{text X} and
a message set @{text H}, and returns the set of the sets of @{text KS}' inverse keys for any list of
keys @{text KS} such that the encryption of @{text X} with @{text KS} is included in @{text H}.
\\In this way, the fact that in state @{text s} the spy can map a compound message @{text X} to some
agent, provided that she knows all the keys in set @{text U}, can be expressed through conditions
@{term "U \<in> key_sets X (crypts (Log -` spied s))"} and @{term "U \<subseteq> spied s"}.
\\The choice to define @{text key_sets} so as to collect the inverse keys of encryption keys, viz.
decryption ones, depends on the fact that the sample protocol verified in this paper uses symmetric
keys alone -- which match their own inverse keys -- for encryption, whereas asymmetric key pairs are
used in cryptograms only for signature generation -- so that the inverse keys are public ones. In
case of a protocol (also) using public keys for encryption, encryption keys themselves should (also)
be collected, since the corresponding decryption keys, i.e. private keys, would be unknown to the
spy by default. This would formalize the fact that encrypted messages can be mapped to agents not
only by decrypting them, but also by recomputing the cryptograms (provided that the plaintexts are
known) and checking whether they match the exchanged ones.
\<close>

subsection "A sample protocol"

text \<open>
As previously mentioned, this paper tries the relational method, including message anonymity, by
applying it to the verification of a sample authentication protocol in which Password Authenticated
Connection Establishment (PACE) with Chip Authentication Mapping (cf. \<^cite>\<open>"ICAO15"\<close>) is first
used by an \emph{owner} to establish a secure channel with her own \emph{asset} and authenticate it,
and then the owner sends a password (other than the PACE one) to the asset over that channel so as
to authenticate herself. This enables to achieve a reliable mutual authentication even if the PACE
key is shared by multiple owners or is weak, as happens in electronic passports. Although the PACE
mechanism is specified for use in electronic documents, nothing prevents it in principle from being
used in other kinds of smart cards or even outside of the smart card world, which is the reason why
this paper uses the generic names \emph{asset} and \emph{owner} for the card and the cardholder,
respectively.

In more detail, this protocol provides for the following steps. In this list, messages are specified
using the same syntax that will be adopted in the formal text (for further information about PACE
with Chip Authentication Mapping, cf. \<^cite>\<open>"ICAO15"\<close>).

  \<^enum> \emph{Asset n} $\rightarrow$ \emph{Owner n}:
\\\hspace*{1em}@{text "Crypt (Auth_ShaKey n) (PriKey S)"}

  \<^enum> \emph{Owner n} $\rightarrow$ \emph{Asset n}:
\\\hspace*{1em}@{text "\<lbrace>Num 1, PubKey A\<rbrace>"}

  \<^enum> \emph{Asset n} $\rightarrow$ \emph{Owner n}:
\\\hspace*{1em}@{text "\<lbrace>Num 2, PubKey B\<rbrace>"}

  \<^enum> \emph{Owner n} $\rightarrow$ \emph{Asset n}:
\\\hspace*{1em}@{text "\<lbrace>Num 3, PubKey C\<rbrace>"}

  \<^enum> \emph{Asset n} $\rightarrow$ \emph{Owner n}:
\\\hspace*{1em}@{text "\<lbrace>Num 4, PubKey D\<rbrace>"}

  \<^enum> \emph{Owner n} $\rightarrow$ \emph{Asset n}:
\\\hspace*{1em}@{text "Crypt (SesK SK) (PubKey D)"}

  \<^enum> \emph{Asset n} $\rightarrow$ \emph{Owner n}:
\\\hspace*{1em}@{text "\<lbrace>Crypt (SesK SK) (PubKey C),"}
\\\hspace*{1.5em}@{text "Crypt (SesK SK) (Auth_PriK n \<otimes> B),"}
\\\hspace*{1.5em}@{text "Crypt (SesK SK) (Crypt SigK"}
\\\hspace*{2em}@{text "\<lbrace>Hash (Agent n), Hash (Auth_PubKey n)\<rbrace>)\<rbrace>"}

  \<^enum> \emph{Owner n} $\rightarrow$ \emph{Asset n}:
\\\hspace*{1em}@{text "Crypt (SesK SK) (Pwd n)"}

  \<^enum> \emph{Asset n} $\rightarrow$ \emph{Owner n}:
\\\hspace*{1em}@{text "Crypt (SesK SK) (Num 0)"}

Legitimate agents consist of an infinite population of assets and owners. For each natural number
@{text n}, @{text "Owner n"} is an owner and @{text "Asset n"} is her own asset, and these agents
are assigned the following authentication data.

  \<^item> @{text "Key (Auth_ShaKey n)"}: static symmetric PACE key shared by both agents.

  \<^item> @{text "Auth_PriKey n"}, @{text "Auth_PubKey n"}: static private and public keys stored on
@{text "Asset n"} and used for @{text "Asset n"}'s authentication via Chip Authentication Mapping.

  \<^item> @{text "Pwd n"}: unique password (other than the PACE one) shared by both agents and used for
@{text "Owner n"}'s authentication.

Function @{text Pwd} is defined as a constructor of datatype @{text msg} and then is injective,
which formalizes the assumption that each asset-owner pair has a distinct password, whereas no such
constraint is put on functions @{text Auth_ShaKey}, @{text Auth_PriKey}, and @{text Auth_PubKey},
which allows multiple asset-owner pairs to be assigned the same keys. On the other hand, function
@{text Auth_PriKey} is constrained to be such that the complement of its range is infinite. As each
protocol run requires the generation of fresh ephemeral private keys, this constraint ensures that
an unbounded number of protocol runs can be carried out. All assumptions are formalized by applying
the definitional approach, viz. without introducing any axiom, and so is this constraint, expressed
by defining function @{text Auth_PriKey} using the indefinite description operator @{text SOME}.

The protocol starts with @{text "Asset n"} sending an ephemeral private key encrypted with the PACE
key to @{text "Owner n"}. Actually, if @{text "Asset n"} is a smart card, the protocol should rather
start with @{text "Owner n"} sending a plain request for such encrypted nonce, but this preliminary
step is omitted here as it is irrelevant for protocol security. After that, @{text "Owner n"} and
@{text "Asset n"} generate two ephemeral key pairs each and send the respective public keys to the
other party.

Then, both parties agree on the same session key by deriving it from the ephemeral keys generated
previously (actually, two distinct session keys would be derived, one for encryption and the other
one for MAC computation, but such a level of detail is unnecessary for protocol verification). The
session key is modeled as @{text "Key (SesK SK)"}, where @{text SesK} is an apposite constructor
added to datatype @{text key} and @{term "SK = (Some S, {A, B}, {C, D})"}. The adoption of type
@{typ "nat option"} for the first component enables to represent as @{term "(None, {A, B}, {C, D})"}
the wrong session key derived from @{text "Owner n"} if @{text "PriKey S"} was encrypted using a key
other than @{text "Key (Auth_ShaKey n)"} -- which reflects the fact that the protocol goes on even
without the two parties sharing the same session key. The use of type @{typ "nat set"} for the other
two components enables the spy to compute @{text "Key (SesK SK)"} if she knows \emph{either} private
key and the other public key referenced by each set, as long as she also knows @{text "PriKey S"} --
which reflects the fact that given two key pairs, Diffie-Hellman key agreement generates the same
shared secret independently of which of the respective private keys is used for computation.

This session key is used by both parties to compute their authentication tokens. Both encrypt the
other party's second ephemeral public key, but @{text "Asset n"} appends two further fields: the
Encrypted Chip Authentication Data, as provided for by Chip Authentication Mapping, and an encrypted
signature of the hash values of @{text "Agent n"} and @{text "Auth_PubKey n"}. Infix notation
@{text "Auth_PriK n \<otimes> B"} refers to a constructor of datatype @{text msg} standing for plain Chip
Authentication Data, and @{text Agent} is another such constructor standing for agent identification
data. @{text "Owner n"} is expected to validate this signature by also checking @{text "Agent n"}'s
hash value against reference identification data known by other means -- otherwise, the spy would
not be forced to know @{text "Auth_PriKey n"} to masquerade as @{text "Asset n"}, since she could do
that by just knowing @{text "Auth_PriKey m"} for some other @{text m}, even if @{term "Auth_PriKey m
\<noteq> Auth_PriKey n"}. If @{text "Asset n"} is an electronic passport, the owner, i.e. the inspection
system, could get cardholder's identification data by reading her personal data on the booklet, and
such a signature could be retrieved from the chip (actually through a distinct message, but this is
irrelevant for protocol security as long as the password is sent after the signature's validation)
by reading the Document Security Object -- provided that @{text "Auth_PubKey n"} is included within
Data Group 14.

The protocol ends with @{text "Owner n"} sending her password, encrypted with the session key, to
@{text "Asset n"}, who validates it and replies with an encrypted acknowledgment.

Here below are some concluding remarks about the way how this sample protocol is formalized.

  \<^item> A single signature private key, unknown to the spy, is assumed to be used for all legitimate
agents. Similarly, the spy might have hacked some legitimate agent so as to steal her ephemeral
private keys and session keys as soon as they are generated, but here all legitimate agents are
assumed to be out of the spy's reach in this respect. Of course, this is just the choice of one of
multiple possible modeling scenarios, and nothing prevents these assumptions from being dropped.

  \<^item> In the real world, a legitimate agent would use any one of her ephemeral private keys just once,
after which the key would be destroyed. On the contrary, no such constraint is enforced here, since
it turns out to be unnecessary for protocol verification. There is a single exception, required for
the proof of a unicity lemma: after @{text "Asset n"} has used @{text "PriKey B"} to compute her
authentication token, she must discard @{text "PriKey B"} so as not to use this key any longer. The
way how this requirement is expressed emphasizes once more the flexibility of the modeling of events
in the relational method: @{text "Asset n"} may use @{text "PriKey B"} in this computation only if
event @{text "(Asset n, PubKey B)"} is not yet contained in the current state @{text s}, and then
@{text s} is augmented with that event. Namely, events can also be used to model garbage collection!

  \<^item> The sets of the legitimate agents whose authentication data have been identified in advance (or
equivalently, by means other than attacking the protocol, e.g. by social engineering) by the spy are
defined consistently with the constraint that known data alone can be mapped to agents, as well as
with the definition of initial state @{text s\<^sub>0}. For instance, the set @{text bad_id_prikey} of the
agents whose Chip Authentication private keys have been identified is defined as a subset of the set
@{text bad_prikey} of the agents whose Chip Authentication private keys have been stolen. Moreover,
all the signatures included in assets' authentication tokens are assumed to be already known to the
spy in state @{text s\<^sub>0}, so that @{text bad_id_prikey} includes also any agent whose identification
data or Chip Authentication public key have been identified in advance.

  \<^item> The protocol rules augmenting the spy's knowledge with some message of the form @{text "\<langle>n, X\<rangle>"}
generally require the spy to already know some other message of the same form. There is just one
exception: the spy can infer @{text "\<langle>n, Agent n\<rangle>"} from @{text "Agent n"}. This expresses the fact
that the detection of identification data within a message generated or accepted by some legitimate
agent is in itself sufficient to map any known component of that message to the identified agent,
regardless of whether any data were already mapped to that agent in advance.

  \<^item> As opposed to what happens for constructors @{text "(\<otimes>)"} and @{text "MPair"}, there do not
exist two protocol rules enabling the spy to infer @{text "\<langle>n, Crypt K X\<rangle>"} from @{text "\<langle>n, X\<rangle>"} or
@{text "\<langle>n, Key K\<rangle>"} and vice versa. A single protocol rule is rather defined, which enables the spy
to infer @{text "\<langle>n, X\<rangle>"} from @{text "\<langle>n, Key K\<rangle>"} or vice versa, provided that @{text "Crypt K X"}
has been exchanged by some legitimate agent. In fact, the protocol provides for just one compound
message made up of cryptograms, i.e. the asset's authentication token, and all these cryptograms are
generated using the same encryption key @{text "Key (SesK SK)"}. Thus, if two such cryptograms have
plaintexts @{text X\<^sub>1}, @{text X\<^sub>2} and the spy knows @{text "\<langle>n, X\<^sub>1\<rangle>"}, she can infer @{text "\<langle>n, X\<^sub>2\<rangle>"}
by inferring @{text "\<langle>n, Key (SesK SK)\<rangle>"}, viz. she need not know @{text "\<langle>n, Crypt (SesK SK) X\<^sub>1\<rangle>"}
to do that.

The formal content is split into the following sections.

  \<^item> Section \ref{Definitions}, \emph{Definitions}, contains all the definitions needed to formalize
the sample protocol by means of the relational method, including message anonymity.

  \<^item> Section \ref{Authentication}, \emph{Confidentiality and authenticity properties}, proves that
the following theorems hold under appropriate assumptions.

    \<^enum> Theorem @{text sigkey_secret}: the signature private key is secret.

    \<^enum> Theorem @{text auth_shakey_secret}: an asset-owner pair's PACE key is secret.

    \<^enum> Theorem @{text auth_prikey_secret}: an asset's Chip Authentication private key is secret.

    \<^enum> Theorem @{text owner_seskey_unique}: an owner's session key is unknown to other owners.

    \<^enum> Theorem @{text owner_seskey_secret}: an owner's session key is secret.

    \<^enum> Theorem @{text owner_num_genuine}: the encrypted acknowledgment received by an owner has been
sent by the respective asset.

    \<^enum> Theorem @{text owner_token_genuine}: the PACE authentication token received by an owner has
been generated by the respective asset, using her Chip Authentication private key and the same
ephemeral keys used to derive the session key.

    \<^enum> Theorem @{text pwd_secret}: an asset-owner pair's password is secret.

    \<^enum> Theorem @{text asset_seskey_unique}: an asset's session key is unknown to other assets, and
may be used by that asset to compute just one PACE authentication token.

    \<^enum> Theorem @{text asset_seskey_secret}: an asset's session key is secret.

    \<^enum> Theorem @{text asset_pwd_genuine}: the encrypted password received by an asset has been sent
by the respective owner.

    \<^enum> Theorem @{text asset_token_genuine}: the PACE authentication token received by an asset has
been generated by the respective owner, using the same ephemeral key used to derive the session key.

    \<^enum> Theorem @{text seskey_forward_secret}: a session key shared by an asset-owner pair is
endowed with \emph{forward secrecy}, viz. it is secret independently of the secrecy of static keys.

  Particularly, these proofs confirm that the mutual authentication between an owner and her asset
is reliable even if their PACE key is compromised, unless either their Chip Authentication private
key or their password also is -- namely, the protocol succeeds in implementing a two-factor mutual
authentication --, with the forward secrecy of the generated session keys being ensured as well.

  \<^item> Section \ref{Anonymity}, \emph{Anonymity properties}, proves that the following theorems hold
under appropriate assumptions.

    \<^enum> Theorem @{text pwd_anonymous}: an asset-owner pair's password is anonymous.

    \<^enum> Theorem @{text auth_prikey_anonymous}: an asset's Chip Authentication private key is
anonymous.

    \<^enum> Theorem @{text auth_shakey_anonymous}: an asset-owner pair's PACE key is anonymous.

  \<^item> Section \ref{Possibility}, \emph{Possibility properties}, shows how possibility properties (cf.
\<^cite>\<open>"Paulson98"\<close>) can be proven by constructing sample protocol runs, either ordinary or attack
ones. Two such properties are proven:

    \<^enum> Theorem @{text runs_unbounded}: for any possible protocol state @{text s} and any asset-owner
pair, there exists a state @{text s'} reachable from @{text s} in which a protocol run has been
completed by those agents using an ephemeral private key @{text "PriKey S"} not yet exchanged in
@{text s} -- namely, an unbounded number of protocol runs can be carried out by legitimate agents.

    \<^enum> Theorem @{text pwd_compromised}: in a scenario not satisfying the assumptions of theorem
@{text pwd_anonymous}, the spy can steal an asset-owner pair's password and even identify those
agents.

  The latter is an example of a possibility property aimed at confirming that the assumptions of a
given confidentiality, authenticity, or anonymity property are necessary for it to hold.

For further information about the formal definitions and proofs contained in these sections, see
Isabelle documentation, particularly \<^cite>\<open>"Paulson20"\<close>, \<^cite>\<open>"Nipkow20"\<close>, \<^cite>\<open>"Krauss20"\<close>,
and \<^cite>\<open>"Nipkow11"\<close>.

\textbf{Important note.} This sample protocol was already considered in a former paper of mine (cf.
\<^cite>\<open>"Noce17"\<close>). For any purpose, that paper should be regarded as being obsolete and superseded
by the present paper.
\<close>

subsection "Definitions"

text \<open>
\label{Definitions}
\<close>

type_synonym agent_id = nat

type_synonym key_id = nat

type_synonym seskey_in = "key_id option \<times> key_id set \<times> key_id set"

datatype agent =
  Asset agent_id |
  Owner agent_id |
  Spy

datatype key =
  SigK |
  VerK |
  PriK key_id |
  PubK key_id |
  ShaK key_id |
  SesK seskey_in

datatype msg =
  Num nat |
  Agent agent_id |
  Pwd agent_id |
  Key key |
  Mult key_id key_id (infixl "\<otimes>" 70) |
  Hash msg |
  Crypt key msg |
  MPair msg msg |
  IDInfo agent_id msg |
  Log msg

syntax
  "_MPair"  :: "['a, args] \<Rightarrow> 'a * 'b"  ("(2\<lbrace>_,/ _\<rbrace>)")
  "_IDInfo" :: "[agent_id, msg] \<Rightarrow> msg"      ("(2\<langle>_,/ _\<rangle>)")
translations
  "\<lbrace>X, Y, Z\<rbrace>" \<rightleftharpoons> "\<lbrace>X, \<lbrace>Y, Z\<rbrace>\<rbrace>"
  "\<lbrace>X, Y\<rbrace>" \<rightleftharpoons> "CONST MPair X Y"
  "\<langle>n, X\<rangle>" \<rightleftharpoons> "CONST IDInfo n X"

abbreviation SigKey :: "msg" where
"SigKey \<equiv> Key SigK"

abbreviation VerKey :: "msg" where
"VerKey \<equiv> Key VerK"

abbreviation PriKey :: "key_id \<Rightarrow> msg" where
"PriKey \<equiv> Key \<circ> PriK"

abbreviation PubKey :: "key_id \<Rightarrow> msg" where
"PubKey \<equiv> Key \<circ> PubK"

abbreviation ShaKey :: "key_id \<Rightarrow> msg" where
"ShaKey \<equiv> Key \<circ> ShaK"

abbreviation SesKey :: "seskey_in \<Rightarrow> msg" where
"SesKey \<equiv> Key \<circ> SesK"

primrec InvK :: "key \<Rightarrow> key" where
"InvK SigK = VerK" |
"InvK VerK = SigK" |
"InvK (PriK A) = PubK A" |
"InvK (PubK A) = PriK A" |
"InvK (ShaK SK) = ShaK SK" |
"InvK (SesK SK) = SesK SK"

abbreviation InvKey :: "key \<Rightarrow> msg" where
"InvKey \<equiv> Key \<circ> InvK"

inductive_set parts :: "msg set \<Rightarrow> msg set"
  for H :: "msg set" where

parts_used [intro]:
  "X \<in> H \<Longrightarrow> X \<in> parts H" |

parts_crypt [intro]:
  "Crypt K X \<in> parts H \<Longrightarrow> X \<in> parts H" |

parts_fst [intro]:
  "\<lbrace>X, Y\<rbrace> \<in> parts H \<Longrightarrow> X \<in> parts H" |

parts_snd [intro]:
  "\<lbrace>X, Y\<rbrace> \<in> parts H \<Longrightarrow> Y \<in> parts H"

inductive_set crypts :: "msg set \<Rightarrow> msg set"
  for H :: "msg set" where

crypts_used [intro]:
  "X \<in> H \<Longrightarrow> X \<in> crypts H" |

crypts_hash [intro]:
  "foldr Crypt KS (Hash X) \<in> crypts H \<Longrightarrow> foldr Crypt KS X \<in> crypts H" |

crypts_fst [intro]:
  "foldr Crypt KS \<lbrace>X, Y\<rbrace> \<in> crypts H \<Longrightarrow> foldr Crypt KS X \<in> crypts H" |

crypts_snd [intro]:
  "foldr Crypt KS \<lbrace>X, Y\<rbrace> \<in> crypts H \<Longrightarrow> foldr Crypt KS Y \<in> crypts H"

definition key_sets :: "msg \<Rightarrow> msg set \<Rightarrow> msg set set" where
"key_sets X H \<equiv> {InvKey ` set KS | KS. foldr Crypt KS X \<in> H}"

definition parts_msg :: "msg \<Rightarrow> msg set" where
"parts_msg X \<equiv> parts {X}"

definition crypts_msg :: "msg \<Rightarrow> msg set" where
"crypts_msg X \<equiv> crypts {X}"

definition key_sets_msg :: "msg \<Rightarrow> msg \<Rightarrow> msg set set" where
"key_sets_msg X Y \<equiv> key_sets X {Y}"

fun seskey_set :: "seskey_in \<Rightarrow> key_id set" where
"seskey_set (Some S, U, V) = insert S (U \<union> V)" |
"seskey_set (None, U, V) = U \<union> V"

definition Auth_PriK :: "agent_id \<Rightarrow> key_id" where
"Auth_PriK \<equiv> SOME f. infinite (- range f)"

abbreviation Auth_PriKey :: "agent_id \<Rightarrow> msg" where
"Auth_PriKey \<equiv> PriKey \<circ> Auth_PriK"

abbreviation Auth_PubKey :: "agent_id \<Rightarrow> msg" where
"Auth_PubKey \<equiv> PubKey \<circ> Auth_PriK"

consts Auth_ShaK :: "agent_id \<Rightarrow> key_id"

abbreviation Auth_ShaKey :: "agent_id \<Rightarrow> key" where
"Auth_ShaKey \<equiv> ShaK \<circ> Auth_ShaK"

abbreviation Sign :: "agent_id \<Rightarrow> key_id \<Rightarrow> msg" where
"Sign n A \<equiv> Crypt SigK \<lbrace>Hash (Agent n), Hash (PubKey A)\<rbrace>"

abbreviation Token :: "agent_id \<Rightarrow> key_id \<Rightarrow> key_id \<Rightarrow> key_id \<Rightarrow> seskey_in \<Rightarrow> msg"
where "Token n A B C SK \<equiv> \<lbrace>Crypt (SesK SK) (PubKey C),
  Crypt (SesK SK) (A \<otimes> B), Crypt (SesK SK) (Sign n A)\<rbrace>"

consts bad_agent :: "agent_id set"

consts bad_pwd :: "agent_id set"

consts bad_shak :: "key_id set"

consts bad_id_pwd :: "agent_id set"

consts bad_id_prik :: "agent_id set"

consts bad_id_pubk :: "agent_id set"

consts bad_id_shak :: "agent_id set"

definition bad_prik :: "key_id set" where
"bad_prik \<equiv> SOME U. U \<subseteq> range Auth_PriK"

abbreviation bad_prikey :: "agent_id set" where
"bad_prikey \<equiv> Auth_PriK -` bad_prik"

abbreviation bad_shakey :: "agent_id set" where
"bad_shakey \<equiv> Auth_ShaK -` bad_shak"

abbreviation bad_id_password :: "agent_id set" where
"bad_id_password \<equiv> bad_id_pwd \<inter> bad_pwd"

abbreviation bad_id_prikey :: "agent_id set" where
"bad_id_prikey \<equiv> (bad_agent \<union> bad_id_pubk \<union> bad_id_prik) \<inter> bad_prikey"

abbreviation bad_id_pubkey :: "agent_id set" where
"bad_id_pubkey \<equiv> bad_agent \<union> bad_id_pubk \<union> bad_id_prik \<inter> bad_prikey"

abbreviation bad_id_shakey :: "agent_id set" where
"bad_id_shakey \<equiv> bad_id_shak \<inter> bad_shakey"

type_synonym event = "agent \<times> msg"

type_synonym state = "event set"

abbreviation used :: "state \<Rightarrow> msg set" where
"used s \<equiv> Range s"

abbreviation spied :: "state \<Rightarrow> msg set" where
"spied s \<equiv> s `` {Spy}"

abbreviation s\<^sub>0 :: state where
"s\<^sub>0 \<equiv> range (\<lambda>n. (Asset n, Auth_PriKey n)) \<union> {Spy} \<times> insert VerKey
  (range Num \<union> range Auth_PubKey \<union> range (\<lambda>n. Sign n (Auth_PriK n)) \<union>
   Agent ` bad_agent \<union> Pwd ` bad_pwd \<union> PriKey ` bad_prik \<union> ShaKey ` bad_shak \<union>
   (\<lambda>n. \<langle>n, Pwd n\<rangle>) ` bad_id_password \<union>
   (\<lambda>n. \<langle>n, Auth_PriKey n\<rangle>) ` bad_id_prikey \<union>
   (\<lambda>n. \<langle>n, Auth_PubKey n\<rangle>) ` bad_id_pubkey \<union>
   (\<lambda>n. \<langle>n, Key (Auth_ShaKey n)\<rangle>) ` bad_id_shakey)"

abbreviation rel_asset_i :: "(state \<times> state) set" where
"rel_asset_i \<equiv> {(s, s') | s s' n S.
  s' = insert (Asset n, PriKey S) s \<union>
    {Asset n, Spy} \<times> {Crypt (Auth_ShaKey n) (PriKey S)} \<union>
    {(Spy, Log (Crypt (Auth_ShaKey n) (PriKey S)))} \<and>
  PriKey S \<notin> used s}"

abbreviation rel_owner_ii :: "(state \<times> state) set" where
"rel_owner_ii \<equiv> {(s, s') | s s' n S A K.
  s' = insert (Owner n, PriKey A) s \<union>
    {Owner n, Spy} \<times> {\<lbrace>Num 1, PubKey A\<rbrace>} \<union>
    {Spy} \<times> Log ` {Crypt K (PriKey S), \<lbrace>Num 1, PubKey A\<rbrace>} \<and>
  Crypt K (PriKey S) \<in> used s \<and>
  PriKey A \<notin> used s}"

abbreviation rel_asset_ii :: "(state \<times> state) set" where
"rel_asset_ii \<equiv> {(s, s') | s s' n A B.
  s' = insert (Asset n, PriKey B) s \<union>
    {Asset n, Spy} \<times> {\<lbrace>Num 2, PubKey B\<rbrace>} \<union>
    {Spy} \<times> Log ` {\<lbrace>Num 1, PubKey A\<rbrace>, \<lbrace>Num 2, PubKey B\<rbrace>} \<and>
  \<lbrace>Num 1, PubKey A\<rbrace> \<in> used s \<and>
  PriKey B \<notin> used s}"

abbreviation rel_owner_iii :: "(state \<times> state) set" where
"rel_owner_iii \<equiv> {(s, s') | s s' n B C.
  s' = insert (Owner n, PriKey C) s \<union>
    {Owner n, Spy} \<times> {\<lbrace>Num 3, PubKey C\<rbrace>} \<union>
    {Spy} \<times> Log ` {\<lbrace>Num 2, PubKey B\<rbrace>, \<lbrace>Num 3, PubKey C\<rbrace>} \<and>
  \<lbrace>Num 2, PubKey B\<rbrace> \<in> used s \<and>
  PriKey C \<notin> used s}"

abbreviation rel_asset_iii :: "(state \<times> state) set" where
"rel_asset_iii \<equiv> {(s, s') | s s' n C D.
  s' = insert (Asset n, PriKey D) s \<union>
    {Asset n, Spy} \<times> {\<lbrace>Num 4, PubKey D\<rbrace>} \<union>
    {Spy} \<times> Log ` {\<lbrace>Num 3, PubKey C\<rbrace>, \<lbrace>Num 4, PubKey D\<rbrace>} \<and>
  \<lbrace>Num 3, PubKey C\<rbrace> \<in> used s \<and>
  PriKey D \<notin> used s}"

abbreviation rel_owner_iv :: "(state \<times> state) set" where
"rel_owner_iv \<equiv> {(s, s') | s s' n S A B C D K SK.
  s' = insert (Owner n, SesKey SK) s \<union>
    {Owner n, Spy} \<times> {Crypt (SesK SK) (PubKey D)} \<union>
    {Spy} \<times> Log ` {\<lbrace>Num 4, PubKey D\<rbrace>, Crypt (SesK SK) (PubKey D)} \<and>
  {Crypt K (PriKey S), \<lbrace>Num 2, PubKey B\<rbrace>, \<lbrace>Num 4, PubKey D\<rbrace>} \<subseteq> used s \<and>
  {Owner n} \<times> {\<lbrace>Num 1, PubKey A\<rbrace>, \<lbrace>Num 3, PubKey C\<rbrace>} \<subseteq> s \<and>
  SK = (if K = Auth_ShaKey n then Some S else None, {A, B}, {C, D})}"

abbreviation rel_asset_iv :: "(state \<times> state) set" where
"rel_asset_iv \<equiv> {(s, s') | s s' n S A B C D SK.
  s' = s \<union> {Asset n} \<times> {SesKey SK, PubKey B} \<union>
    {Asset n, Spy} \<times> {Token n (Auth_PriK n) B C SK} \<union>
    {Spy} \<times> Log ` {Crypt (SesK SK) (PubKey D),
      Token n (Auth_PriK n) B C SK} \<and>
  {Asset n} \<times> {Crypt (Auth_ShaKey n) (PriKey S),
    \<lbrace>Num 2, PubKey B\<rbrace>, \<lbrace>Num 4, PubKey D\<rbrace>} \<subseteq> s \<and>
  {\<lbrace>Num 1, PubKey A\<rbrace>, \<lbrace>Num 3, PubKey C\<rbrace>,
    Crypt (SesK SK) (PubKey D)} \<subseteq> used s \<and>
  (Asset n, PubKey B) \<notin> s \<and>
  SK = (Some S, {A, B}, {C, D})}"

abbreviation rel_owner_v :: "(state \<times> state) set" where
"rel_owner_v \<equiv> {(s, s') | s s' n A B C SK.
  s' = s \<union> {Owner n, Spy} \<times> {Crypt (SesK SK) (Pwd n)} \<union>
    {Spy} \<times> Log ` {Token n A B C SK, Crypt (SesK SK) (Pwd n)} \<and>
  Token n A B C SK \<in> used s \<and>
  (Owner n, SesKey SK) \<in> s \<and>
  B \<in> fst (snd SK)}"

abbreviation rel_asset_v :: "(state \<times> state) set" where
"rel_asset_v \<equiv> {(s, s') | s s' n SK.
  s' = s \<union> {Asset n, Spy} \<times> {Crypt (SesK SK) (Num 0)} \<union>
    {Spy} \<times> Log ` {Crypt (SesK SK) (Pwd n), Crypt (SesK SK) (Num 0)} \<and>
  (Asset n, SesKey SK) \<in> s \<and>
  Crypt (SesK SK) (Pwd n) \<in> used s}"

abbreviation rel_prik :: "(state \<times> state) set" where
"rel_prik \<equiv> {(s, s') | s s' A.
  s' = insert (Spy, PriKey A) s \<and>
  PriKey A \<notin> used s}"

abbreviation rel_pubk :: "(state \<times> state) set" where
"rel_pubk \<equiv> {(s, s') | s s' A.
  s' = insert (Spy, PubKey A) s \<and>
  PriKey A \<in> spied s}"

abbreviation rel_sesk :: "(state \<times> state) set" where
"rel_sesk \<equiv> {(s, s') | s s' A B C D S.
  s' = insert (Spy, SesKey (Some S, {A, B}, {C, D})) s \<and>
  {PriKey S, PriKey A, PubKey B, PriKey C, PubKey D} \<subseteq> spied s}"

abbreviation rel_fact :: "(state \<times> state) set" where
"rel_fact \<equiv> {(s, s') | s s' A B.
  s' = s \<union> {Spy} \<times> {PriKey A, PriKey B} \<and>
  A \<otimes> B \<in> spied s \<and>
  (PriKey A \<in> spied s \<or> PriKey B \<in> spied s)}"

abbreviation rel_mult :: "(state \<times> state) set" where
"rel_mult \<equiv> {(s, s') | s s' A B.
  s' = insert (Spy, A \<otimes> B) s \<and>
  {PriKey A, PriKey B} \<subseteq> spied s}"

abbreviation rel_hash :: "(state \<times> state) set" where
"rel_hash \<equiv> {(s, s') | s s' X.
  s' = insert (Spy, Hash X) s \<and>
  X \<in> spied s}"

abbreviation rel_dec :: "(state \<times> state) set" where
"rel_dec \<equiv> {(s, s') | s s' K X.
  s' = insert (Spy, X) s \<and>
  {Crypt K X, InvKey K} \<subseteq> spied s}"

abbreviation rel_enc :: "(state \<times> state) set" where
"rel_enc \<equiv> {(s, s') | s s' K X.
  s' = insert (Spy, Crypt K X) s \<and>
  {X, Key K} \<subseteq> spied s}"

abbreviation rel_sep :: "(state \<times> state) set" where
"rel_sep \<equiv> {(s, s') | s s' X Y.
  s' = s \<union> {Spy} \<times> {X, Y} \<and>
  \<lbrace>X, Y\<rbrace> \<in> spied s}"

abbreviation rel_con :: "(state \<times> state) set" where
"rel_con \<equiv> {(s, s') | s s' X Y.
  s' = insert (Spy, \<lbrace>X, Y\<rbrace>) s \<and>
  {X, Y} \<subseteq> spied s}"

abbreviation rel_id_agent :: "(state \<times> state) set" where
"rel_id_agent \<equiv> {(s, s') | s s' n.
  s' = insert (Spy, \<langle>n, Agent n\<rangle>) s \<and>
  Agent n \<in> spied s}"

abbreviation rel_id_invk :: "(state \<times> state) set" where
"rel_id_invk \<equiv> {(s, s') | s s' n K.
  s' = insert (Spy, \<langle>n, InvKey K\<rangle>) s \<and>
  {InvKey K, \<langle>n, Key K\<rangle>} \<subseteq> spied s}"

abbreviation rel_id_sesk :: "(state \<times> state) set" where
"rel_id_sesk \<equiv> {(s, s') | s s' n A SK X U.
  s' = s \<union> {Spy} \<times> {\<langle>n, PubKey A\<rangle>, \<langle>n, SesKey SK\<rangle>} \<and>
  {PubKey A, SesKey SK} \<subseteq> spied s \<and>
  (\<langle>n, PubKey A\<rangle> \<in> spied s \<or> \<langle>n, SesKey SK\<rangle> \<in> spied s) \<and>
  A \<in> seskey_set SK \<and>
  SesKey SK \<in> U \<and>
  U \<in> key_sets X (crypts (Log -` spied s))}"

abbreviation rel_id_fact :: "(state \<times> state) set" where
"rel_id_fact \<equiv> {(s, s') | s s' n A B.
  s' = s \<union> {Spy} \<times> {\<langle>n, PriKey A\<rangle>, \<langle>n, PriKey B\<rangle>} \<and>
  {PriKey A, PriKey B, \<langle>n, A \<otimes> B\<rangle>} \<subseteq> spied s}"

abbreviation rel_id_mult :: "(state \<times> state) set" where
"rel_id_mult \<equiv> {(s, s') | s s' n A B U.
  s' = insert (Spy, \<langle>n, A \<otimes> B\<rangle>) s \<and>
  U \<union> {PriKey A, PriKey B, A \<otimes> B} \<subseteq> spied s \<and>
  (\<langle>n, PriKey A\<rangle> \<in> spied s \<or> \<langle>n, PriKey B\<rangle> \<in> spied s) \<and>
  U \<in> key_sets (A \<otimes> B) (crypts (Log -` spied s))}"

abbreviation rel_id_hash :: "(state \<times> state) set" where
"rel_id_hash \<equiv> {(s, s') | s s' n X U.
  s' = s \<union> {Spy} \<times> {\<langle>n, X\<rangle>, \<langle>n, Hash X\<rangle>} \<and>
  U \<union> {X, Hash X} \<subseteq> spied s \<and>
  (\<langle>n, X\<rangle> \<in> spied s \<or> \<langle>n, Hash X\<rangle> \<in> spied s) \<and>
  U \<in> key_sets (Hash X) (crypts (Log -` spied s))}"

abbreviation rel_id_crypt :: "(state \<times> state) set" where
"rel_id_crypt \<equiv> {(s, s') | s s' n X U.
  s' = s \<union> {Spy} \<times> IDInfo n ` insert X U \<and>
  insert X U \<subseteq> spied s \<and>
  (\<langle>n, X\<rangle> \<in> spied s \<or> (\<exists>K \<in> U. \<langle>n, K\<rangle> \<in> spied s)) \<and>
  U \<in> key_sets X (crypts (Log -` spied s))}"

abbreviation rel_id_sep :: "(state \<times> state) set" where
"rel_id_sep \<equiv> {(s, s') | s s' n X Y.
  s' = s \<union> {Spy} \<times> {\<langle>n, X\<rangle>, \<langle>n, Y\<rangle>} \<and>
  {X, Y, \<langle>n, \<lbrace>X, Y\<rbrace>\<rangle>} \<subseteq> spied s}"

abbreviation rel_id_con :: "(state \<times> state) set" where
"rel_id_con \<equiv> {(s, s') | s s' n X Y U.
  s' = insert (Spy, \<langle>n, \<lbrace>X, Y\<rbrace>\<rangle>) s \<and>
  U \<union> {X, Y, \<lbrace>X, Y\<rbrace>} \<subseteq> spied s \<and>
  (\<langle>n, X\<rangle> \<in> spied s \<or> \<langle>n, Y\<rangle> \<in> spied s) \<and>
  U \<in> key_sets \<lbrace>X, Y\<rbrace> (crypts (Log -` spied s))}"

definition rel :: "(state \<times> state) set" where
"rel \<equiv> rel_asset_i \<union> rel_owner_ii \<union> rel_asset_ii \<union> rel_owner_iii \<union>
  rel_asset_iii \<union> rel_owner_iv \<union> rel_asset_iv \<union> rel_owner_v \<union> rel_asset_v \<union>
  rel_prik \<union> rel_pubk \<union> rel_sesk \<union> rel_fact \<union> rel_mult \<union> rel_hash \<union> rel_dec \<union>
  rel_enc \<union> rel_sep \<union> rel_con \<union> rel_id_agent \<union> rel_id_invk \<union> rel_id_sesk \<union>
  rel_id_fact \<union> rel_id_mult \<union> rel_id_hash \<union> rel_id_crypt \<union> rel_id_sep \<union> rel_id_con"

abbreviation in_rel :: "state \<Rightarrow> state \<Rightarrow> bool" (infix "\<turnstile>" 60) where
"s \<turnstile> s' \<equiv> (s, s') \<in> rel"

abbreviation in_rel_rtrancl :: "state \<Rightarrow> state \<Rightarrow> bool" (infix "\<Turnstile>" 60) where
"s \<Turnstile> s' \<equiv> (s, s') \<in> rel\<^sup>*"

end


(*  Title:      JinjaDCI/BV/BVSpec.thy

    Author:     Cornelia Pusch, Gerwin Klein, Susannah Mansky
    Copyright   1999 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory BV/BVSpec.thy by Tobias Nipkow
*)

section \<open> The Bytecode Verifier \label{sec:BVSpec} \<close>

theory BVSpec
imports Effect
begin

text \<open>
  This theory contains a specification of the BV. The specification
  describes correct typings of method bodies; it corresponds
  to type \emph{checking}.
\<close>

definition
  \<comment> \<open>The method type only contains declared classes:\<close>
  check_types :: "'m prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err list \<Rightarrow> bool"
where
  "check_types P mxs mxl \<tau>s \<equiv> set \<tau>s \<subseteq> states P mxs mxl"

  \<comment> \<open>An instruction is welltyped if it is applicable and its effect\<close>
  \<comment> \<open>is compatible with the type at all successor instructions:\<close>
definition
  wt_instr :: "['m prog,ty,nat,pc,ex_table,instr,pc,ty\<^sub>m] \<Rightarrow> bool"
  ("_,_,_,_,_ \<turnstile> _,_ :: _" [60,0,0,0,0,0,0,61] 60)
where
  "P,T,mxs,mpc,xt \<turnstile> i,pc :: \<tau>s \<equiv>
  app i P mxs T pc mpc xt (\<tau>s!pc) \<and>
  (\<forall>(pc',\<tau>') \<in> set (eff i P pc xt (\<tau>s!pc)). P \<turnstile> \<tau>' \<le>' \<tau>s!pc')"

  \<comment> \<open>The type at @{text "pc=0"} conforms to the method calling convention:\<close>
definition wt_start :: "['m prog,cname,staticb,ty list,nat,ty\<^sub>m] \<Rightarrow> bool"
where
  "wt_start P C b Ts mxl\<^sub>0 \<tau>s \<equiv>
case b of NonStatic \<Rightarrow> P \<turnstile> Some ([],OK (Class C)#map OK Ts@replicate mxl\<^sub>0 Err) \<le>' \<tau>s!0
        | Static \<Rightarrow>  P \<turnstile> Some ([],map OK Ts@replicate mxl\<^sub>0 Err) \<le>' \<tau>s!0"

  \<comment> \<open>A method is welltyped if the body is not empty,\<close>
  \<comment> \<open>if the method type covers all instructions and mentions\<close>
  \<comment> \<open>declared classes only, if the method calling convention is respected, and\<close>
  \<comment> \<open>if all instructions are welltyped.\<close>
definition wt_method :: "['m prog,cname,staticb,ty list,ty,nat,nat,instr list,
                 ex_table,ty\<^sub>m] \<Rightarrow> bool"
where
  "wt_method P C b Ts T\<^sub>r mxs mxl\<^sub>0 is xt \<tau>s \<equiv> (b = Static \<or> b = NonStatic) \<and>
  0 < size is \<and> size \<tau>s = size is \<and>
  check_types P mxs ((case b of Static \<Rightarrow> 0 | NonStatic \<Rightarrow> 1)+size Ts+mxl\<^sub>0) (map OK \<tau>s) \<and>
  wt_start P C b Ts mxl\<^sub>0 \<tau>s \<and>
  (\<forall>pc < size is. P,T\<^sub>r,mxs,size is,xt \<turnstile> is!pc,pc :: \<tau>s)"

  \<comment> \<open>A program is welltyped if it is wellformed and all methods are welltyped\<close>
definition  wf_jvm_prog_phi :: "ty\<^sub>P \<Rightarrow> jvm_prog \<Rightarrow> bool" ("wf'_jvm'_prog\<^bsub>_\<^esub>")
where
  "wf_jvm_prog\<^bsub>\<Phi>\<^esub> \<equiv>
    wf_prog (\<lambda>P C (M,b,Ts,T\<^sub>r,(mxs,mxl\<^sub>0,is,xt)).
      wt_method P C b Ts T\<^sub>r mxs mxl\<^sub>0 is xt (\<Phi> C M))"

definition wf_jvm_prog :: "jvm_prog \<Rightarrow> bool"
where
  "wf_jvm_prog P \<equiv> \<exists>\<Phi>. wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"

lemma wt_jvm_progD:
  "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P \<Longrightarrow> \<exists>wt. wf_prog wt P"
(*<*) by (unfold wf_jvm_prog_phi_def, blast) (*>*)

lemma wt_jvm_prog_impl_wt_instr:
assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P" and
      sees: "P \<turnstile> C sees M,b:Ts \<rightarrow> T = (mxs,mxl\<^sub>0,ins,xt) in C" and
        pc: "pc < size ins"
shows "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
(*<*)
proof -
  have wfm: "wf_prog
     (\<lambda>P C (M, b, Ts, T\<^sub>r, mxs, mxl\<^sub>0, is, xt).
         wt_method P C b Ts T\<^sub>r mxs mxl\<^sub>0 is xt (\<Phi> C M)) P" using wf
    by (unfold wf_jvm_prog_phi_def)
  show ?thesis using sees_wf_mdecl[OF wfm sees] pc
    by (simp add: wf_mdecl_def wt_method_def)
qed
(*>*)

lemma wt_jvm_prog_impl_wt_start:
assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P" and
      sees: "P \<turnstile> C sees M,b:Ts \<rightarrow> T = (mxs,mxl\<^sub>0,ins,xt) in C"
shows "0 < size ins \<and> wt_start P C b Ts mxl\<^sub>0 (\<Phi> C M)"
(*<*)
proof -
  have wfm: "wf_prog
     (\<lambda>P C (M, b, Ts, T\<^sub>r, mxs, mxl\<^sub>0, is, xt).
         wt_method P C b Ts T\<^sub>r mxs mxl\<^sub>0 is xt (\<Phi> C M)) P" using wf
    by (unfold wf_jvm_prog_phi_def)
  show ?thesis using sees_wf_mdecl[OF wfm sees]
    by (simp add: wf_mdecl_def wt_method_def)
qed
(*>*)

lemma wf_jvm_prog_nclinit:
assumes wtp: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
  and meth:  "P \<turnstile> C sees M, b :  Ts\<rightarrow>T = (mxs, mxl\<^sub>0, ins, xt) in D"
  and wt:    "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
  and pc:    "pc < length ins" and \<Phi>: "\<Phi> C M ! pc = Some(ST,LT)"
  and ins:   "ins ! pc = Invokestatic C\<^sub>0 M\<^sub>0 n"
shows "M\<^sub>0 \<noteq> clinit"
 using assms by(simp add: wf_jvm_prog_phi_def wt_instr_def app_def)

end