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

  Project: Refining Authenticated Key Agreement with Strong Adversaries

  Module:  sklvl1.thy (Isabelle/HOL 2016-1)
  ID:      $Id: sklvl1.thy 133183 2017-01-31 13:55:43Z csprenge $
  Author:  Joseph Lallemand, INRIA Nancy <joseph.lallemand@loria.fr>
           Christoph Sprenger, ETH Zurich <sprenger@inf.ethz.ch>

  Level-1 Diffie-Hellman guard protocol augmented with two nonces.
  Refines model dhlvl1, moving towards SKEME/IKEv1 protocol.

  Copyright (c) 2015-2016 Joseph Lallemand and Christoph Sprenger
  Licence: LGPL

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

section \<open>SKEME Protocol (L1)\<close>

theory sklvl1
imports dhlvl1
begin

declare option.split_asm [split]

(**************************************************************************************************)
subsection \<open>State and Events\<close>
(**************************************************************************************************)

abbreviation ni :: nat where "ni \<equiv> 4"
abbreviation nr :: nat where "nr \<equiv> 5"

text \<open>Proofs break if @{term "1"} is used, because @{method "simp"} replaces it with
@{term "Suc 0"}\dots.\<close>

abbreviation
  "xni \<equiv> Var 7"

abbreviation
  "xnr \<equiv> Var 8"

text \<open>Domain of each role (protocol-dependent).\<close>

fun domain :: "role_t \<Rightarrow> var set" where
  "domain Init = {xnx, xni, xnr, xgnx, xgny, xsk, xEnd}"
| "domain Resp = {xny, xni, xnr, xgnx, xgny, xsk, xEnd}"

consts
  guessed_frame :: "rid_t \<Rightarrow> frame"

text \<open>Specification of the guessed frame:
\begin{enumerate}
\item Domain.
\item Well-typedness.
  The messages in the frame of a run never contain implementation material
  even if the agents of the run are dishonest.
  Therefore we consider only well-typed frames.
  This is notably required for the session key compromise; it also helps proving
  the partitionning of ik,
  since we know that the messages added by the protocol do not contain ltkeys in their
  payload and are therefore valid implementations.
\item We also ensure that the values generated by the frame owner are correctly guessed.
\item The new frame extends the previous one (from @{theory Key_Agreement_Strong_Adversaries.dhlvl1})
\end{enumerate}
\<close>
specification (guessed_frame)
  guessed_frame_dom_spec [simp]:
    "dom (guessed_frame R) = domain (role (guessed_runs R))"
  guessed_frame_payload_spec [simp, elim]:
    "guessed_frame R x = Some y \<Longrightarrow> y \<in> payload"
  guessed_frame_Init_xnx [simp]:
    "role (guessed_runs R) = Init \<Longrightarrow> guessed_frame R xnx = Some (NonceF (R$nx))"
  guessed_frame_Init_xgnx [simp]:
    "role (guessed_runs R) = Init \<Longrightarrow> guessed_frame R xgnx = Some (Exp Gen (NonceF (R$nx)))"
  guessed_frame_Init_xni [simp]:
    "role (guessed_runs R) = Init \<Longrightarrow> guessed_frame R xni = Some (NonceF (R$ni))"
  guessed_frame_Resp_xny [simp]:
    "role (guessed_runs R) = Resp \<Longrightarrow> guessed_frame R xny = Some (NonceF (R$ny))"
  guessed_frame_Resp_xgny [simp]:
    "role (guessed_runs R) = Resp \<Longrightarrow> guessed_frame R xgny = Some (Exp Gen (NonceF (R$ny)))"
  guessed_frame_Resp_xnr [simp]:
    "role (guessed_runs R) = Resp \<Longrightarrow> guessed_frame R xnr = Some (NonceF (R$nr))"
  guessed_frame_xEnd [simp]:
    "guessed_frame R xEnd = Some End"
  guessed_frame_eq [simp]:
    "x \<in> {xnx, xny, xgnx, xgny, xsk, xEnd} \<Longrightarrow> dhlvl1.guessed_frame R x = guessed_frame R x"
apply (rule exI [of _
    "\<lambda>R.
      if role (guessed_runs R) = Init then
        (dhlvl1.guessed_frame R) (xni \<mapsto> NonceF (R$ni), xnr \<mapsto> End)
      else
        (dhlvl1.guessed_frame R) (xnr \<mapsto> NonceF (R$nr), xni \<mapsto> End)"],
  auto simp add: domIff intro: role_t.exhaust)
done

record skl1_state =
  l1_state +
  signalsInit2 :: "signal \<Rightarrow> nat"
  signalsResp2 :: "signal \<Rightarrow> nat"

type_synonym skl1_obs = "skl1_state"

text \<open>Protocol events:
\begin{itemize}
\item step 1: create @{term "Ra"}, @{term "A"} generates @{term "nx"} and @{term "ni"},
  computes $@{term "g"}^@{term "nx"}$
\item step 2: create @{term "Rb"}, @{term "B"} reads @{term "ni"} and $@{term "g"}^@{term "nx"}$
  insecurely,
  generates @{term "ny"} and @{term "nr"}, computes $@{term "g"}^@{term "ny"}$,
  computes $@{term "g"}^@{term "nx*ny"}$,
  emits a running signal for @{term "Init"}, @{term "ni"}, @{term "nr"}, $@{term "g"}^@{term "nx*ny"}$
\item step 3: @{term "A"} reads $@{term "g"}^@{term "ny"}$ and $@{term "g"}^@{term "nx"}$
  authentically,
  computes $@{term "g"}^@{term "ny*nx"}$, emits a commit signal for @{term "Init"}, @{term "ni"},
  @{term "nr"}, $@{term "g"}^@{term "ny*nx"}$,
  a running signal for @{term "Resp"}, @{term "ni"}, @{term "nr"}, $@{term "g"}^@{term "ny*nx"}$,
  declares the secret $@{term "g"}^@{term "ny*nx"}$
\item step 4: @{term "B"} reads @{term "nr"}, @{term "ni"}, $@{term "g"}^@{term "nx"}$
  and $@{term "g"}^@{term "ny"}$ authentically,
  emits a commit signal for @{term "Resp"}, @{term "ni"}, @{term "nr"},
  $@{term "g"}^@{term "nx*ny"}$,
  declares the secret $@{term "g"}^@{term "nx*ny"}$
\end{itemize}
\<close>
definition
  skl1_step1 :: "rid_t \<Rightarrow> agent \<Rightarrow> agent \<Rightarrow> ('a skl1_state_scheme * 'a skl1_state_scheme) set"
where
  "skl1_step1 Ra A B \<equiv> {(s, s').
    \<comment> \<open>guards:\<close>
    Ra \<notin> dom (progress s) \<and>
    guessed_runs Ra = \<lparr>role=Init, owner=A, partner=B\<rparr> \<and>
    \<comment> \<open>actions:\<close>
    s' = s\<lparr>
      progress := (progress s)(Ra \<mapsto> {xnx, xni, xgnx})
      \<rparr>
  }"

definition
  skl1_step2 ::
    "rid_t \<Rightarrow> agent \<Rightarrow> agent \<Rightarrow> msg \<Rightarrow> msg \<Rightarrow> ('a skl1_state_scheme * 'a skl1_state_scheme) set"
where
  "skl1_step2 Rb A B Ni gnx \<equiv> {(s, s').
    \<comment> \<open>guards:\<close>
    guessed_runs Rb = \<lparr>role=Resp, owner=B, partner=A\<rparr> \<and>
    Rb \<notin> dom (progress s) \<and>
    guessed_frame Rb xgnx = Some gnx \<and>
    guessed_frame Rb xni = Some Ni \<and>
    guessed_frame Rb xsk = Some (Exp gnx (NonceF (Rb$ny))) \<and>
    \<comment> \<open>actions:\<close>
    s' = s\<lparr> progress := (progress s)(Rb \<mapsto> {xny, xni, xnr, xgny, xgnx, xsk}),
            signalsInit :=
              if can_signal s A B then
                addSignal (signalsInit s)
                          (Running A B \<langle>Ni, NonceF (Rb$nr), Exp gnx (NonceF (Rb$ny))\<rangle>)
              else
                signalsInit s,
            signalsInit2 :=
              if can_signal s A B then
                addSignal (signalsInit2 s) (Running A B (Exp gnx (NonceF (Rb$ny))))
              else
                signalsInit2 s
          \<rparr>
  }"

definition
  skl1_step3 ::
    "rid_t \<Rightarrow> agent \<Rightarrow> agent \<Rightarrow> msg \<Rightarrow> msg \<Rightarrow> ('a skl1_state_scheme * 'a skl1_state_scheme) set"
where
  "skl1_step3 Ra A B Nr gny \<equiv> {(s, s').
    \<comment> \<open>guards:\<close>
    guessed_runs Ra = \<lparr>role=Init, owner=A, partner=B\<rparr> \<and>
    progress s Ra = Some {xnx, xni, xgnx} \<and>
    guessed_frame Ra xgny = Some gny \<and>
    guessed_frame Ra xnr = Some Nr \<and>
    guessed_frame Ra xsk = Some (Exp gny (NonceF (Ra$nx))) \<and>
    (can_signal s A B \<longrightarrow> \<comment> \<open>authentication guard\<close>
      (\<exists> Rb. guessed_runs Rb = \<lparr>role=Resp, owner=B, partner=A\<rparr> \<and>
             in_progressS (progress s Rb) {xny, xni, xnr, xgnx, xgny, xsk} \<and>
             guessed_frame Rb xgny = Some gny \<and>
             guessed_frame Rb xnr = Some Nr \<and>
             guessed_frame Rb xni = Some (NonceF (Ra$ni)) \<and>
             guessed_frame Rb xgnx = Some (Exp Gen (NonceF (Ra$nx))))) \<and>
    (Ra = test \<longrightarrow> Exp gny (NonceF (Ra$nx)) \<notin> synth (analz (ik s))) \<and>

    \<comment> \<open>actions:\<close>
    s' = s\<lparr> progress := (progress s)(Ra \<mapsto> {xnx, xni, xnr, xgnx, xgny, xsk, xEnd}),
            secret := {x. x = Exp gny (NonceF (Ra$nx)) \<and> Ra = test} \<union> secret s,
            signalsInit :=
              if can_signal s A B then
                addSignal (signalsInit s)
                          (Commit A B \<langle>NonceF (Ra$ni), Nr, Exp gny (NonceF (Ra$nx))\<rangle>)
              else
                signalsInit s,
            signalsInit2 :=
              if can_signal s A B then
                addSignal (signalsInit2 s) (Commit A B (Exp gny (NonceF (Ra$nx))))
              else
                signalsInit2 s,
            signalsResp :=
              if can_signal s A B then
                addSignal (signalsResp s)
                          (Running A B \<langle>NonceF (Ra$ni), Nr, Exp gny (NonceF (Ra$nx))\<rangle>)
              else
                signalsResp s,
            signalsResp2 :=
              if can_signal s A B then
                addSignal (signalsResp2 s) (Running A B (Exp gny (NonceF (Ra$nx))))
              else
                signalsResp2 s
          \<rparr>
  }"

definition
  skl1_step4 ::
    "rid_t \<Rightarrow> agent \<Rightarrow> agent \<Rightarrow> msg \<Rightarrow> msg \<Rightarrow> ('a skl1_state_scheme * 'a skl1_state_scheme) set"
where
  "skl1_step4 Rb A B Ni gnx \<equiv> {(s, s').
    \<comment> \<open>guards:\<close>
    guessed_runs Rb = \<lparr>role=Resp, owner=B, partner=A\<rparr> \<and>
    progress s Rb = Some {xny, xni, xnr, xgnx, xgny, xsk} \<and>
    guessed_frame Rb xgnx = Some gnx \<and>
    guessed_frame Rb xni = Some Ni \<and>
    (can_signal s A B \<longrightarrow> \<comment> \<open>authentication guard\<close>
      (\<exists> Ra. guessed_runs Ra = \<lparr>role=Init, owner=A, partner=B\<rparr> \<and>
             in_progressS (progress s Ra) {xnx, xni, xnr, xgnx, xgny, xsk, xEnd} \<and>
             guessed_frame Ra xgnx = Some gnx \<and>
             guessed_frame Ra xni = Some Ni \<and>
             guessed_frame Ra xnr = Some (NonceF (Rb$nr)) \<and>
             guessed_frame Ra xgny = Some (Exp Gen (NonceF (Rb$ny))))) \<and>
    (Rb = test \<longrightarrow> Exp gnx (NonceF (Rb$ny)) \<notin> synth (analz (ik s))) \<and>

    \<comment> \<open>actions:\<close>
    s' = s\<lparr> progress := (progress s)(Rb \<mapsto> {xny, xni, xnr, xgnx, xgny, xsk, xEnd}),
            secret := {x. x = Exp gnx (NonceF (Rb$ny)) \<and> Rb = test} \<union> secret s,
            signalsResp :=
              if can_signal s A B then
                addSignal (signalsResp s)
                          (Commit A B \<langle>Ni, NonceF (Rb$nr), Exp gnx (NonceF (Rb$ny))\<rangle>)
              else
                signalsResp s,
            signalsResp2 :=
              if can_signal s A B then
                addSignal (signalsResp2 s) (Commit A B (Exp gnx (NonceF (Rb$ny))))
              else
                signalsResp2 s
          \<rparr>
  }"

text \<open>Specification.\<close>

definition
  skl1_trans :: "('a skl1_state_scheme * 'a skl1_state_scheme) set" where
  "skl1_trans \<equiv> (\<Union>m Ra Rb A B x y.
     skl1_step1 Ra A B \<union>
     skl1_step2 Rb A B x y \<union>
     skl1_step3 Ra A B x y \<union>
     skl1_step4 Rb A B x y \<union>
     l1_learn m \<union>
     Id
  )"

definition
  skl1_init :: "skl1_state set"
where
  "skl1_init \<equiv> { \<lparr>
    ik = {},
    secret = {},
    progress = Map.empty,
    signalsInit = \<lambda>x. 0,
    signalsResp = \<lambda>x. 0,
    signalsInit2 = \<lambda>x. 0,
    signalsResp2 = \<lambda>x. 0
    \<rparr> }"

definition
  skl1 :: "(skl1_state, skl1_obs) spec" where
  "skl1 \<equiv> \<lparr>
    init = skl1_init,
    trans = skl1_trans,
    obs = id
  \<rparr>"

lemmas skl1_defs =
  skl1_def skl1_init_def skl1_trans_def
  l1_learn_def
  skl1_step1_def skl1_step2_def skl1_step3_def skl1_step4_def

lemmas skl1_nostep_defs =
  skl1_def skl1_init_def skl1_trans_def

lemma skl1_obs_id [simp]: "obs skl1 = id"
by (simp add: skl1_def)

lemma run_ended_trans:
  "run_ended (progress s R) \<Longrightarrow>
   (s, s') \<in> trans skl1 \<Longrightarrow>
   run_ended (progress s' R)"
by (auto simp add: skl1_nostep_defs)
   (auto simp add: skl1_defs ik_dy_def domIff)

lemma can_signal_trans:
  "can_signal s' A B \<Longrightarrow>
  (s, s') \<in> trans skl1 \<Longrightarrow>
  can_signal s A B"
by (auto simp add: can_signal_def run_ended_trans)

(**************************************************************************************************)
subsection \<open>Refinement: secrecy\<close>
(**************************************************************************************************)

fun option_inter :: "var set \<Rightarrow> var set option \<Rightarrow> var set option"
where
  "option_inter S (Some x) = Some (x \<inter> S)"
 |"option_inter S None = None"

definition med_progress :: "progress_t \<Rightarrow> progress_t"
where
  "med_progress r \<equiv> \<lambda> R. option_inter {xnx, xny, xgnx, xgny, xsk, xEnd} (r R)"

lemma med_progress_upd [simp]:
  "med_progress (r(R \<mapsto> S)) = (med_progress r) (R \<mapsto> S \<inter> {xnx, xny, xgnx, xgny, xsk, xEnd})"
by (auto simp add: med_progress_def)

lemma med_progress_Some:
  "r x = Some s \<Longrightarrow> med_progress r x = Some (s \<inter> {xnx, xny, xgnx, xgny, xsk, xEnd})"
by (auto simp add: med_progress_def)

lemma med_progress_None [simp]: "med_progress r x = None \<longleftrightarrow> r x = None"
by (cases "r x", auto simp add: med_progress_def)

lemma med_progress_Some2 [dest]:
  "med_progress r x = Some y \<Longrightarrow> \<exists> z. r x = Some z \<and> y = z \<inter> {xnx, xny, xgnx, xgny, xsk, xEnd}"
by (cases "r x", auto simp add: med_progress_def)

lemma med_progress_dom [simp]: "dom (med_progress r) = dom r"
apply (auto simp add: domIff med_progress_def)
apply (rename_tac x y, case_tac "r x", auto)
done

lemma med_progress_empty [simp]: "med_progress Map.empty = Map.empty"
by (rule ext, auto)

text \<open>Mediator function.\<close>

definition
  med11 :: "skl1_obs \<Rightarrow> l1_obs"
where
  "med11 t \<equiv> \<lparr>ik = ik t,
              secret=secret t,
              progress = med_progress (progress t),
              signalsInit = signalsInit2 t,
              signalsResp = signalsResp2 t\<rparr>"

text \<open>relation between states\<close>
definition
  R11 :: "(l1_state * skl1_state) set"
where
  "R11 \<equiv> {(s,s').
    s = med11 s'
    }"

lemmas R11_defs = R11_def med11_def

lemma in_progress_med_progress:
  "x \<in> {xnx, xny, xgnx, xgny, xsk, xEnd}
  \<Longrightarrow> in_progress (med_progress r R) x \<longleftrightarrow> in_progress (r R) x"
by (cases "r R", auto)
   (cases "med_progress r R", auto)+

lemma in_progressS_eq: "in_progressS S S' \<longleftrightarrow> (S \<noteq> None \<and> (\<forall> x \<in> S'. in_progress S x))"
by (cases S, auto)

lemma in_progressS_med_progress:
  "in_progressS (r R) S
  \<Longrightarrow> in_progressS (med_progress r R) (S \<inter> {xnx, xny, xgnx, xgny, xsk, xEnd})"
by (auto simp add: in_progressS_eq in_progress_med_progress)

lemma can_signal_R11 [simp]:
  "(s1, s2) \<in> R11 \<Longrightarrow>
   can_signal s1 A B \<longleftrightarrow> can_signal s2 A B"
by (auto simp add: can_signal_def R11_defs in_progress_med_progress)

text \<open>Protocol-independent events.\<close>

lemma skl1_learn_refines_learn:
  "{R11} l1_learn m, l1_learn m {>R11}"
by (auto simp add: PO_rhoare_defs R11_defs)
   (simp add: l1_defs)

text \<open>Protocol events.\<close>

lemma skl1_step1_refines_step1:
  "{R11} l1_step1 Ra A B, skl1_step1 Ra A B {>R11}"
by (auto simp add: PO_rhoare_defs R11_defs l1_step1_def skl1_step1_def)

lemma skl1_step2_refines_step2:
  "{R11} l1_step2 Rb A B gnx, skl1_step2 Rb A B Ni gnx {>R11}"
by (auto simp add: PO_rhoare_defs R11_defs  l1_step2_def)
   (auto simp add: skl1_step2_def)

lemma skl1_step3_refines_step3:
  "{R11} l1_step3 Ra A B gny, skl1_step3 Ra A B Nr gny {>R11}"
apply (auto simp add: PO_rhoare_defs R11_defs l1_step3_def)
apply (auto simp add: skl1_step3_def, auto dest: med_progress_Some)
apply (drule in_progressS_med_progress, auto)+
done

lemma skl1_step4_refines_step4:
  "{R11} l1_step4 Rb A B gnx, skl1_step4 Rb A B Ni gnx {>R11}"
apply (auto simp add: PO_rhoare_defs R11_defs l1_step4_def)
apply (auto simp add: skl1_step4_def, auto dest: med_progress_Some)
apply (drule in_progressS_med_progress, auto)+
done

text \<open>Refinement proof.\<close>

lemmas skl1_trans_refines_l1_trans =
  skl1_learn_refines_learn
  skl1_step1_refines_step1 skl1_step2_refines_step2
  skl1_step3_refines_step3 skl1_step4_refines_step4

lemma skl1_refines_init_l1 [iff]:
  "init skl1 \<subseteq> R11 `` (init l1)"
by (auto simp add: R11_defs l1_defs skl1_defs)

lemma skl1_refines_trans_l1 [iff]:
  "{R11} trans l1, trans skl1 {> R11}"
by (auto 0 3 simp add: l1_def skl1_def l1_trans_def skl1_trans_def
             intro: skl1_trans_refines_l1_trans)

lemma obs_consistent_med11 [iff]:
  "obs_consistent R11 med11 l1 skl1"
by (auto simp add: obs_consistent_def R11_defs)

text \<open>Refinement result.\<close>

lemma skl1_refines_l1 [iff]:
  "refines
     R11
     med11 l1 skl1"
by (auto simp add:refines_def PO_refines_def)

lemma  skl1_implements_l1 [iff]: "implements med11 l1 skl1"
by (rule refinement_soundness) (fast)

(**************************************************************************************************)
subsection \<open>Derived invariants: secrecy\<close>
(**************************************************************************************************)

lemma skl1_obs_secrecy [iff]: "oreach skl1 \<subseteq> s0_secrecy"
apply (rule external_invariant_translation [OF l1_obs_secrecy _ skl1_implements_l1])
apply (auto simp add: med11_def s0_secrecy_def)
done

lemma skl1_secrecy [iff]: "reach skl1 \<subseteq> s0_secrecy"
by (rule external_to_internal_invariant [OF skl1_obs_secrecy], auto)

(**************************************************************************************************)
subsection \<open>Invariants: @{term "Init"} authenticates @{term "Resp"}\<close>
(**************************************************************************************************)

subsubsection \<open>inv1\<close>
(**************************************************************************************************)

text \<open>If an initiator commit signal exists for @{term "Ra$ni"}, @{term "Nr"},
  $(@{term "g"}^@{term "ny"})^@{term "Ra$nx"}$, then @{term "Ra"} is
  @{term "Init"}, has passed step 3, and has the nonce @{term "Nr"}, and
  \<open>(g^ny)^(Ra$nx)\<close> as the key in its frame.
\<close>
definition
  skl1_inv1 :: "skl1_state set"
where
  "skl1_inv1 \<equiv> {s. \<forall> Ra A B gny Nr.
    signalsInit s (Commit A B \<langle>NonceF (Ra$ni), Nr, Exp gny (NonceF (Ra$nx))\<rangle>) > 0 \<longrightarrow>
      guessed_runs Ra = \<lparr>role=Init, owner=A, partner=B\<rparr> \<and>
      progress s Ra = Some {xnx, xni, xnr, xgnx, xgny, xsk, xEnd} \<and>
      guessed_frame Ra xnr = Some Nr \<and>
      guessed_frame Ra xsk = Some (Exp gny (NonceF (Ra$nx)))
   }"

lemmas skl1_inv1I = skl1_inv1_def [THEN setc_def_to_intro, rule_format]
lemmas skl1_inv1E [elim] = skl1_inv1_def [THEN setc_def_to_elim, rule_format]
lemmas skl1_inv1D = skl1_inv1_def [THEN setc_def_to_dest, rule_format, rotated 1, simplified]

lemma skl1_inv1_init [iff]:
  "init skl1 \<subseteq> skl1_inv1"
by (auto simp add: skl1_def skl1_init_def skl1_inv1_def)

lemma skl1_inv1_trans [iff]:
  "{skl1_inv1} trans skl1 {> skl1_inv1}"
apply (auto simp add: PO_hoare_defs skl1_nostep_defs intro!: skl1_inv1I)
apply (auto simp add: skl1_defs ik_dy_def skl1_inv1_def domIff dest: Exp_Exp_Gen_inj2 [OF sym])
done

lemma PO_skl1_inv1 [iff]: "reach skl1 \<subseteq> skl1_inv1"
by (rule inv_rule_basic) (auto)

subsubsection \<open>inv2\<close>
(**************************************************************************************************)

text \<open>If a @{term "Resp"} run @{term "Rb"} has passed step 2 then (if possible)
an initiator running signal has been emitted.\<close>

definition
  skl1_inv2 :: "skl1_state set"
where
  "skl1_inv2 \<equiv> {s. \<forall> gnx A B Rb Ni.
    guessed_runs Rb = \<lparr>role=Resp, owner=B, partner=A\<rparr> \<longrightarrow>
    in_progressS (progress s Rb) {xny, xni, xnr, xgnx, xgny, xsk} \<longrightarrow>
    guessed_frame Rb xgnx = Some gnx \<longrightarrow>
    guessed_frame Rb xni = Some Ni \<longrightarrow>
    can_signal s A B \<longrightarrow>
      signalsInit s (Running A B \<langle>Ni, NonceF (Rb$nr), Exp gnx (NonceF (Rb$ny))\<rangle>) > 0
  }"

lemmas skl1_inv2I = skl1_inv2_def [THEN setc_def_to_intro, rule_format]
lemmas skl1_inv2E [elim] = skl1_inv2_def [THEN setc_def_to_elim, rule_format]
lemmas skl1_inv2D = skl1_inv2_def [THEN setc_def_to_dest, rule_format, rotated 1, simplified]

lemma skl1_inv2_init [iff]:
  "init skl1 \<subseteq> skl1_inv2"
by (auto simp add: skl1_def skl1_init_def skl1_inv2_def)

lemma skl1_inv2_trans [iff]:
  "{skl1_inv2} trans skl1 {> skl1_inv2}"
apply (auto simp add: PO_hoare_defs intro!: skl1_inv2I)
apply (drule can_signal_trans, assumption)
apply (auto simp add: skl1_nostep_defs)
apply (auto simp add: skl1_defs ik_dy_def skl1_inv2_def)
done

lemma PO_skl1_inv2 [iff]: "reach skl1 \<subseteq> skl1_inv2"
by (rule inv_rule_basic) (auto)

subsubsection \<open>inv3 (derived)\<close>
(**************************************************************************************************)

text \<open>If an @{term "Init"} run before step 3 and a @{term "Resp"} run after step 2 both know
  the same half-keys and nonces (more or less), then the number of @{term "Init"} running signals
  for the key is strictly greater than the number of @{term "Init"} commit signals.
  (actually, there are 0 commit and 1 running).
\<close>

definition
  skl1_inv3 :: "skl1_state set"
where
  "skl1_inv3 \<equiv> {s. \<forall> A B Rb Ra gny Nr.
    guessed_runs Rb = \<lparr>role=Resp, owner=B, partner=A\<rparr> \<longrightarrow>
    in_progressS (progress s Rb) {xny, xni, xnr, xgnx, xgny, xsk} \<longrightarrow>
    guessed_frame Rb xgny = Some gny \<longrightarrow>
    guessed_frame Rb xnr = Some Nr \<longrightarrow>
    guessed_frame Rb xni = Some (NonceF (Ra$ni)) \<longrightarrow>
    guessed_frame Rb xgnx = Some (Exp Gen (NonceF (Ra$nx))) \<longrightarrow>
    guessed_runs Ra = \<lparr>role=Init, owner=A, partner=B\<rparr> \<longrightarrow>
    progress s Ra = Some {xnx, xgnx, xni} \<longrightarrow>
    can_signal s A B \<longrightarrow>
      signalsInit s (Commit A B \<langle>NonceF (Ra$ni), Nr, Exp gny (NonceF (Ra$nx))\<rangle>)
    < signalsInit s (Running A B \<langle>NonceF (Ra$ni), Nr, Exp gny (NonceF (Ra$nx))\<rangle>)
  }"

lemmas skl1_inv3I = skl1_inv3_def [THEN setc_def_to_intro, rule_format]
lemmas skl1_inv3E [elim] = skl1_inv3_def [THEN setc_def_to_elim, rule_format]
lemmas skl1_inv3D = skl1_inv3_def [THEN setc_def_to_dest, rule_format, rotated 1, simplified]

lemma skl1_inv3_derived: "skl1_inv1 \<inter> skl1_inv2 \<subseteq> skl1_inv3"
apply (auto intro!:skl1_inv3I)
apply (auto dest!: skl1_inv2D)
apply (rename_tac x A B Rb Ra)
apply (case_tac
  "signalsInit x (Commit A B
     \<langle>NonceF (Ra $ ni), NonceF (Rb $ nr),
      Exp (Exp Gen (NonceF (Rb $ ny))) (NonceF (Ra $ nx))\<rangle>) > 0", auto)
apply (fastforce dest: skl1_inv1D elim: equalityE)
done

subsection \<open>Invariants: Resp authenticates Init\<close>
(**************************************************************************************************)

subsubsection \<open>inv4\<close>
(**************************************************************************************************)

text \<open>If a @{term "Resp"} commit signal exists for @{term "Ni"}, @{term "Rb$nr"},
  $(@{term "g"}^@{term "nx"})^@{term "Rb$ny"}$
  then @{term "Rb"} is @{term "Resp"}, has finished its run, and has the nonce @{term "Ni"} and
  $(@{term "g"}^@{term "nx"})^@{term "Rb$ny"}$ as the key in its frame.
\<close>
definition
  skl1_inv4 :: "skl1_state set"
where
  "skl1_inv4 \<equiv> {s. \<forall> Rb A B gnx Ni.
    signalsResp s (Commit A B \<langle>Ni, NonceF (Rb$nr), Exp gnx (NonceF (Rb$ny))\<rangle>) > 0 \<longrightarrow>
      guessed_runs Rb = \<lparr>role=Resp, owner=B, partner=A\<rparr> \<and>
      progress s Rb = Some {xny, xni, xnr, xgnx, xgny, xsk, xEnd} \<and>
      guessed_frame Rb xgnx = Some gnx \<and>
      guessed_frame Rb xni = Some Ni
   }"

lemmas skl1_inv4I = skl1_inv4_def [THEN setc_def_to_intro, rule_format]
lemmas skl1_inv4E [elim] = skl1_inv4_def [THEN setc_def_to_elim, rule_format]
lemmas skl1_inv4D = skl1_inv4_def [THEN setc_def_to_dest, rule_format, rotated 1, simplified]

lemma skl1_inv4_init [iff]:
  "init skl1 \<subseteq> skl1_inv4"
by (auto simp add: skl1_def skl1_init_def skl1_inv4_def)

lemma skl1_inv4_trans [iff]:
  "{skl1_inv4} trans skl1 {> skl1_inv4}"
apply (auto simp add: PO_hoare_defs skl1_nostep_defs intro!: skl1_inv4I)
apply (auto simp add: skl1_inv4_def skl1_defs ik_dy_def domIff dest: Exp_Exp_Gen_inj2 [OF sym])
done

lemma PO_skl1_inv4 [iff]: "reach skl1 \<subseteq> skl1_inv4"
by (rule inv_rule_basic) (auto)

subsubsection \<open>inv5\<close>
(**************************************************************************************************)

text \<open>If an @{term "Init"} run @{term "Ra"} has passed step3 then (if possible) a
@{term "Resp"} running signal has been emitted.\<close>

definition
  skl1_inv5 :: "skl1_state set"
where
  "skl1_inv5 \<equiv> {s. \<forall> gny A B Ra Nr.
    guessed_runs Ra = \<lparr>role=Init, owner=A, partner=B\<rparr> \<longrightarrow>
    in_progressS (progress s Ra) {xnx, xni, xnr, xgnx, xgny, xsk, xEnd} \<longrightarrow>
    guessed_frame Ra xgny = Some gny \<longrightarrow>
    guessed_frame Ra xnr = Some Nr \<longrightarrow>
    can_signal s A B \<longrightarrow>
      signalsResp s (Running A B \<langle>NonceF (Ra$ni), Nr, Exp gny (NonceF (Ra$nx))\<rangle>) > 0
  }"

lemmas skl1_inv5I = skl1_inv5_def [THEN setc_def_to_intro, rule_format]
lemmas skl1_inv5E [elim] = skl1_inv5_def [THEN setc_def_to_elim, rule_format]
lemmas skl1_inv5D = skl1_inv5_def [THEN setc_def_to_dest, rule_format, rotated 1, simplified]

lemma skl1_inv5_init [iff]:
  "init skl1 \<subseteq> skl1_inv5"
by (auto simp add: skl1_def skl1_init_def skl1_inv5_def)

lemma skl1_inv5_trans [iff]:
  "{skl1_inv5} trans skl1 {> skl1_inv5}"
apply (auto simp add: PO_hoare_defs intro!: skl1_inv5I)
apply (drule can_signal_trans, assumption)
apply (auto simp add: skl1_nostep_defs)
apply (auto simp add: skl1_defs ik_dy_def dest: skl1_inv5D)
done

lemma PO_skl1_inv5 [iff]: "reach skl1 \<subseteq> skl1_inv5"
by (rule inv_rule_basic) (auto)

subsubsection \<open>inv6 (derived)\<close>
(**************************************************************************************************)

text \<open>If a @{term "Resp"} run before step 4 and an @{term "Init"} run after step 3 both know
  the same half-keys (more or less), then the number of @{term "Resp"} running signals
  for the key is strictly greater than the number of @{term "Resp"} commit signals.
  (actually, there are 0 commit and 1 running).
\<close>

definition
  skl1_inv6 :: "skl1_state set"
where
  "skl1_inv6 \<equiv> {s. \<forall> A B Rb Ra gnx Ni.
    guessed_runs Ra = \<lparr>role=Init, owner=A, partner=B\<rparr> \<longrightarrow>
    in_progressS (progress s Ra) {xnx, xni, xnr, xgnx, xgny, xsk, xEnd} \<longrightarrow>
    guessed_frame Ra xgnx = Some gnx \<longrightarrow>
    guessed_frame Ra xni = Some Ni \<longrightarrow>
    guessed_frame Ra xgny = Some (Exp Gen (NonceF (Rb$ny))) \<longrightarrow>
    guessed_frame Ra xnr = Some (NonceF (Rb$nr)) \<longrightarrow>
    guessed_runs Rb = \<lparr>role=Resp, owner=B, partner=A\<rparr> \<longrightarrow>
    progress s Rb = Some {xny, xni, xnr, xgnx, xgny, xsk} \<longrightarrow>
    can_signal s A B \<longrightarrow>
      signalsResp s (Commit A B \<langle>Ni, NonceF (Rb$nr), Exp gnx (NonceF (Rb$ny))\<rangle>)
    < signalsResp s (Running A B \<langle>Ni, NonceF (Rb$nr), Exp gnx (NonceF (Rb$ny))\<rangle>)
  }"

lemmas skl1_inv6I = skl1_inv6_def [THEN setc_def_to_intro, rule_format]
lemmas skl1_inv6E [elim] = skl1_inv6_def [THEN setc_def_to_elim, rule_format]
lemmas skl1_inv6D = skl1_inv6_def [THEN setc_def_to_dest, rule_format, rotated 1, simplified]

lemma skl1_inv6_derived:
  "skl1_inv4 \<inter> skl1_inv5 \<subseteq> skl1_inv6"
proof (auto intro!: skl1_inv6I)
  fix s::skl1_state fix A B Rb Ra
  assume HRun:"guessed_runs Ra = \<lparr>role = Init, owner = A, partner = B\<rparr>"
              "in_progressS (progress s Ra) {xnx, xni, xnr, xgnx, xgny, xsk, xEnd}"
              "guessed_frame Ra xgny = Some (Exp Gen (NonceF (Rb $ ny)))"
              "guessed_frame Ra xnr = Some (NonceF (Rb $ nr))"
              "can_signal s A B"
  assume HRb: "progress s Rb = Some {xny, xni, xnr, xgnx, xgny, xsk}"
  assume I4:"s \<in> skl1_inv4"
  assume I5:"s \<in> skl1_inv5"
  from I4 HRb have "signalsResp s (Commit A B \<langle>NonceF (Ra$ni), NonceF (Rb$nr),
                      Exp (Exp Gen (NonceF (Rb $ ny))) (NonceF (Ra $ nx))\<rangle>) > 0 \<Longrightarrow> False"
    proof (auto dest!: skl1_inv4D)
      assume "{xny, xni, xnr, xgnx, xgny, xsk, xEnd} = {xny, xni, xnr, xgnx, xgny, xsk}"
      thus ?thesis by force
    qed
  then have HC:"signalsResp s (Commit A B \<langle>NonceF (Ra$ni), NonceF (Rb$nr),
                      Exp (Exp Gen (NonceF (Rb $ ny))) (NonceF (Ra $ nx))\<rangle>) = 0"
    by auto
  from I5 HRun have "signalsResp s (Running A B \<langle>NonceF (Ra$ni), NonceF (Rb$nr),
                      Exp (Exp Gen (NonceF (Rb $ ny))) (NonceF (Ra $ nx))\<rangle>) > 0"
    by (auto dest!: skl1_inv5D)
  with HC show "signalsResp s (Commit A B \<langle>NonceF (Ra$ni), NonceF (Rb$nr),
                      Exp (Exp Gen (NonceF (Rb $ ny))) (NonceF (Ra $ nx))\<rangle>)
              < signalsResp s (Running A B \<langle>NonceF (Ra$ni), NonceF (Rb$nr),
                      Exp (Exp Gen (NonceF (Rb $ ny))) (NonceF (Ra $ nx))\<rangle>)"
    by auto
qed

(**************************************************************************************************)
subsection \<open>Refinement: injective agreement  (Init authenticates Resp)\<close>
(**************************************************************************************************)

text \<open>Mediator function.\<close>

definition
  med0sk1iai :: "skl1_obs \<Rightarrow> a0i_obs"
where
  "med0sk1iai t \<equiv> \<lparr>a0n_state.signals = signalsInit t\<rparr>"

text \<open>Relation between states.\<close>

definition
  R0sk1iai :: "(a0i_state * skl1_state) set"
where
  "R0sk1iai \<equiv> {(s,s').
    a0n_state.signals s = signalsInit s'
    }"

text \<open>Protocol-independent events.\<close>

text \<open>Protocol events.\<close>

lemma skl1_step1_refines_a0i_skip_i:
  "{R0sk1iai} Id, skl1_step1 Ra A B {>R0sk1iai}"
by (auto simp add: PO_rhoare_defs R0sk1iai_def skl1_step1_def)

lemma skl1_step2_refines_a0i_running_skip_i:
  "{R0sk1iai} a0i_running A B \<langle>Ni, NonceF (Rb$nr),Exp gnx (NonceF (Rb$ny))\<rangle> \<union> Id,
              skl1_step2 Rb A B Ni gnx {>R0sk1iai}"
by (auto simp add: PO_rhoare_defs R0sk1iai_def,
    simp_all add: skl1_step2_def a0i_running_def, auto)

lemma skl1_step4_refines_a0i_skip_i:
  "{R0sk1iai} Id, skl1_step4 Rb A B Ni gnx {>R0sk1iai}"
by (auto simp add: PO_rhoare_defs R0sk1iai_def, auto simp add: skl1_step4_def)

text \<open>refinement proof\<close>
lemmas skl1_trans_refines_a0i_trans_i =
  skl1_learn_refines_a0_ia_skip_i
  skl1_step1_refines_a0i_skip_i skl1_step2_refines_a0i_running_skip_i
  skl1_step3_refines_a0i_commit_skip_i skl1_step4_refines_a0i_skip_i

lemma skl1_refines_init_a0i_i [iff]:
  "init skl1 \<subseteq> R0sk1iai `` (init a0i)"
by (auto simp add: R0sk1iai_def a0i_defs skl1_defs)

lemma skl1_refines_trans_a0i_i [iff]:
  "{R0sk1iai \<inter> (UNIV \<times> (skl1_inv1 \<inter> skl1_inv2))} trans a0i, trans skl1 {> R0sk1iai}"
proof -
  let ?pre' = "R0sk1iai \<inter> (UNIV \<times> skl1_inv3)"
  show ?thesis (is "{?pre} ?t1, ?t2 {>?post}")
  proof (rule relhoare_conseq_left)
    show "?pre \<subseteq> ?pre'"
      using skl1_inv3_derived by blast
  next
    show "{?pre'} ?t1, ?t2 {> ?post}"
      apply (auto simp add: a0i_def skl1_def a0i_trans_def skl1_trans_def)
      prefer 2 using skl1_step2_refines_a0i_running_skip_i apply (simp add: PO_rhoare_defs, blast)
      prefer 2 using skl1_step3_refines_a0i_commit_skip_i apply (simp add: PO_rhoare_defs, blast)
      apply (blast intro!:skl1_trans_refines_a0i_trans_i)+
      done
  qed
qed

lemma obs_consistent_med01iai [iff]:
  "obs_consistent R0sk1iai med0sk1iai a0i skl1"
by (auto simp add: obs_consistent_def R0sk1iai_def med0sk1iai_def)

text \<open>refinement result\<close>
lemma skl1_refines_a0i_i [iff]:
  "refines
     (R0sk1iai \<inter> (reach a0i \<times> (skl1_inv1 \<inter> skl1_inv2)))
     med0sk1iai a0i skl1"
by (rule Refinement_using_invariants, auto)

lemma  skl1_implements_a0i_i [iff]: "implements med0sk1iai a0i skl1"
by (rule refinement_soundness) (fast)

(**************************************************************************************************)
subsection \<open>Derived invariants: injective agreement (@{term "Init"} authenticates @{term "Resp"})\<close>
(**************************************************************************************************)

lemma skl1_obs_iagreement_Init [iff]: "oreach skl1 \<subseteq> l1_iagreement_Init"
apply (rule external_invariant_translation
         [OF PO_a0i_obs_agreement _ skl1_implements_a0i_i])
apply (auto simp add: med0sk1iai_def l1_iagreement_Init_def a0i_agreement_def)
done

lemma skl1_iagreement_Init [iff]: "reach skl1 \<subseteq> l1_iagreement_Init"
by (rule external_to_internal_invariant [OF skl1_obs_iagreement_Init], auto)

(**************************************************************************************************)
subsection \<open>Refinement: injective agreement  (@{term "Resp"} authenticates @{term "Init"})\<close>
(**************************************************************************************************)

text \<open>Mediator function.\<close>
definition
  med0sk1iar :: "skl1_obs \<Rightarrow> a0i_obs"
where
  "med0sk1iar t \<equiv> \<lparr>a0n_state.signals = signalsResp t\<rparr>"

text \<open>Relation between states.\<close>
definition
  R0sk1iar :: "(a0i_state * skl1_state) set"
where
  "R0sk1iar \<equiv> {(s,s').
    a0n_state.signals s = signalsResp s'
    }"

text \<open>Protocol independent events.\<close>

lemma skl1_learn_refines_a0_ia_skip_r:
  "{R0sk1iar} Id, l1_learn m {>R0sk1iar}"
apply (auto simp add: PO_rhoare_defs R0sk1iar_def)
apply (simp add: l1_learn_def)
done

text \<open>Protocol events.\<close>

lemma skl1_step1_refines_a0i_skip_r:
  "{R0sk1iar} Id, skl1_step1 Ra A B {>R0sk1iar}"
by (auto simp add: PO_rhoare_defs R0sk1iar_def skl1_step1_def)

lemma skl1_step2_refines_a0i_skip_r:
  "{R0sk1iar} Id, skl1_step2 Rb A B Ni gnx {>R0sk1iar}"
by (auto simp add: PO_rhoare_defs R0sk1iar_def, auto simp add:skl1_step2_def)

lemma skl1_step3_refines_a0i_running_skip_r:
  "{R0sk1iar}
     a0i_running A B \<langle>NonceF (Ra$ni), Nr, Exp gny (NonceF (Ra$nx))\<rangle> \<union> Id,
     skl1_step3 Ra A B Nr gny
   {>R0sk1iar}"
by (auto simp add: PO_rhoare_defs R0sk1iar_def,
    simp_all add: skl1_step3_def a0i_running_def, auto)

lemma skl1_step4_refines_a0i_commit_skip_r:
  "{R0sk1iar \<inter> UNIV\<times>skl1_inv6}
      a0i_commit A B \<langle>Ni, NonceF (Rb$nr), Exp gnx (NonceF (Rb$ny))\<rangle> \<union> Id,
      skl1_step4 Rb A B Ni gnx
   {>R0sk1iar}"
apply (auto simp add: PO_rhoare_defs R0sk1iar_def)
apply (auto simp add: skl1_step4_def a0i_commit_def)
apply (auto dest!: skl1_inv6D [rotated 1])
done

text \<open>Refinement proof.\<close>

lemmas skl1_trans_refines_a0i_trans_r =
  skl1_learn_refines_a0_ia_skip_r
  skl1_step1_refines_a0i_skip_r skl1_step2_refines_a0i_skip_r
  skl1_step3_refines_a0i_running_skip_r skl1_step4_refines_a0i_commit_skip_r

lemma skl1_refines_init_a0i_r [iff]:
  "init skl1 \<subseteq> R0sk1iar `` (init a0i)"
by (auto simp add: R0sk1iar_def a0i_defs skl1_defs)

lemma skl1_refines_trans_a0i_r [iff]:
  "{R0sk1iar \<inter> (UNIV \<times> (skl1_inv4 \<inter> skl1_inv5))} trans a0i, trans skl1 {> R0sk1iar}"
proof -
  let ?pre' = "R0sk1iar \<inter> (UNIV \<times> skl1_inv6)"
  show ?thesis (is "{?pre} ?t1, ?t2 {>?post}")
  proof (rule relhoare_conseq_left)
    show "?pre \<subseteq> ?pre'"
      using skl1_inv6_derived by blast
  next
    show "{?pre'} ?t1, ?t2 {> ?post}"
      apply (auto simp add: a0i_def skl1_def a0i_trans_def skl1_trans_def)
      prefer 3 using skl1_step3_refines_a0i_running_skip_r apply (simp add: PO_rhoare_defs, blast)
      prefer 3 using skl1_step4_refines_a0i_commit_skip_r apply (simp add: PO_rhoare_defs, blast)
      apply (blast intro!:skl1_trans_refines_a0i_trans_r)+
      done
  qed
qed

lemma obs_consistent_med0sk1iar [iff]:
  "obs_consistent R0sk1iar med0sk1iar a0i skl1"
by (auto simp add: obs_consistent_def R0sk1iar_def med0sk1iar_def)

text \<open>Refinement result.\<close>

lemma skl1_refines_a0i_r [iff]:
  "refines
     (R0sk1iar \<inter> (reach a0i \<times> (skl1_inv4 \<inter> skl1_inv5)))
     med0sk1iar a0i skl1"
by (rule Refinement_using_invariants, auto)

lemma  skl1_implements_a0i_r [iff]: "implements med0sk1iar a0i skl1"
by (rule refinement_soundness) (fast)

(**************************************************************************************************)
subsection \<open>Derived invariants: injective agreement (@{term "Resp"} authenticates @{term "Init"})\<close>
(**************************************************************************************************)

lemma skl1_obs_iagreement_Resp [iff]: "oreach skl1 \<subseteq> l1_iagreement_Resp"
apply (rule external_invariant_translation
         [OF PO_a0i_obs_agreement _ skl1_implements_a0i_r])
apply (auto simp add: med0sk1iar_def l1_iagreement_Resp_def a0i_agreement_def)
done

lemma skl1_iagreement_Resp [iff]: "reach skl1 \<subseteq> l1_iagreement_Resp"
by (rule external_to_internal_invariant [OF skl1_obs_iagreement_Resp], auto)

end


(*  Title:      HOL/Auth/n_german_lemma_on_inv__6.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_german Protocol Case Study*}

theory n_german_lemma_on_inv__6 imports n_german_base
begin
section{*All lemmas on causal relation between inv__6 and some rule r*}
lemma n_SendInvAckVsinv__6:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvAck  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__6  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvInvAckVsinv__6:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvInvAck  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__6  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P3 s"
    apply (cut_tac a1 a2 b1 c1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan3'') p__Inv4) ''Cmd'')) (Const InvAck)) (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E))))" in exI, auto) done
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P3 s"
    apply (cut_tac a1 a2 b1 c1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan3'') i) ''Cmd'')) (Const InvAck)) (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E))))" in exI, auto) done
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntEVsinv__6:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntE N i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__6  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntSVsinv__6:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntS  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__6  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntEVsinv__6:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntE  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__6  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Ident ''ExGntd'')) (Const false)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntE))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_StoreVsinv__6:
  assumes a1: "\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqESVsinv__6:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqES  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendGntSVsinv__6:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendGntS  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInvSVsinv__6:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInvS  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInvEVsinv__6:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInvE  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqVsinv__6:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReq N i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqSVsinv__6:
  assumes a1: "\<exists> j. j\<le>N\<and>r=n_SendReqS  j" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqEIVsinv__6:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqEI  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end