theory Modelica_Blocks_Core
  imports "../Modelica_Core"
begin

consts
  eps\<^sub>m :: real

type_synonym ('a, 'l, 'c) mcon = "('a \<Longrightarrow> ('l, 'c) mst_scheme)"

translations
  (type) "('a, 'l, 'c) mcon" <= (type) "('a \<Longrightarrow> ('l, 'c) mst_scheme)"

datatype ('l, 'c) mevgrd =
  TimeEvent (ofTimeEvent: "real \<Rightarrow> bool") | StateEvent (ofStateEvent: "(real, 'l, 'c) mexpr")

record (overloaded) ('l, 'c) mblock =
  mieqs :: "('l, 'c) mst_scheme upred"               -- {* Initial Equations *}
  mdeqs :: "('l, 'c) mrel"                           -- {* Differential Equations *}
  maeqs :: "('l, 'c) mst_scheme upred"               -- {* Algebraic Equations *}
  mqeqs :: "('l, 'c) mst_scheme upred"               -- {* Discrete Equations *}
  mreqs :: "('l, 'c) mst_scheme hrel set"            -- {* Reset Equations *}
  mzcfs :: "(real, ('l, 'c) mst_scheme) uexpr set"   -- {* Zero Crossing Expressions *}
  mtevs :: "real \<Rightarrow> bool"                            -- {* Time Event Expressions *}

definition "EvInv eps z  = (\<lceil>z\<rceil>\<^sub>< >\<^sub>u -eps \<Rightarrow> \<lceil>z\<rceil>\<^sub>> >\<^sub>u -eps)"
definition "EvExit eps z = (\<lceil>z\<rceil>\<^sub>< >\<^sub>u 0 \<and> \<lceil>z\<rceil>\<^sub>> \<le>\<^sub>u 0)"

definition interleave_r :: "'a hrel set \<Rightarrow> 'a hrel" ("|||\<^sub>r _") where
"interleave_r A = (\<Sqinter> xs\<in>{xs. set(xs) = A} \<bullet> (;; p : xs \<bullet> p))"

definition svid_fst :: "'a \<Longrightarrow> 'a \<times> 'b" ("\<^bold>v\<^sub>0") where
[lens_defs]: "svid_fst = fst\<^sub>L"

definition svid_snd :: "'b \<Longrightarrow> 'a \<times> 'b" ("\<^bold>v\<^sub>1") where
[lens_defs]: "svid_snd = snd\<^sub>L"

syntax
  "_svid_fst" :: "svid" ("\<^bold>v\<^sub>0")
  "_svid_snd" :: "svid" ("\<^bold>v\<^sub>1")

translations
  "_svid_fst" == "CONST svid_fst"
  "_svid_snd" == "CONST svid_snd"

lemma skip_lens_ext_fst:
  "II \<oplus>\<^sub>p (\<^bold>v\<^sub>0 \<times>\<^sub>L \<^bold>v\<^sub>0) = ($\<^bold>v\<^sub>0\<acute> =\<^sub>u $\<^bold>v\<^sub>0)"
  by (rel_auto)

lemma fst_snd_eq_skip:
  "($\<^bold>v\<^sub>0\<acute> =\<^sub>u $\<^bold>v\<^sub>0 \<and> $\<^bold>v\<^sub>1\<acute> =\<^sub>u $\<^bold>v\<^sub>1) = II"
  by (rel_auto)

lemma iterate_skip_lemma_1:
  "($\<^bold>v\<^sub>0\<acute> =\<^sub>u $\<^bold>v\<^sub>0 \<and> $\<^bold>v\<^sub>1\<acute> =\<^sub>u $\<^bold>v\<^sub>0) ;; (II \<triangleleft> &\<^bold>v\<^sub>0 =\<^sub>u &\<^bold>v\<^sub>1 \<triangleright>\<^sub>r X) = \<^bold>v\<^sub>1 := &\<^bold>v\<^sub>0"
  by (rel_auto)

definition iterate :: "'a hrel \<Rightarrow> 'a hrel" where
"iterate P = (\<exists> $\<^bold>v\<^sub>1;$\<^bold>v\<^sub>1\<acute> \<bullet> (\<nu> X \<bullet> (P \<oplus>\<^sub>p (\<^bold>v\<^sub>0 \<times>\<^sub>L \<^bold>v\<^sub>0) \<and> $\<^bold>v\<^sub>1\<acute> =\<^sub>u $\<^bold>v\<^sub>0) ;; (II \<triangleleft> &\<^bold>v\<^sub>0 =\<^sub>u &\<^bold>v\<^sub>1 \<triangleright>\<^sub>r X))) \<restriction>\<^sub>e (\<^bold>v\<^sub>0 \<times>\<^sub>L \<^bold>v\<^sub>0)"

lemma iterate_II: "iterate II = II"
  by (simp add: iterate_def skip_lens_ext_fst iterate_skip_lemma_1 lfp_const, rel_auto)

definition mblock_comp :: "('l,'c) mblock \<Rightarrow> ('l,'c) mblock \<Rightarrow> ('l,'c) mblock" (infixr "\<oplus>\<^sub>m" 85) where
[upred_defs, mo_defs]:
"A \<oplus>\<^sub>m B = \<lparr> mieqs = (mieqs A \<and> mieqs B)
          , mdeqs = (mdeqs A \<and> mdeqs B)
          , maeqs = (maeqs A \<and> maeqs B)
          , mqeqs = (mqeqs A \<and> mqeqs B)
          , mreqs = (mreqs A \<union> mreqs B)
          , mzcfs = (mzcfs A \<union> mzcfs B)
          , mtevs = (\<lambda> t. mtevs A t \<or> mtevs B t) \<rparr>"

(* FIXME: Take account of time events here too. *)

definition mblock_sem ::
  "_ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> ('l::t2_space,'c::t2_space) mblock \<Rightarrow> ('l,'c) mrel" ("'(_,_,_') \<Turnstile> \<lbrakk>_\<rbrakk>\<^sub>m") where
[upred_defs, mo_defs]:
"(\<epsilon>, s, q) \<Turnstile> \<lbrakk>M\<rbrakk>\<^sub>m =
  (let I = mieqs M; D = mdeqs M; A = maeqs M; Q = mqeqs M; R = mreqs M; Z = mzcfs M; T = mtevs M in
   \<^bold>R\<^sub>s(true\<^sub>r \<turnstile> false \<diamondop> [I \<and> Q \<and> A]\<^sub>C\<^sub>>) ;;
   (\<mu>\<^sub>R X \<bullet> ([D \<and> \<lceil>\<lceil>A\<rceil>\<^sub>>\<rceil>\<^sub>h \<and> q \<leftarrow>\<^sub>h $q]\<^sub>H
                 inv (\<not> \<guillemotleft>T\<guillemotright>($mtime\<acute>)\<^sub>a) \<and> (\<And> z\<in>Z \<bullet> EvInv \<epsilon> z)
                 until\<^sub>H ((\<guillemotleft>T\<guillemotright>($mtime\<acute>)\<^sub>a) \<or> (\<Or> z\<in>Z \<bullet> EvExit \<epsilon> z))) ;;
            \<^bold>R\<^sub>s(true\<^sub>r \<turnstile> false \<diamondop> [iterate($s\<acute> =\<^sub>u $s \<and> \<lceil>Q\<rceil>\<^sub>> \<and> \<lceil>A\<rceil>\<^sub>>) ;; |||\<^sub>r R]\<^sub>C) ;; X))"

(*
definition timeGuards :: "('l, 'c) mblock \<Rightarrow> ((real \<Rightarrow> bool) \<times> ('l, 'c) mrel) list" where
[upred_defs, mo_defs]:
"timeGuards M = map (\<lambda> (g, e). (ofTimeEvent g, e)) (filter (is_TimeEvent \<circ> fst) (mgrds M))"

definition stateGuards :: "('l, 'c) mblock \<Rightarrow> ((real, 'l, 'c) mexpr \<times> ('l, 'c) mrel) list" where
[upred_defs, mo_defs]:
"stateGuards M = map (\<lambda> (g, e). (ofStateEvent g, e)) (filter (Not \<circ> is_TimeEvent \<circ> fst) (mgrds M))"

text {* A time event is triggered whenever the internal clock hits one of the instants in
  the given set of real number. *}

definition ti_event :: "(real \<Rightarrow> bool) \<Rightarrow> ('l, 'c) mst_scheme hrel" where
[upred_defs, mo_defs]: "ti_event P = (\<guillemotleft>P\<guillemotright>($time\<acute>)\<^sub>a)"

text {* State events are recorded whenever the given function crosses zero. A zero crossing event
  is registered at some non-deterministically chosen instant when the function $zcf$ was previously
  $\ge eps$ and it becomes less than $eps$. There is not one point which satisifies this specification
  and then event can occur at any $t$ when $zcf(t) \in [0,eps)$ *}

definition zc_event :: "(real, ('l, 'c) mst_scheme) uexpr \<Rightarrow> ('l, 'c) mst_scheme hrel \<times> ('l, 'c) mst_scheme hrel" where
[upred_defs, mo_defs]: "zc_event zcf = (\<lceil>zcf\<rceil>\<^sub>> \<ge>\<^sub>u 0, (\<lceil>zcf \<ge>\<^sub>u \<guillemotleft>eps\<^sub>m\<guillemotright>\<rceil>\<^sub>< \<and> \<lceil>zcf <\<^sub>u \<guillemotleft>eps\<^sub>m\<guillemotright>\<rceil>\<^sub>>))"

text {* When the zero-crossing function was previously close to 0, but now it is sufficiently far
  away ($> eps$), a "phantom" event iteration executes which simply resets the previous value
  of the zero crossing function to that point so that any correspondonding when statement is
  re-enabled. *}

definition zc_restore :: "(real, ('l, 'c) mst_scheme) uexpr \<Rightarrow> ('l, 'c) mst_scheme hrel" where
[upred_defs, mo_defs]: "zc_restore zcf = (\<lceil>zcf <\<^sub>u \<guillemotleft>eps\<^sub>m\<guillemotright>\<rceil>\<^sub><  \<and> \<lceil>zcf \<ge>\<^sub>u \<guillemotleft>eps\<^sub>m\<guillemotright>\<rceil>\<^sub>>)"

definition minvs :: "('l, 'c) mblock \<Rightarrow> ('l, 'c) mst_scheme hrel" where
[upred_defs, mo_defs]:
  "minvs M = foldr (op \<and>) (map (fst \<circ> zc_event \<circ> fst) (stateGuards M)) true"

definition mconds :: "('l, 'c) mblock \<Rightarrow> ('l, 'c) mst_scheme hrel" where
[upred_defs, mo_defs]:
  "mconds M = (foldr (op \<or>) (map (snd \<circ> zc_event \<circ> fst) (stateGuards M)) false \<or>
               foldr (op \<or>) (map (zc_restore \<circ> fst) (stateGuards M)) false \<or>
               foldr (op \<or>) (map (ti_event \<circ> fst) (timeGuards M)) false)"

text {* For discrete events, we first execute each time event up to once, and then enter iteration
  for the state events. *}

definition mdeqs :: "('l::t2_space,'c::t2_space) mblock \<Rightarrow> ('l,'c) mrel" where
[upred_defs, mo_defs]: "mdeqs M =
   (foldr (op ;;) (map (\<lambda> (R, dq). dq \<triangleleft> \<guillemotleft>R\<guillemotright>(&\<^bold>c:time)\<^sub>a \<triangleright>\<^sub>R II\<^sub>R) (timeGuards M)) II\<^sub>R) ;;
   (\<mu>\<^sub>R X \<bullet> foldr
           (\<lambda> (zcf, dq) q.
           (dq ;; X) \<triangleleft> (\<lceil>zcf\<rceil>\<^sub>< \<ge>\<^sub>u \<guillemotleft>eps\<^sub>m\<guillemotright>)\<lbrakk>&\<^bold>d/&\<^bold>c\<rbrakk> \<and> (\<lceil>zcf\<rceil>\<^sub>< <\<^sub>u \<guillemotleft>eps\<^sub>m\<guillemotright>) \<triangleright>\<^sub>R q) (stateGuards M) II\<^sub>R)"
 (* zcf  previously not satisfied ---^               ^--- now it is *)

definition CoreTime :: "('l::t2_space,'c::t2_space) mblock" where
[upred_defs, mo_defs]:
  "CoreTime = \<lparr> minit = (&time =\<^sub>u 0), mceqs = &time \<leftarrow>\<^sub>h ($time + \<guillemotleft>ti\<guillemotright>), mgrds = [] \<rparr>"

definition mblock_comp :: "('l,'c) mblock \<Rightarrow> ('l,'c) mblock \<Rightarrow> ('l,'c) mblock" (infixr "\<oplus>\<^sub>m" 85) where
[upred_defs, mo_defs]:
"A \<oplus>\<^sub>m B = \<lparr> minit = (minit A \<and> minit B)
          , mceqs = (mceqs A \<and> mceqs B)
          , mgrds = (mgrds A @ mgrds B) \<rparr>"

definition mblock_sem :: "('l::t2_space,'c::t2_space) mblock \<Rightarrow> ('l,'c) mrel" ("\<lbrakk>_\<rbrakk>\<^sub>m") where
[upred_defs, mo_defs]:
"\<lbrakk>M\<rbrakk>\<^sub>m = (let M' = CoreTime \<oplus>\<^sub>m M in
        \<^bold>R\<^sub>s(true\<^sub>r \<turnstile> false \<diamondop> [minit M']\<^sub>C\<^sub>>) ;;
        (\<mu>\<^sub>R X \<bullet> \<^bold>d :=\<^sub>R &\<^bold>c ;; ([mceqs M']\<^sub>H [minvs M' | mconds M']\<^sub>H\<^sup>+ (mdeqs M')) ;; X))"
*)

default_sort t2_space

end


theory Cell
  imports Simpl.Vcg "Rust-Verification.Rust_Semantics"
begin

text \<open>Formalization of Cell<T>. In this theory, we interpret &Cell<T> as
a SharedReadWrite pointer to the location.\<close>

record cell_env = globals_ram +
  self :: tagged_ref
  return :: tagged_ref

record cell_set_env = cell_env +
  val :: tagged_ref

record cell_swap_env = cell_env +
  other :: tagged_ref
  tmp :: tagged_ref \<comment> \<open>inlining local variable for ptr::swap\<close>

(* TODO: Current definition demands only read grant of argument, but it should be owner grant
 * because Cell::set moves the argument.
 *)
definition cell_set_body :: "(cell_set_env, 'p, rust_error) com" where
  "cell_set_body == copy_betw_places val self"

(* TODO: We need to define a "calling convention" for handling arguments/return value.
 *)
definition cell_get_body :: "(cell_env, 'p, rust_error) com" where
  "cell_get_body == copy_betw_places self return"

text \<open>The implementation of Cell::swap is basically along the following lines
(inlining ptr::swap):

``` rust
if ptr::eq(self, other) {
  return
}

let tmp = uninit();
*tmp = *self;
*self = *other;
*other = *tmp;
```

according to \<^url>\<open>https://doc.rust-lang.org/src/core/cell.rs.html#364-375\<close> and
\<^url>\<open>https://doc.rust-lang.org/src/core/ptr/mod.rs.html#373-388\<close>.
\<close>

definition cell_swap_body :: "(cell_swap_env, 'p, rust_error) com" where
  "cell_swap_body ==
    IFR {s. ptr_eq (self s) (other s)}
    THEN
      Skip
    ELSE
      \<comment> \<open>Initializing tmp with uninit\<close>
      Basic (\<lambda>s. (let (r, s') = heap_new uninit s in s'\<lparr> tmp := r \<rparr>));;

      \<comment> \<open>*tmp = *self\<close>
      copy_betw_places self tmp;;
      \<comment> \<open>*self = *other\<close>
      copy_betw_places other self;;
      \<comment> \<open>*self = *tmp\<close>
      copy_betw_places tmp other
    FI
"

lemma cell_set_value_safety: "\<Gamma> \<turnstile>\<^sub>t
  {s. wf_heap s
  \<and> permission_is SharedReadWrite (self s) s
  \<and> readable (val s) s}
  cell_set_body
  {s. True}"
  unfolding cell_set_body_def
  apply vcg
  by (auto simp add: Let_def)

\<comment> \<open>A proof that shows self and val have the same value after Cell::set.\<close>
lemma cell_set_value: "\<Gamma> \<turnstile>\<^sub>t
  {s. wf_heap s
  \<and> permission_is SharedReadWrite (self s) s
  \<and> readable (val s) s}
  cell_set_body
  {s. memread (self s) s = memread (val s) s}"
  unfolding cell_set_body_def
  apply vcg
  apply (auto simp add: Let_def)
  by (metis nth_list_update_eq nth_list_update_neq)

lemma cell_get_value_safety: "\<Gamma> \<turnstile>\<^sub>t
  {s. wf_heap s
  \<and> permission_is SharedReadWrite (self s) s
  \<and> writable (return s) s}
  cell_get_body
  {s. True}"
  unfolding cell_get_body_def
  apply vcg
  by (auto simp add: Let_def)

\<comment> \<open>A proof that shows self and return have the same value after Cell::get.\<close>
lemma cell_get_value: "\<Gamma> \<turnstile>\<^sub>t
  {s. wf_heap s
  \<and> permission_is SharedReadWrite (self s) s
  \<and> writable (return s) s}
  cell_get_body
  {s. memread (self s) s = memread (return s) s}"
  unfolding cell_get_body_def
  apply vcg
  apply (auto simp add: Let_def)
  by (metis nth_list_update_eq nth_list_update_neq)

lemma cell_swap_safety: "\<Gamma> \<turnstile>\<^sub>t
  {s. wf_heap s
  \<and> permission_is SharedReadWrite (self s) s
  \<and> permission_is SharedReadWrite (other s) s}
  cell_swap_body
  {s. True}"
  unfolding cell_swap_body_def
  apply vcg
  apply (auto simp add: Let_def nth_append)
  using permission_is_imp_writable writable_pop_tags by auto

\<comment> \<open>A proof that shows Cell::swap(self, other) swaps the value in the memory.\<close>
lemma cell_swap_correctness: "\<Gamma> \<turnstile>\<^sub>t
  {s. wf_heap s
  \<and> permission_is SharedReadWrite (self s) s
  \<and> permission_is SharedReadWrite (other s) s
  \<and> memread (self s) s = x
  \<and> memread (other s) s = y}
  cell_swap_body
  {s. memread (self s) s = y \<and> memread (other s) s = x}"
  unfolding cell_swap_body_def
  apply vcg
  apply (auto simp add: Let_def nth_append)
  using permission_is_imp_writable writable_pop_tags by auto

end


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

  Project: IsaNet

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

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

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

section \<open>ICING variant\<close>
text\<open>We abstract and simplify from the protocol ICING in several ways. First, we only consider
Proofs of Consent (PoC), not Proofs of Provenance (PoP). Our framework does not support proving the
path validation properties that PoPs provide, and it also currently does not support XOR, and
dynamically changing hop fields.
Thus, instead of embedding $A_i \oplus PoP_{0,1}$, we embed $A_i$ directly.
We also remove the payload from the Hash that is included in each packet.

We offer three versions of this protocol:
\begin{itemize}
\item @{text "ICING"}, which contains our best effort at modeling the protocol as accurately as
possible.
\item @{text "ICING_variant"}, in which we strip down the protocol to what is required to obtain the
security guarantees and remove unnecessary fields.
\item @{text "ICING_variant2"}, in which we furthermore simplify the protocol. The key of the MAC in
this protocol is only the key of the AS, as opposed to a key derived specifically for this hop field.
In order to prove that this scheme is secure, we have to assume that ASes only occur once on an
authorized path, since otherwise the MAC for two different hop fields (by the same AS) would be the
same, and the AS could not distinguish the hop fields based on the MAC.
\end{itemize}\<close>
theory ICING_variant
  imports
    "../Parametrized_Dataplane_3_undirected"
begin

locale icing_defs = network_assums_undirect _ _ _ auth_seg0
  for auth_seg0 :: "(msgterm \<times> ahi list) set"
begin

(******************************************************************************)
subsection \<open>Hop validation check and extract functions\<close>
(******************************************************************************)
type_synonym ICING_HF = "(unit, unit) HF"

text\<open>The term @{term "sntag"} is a key that is derived from the key of an AS and a specific
hop field. We use it in the computation of @{term "hf_valid"}.\<close>

fun sntag :: "ahi \<Rightarrow> msgterm" where
  "sntag \<lparr>UpIF = upif, DownIF = downif, ASID = asid\<rparr> = \<langle>macKey asid,\<langle>if2term upif,if2term downif\<rangle>\<rangle>"

lemma sntag_eq: "sntag ahi2 = sntag ahi1 \<Longrightarrow> ahi2 = ahi1"
  by(cases ahi1,cases ahi2) auto

text\<open>The predicate @{term "hf_valid"} is given to the concrete parametrized model as a parameter.
It ensures the authenticity of the hop authenticator in the hop field. The predicate takes an
expiration timestamp (in this model always a numeric value, hence the matching on
@{term "Num PoC_i_expire"}), the entire segment and the hop field to be validated.\<close>
fun hf_valid :: "msgterm \<Rightarrow> msgterm
    \<Rightarrow> ICING_HF list
    \<Rightarrow> ICING_HF
    \<Rightarrow> bool" where
  "hf_valid (Num PoC_i_expire) uinfo hfs \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> \<longleftrightarrow> uhi = () \<and>
    x = Mac[sntag ahi] (L ((Num PoC_i_expire)#(map (hf2term o AHI) hfs))) \<and> uinfo = \<epsilon>"
| "hf_valid _ _ _ _ = False"

text\<open>We can extract the entire path (past and future) from the hvf field.\<close>
fun extr :: "msgterm \<Rightarrow> ahi list" where
  "extr (Mac[_] (L hfs))
 = map term2hf (tl hfs)"
| "extr _ = []"

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

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

text\<open>An authenticated info field is always a number (corresponding to a timestamp). The
     unauthenticated info field is set to the empty term @{term "\<epsilon>"}.\<close>
definition auth_restrict where
  "auth_restrict ainfo uinfo l \<equiv> (\<exists>ts. ainfo = Num ts) \<and> (uinfo = \<epsilon>)"

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

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

abbreviation no_oracle where "no_oracle \<equiv> (\<lambda> _ _. True)"

text\<open>We now define useful properties of the above definition.\<close>
lemma hf_valid_invert:
  "hf_valid tsn uinfo hfs hf \<longleftrightarrow>
(\<exists> ts ahi. tsn = Num ts \<and> ahi = AHI hf \<and>
UHI hf = () \<and>
HVF hf = Mac[sntag ahi] (L ((Num ts)#(map (hf2term o AHI) hfs))) \<and> uinfo = \<epsilon>)"
  apply(cases hf) by(auto elim!: hf_valid.elims)

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

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

lemma info_hvf:
  assumes "hf_valid ainfo uinfo hfs m" "hf_valid ainfo' uinfo' hfs' m'"
          "HVF m = HVF m'" "m \<in> set hfs" "m' \<in> set hfs'"
  shows "ainfo' = ainfo" "m' = m"
  using assms
  apply(auto simp add: hf_valid_invert intro: ahi_eq)
  apply(cases m,cases m')
  by(auto intro: sntag_eq)

(******************************************************************************)
subsection\<open>Definitions and properties of the added intruder knowledge\<close>
(******************************************************************************)
text\<open>Here we define a @{text "ik_add"} and @{text "ik_oracle"} as being empty, as these features are
not used in this instance model.\<close>
print_locale dataplane_3_undirected_defs
sublocale dataplane_3_undirected_defs _ _ _ auth_seg0 hf_valid auth_restrict extr extr_ainfo
  term_ainfo terms_hf terms_uinfo no_oracle
  by unfold_locales

declare parts_singleton[dest]

abbreviation ik_add :: "msgterm set" where "ik_add \<equiv> {}"

abbreviation ik_oracle :: "msgterm set" where "ik_oracle \<equiv> {}"

lemma uinfo_empty[dest]: "(ainfo, hfs) \<in> auth_seg2 uinfo \<Longrightarrow> uinfo = \<epsilon>"
  by(auto simp add: auth_seg2_def auth_restrict_def)

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

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

declare ik_hfs_def[simp del]

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

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

lemma ik_uinfo_empty[simp]: "ik_uinfo = {\<epsilon>}"
  by(auto simp add: ik_uinfo_def auth_seg2_def auth_restrict_def intro!: exI[of _ "[]"])
declare ik_uinfo_def[simp del]

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

lemma Num_ik[intro]: "Num ts \<in> ik"
  by(auto simp add: ik_def auth_seg2_def auth_restrict_def intro!: exI[of _ "[]"])

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

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

lemma sntag_synth_bad: "sntag ahi \<in> synth ik \<Longrightarrow> ASID ahi \<in> bad"
  apply(cases ahi)
  by(auto simp add: ik_def ik_hfs_simp)

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

lemma COND_honest_hf_analz:
  assumes "ASID (AHI hf) \<notin> bad" "hf_valid ainfo uinfo hfs hf" "terms_hf hf \<subseteq> synth (analz ik)"
    "no_oracle ainfo uinfo" "hf \<in> set hfs"
    shows "terms_hf hf \<subseteq> analz ik"
proof-
  from assms(3) have hf_synth_ik: "HVF hf \<in> synth ik" by auto
  then have "\<exists>hfs uinfo. hf \<in> set hfs \<and> (ainfo, hfs) \<in> auth_seg2 uinfo"
    using assms(1,2,4,5)
    apply(auto simp add: ik_def hf_valid_invert ik_hfs_simp)
    subgoal for ts' hf' hfs'
      using HF.equality by (fastforce dest!: sntag_eq intro: exI[of _ hfs'])
    by(auto simp add: ik_hfs_simp ik_def hf_valid_invert sntag_synth_bad)
  then have "HVF hf \<in> ik"
    using assms(2)
    by(auto simp add: ik_hfs_def intro!: ik_ik_hfs intro!: exI)
  then show ?thesis by auto
qed

lemma COND_terms_hf:
  assumes "hf_valid ainfo uinfo hfs hf" and "HVF hf \<in> ik" and "no_oracle ainfo uinfo" and "hf \<in> set hfs"
  shows "\<exists>hfs. hf \<in> set hfs \<and> (\<exists>uinfo' . (ainfo, hfs) \<in> auth_seg2 uinfo')"
  using assms apply(auto 3 4 simp add: hf_valid_invert ik_hfs_simp ik_def dest: ahi_eq)
  apply(frule sntag_eq)
  apply(auto simp add: ik_def ik_hfs_simp)
  by (metis (mono_tags, lifting) HF.surjective old.unit.exhaust)

lemma COND_extr:
    "\<lbrakk>hf_valid ainfo uinfo l hf\<rbrakk> \<Longrightarrow> extr (HVF hf) = AHIS l"
  by(auto simp add: hf_valid_invert)

lemma COND_hf_valid_uinfo:
    "\<lbrakk>hf_valid ainfo uinfo l hf; hf_valid ainfo' uinfo' l' hf\<rbrakk>
    \<Longrightarrow> uinfo' = uinfo"
  by(auto simp add: hf_valid_invert)

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

end
end