(*  Title:      ZF/UNITY/Mutex.thy
    Author:     Sidi O Ehmety, Computer Laboratory
    Copyright   2001  University of Cambridge

Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra.

Variables' types are introduced globally so that type verification
reduces to the usual ZF typechecking \<in> an ill-tyed expression will
reduce to the empty set.
*)

section\<open>Mutual Exclusion\<close>

theory Mutex
imports SubstAx
begin

text\<open>Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra

Variables' types are introduced globally so that type verification reduces to
the usual ZF typechecking: an ill-tyed expressions reduce to the empty set.
\<close>

abbreviation "p \<equiv> Var([0])"
abbreviation "m \<equiv> Var([1])"
abbreviation "n \<equiv> Var([0,0])"
abbreviation "u \<equiv> Var([0,1])"
abbreviation "v \<equiv> Var([1,0])"

axiomatization where \<comment> \<open>Type declarations\<close>
  p_type:  "type_of(p)=bool \<and> default_val(p)=0" and
  m_type:  "type_of(m)=int  \<and> default_val(m)=#0" and
  n_type:  "type_of(n)=int  \<and> default_val(n)=#0" and
  u_type:  "type_of(u)=bool \<and> default_val(u)=0" and
  v_type:  "type_of(v)=bool \<and> default_val(v)=0"

definition
  (** The program for process U **)
  "U0 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(u:=1, m:=#1) \<and> s`m = #0}"

definition
  "U1 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(p:= s`v, m:=#2) \<and>  s`m = #1}"

definition
  "U2 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(m:=#3) \<and> s`p=0 \<and> s`m = #2}"

definition
  "U3 \<equiv> {\<langle>s,t\<rangle>:state*state. t=s(u:=0, m:=#4) \<and> s`m = #3}"

definition
  "U4 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(p:=1, m:=#0) \<and> s`m = #4}"

   (** The program for process V **)

definition
  "V0 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s (v:=1, n:=#1) \<and> s`n = #0}"

definition
  "V1 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(p:=not(s`u), n:=#2) \<and> s`n = #1}"

definition
  "V2 \<equiv> {\<langle>s,t\<rangle>:state*state. t  = s(n:=#3) \<and> s`p=1 \<and> s`n = #2}"

definition
  "V3 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s (v:=0, n:=#4) \<and> s`n = #3}"

definition
  "V4 \<equiv> {\<langle>s,t\<rangle>:state*state. t  = s (p:=0, n:=#0) \<and> s`n = #4}"

definition
  "Mutex \<equiv> mk_program({s:state. s`u=0 \<and> s`v=0 \<and> s`m = #0 \<and> s`n = #0},
              {U0, U1, U2, U3, U4, V0, V1, V2, V3, V4}, Pow(state*state))"

  (** The correct invariants **)

definition
  "IU \<equiv> {s:state. (s`u = 1\<longleftrightarrow>(#1 $\<le> s`m \<and> s`m $\<le> #3))
                     \<and> (s`m = #3 \<longrightarrow> s`p=0)}"

definition
  "IV \<equiv> {s:state. (s`v = 1 \<longleftrightarrow> (#1 $\<le> s`n \<and> s`n $\<le> #3))
                      \<and> (s`n = #3 \<longrightarrow> s`p=1)}"

  (** The faulty invariant (for U alone) **)

definition
  "bad_IU \<equiv> {s:state. (s`u = 1 \<longleftrightarrow> (#1 $\<le> s`m \<and> s`m  $\<le> #3))\<and>
                   (#3 $\<le> s`m \<and> s`m $\<le> #4 \<longrightarrow> s`p=0)}"

(** Variables' types **)

declare p_type [simp] u_type [simp] v_type [simp] m_type [simp] n_type [simp]

lemma u_value_type: "s \<in> state \<Longrightarrow>s`u \<in> bool"
  unfolding state_def
apply (drule_tac a = u in apply_type, auto)
done

lemma v_value_type: "s \<in> state \<Longrightarrow> s`v \<in> bool"
  unfolding state_def
apply (drule_tac a = v in apply_type, auto)
done

lemma p_value_type: "s \<in> state \<Longrightarrow> s`p \<in> bool"
  unfolding state_def
apply (drule_tac a = p in apply_type, auto)
done

lemma m_value_type: "s \<in> state \<Longrightarrow> s`m \<in> int"
  unfolding state_def
apply (drule_tac a = m in apply_type, auto)
done

lemma n_value_type: "s \<in> state \<Longrightarrow>s`n \<in> int"
  unfolding state_def
apply (drule_tac a = n in apply_type, auto)
done

declare p_value_type [simp] u_value_type [simp] v_value_type [simp]
        m_value_type [simp] n_value_type [simp]

declare p_value_type [TC] u_value_type [TC] v_value_type [TC]
        m_value_type [TC] n_value_type [TC]

text\<open>Mutex is a program\<close>

lemma Mutex_in_program [simp,TC]: "Mutex \<in> program"
by (simp add: Mutex_def)

declare Mutex_def [THEN def_prg_Init, simp]
declare Mutex_def [program]

declare  U0_def [THEN def_act_simp, simp]
declare  U1_def [THEN def_act_simp, simp]
declare  U2_def [THEN def_act_simp, simp]
declare  U3_def [THEN def_act_simp, simp]
declare  U4_def [THEN def_act_simp, simp]

declare  V0_def [THEN def_act_simp, simp]
declare  V1_def [THEN def_act_simp, simp]
declare  V2_def [THEN def_act_simp, simp]
declare  V3_def [THEN def_act_simp, simp]
declare  V4_def [THEN def_act_simp, simp]

declare  U0_def [THEN def_set_simp, simp]
declare  U1_def [THEN def_set_simp, simp]
declare  U2_def [THEN def_set_simp, simp]
declare  U3_def [THEN def_set_simp, simp]
declare  U4_def [THEN def_set_simp, simp]

declare  V0_def [THEN def_set_simp, simp]
declare  V1_def [THEN def_set_simp, simp]
declare  V2_def [THEN def_set_simp, simp]
declare  V3_def [THEN def_set_simp, simp]
declare  V4_def [THEN def_set_simp, simp]

declare  IU_def [THEN def_set_simp, simp]
declare  IV_def [THEN def_set_simp, simp]
declare  bad_IU_def [THEN def_set_simp, simp]

lemma IU: "Mutex \<in> Always(IU)"
apply (rule AlwaysI, force)
apply (unfold Mutex_def, safety, auto)
done

lemma IV: "Mutex \<in> Always(IV)"
apply (rule AlwaysI, force)
apply (unfold Mutex_def, safety)
done

(*The safety property: mutual exclusion*)
lemma mutual_exclusion: "Mutex \<in> Always({s \<in> state. \<not>(s`m = #3 \<and> s`n = #3)})"
apply (rule Always_weaken)
apply (rule Always_Int_I [OF IU IV], auto)
done

(*The bad invariant FAILS in V1*)

lemma less_lemma: "\<lbrakk>x$<#1; #3 $\<le> x\<rbrakk> \<Longrightarrow> P"
apply (drule_tac j = "#1" and k = "#3" in zless_zle_trans)
apply (drule_tac [2] j = x in zle_zless_trans, auto)
done

lemma "Mutex \<in> Always(bad_IU)"
apply (rule AlwaysI, force)
apply (unfold Mutex_def, safety, auto)
apply (subgoal_tac "#1 $\<le> #3")
apply (drule_tac x = "#1" and y = "#3" in zle_trans, auto)
apply (simp (no_asm) add: not_zless_iff_zle [THEN iff_sym])
apply auto
(*Resulting state: n=1, p=false, m=4, u=false.
  Execution of V1 (the command of process v guarded by n=1) sets p:=true,
  violating the invariant!*)
oops

(*** Progress for U ***)

lemma U_F0: "Mutex \<in> {s \<in> state. s`m=#2} Unless {s \<in> state. s`m=#3}"
by (unfold op_Unless_def Mutex_def, safety)

lemma U_F1:
     "Mutex \<in> {s \<in> state. s`m=#1} \<longmapsto>w {s \<in> state. s`p = s`v \<and> s`m = #2}"
by (unfold Mutex_def, ensures U1)

lemma U_F2: "Mutex \<in> {s \<in> state. s`p =0 \<and> s`m = #2} \<longmapsto>w {s \<in> state. s`m = #3}"
apply (cut_tac IU)
apply (unfold Mutex_def, ensures U2)
done

lemma U_F3: "Mutex \<in> {s \<in> state. s`m = #3} \<longmapsto>w {s \<in> state. s`p=1}"
apply (rule_tac B = "{s \<in> state. s`m = #4}" in LeadsTo_Trans)
   unfolding Mutex_def
 apply (ensures U3)
apply (ensures U4)
done

lemma U_lemma2: "Mutex \<in> {s \<in> state. s`m = #2} \<longmapsto>w {s \<in> state. s`p=1}"
apply (rule LeadsTo_Diff [OF LeadsTo_weaken_L
                             Int_lower2 [THEN subset_imp_LeadsTo]])
apply (rule LeadsTo_Trans [OF U_F2 U_F3], auto)
apply (auto dest!: p_value_type simp add: bool_def)
done

lemma U_lemma1: "Mutex \<in> {s \<in> state. s`m = #1} \<longmapsto>w {s \<in> state. s`p =1}"
by (rule LeadsTo_Trans [OF U_F1 [THEN LeadsTo_weaken_R] U_lemma2], blast)

lemma eq_123: "i \<in> int \<Longrightarrow> (#1 $\<le> i \<and> i $\<le> #3) \<longleftrightarrow> (i=#1 | i=#2 | i=#3)"
apply auto
apply (auto simp add: neq_iff_zless)
apply (drule_tac [4] j = "#3" and i = i in zle_zless_trans)
apply (drule_tac [2] j = i and i = "#1" in zle_zless_trans)
apply (drule_tac j = i and i = "#1" in zle_zless_trans, auto)
apply (rule zle_anti_sym)
apply (simp_all (no_asm_simp) add: zless_add1_iff_zle [THEN iff_sym])
done

lemma U_lemma123: "Mutex \<in> {s \<in> state. #1 $\<le> s`m \<and> s`m $\<le> #3} \<longmapsto>w {s \<in> state. s`p=1}"
by (simp add: eq_123 Collect_disj_eq LeadsTo_Un_distrib U_lemma1 U_lemma2 U_F3)

(*Misra's F4*)
lemma u_Leadsto_p: "Mutex \<in> {s \<in> state. s`u = 1} \<longmapsto>w {s \<in> state. s`p=1}"
by (rule Always_LeadsTo_weaken [OF IU U_lemma123], auto)

(*** Progress for V ***)

lemma V_F0: "Mutex \<in> {s \<in> state. s`n=#2} Unless {s \<in> state. s`n=#3}"
by (unfold op_Unless_def Mutex_def, safety)

lemma V_F1: "Mutex \<in> {s \<in> state. s`n=#1} \<longmapsto>w {s \<in> state. s`p = not(s`u) \<and> s`n = #2}"
by (unfold Mutex_def, ensures "V1")

lemma V_F2: "Mutex \<in> {s \<in> state. s`p=1 \<and> s`n = #2} \<longmapsto>w {s \<in> state. s`n = #3}"
apply (cut_tac IV)
apply (unfold Mutex_def, ensures "V2")
done

lemma V_F3: "Mutex \<in> {s \<in> state. s`n = #3} \<longmapsto>w {s \<in> state. s`p=0}"
apply (rule_tac B = "{s \<in> state. s`n = #4}" in LeadsTo_Trans)
   unfolding Mutex_def
 apply (ensures V3)
apply (ensures V4)
done

lemma V_lemma2: "Mutex \<in> {s \<in> state. s`n = #2} \<longmapsto>w {s \<in> state. s`p=0}"
apply (rule LeadsTo_Diff [OF LeadsTo_weaken_L
                             Int_lower2 [THEN subset_imp_LeadsTo]])
apply (rule LeadsTo_Trans [OF V_F2 V_F3], auto)
apply (auto dest!: p_value_type simp add: bool_def)
done

lemma V_lemma1: "Mutex \<in> {s \<in> state. s`n = #1} \<longmapsto>w {s \<in> state. s`p = 0}"
by (rule LeadsTo_Trans [OF V_F1 [THEN LeadsTo_weaken_R] V_lemma2], blast)

lemma V_lemma123: "Mutex \<in> {s \<in> state. #1 $\<le> s`n \<and> s`n $\<le> #3} \<longmapsto>w {s \<in> state. s`p = 0}"
by (simp add: eq_123 Collect_disj_eq LeadsTo_Un_distrib V_lemma1 V_lemma2 V_F3)

(*Misra's F4*)
lemma v_Leadsto_not_p: "Mutex \<in> {s \<in> state. s`v = 1} \<longmapsto>w {s \<in> state. s`p = 0}"
by (rule Always_LeadsTo_weaken [OF IV V_lemma123], auto)

(** Absence of starvation **)

(*Misra's F6*)
lemma m1_Leadsto_3: "Mutex \<in> {s \<in> state. s`m = #1} \<longmapsto>w {s \<in> state. s`m = #3}"
apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
apply (rule_tac [2] U_F2)
apply (simp add: Collect_conj_eq)
apply (subst Un_commute)
apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
 apply (rule_tac [2] PSP_Unless [OF v_Leadsto_not_p U_F0])
apply (rule U_F1 [THEN LeadsTo_weaken_R], auto)
apply (auto dest!: v_value_type simp add: bool_def)
done

(*The same for V*)
lemma n1_Leadsto_3: "Mutex \<in> {s \<in> state. s`n = #1} \<longmapsto>w {s \<in> state. s`n = #3}"
apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
apply (rule_tac [2] V_F2)
apply (simp add: Collect_conj_eq)
apply (subst Un_commute)
apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
 apply (rule_tac [2] PSP_Unless [OF u_Leadsto_p V_F0])
apply (rule V_F1 [THEN LeadsTo_weaken_R], auto)
apply (auto dest!: u_value_type simp add: bool_def)
done

end


(*
    Author:      Norbert Schirmer
    Maintainer:  Norbert Schirmer, norbert.schirmer at web de
    License:     LGPL
*)

(*  Title:      ProcParEx.thy
    Author:     Norbert Schirmer, TU Muenchen

Copyright (C) 2007-2008 Norbert Schirmer
Some rights reserved, TU Muenchen

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
*)

section "Examples for Procedures as Parameters using Statespaces"
theory ProcParExSP imports "../Vcg" begin

lemma conseq_exploit_pre':
             "\<lbrakk>\<forall>s \<in> S. \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P) c Q,A\<rbrakk>
              \<Longrightarrow>
              \<Gamma>,\<Theta>\<turnstile> (P \<inter> S)c Q,A"
  apply (rule HoarePartialDef.Conseq)
  apply clarify
  by (metis IntI insertI1 subset_refl)

lemma conseq_exploit_pre'':
             "\<lbrakk>\<forall>Z. \<forall>s \<in> S Z.  \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P Z) c (Q Z),(A Z)\<rbrakk>
              \<Longrightarrow>
              \<forall>Z. \<Gamma>,\<Theta>\<turnstile> (P Z \<inter> S Z)c (Q Z),(A Z)"
  apply (rule allI)
  apply (rule conseq_exploit_pre')
  apply blast
  done

lemma conseq_exploit_pre''':
             "\<lbrakk>\<forall>s \<in> S. \<forall>Z. \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P Z) c (Q Z),(A Z)\<rbrakk>
              \<Longrightarrow>
              \<forall>Z. \<Gamma>,\<Theta>\<turnstile> (P Z \<inter> S)c (Q Z),(A Z)"
  apply (rule allI)
  apply (rule conseq_exploit_pre')
  apply blast
  done

procedures compare(i::nat,j::nat|r::bool) "NoBody"

print_locale! compare_signature

context compare_impl
begin
declare [[hoare_use_call_tr' = false]]
term "\<acute>r :== CALL compare(\<acute>i,\<acute>j)"
declare [[hoare_use_call_tr' = true]]
end

(* FIXME: typing issue with modifies locale*)
procedures
  LEQ (i::nat,j::nat | r::bool) "\<acute>r :== \<acute>i \<le> \<acute>j"
  LEQ_spec: "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>}  PROC LEQ(\<acute>i,\<acute>j,\<acute>r) \<lbrace>\<acute>r = (\<^bsup>\<sigma>\<^esup>i \<le> \<^bsup>\<sigma>\<^esup>j)\<rbrace>"

  LEQ_modifies: "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} PROC LEQ(\<acute>i,\<acute>j,\<acute>r) {t. t may_only_modify_globals \<sigma> in []}"

definition mx:: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"
  where "mx leq a b = (if leq a b then a else b)"

procedures (imports compare_signature)
  Max (compare::string, n::nat, m::nat | k::nat)
  where b::bool
  in
  "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m);;
   IF \<acute>b THEN \<acute>k :== \<acute>n ELSE \<acute>k :== \<acute>m FI"

  Max_spec: "\<And>leq. \<forall>\<sigma>. \<Gamma>\<turnstile>
  ({\<sigma>} \<inter> {s. (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<^bsup>s\<^esup>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>) \<and>
              (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<^bsup>s\<^esup>compare(\<acute>i,\<acute>j) {t. t may_only_modify_globals \<tau> in []})})
    PROC Max(\<acute>compare,\<acute>n,\<acute>m,\<acute>k)
  \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"

context Max_spec
begin
thm Max_spec
end
context Max_impl
begin
term "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m)"
declare [[hoare_use_call_tr' = false]]
term "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m)"
declare [[hoare_use_call_tr' = true]]
end

lemma (in Max_impl ) Max_spec1:
shows
"\<forall>\<sigma> leq. \<Gamma>\<turnstile>
  ({\<sigma>} \<inter> \<lbrace> (\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>) \<and>
      (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
    \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
  \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (intro allI)
apply (rule conseq_exploit_pre')
apply (rule)
apply clarify
proof -
  fix \<sigma>:: "('a, 'b, 'c, 'd) stateSP_scheme" and s::"('a, 'b, 'c, 'd) stateSP_scheme" and leq
   assume compare_spec:
       "\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>r :== PROC \<^bsup>s\<^esup>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j\<rbrace>"

  assume compare_modifies:
        "\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>r :== PROC \<^bsup>s\<^esup>compare(\<acute>i,\<acute>j)
                {t. t may_only_modify_globals \<tau> in []}"

   show "\<Gamma>\<turnstile>({s} \<inter> {\<sigma>})
            \<acute>b :== DYNCALL \<acute>compare (\<acute>n,\<acute>m);;
            IF \<acute>b THEN \<acute>k :== \<acute>n ELSE \<acute>k :== \<acute>m FI
            \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
     apply vcg
     apply (clarsimp simp add: mx_def)
     done
 qed

lemma (in Max_impl) Max_spec2:
shows
"\<forall>\<sigma> leq. \<Gamma>\<turnstile>
  ({\<sigma>} \<inter> \<lbrace>(\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>) \<and>
      (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
    \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
  \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (intro allI)
apply (rule conseq_exploit_pre')
apply (rule)
apply clarify
apply vcg
apply (clarsimp simp add: mx_def)
done

lemma (in Max_impl) Max_spec3:
shows
"\<forall>n m leq. \<Gamma>\<turnstile>
  (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace>  \<inter>
   \<lbrace>(\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>) \<and>
     (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
    \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
  \<lbrace>\<acute>k = mx leq n m\<rbrace>"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (intro allI)
apply (rule conseq_exploit_pre')
apply (rule)
apply clarify
apply vcg
apply (clarsimp simp add: mx_def)
done

print_locale Max_spec

(* We have to rename the parameters of the compare procedure to match the LEQ procedure *)
locale Max_test = Max_spec where
        i_'compare_' = i_'LEQ_' and
        j_'compare_' = j_'LEQ_' and
        r_'compare_' = r_'LEQ_'
       + LEQ_spec + LEQ_modifies

lemma (in Max_test)
  shows
  "\<Gamma>\<turnstile> {\<sigma>} \<acute>k :== CALL Max(LEQ_'proc,\<acute>n,\<acute>m) \<lbrace>\<acute>k = mx (op \<le>) \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
proof -
  note Max_spec = Max_spec [where leq="(op \<le>)"]
  show ?thesis
    apply vcg
    apply (clarsimp)
    apply (rule conjI)
    apply (rule LEQ_spec)
    apply (rule LEQ_modifies)
    done
qed

lemma (in Max_impl) Max_spec5:
shows
"\<forall>n m leq. \<Gamma>\<turnstile>
  (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<inter> \<lbrace>\<forall>n' m'. \<Gamma>\<turnstile> \<lbrace>\<acute>i=n' \<and> \<acute>j=m'\<rbrace> \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq n' m')\<rbrace>\<rbrace>)
    \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
  \<lbrace>\<acute>k = mx leq n m\<rbrace>"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (intro allI)
apply (rule conseq_exploit_pre')
apply (rule)
apply clarify
apply vcg
apply clarsimp
apply (clarsimp simp add: mx_def)
done

lemma (in LEQ_impl)
 LEQ_spec: "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>i=n \<and> \<acute>j=m\<rbrace>  PROC LEQ(\<acute>i,\<acute>j,\<acute>r) \<lbrace>\<acute>r = (n \<le> m)\<rbrace>"
  apply vcg
  apply simp
  done

print_locale Max_impl
locale Max_test' = Max_impl where
        i_'compare_' = i_'LEQ_' and
        j_'compare_' = j_'LEQ_' and
        r_'compare_' = r_'LEQ_'
        + LEQ_impl
lemma (in Max_test')
  shows
  "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<acute>k :== CALL Max(LEQ_'proc,\<acute>n,\<acute>m) \<lbrace>\<acute>k = mx (op \<le>) n m\<rbrace>"
proof -
  note Max_spec = Max_spec5
  show ?thesis
    apply vcg
    apply (rule_tac x="op \<le>" in exI)
    apply clarsimp
    apply (rule LEQ_spec [rule_format])
    done
qed

end


theory outEvenData

imports bundle.SB
  begin

typedef outEven = "{cout}"
  by auto

instantiation outEven::"{somechan,finite}"
begin
definition "Rep = Rep_outEven"
instance
  apply(standard)
  apply(auto simp add: Rep_outEven_def cEmpty_def)
  apply(auto simp add: ctype_empty_iff)
  using ctype_empty_iff
  apply (metis Rep_outEven cMsg.simps ex_in_conv insertE insert_iff)
  apply (meson Rep_outEven_inject injI) using cMsg.elims Rep_outEven apply simp
  using type_definition.Abs_image type_definition_outEven typedef_finite_UNIV by fastforce
end

definition "Evenout \<equiv> Abs_outEven cout"

free_constructors outEven for "Evenout"
  by (metis(full_types) Abs_outEven_cases singletonD)

lemma Andin1_rep [simp]: "Rep (Evenout) = cout"
  by (simp add: Abs_outEven_inverse Evenout_def Rep_outEven_def)

fun outEvenChan::"('bool::type \<Rightarrow> 'a::type) \<Rightarrow> 'bool \<Rightarrow> outEven \<Rightarrow> 'a" where
"outEvenChan Cc1 bool Evenout = Cc1 bool"

abbreviation "buildEvenoutSBE \<equiv> outEvenChan (Untimed o \<B>)"

lemma buildevenout_ctype: "buildEvenoutSBE a c \<in> ctype (Rep c)"
  sorry

lemma buildevenout_inj: "inj buildEvenoutSBE"
  sorry

lemma buildevenout_range: "range (\<lambda>a. buildEvenoutSBE a c) = ctype (Rep c)"
  sorry

lemma buildevenout_surj: assumes "sbElem_well (Some sbe)"
  shows "sbe \<in> range buildEvenoutSBE"
proof -
  have ctypewell:"\<And> c. sbe c\<in> ctype (Rep c)"
    using assms by auto
  hence "\<And>c. sbe c \<in> range (\<lambda>a. buildEvenoutSBE a c)"
    by (simp add: buildevenout_range)
  hence "\<exists>prod. sbe = buildEvenoutSBE prod"
    apply(subst fun_eq_iff,auto)
    sorry
  thus ?thesis
    by auto
qed

abbreviation "buildEvenoutSB \<equiv> outEvenChan (Rep_cfun (smap (Untimed o \<B>)))"

end


section \<open>Accessed Variables\<close>
theory SM_Variables
imports "../Refine/SM_Pid"
begin

  subsection "Expressions"

  primrec udvars_of_exp :: "exp \<Rightarrow> ident set" where
      "udvars_of_exp (e_var x) = {x}"
    | "udvars_of_exp (e_localvar x) = {}"
    | "udvars_of_exp (e_globalvar x) = {}"
    | "udvars_of_exp (e_const c) = {}"
    | "udvars_of_exp (e_bin bop e1 e2) = (udvars_of_exp e1) \<union> (udvars_of_exp e2)"
    | "udvars_of_exp (e_un uop e) = (udvars_of_exp e)"

  primrec lvars_of_exp :: "exp \<Rightarrow> ident set" where
      "lvars_of_exp (e_var x) = {}"
    | "lvars_of_exp (e_localvar x) = {x}"
    | "lvars_of_exp (e_globalvar x) = {}"
    | "lvars_of_exp (e_const c) = {}"
    | "lvars_of_exp (e_bin bop e1 e2) = (lvars_of_exp e1) \<union> (lvars_of_exp e2)"
    | "lvars_of_exp (e_un uop e) = (lvars_of_exp e)"

  primrec gvars_of_exp :: "exp \<Rightarrow> ident set" where
      "gvars_of_exp (e_var x) = {}"
    | "gvars_of_exp (e_localvar x) = {}"
    | "gvars_of_exp (e_globalvar x) = {x}"
    | "gvars_of_exp (e_const c) = {}"
    | "gvars_of_exp (e_bin bop e1 e2) = (gvars_of_exp e1) \<union> (gvars_of_exp e2)"
    | "gvars_of_exp (e_un uop e) = (gvars_of_exp e)"

  subsection "Commands"
  primrec join_cmd_exp :: "'a \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> (exp \<Rightarrow> 'a) \<Rightarrow> cmd \<Rightarrow> 'a" where
    "join_cmd_exp z join f (Assign c x e) = join (f c) (f e)"
  | "join_cmd_exp z join f (Assign_local c x e) = join (f c) (f e)"
  | "join_cmd_exp z join f (Assign_global c x e) = join (f c) (f e)"
  | "join_cmd_exp z join f (Test e) = f e"
  | "join_cmd_exp z join f (Skip) = z"
  | "join_cmd_exp z join f (Seq c1 c2)
      = join (join_cmd_exp z join f c1) (join_cmd_exp z join f c2)"
  | "join_cmd_exp z join f (Or c1 c2)
      = join (join_cmd_exp z join f c1) (join_cmd_exp z join f c2)"
  | "join_cmd_exp z join f (Break) = z"
  | "join_cmd_exp z join f (Continue) = z"
  | "join_cmd_exp z join f (Iterate c1 c2)
      = join (join_cmd_exp z join f c1) (join_cmd_exp z join f c2)"
  | "join_cmd_exp z join f (Invalid) = z"

  abbreviation "union_cmd_exp \<equiv> join_cmd_exp {} (\<union>)"
  abbreviation "all_cmd_exp \<equiv> join_cmd_exp True (\<and>)"
  abbreviation "ex_cmd_exp \<equiv> join_cmd_exp False (\<or>)"

  abbreviation "ud_rvars_of_cmd == union_cmd_exp udvars_of_exp"
  abbreviation "g_rvars_of_cmd == union_cmd_exp gvars_of_exp"
  abbreviation "l_rvars_of_cmd == union_cmd_exp lvars_of_exp"

  primrec ud_wvars_of_cmd :: "cmd \<Rightarrow> ident set" where
    "ud_wvars_of_cmd (Assign c x e) = {x}"
  | "ud_wvars_of_cmd (Assign_local c x e) = {}"
  | "ud_wvars_of_cmd (Assign_global c x e) = {}"
  | "ud_wvars_of_cmd (Test e) = {}"
  | "ud_wvars_of_cmd (Skip) = {}"
  | "ud_wvars_of_cmd (Seq c1 c2) = (ud_wvars_of_cmd c1 \<union> ud_wvars_of_cmd c2)"
  | "ud_wvars_of_cmd (Or c1 c2) = (ud_wvars_of_cmd c1 \<union> ud_wvars_of_cmd c2)"
  | "ud_wvars_of_cmd (Break) = {}"
  | "ud_wvars_of_cmd (Continue) = {}"
  | "ud_wvars_of_cmd (Iterate c1 c2) = (ud_wvars_of_cmd c1 \<union> ud_wvars_of_cmd c2)"
  | "ud_wvars_of_cmd (Invalid) = {}"

  primrec l_wvars_of_cmd :: "cmd \<Rightarrow> ident set" where
    "l_wvars_of_cmd (Assign c x e) = {}"
  | "l_wvars_of_cmd (Assign_local c x e) = {x}"
  | "l_wvars_of_cmd (Assign_global c x e) = {}"
  | "l_wvars_of_cmd (Test e) = {}"
  | "l_wvars_of_cmd (Skip) = {}"
  | "l_wvars_of_cmd (Seq c1 c2) = (l_wvars_of_cmd c1 \<union> l_wvars_of_cmd c2)"
  | "l_wvars_of_cmd (Or c1 c2) = (l_wvars_of_cmd c1 \<union> l_wvars_of_cmd c2)"
  | "l_wvars_of_cmd (Break) = {}"
  | "l_wvars_of_cmd (Continue) = {}"
  | "l_wvars_of_cmd (Iterate c1 c2) = (l_wvars_of_cmd c1 \<union> l_wvars_of_cmd c2)"
  | "l_wvars_of_cmd (Invalid) = {}"

  primrec g_wvars_of_cmd :: "cmd \<Rightarrow> ident set" where
    "g_wvars_of_cmd (Assign c x e) = {}"
  | "g_wvars_of_cmd (Assign_local c x e) = {}"
  | "g_wvars_of_cmd (Assign_global c x e) = {x}"
  | "g_wvars_of_cmd (Test e) = {}"
  | "g_wvars_of_cmd (Skip) = {}"
  | "g_wvars_of_cmd (Seq c1 c2) = (g_wvars_of_cmd c1 \<union> g_wvars_of_cmd c2)"
  | "g_wvars_of_cmd (Or c1 c2) = (g_wvars_of_cmd c1 \<union> g_wvars_of_cmd c2)"
  | "g_wvars_of_cmd (Break) = {}"
  | "g_wvars_of_cmd (Continue) = {}"
  | "g_wvars_of_cmd (Iterate c1 c2) = (g_wvars_of_cmd c1 \<union> g_wvars_of_cmd c2)"
  | "g_wvars_of_cmd (Invalid) = {}"

  definition "udvars_of_cmd c \<equiv> ud_rvars_of_cmd c \<union> ud_wvars_of_cmd c"
  definition "lvars_of_cmd c \<equiv> l_rvars_of_cmd c \<union> l_wvars_of_cmd c"
  definition "gvars_of_cmd c \<equiv> g_rvars_of_cmd c \<union> g_wvars_of_cmd c"

  fun read_globals :: "action \<Rightarrow> ident set" where
    "read_globals (AAssign c _ e) = gvars_of_exp c \<union> udvars_of_exp c \<union>
      gvars_of_exp e \<union> udvars_of_exp e"
  | "read_globals (AAssign_local c _ e) = gvars_of_exp c \<union> udvars_of_exp c \<union>
      gvars_of_exp e \<union> udvars_of_exp e"
  | "read_globals (AAssign_global c _ e) = gvars_of_exp c \<union> udvars_of_exp c \<union>
      gvars_of_exp e \<union> udvars_of_exp e"
  | "read_globals (ATest e) = gvars_of_exp e \<union> udvars_of_exp e"
  | "read_globals (ASkip) = {}"

  fun write_globals :: "action \<Rightarrow> ident set" where
    "write_globals (AAssign _ x _) = {x}"
  | "write_globals (AAssign_local _ _ _) = {}"
  | "write_globals (AAssign_global _ x _) = {x}"
  | "write_globals (ATest e) = {}"
  | "write_globals (ASkip) = {}"

  abbreviation "rw_globals a \<equiv> read_globals a \<union> write_globals a"

  definition eq_on :: "ident set \<Rightarrow> valuation \<Rightarrow> valuation \<Rightarrow> bool"
    where "eq_on X s1 s2 \<equiv> \<forall>x\<in>X. s1 x = s2 x"

  lemma eq_onD: "\<lbrakk>eq_on X s1 s2; x\<in>X\<rbrakk> \<Longrightarrow> s1 x = s2 x"
    unfolding eq_on_def by auto

  lemma
    eq_on_refl[simp]: "eq_on X s s" and
    eq_on_sym: "eq_on X s1 s2 \<Longrightarrow> eq_on X s2 s1" and
    eq_on_sym_eq: "eq_on X s1 s2 \<longleftrightarrow> eq_on X s2 s1" and
    eq_on_trans[trans]: "\<lbrakk>eq_on Xa s1 s2; eq_on Xb s2 s3\<rbrakk>
      \<Longrightarrow> eq_on (Xa\<inter>Xb) s1 s3" and
    eq_on_UNIV_eq[simp]: "eq_on UNIV s1 s2 \<longleftrightarrow> s1=s2"
    unfolding eq_on_def by auto

  lemma eq_on_join: "\<lbrakk>eq_on X s s'; eq_on Y s s'\<rbrakk> \<Longrightarrow> eq_on (X\<union>Y) s s'"
    unfolding eq_on_def by auto

  abbreviation ls_eq_on :: "ident set \<Rightarrow> local_state \<Rightarrow> local_state \<Rightarrow> bool"
    where "ls_eq_on X ls1 ls2 \<equiv>
      eq_on X (local_state.variables ls1) (local_state.variables ls2)"

  abbreviation gs_eq_on :: "ident set \<Rightarrow> global_state \<Rightarrow> global_state \<Rightarrow> bool"
    where "gs_eq_on X ls1 ls2 \<equiv>
      eq_on X (global_state.variables ls1) (global_state.variables ls2)"

  lemma eval_dep_vars:
    assumes "gs_eq_on X gs gs'"
    assumes "udvars_of_exp e \<subseteq> X" "gvars_of_exp e \<subseteq> X"
    shows "eval_exp e (ls,gs) = eval_exp e (ls,gs')"
    using assms
    apply (induction e)
    apply (auto split: option.splits simp: eq_on_def)
    done

  lemma en_dep_read:
    assumes "gs_eq_on X gs gs'"
    assumes "read_globals a \<subseteq> X"
    shows "la_en' (ls,gs) a = la_en' (ls,gs') a"
    using assms
    apply (cases a)
    apply (auto
      simp: la_en'_def eval_dep_vars
      split: Option.bind_splits)
    done

  lemma ex_mod_limit:
    assumes "la_ex' (ls,gs) a = (ls',gs')"
    shows "gs_eq_on (-write_globals a) gs gs'"
    using assms
    apply (cases a)
    apply (auto
      simp: la_ex'_def eval_dep_vars eq_on_def
      split: option.splits Option.bind_splits if_split_asm)
    done

  lemma ex_dep_pres:
    assumes "gs_eq_on X gs1 gs2"
    assumes "read_globals a \<subseteq> X"
    assumes "la_ex' (ls,gs1) a = (ls1',gs1')"
    assumes "la_ex' (ls,gs2) a = (ls2',gs2')"
    shows "ls1'=ls2' \<and> gs_eq_on X gs1' gs2'"
    using assms
    apply (cases a)
    apply (auto
      simp: la_ex'_def eval_dep_vars eq_on_def
      split: Option.bind_splits option.splits bool.splits if_split_asm)
    done

  lemma ex_swap_global:
    assumes DJ:
      "write_globals a1 \<inter> read_globals a2 = {}"
      "write_globals a2 \<inter> read_globals a1 = {}"
      "write_globals a1 \<inter> write_globals a2 = {}"
    assumes EXA:
      "la_ex' (ls1,gs) a1 = (ls1a, gsa)"
      "la_ex' (ls2, gsa) a2 = (ls2a, gsa')"
    assumes EXB:
      "la_ex' (ls2,gs) a2 = (ls2b, gsb)"
      "la_ex' (ls1, gsb) a1 = (ls1b, gsb')"
    shows "ls1a=ls1b" "ls2a=ls2b" "gsa'=gsb'"
  proof -
    from ex_dep_pres[OF ex_mod_limit[OF EXB(1)] _ EXA(1) EXB(2)] DJ
    have "ls1a = ls1b" and E1: "gs_eq_on (- write_globals a2) gsa gsb'"
      by auto
    thus [simp]: "ls1a=ls1b" by simp

    from
      ex_dep_pres[OF
        ex_mod_limit[OF EXA(1), THEN eq_on_sym] _ EXA(2) EXB(1)
      ] DJ
    have "ls2a = ls2b" and E2: "gs_eq_on (- write_globals a1) gsa' gsb"
      by auto
    thus [simp]: "ls2a=ls2b" by simp

    from DJ have [simp]: "- write_globals a1 \<union> - write_globals a2 = UNIV"
      by auto

    from eq_on_trans[OF E2 ex_mod_limit[OF EXB(2)]]
    have "gs_eq_on (- write_globals a1) gsa' gsb'" by simp
    also from eq_on_trans[OF ex_mod_limit[OF EXA(2), THEN eq_on_sym] E1]
    have "gs_eq_on (- write_globals a2) gsa' gsb'" by simp
    finally (eq_on_join) have "gs_eq_on UNIV gsa' gsb'" by simp
    thus "gsa' = gsb'"
      apply (cases gsa', cases gsb')
      apply simp
      done
  qed

  lemma ex_pres_en:
    assumes EX: "la_ex' (ls1,gs) a1 = (ls1',gs')"
    assumes DJ: "write_globals a1 \<inter> read_globals a2 = {}"
    shows "la_en' (ls2,gs') a2 = la_en' (ls2,gs) a2"
    using en_dep_read[OF ex_mod_limit[OF EX], of a2] DJ by auto

end


theory Post_ISSUER
  imports
    "Bounded_Deducibility_Security.Compositional_Reasoning"
    "Post_Observation_Setup_ISSUER"
    "Post_Value_Setup_ISSUER"
begin

subsubsection \<open>Issuer declassification bound\<close>

text \<open>We verify that a group of users of some node \<open>i\<close>,
allowed to take normal actions to the system and observe their outputs
\emph{and additionally allowed to observe communication},
can learn nothing about the updates to a post located at node \<open>i\<close>
and the sends of that post to other nodes beyond

(1) the presence of the sends (i.e., the number of the sending actions)

(2) the public knowledge that what is being sent is always the last version (modeled as
the correlation predicate)

unless:
\begin{itemize}
\item either a user in the group is the post's owner or the administrator
\item or a user in the group becomes a friend of the owner
\item or the group has at least one registered user and the post is being marked as "public"
\end{itemize}

See \<^cite>\<open>"cosmedis-SandP2017"\<close> for more details.
\<close>

context Post_ISSUER
begin

fun T :: "(state,act,out) trans \<Rightarrow> bool" where
"T (Trans s a ou s') \<longleftrightarrow>
 (\<exists> uid \<in> UIDs.
   uid \<in>\<in> userIDs s' \<and> PID \<in>\<in> postIDs s' \<and>
   (uid = admin s' \<or>
    uid = owner s' PID \<or>
    uid \<in>\<in> friendIDs s' (owner s' PID) \<or>
    vis s' PID = PublicV))"

(* Correlation is defined to mean: always send what was last uploaded, or emptyPost
if nothing had been uploaded. This needs the auxiliary notion of "correlated from" *)
fun corrFrom :: "post \<Rightarrow> value list \<Rightarrow> bool" where
 "corrFrom pst [] = True"
|"corrFrom pst (PVal pstt # vl) = corrFrom pstt vl"
|"corrFrom pst (PValS aid pstt # vl) = (pst = pstt \<and> corrFrom pst vl)"

abbreviation corr :: "value list \<Rightarrow> bool" where "corr \<equiv> corrFrom emptyPost"

(* Beyond correlation (which is public knowledge), one can only learn
the absence of any secret produced (if that is the case), the number of
times the notice has been sent, and to which nodes they have been sent:
(since network traffic is assumed to be observable) *)
definition B :: "value list \<Rightarrow> value list \<Rightarrow> bool" where
"B vl vl1 \<equiv>
 corr vl1 \<and>
 (vl = [] \<longrightarrow> vl1 = []) \<and>
 map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"

sublocale BD_Security_IO where
istate = istate and step = step and
\<phi> = \<phi> and f = f and \<gamma> = \<gamma> and g = g and T = T and B = B
done

subsubsection \<open>Unwinding proof\<close>

lemma reach_PublicV_imples_FriendV[simp]:
assumes "reach s"
and "vis s pID \<noteq> PublicV"
shows "vis s pID = FriendV"
using assms reach_vis by auto

lemma reachNT_state:
assumes "reachNT s"
shows "\<not> (\<exists> uid \<in> UIDs.
   uid \<in>\<in> userIDs s \<and> PID \<in>\<in> postIDs s \<and>
   (uid = admin s \<or> uid = owner s PID \<or> uid \<in>\<in> friendIDs s (owner s PID) \<or>
    vis s PID = PublicV))"
using assms proof induct
  case (Step trn) thus ?case
  by (cases trn) auto
qed (simp add: istate_def)

(* major *) lemma T_\<phi>_\<gamma>:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')"
and 3: "\<phi> (Trans s a ou s')" and
(* note that now we have some overlap between \<phi> and \<gamma>, even for reachNT: *)
4: "\<forall> ca. a \<noteq> COMact ca"
shows "\<not> \<gamma> (Trans s a ou s')"
using reachNT_state[OF 1] 2 3 4 using \<phi>_def2(* [OF 2] *)
by (auto simp add: u_defs com_defs)

(* major *) lemma eqButPID_step_\<gamma>_out:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and T: "\<not> T (Trans s a ou s')"
and s1: "reach s1"
and \<gamma>: "\<gamma> (Trans s a ou s')"
shows "(\<exists> uid p aid pid. a = COMact (comSendPost uid p aid pid) \<and> outPurge ou = outPurge ou1) \<or> ou = ou1"
proof-
  have s'T: "reachNT s'" using step sT T using reachNT_PairI by blast
  note op = reachNT_state[OF s'T]
  note [simp] = all_defs
  note s = reachNT_reach[OF sT]
  note willUse =
    step step1 \<gamma>
    op
    reach_vis[OF s]
    eqButPID_stateSelectors[OF ss1] (* eqButPID_postSelectors[OF ss1] *)
    eqButPID_actions[OF ss1]
    eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_not_PID[OF ss1]
    (* added to cope with extra leak towards the admin, when moving from API to CAPI: *)
    (* eqButPID_eqButT[OF ss1] *) eqButPID_eqButF[OF ss1]
    eqButPID_setShared[OF ss1] eqButPID_updateShared[OF ss1]
    eeqButPID_F_not_PID eqButPID_not_PID_sharedWith
    eqButPID_insert2[OF ss1]
  show ?thesis
  proof (cases a)
    case (Sact x1)
    with willUse show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with willUse show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with willUse show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with willUse show ?thesis by (cases x4) auto
  next
    case (Ract x5)
    with willUse show ?thesis
    proof (cases x5)
      case (rPost uid p pid)
      with Ract willUse show ?thesis by (cases "pid = PID") auto
    qed auto
  next
    case (Lact x6)
    with willUse show ?thesis
    proof (cases x6)
      case (lClientsPost uid p pid)
      with Lact willUse show ?thesis by (cases "pid = PID") auto
    qed auto
  next
    case (COMact x7)
    with willUse show ?thesis by (cases x7) auto
  qed
qed

(* major *) lemma eqButPID_step_eq:
assumes ss1: "eqButPID s s1"
and a: "a = Uact (uPost uid p PID pst)" "ou = outOK"
and step: "step s a = (ou, s')" and step1: "step s1 a = (ou', s1')"
shows "s' = s1'"
using ss1 step step1
using eqButPID_stateSelectors[OF ss1]
eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_setShared[OF ss1]
unfolding a by (auto simp: u_defs)

definition \<Delta>0 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>0 s vl s1 vl1 \<equiv>
 \<not> PID \<in>\<in> postIDs s \<and> post s PID = emptyPost \<and>
 s = s1 \<and>
 corrFrom (post s1 PID) vl1 \<and>
 (vl = [] \<longrightarrow> vl1 = []) \<and>
 map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"

definition \<Delta>1 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>1 s vl s1 vl1 \<equiv>
 PID \<in>\<in> postIDs s \<and>
 eqButPID s s1 \<and>
 corrFrom (post s1 PID) vl1 \<and>
 (vl = [] \<longrightarrow> vl1 = []) \<and>
 map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"

definition \<Delta>2 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>2 s vl s1 vl1 \<equiv>
 PID \<in>\<in> postIDs s \<and>
 eqButPID s s1 \<and>
 vl = [] \<and> list_all isPVal vl1"

lemma istate_\<Delta>0:
assumes B: "B vl vl1"
shows "\<Delta>0 istate vl istate vl1"
using assms unfolding \<Delta>0_def B_def istate_def by auto

lemma unwind_cont_\<Delta>0: "unwind_cont \<Delta>0 {\<Delta>0,\<Delta>1}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>0 s vl s1 vl1 \<or> \<Delta>1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>0 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and pPID: "post s PID = emptyPost"
  and ch: "corrFrom (post s1 PID) vl1"
  and l: "map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"
  and PID: "\<not> PID \<in>\<in> postIDs s" and vlvl1: "vl = [] \<Longrightarrow> vl1 = []"
  using reachNT_reach unfolding \<Delta>0_def by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof-
        have \<phi>: "\<not> \<phi> ?trn" using PID step unfolding \<phi>_def2(* [OF step] *) by (auto simp: u_defs com_defs)
        hence vl': "vl' = vl" using c \<phi> unfolding consume_def by simp
        have pPID': "post s' PID = emptyPost"
          using pPID PID step
          apply(cases a)
          subgoal for x1 apply(cases x1, auto simp: all_defs) .
          subgoal for x2 apply(cases x2, auto simp: all_defs) .
          subgoal for x3 apply(cases x3, auto simp: all_defs) .
          subgoal for x4 apply(cases x4, auto simp: all_defs) .
          subgoal by auto
          subgoal by auto
          subgoal for x7 apply(cases x7, auto simp: all_defs) .
          done
        have ?match proof(cases "\<exists> uid p. a = Cact (cPost uid p PID) \<and> ou = outOK")
          case True
          then obtain uid p where a: "a = Cact (cPost uid p PID)" and ou: "ou = outOK" by auto
          have PID': "PID \<in>\<in> postIDs s'"
          using step PID unfolding a ou by (auto simp: c_defs)
          note uid = reachNT_state[OF rsT]
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using \<phi> unfolding consume_def ss1 by auto
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "\<Delta>1 s' vl' s' vl1" using l PID' c ch vlvl1 pPID' pPID
             unfolding ss1 \<Delta>1_def vl' by auto
            thus "?\<Delta> s' vl' s' vl1" by simp
          qed
        next
          case False note a = False
          have PID': "\<not> PID \<in>\<in> postIDs s'"
            using step PID a
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using \<phi> unfolding consume_def ss1 by auto
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "\<Delta>0 s' vl' s' vl1" using a PID' pPID pPID' ch vlvl1 l unfolding \<Delta>0_def vl' ss1 by simp
            thus "?\<Delta> s' vl' s' vl1" by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_\<Delta>1: "unwind_cont \<Delta>1 {\<Delta>1,\<Delta>2}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>1 s vl s1 vl1 \<or> \<Delta>2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>1 s vl s1 vl1"
  hence vlvl1: "vl = [] \<longrightarrow> vl1 = []" and ch1: "corrFrom (post s1 PID) vl1"
  and rs: "reach s" and ss1: "eqButPID s s1" and PID: "PID \<in>\<in> postIDs s"
  and l: "map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"
  using reachNT_reach unfolding \<Delta>1_def by auto
  have PID1: "PID \<in>\<in> postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID \<in> set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID \<in> set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof(cases vl1)
    case (Cons v1 vll1) note vl1 = Cons
    obtain v vll where vl: "vl = v # vll" using vl1 vlvl1 by (cases vl) auto
    show ?thesis
    proof(cases v1)
      case (PVal pst1) note v1 = PVal
      let ?uid1 = "owner s1 PID" let ?p1 = "pass s1 ?uid1"
      have uid1: "?uid1 \<in>\<in> userIDs s1" using reach_owner_userIDs[OF rs1 PID1] .
      define a1 where "a1 \<equiv> Uact (uPost ?uid1 ?p1 PID pst1)"
      obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by force
      hence ou1: "ou1 = outOK" using PID1 uid1 unfolding a1_def by (auto simp: u_defs)
      let ?trn1 = "Trans s1 a1 ou1 s1'"
      have \<phi>1: "\<phi> ?trn1" unfolding a1_def PID1 ou1 by simp
      have 2[simp]: "post s1' PID = pst1"
      using step1 unfolding a1_def ou1 by (auto simp: u_defs)
      have "?uid1 = owner s PID" using eqButPID_stateSelectors[OF ss1] by simp
      hence uid1: "?uid1 \<notin> UIDs" using reachNT_state own rsT PID by auto
      have "eqButPID s1 s1'" using step1 a1_def Uact_uPaperC_step_eqButPID by auto
      hence ss1': "eqButPID s s1'" using ss1 using eqButPID_trans by blast
      have "?iact" proof
        show "step s1 a1 = (ou1, s1')" "\<phi> ?trn1" by fact+
        show "consume (Trans s1 a1 ou1 s1') vl1 vll1"
        using \<phi>1 unfolding consume_def vl1 a1_def v1 by simp
        show "\<not> \<gamma> ?trn1" using uid1 unfolding a1_def by auto
        show "?\<Delta> s vl s1' vll1"
        proof(cases vll1)
          case Nil
          have "\<Delta>1 s vl s1' vll1" using PID ss1' l unfolding \<Delta>1_def B_def vl1 v1 Nil by auto
          thus ?thesis by simp
        next
          case (Cons w1 vlll1) note vll1 = Cons
          have "\<Delta>1 s vl s1' vll1" using PID ss1' l ch1
          unfolding \<Delta>1_def B_def vl1 v1 vl by auto
          thus ?thesis by simp
        qed
      qed
      thus ?thesis by simp
    next
      case (PValS aid1 pst1) note v1 = PValS
      have pst1: "pst1 = post s1 PID" using ch1 unfolding vl1 v1 by simp
      show ?thesis
      proof(cases v)
        case (PVal "pst") note v = PVal
        hence vll: "vll \<noteq> []" using vlvl1 l unfolding vl vl1 v v1 by auto
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"
          assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
          have vl': "vl' = vl \<or> vl' = vll" using c unfolding vl consume_def by (cases "\<phi> ?trn") auto
          hence vl'NE: "vl' \<noteq> []" using vll vl by auto
          have fvl': "filter isPValS vl' = filter isPValS vll" using vl' unfolding vl v by auto
          obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by fastforce
          let ?trn1 = "Trans s1 a ou1 s1'"
          have s's1': "eqButPID s' s1'" using eqButPID_step ss1 step step1 by blast
          have \<gamma>\<gamma>1: "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by simp
          have PID': "PID \<in>\<in> postIDs s'" using step rs PID using reach_postIDs_persist by blast
          have 2[simp]: "\<not> \<phi> ?trn1 \<Longrightarrow> post s1' PID = post s1 PID"
            using step1 PID1 unfolding \<phi>_def2(* [OF step1] *)
            apply(cases a, auto)
            subgoal for x1 apply(cases x1, auto simp: all_defs) .
            subgoal for x2 apply(cases x2, auto simp: all_defs) .
            subgoal for x3 apply(cases x3, auto simp: all_defs) .
            subgoal for x4 apply(cases x4, auto simp: all_defs) .
            subgoal for x4 apply(cases x4, auto simp: all_defs) .
            subgoal for x7 apply(cases x7, auto simp: all_defs) .
            subgoal for x7 apply(cases x7, auto simp: all_defs) .
            done
          show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
          proof(cases "\<gamma> ?trn")
            case True note \<gamma> = True
            have ou: "(\<exists> uid p aid pid. a = COMact (comSendPost uid p aid pid) \<and> outPurge ou = outPurge ou1) \<or>
                                        ou = ou1"
            using eqButPID_step_\<gamma>_out[OF ss1 step step1 rsT T rs1 \<gamma>] .
            {assume \<phi>: "\<phi> ?trn"
             hence "f ?trn = v" using c unfolding consume_def vl by simp
             hence "\<forall>ca. a \<noteq> COMact ca" using \<phi> unfolding \<phi>_def3[OF step] v by auto
             hence False using T_\<phi>_\<gamma>[OF rsT step \<phi>] \<gamma> by auto
            }
            hence \<phi>: "\<not> \<phi> ?trn" by auto
            have vl': "vl' = vl" using \<phi> c unfolding consume_def by simp
            have \<phi>1: "\<not> \<phi> ?trn1" using step step1 ss1 \<phi> eqButPID_step_\<phi> by blast
            have ?match proof
              show "validTrans ?trn1" using step1 by auto
              show "consume ?trn1 vl1 vl1" using \<phi>1 unfolding consume_def by simp
              show "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by fact
            next
              show "g ?trn = g ?trn1" using ou by (cases a) auto
              have "\<Delta>1 s' vl' s1' vl1"
              using PID' s's1' vlvl1 l ch1 \<phi>1 unfolding \<Delta>1_def vl' by auto
              thus "?\<Delta> s' vl' s1' vl1" by simp
            qed
            thus ?thesis by simp
          next
            case False note \<gamma> = False
            show ?thesis
            proof(cases "\<phi> ?trn")
              case True note \<phi> = True
              hence "f ?trn = v" using c unfolding consume_def vl by simp
              hence "\<forall>ca. a \<noteq> COMact ca" using \<phi> unfolding \<phi>_def3[OF step] v by auto
              then obtain uid p "pstt" where a: "a = Uact (uPost uid p PID pstt)"
              using \<phi> unfolding \<phi>_def2(* [OF step] *) by auto
              hence ss': "eqButPID s s'" using step Uact_uPaperC_step_eqButPID by auto
              hence s's1: "eqButPID s' s1" using ss1 eqButPID_sym eqButPID_trans by blast
              have ?ignore proof
                show "\<not> \<gamma> ?trn" by fact
                have "\<Delta>1 s' vl' s1 vl1"
                using PID' s's1' ch1 l vl'NE s's1 unfolding \<Delta>1_def fvl' vl v by auto
                thus "?\<Delta> s' vl' s1 vl1" by simp
              qed
              thus ?thesis by simp
            next
              case False note \<phi> = False
              have vl': "vl' = vl" using \<phi> c unfolding consume_def by simp
              have \<phi>1: "\<not> \<phi> ?trn1" using step step1 ss1 \<phi> eqButPID_step_\<phi> by blast
              have ?match proof
                show "validTrans ?trn1" using step1 by auto
                show "consume ?trn1 vl1 vl1" using \<phi>1 unfolding consume_def by simp
                show "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by fact
              next
                assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" using \<gamma> by simp
              next
                have "\<Delta>1 s' vl' s1' vl1"
                using PID' s's1' vlvl1 l ch1 \<phi>1 unfolding \<Delta>1_def vl' by auto
                thus "?\<Delta> s' vl' s1' vl1" by simp
              qed
              thus ?thesis by simp
            qed
          qed
        qed
        thus ?thesis using vlvl1 by simp
      next
        case (PValS aid "pst") note v = PValS
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"
          assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
          have vl': "vl' = vl \<or> vl' = vll" using c unfolding vl consume_def by (cases "\<phi> ?trn") auto
          obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by fastforce
          let ?trn1 = "Trans s1 a ou1 s1'"
          have s's1': "eqButPID s' s1'" using eqButPID_step ss1 step step1 by blast
          have \<gamma>\<gamma>1: "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by simp
          have PID': "PID \<in>\<in> postIDs s'" using step rs PID using reach_postIDs_persist by blast
          show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
          proof-
            have ?match proof(cases "\<phi> ?trn")
              case True note \<phi> = True
              have \<phi>1: "\<phi> ?trn1" using step step1 ss1 \<phi> eqButPID_step_\<phi> by blast
              let ?ad = "admin s"  let ?p = "pass s ?ad" let ?pst = "post s PID"
              let ?uid = "owner s PID" let ?vs = "vis s PID"
              obtain vl': "vl' = vll"
              and ou: "ou = O_sendPost (aid, clientPass s aid, PID, pst, ?uid, ?vs)"
              and a: "a = COMact (comSendPost ?ad ?p aid PID)" and "pst": "pst = ?pst"
              using \<phi> c unfolding \<phi>_def3[OF step] consume_def vl v by auto
              let ?pst1 = "post s1 PID"
              have "clientPass s aid = clientPass s1 aid" and "?uid = owner s1 PID"
              and "?vs = vis s1 PID"
              using eqButPID_stateSelectors[OF ss1] by auto
              hence ou1: "ou1 = O_sendPost (aid, clientPass s aid, PID, ?pst1, ?uid, ?vs)"
              using step1 \<phi>1 unfolding \<phi>_def3[OF step1] vl1 v1 a
              by (auto simp: com_defs)
              have 2[simp]: "post s1' PID = pst1"
              using step1 unfolding a ou1 pst1 by (auto simp: com_defs)
              have ch_vll1: "corrFrom pst1 vll1" using ch1 unfolding pst1[symmetric] vl1 v1 by auto
              show ?thesis proof
                show "validTrans ?trn1" using step1 by auto
                show "consume (Trans s1 a ou1 s1') vl1 vll1"
                using l \<phi>1 pst1 unfolding consume_def vl vl1 v v1 a ou1 by simp
                show "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by fact
              next
                show "g ?trn = g ?trn1" unfolding a ou ou1 by (simp add: ss1)
                show "?\<Delta> s' vl' s1' vll1"
                proof(cases "vll = []")
                  case False
                  hence "\<Delta>1 s' vl' s1' vll1" using PID' s's1' vlvl1 l ch1 ch_vll1
                  unfolding \<Delta>1_def vl' vl vl1 v v1 by auto
                  thus ?thesis by simp
                next
                  case True
                  hence "list_all isPVal vll1" using l unfolding vl vl1 v v1 by (simp add: filter_isPValS_Nil)
                  hence "\<Delta>2 s' vl' s1' vll1" using True PID' s's1' vlvl1 l ch1 ch_vll1
                  unfolding \<Delta>2_def vl' vl vl1 v v1 by simp
                  thus ?thesis by simp
                qed
              qed
            next
              case False note \<phi> = False
              have vl': "vl' = vl" using \<phi> c unfolding consume_def by simp
              have \<phi>1: "\<not> \<phi> ?trn1" using step step1 ss1 \<phi> eqButPID_step_\<phi> by blast
              have ?match proof
                show "validTrans ?trn1" using step1 by auto
                show "consume ?trn1 vl1 vl1" using \<phi>1 unfolding consume_def by simp
                show "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by fact
              next
                assume "\<gamma> ?trn" note \<gamma> = this
                have ou: "(\<exists> uid p aid pid. a = COMact (comSendPost uid p aid pid) \<and> outPurge ou = outPurge ou1) \<or>
                                        ou = ou1"
                using eqButPID_step_\<gamma>_out[OF ss1 step step1 rsT T rs1 \<gamma>] .
                thus "g ?trn = g ?trn1" by (cases a) auto
              next
                have 2[simp]: "post s1' PID  = post s1 PID"
                  using step1 PID1 \<phi>1 unfolding \<phi>_def2(* [OF step1] *)
                  apply(cases a)
                  subgoal for x1 apply(cases x1, auto simp: all_defs) .
                  subgoal for x2 apply(cases x2, auto simp: all_defs) .
                  subgoal for x3 apply(cases x3, auto simp: all_defs) .
                  subgoal for x4 apply(cases x4, auto simp: all_defs) .
                  subgoal by auto
                  subgoal by auto
                  subgoal for x7 apply(cases x7, auto simp: all_defs) .
                  done
                have "\<Delta>1 s' vl' s1' vl1" using PID' s's1' vlvl1 l ch1
                unfolding \<Delta>1_def vl' vl vl1 v v1 by auto
                thus "?\<Delta> s' vl' s1' vl1" by simp
              qed
              thus ?thesis by simp
            qed
            thus ?thesis by simp
          qed
        qed
        thus ?thesis using vlvl1 by simp
      qed
    qed
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by fastforce
      let ?trn1 = "Trans s1 a ou1 s1'"
      have s's1': "eqButPID s' s1'" using eqButPID_step ss1 step step1 by blast
      have \<gamma>\<gamma>1: "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by simp
      have PID': "PID \<in>\<in> postIDs s'" using step rs PID using reach_postIDs_persist by blast
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof(cases "\<phi> ?trn")
        case True note \<phi> = True
        then obtain v vll where vl: "vl = v # vll"
        and f: "f ?trn = v" using c unfolding consume_def by (cases vl) auto
        obtain "pst" where v: "v = PVal pst" using l unfolding vl1 vl by (cases v) auto
        have fvll: "filter isPValS vll = []"using l unfolding vl1 vl by auto
        have vl': "vl' = vll" using c \<phi> unfolding vl consume_def by auto
        hence 0: "\<forall>ca. a \<noteq> COMact ca" using \<phi> v f unfolding \<phi>_def3[OF step] by auto
        then obtain uid p "pstt" where a: "a = Uact (uPost uid p PID pstt)"
        using \<phi> unfolding \<phi>_def2(* [OF step] *) by auto
        hence ss': "eqButPID s s'" using step Uact_uPaperC_step_eqButPID by auto
        hence s's1: "eqButPID s' s1" using ss1 eqButPID_sym eqButPID_trans by blast
        have ?ignore proof
          show "\<not> \<gamma> ?trn" using T_\<phi>_\<gamma>[OF rsT step \<phi> 0] .
          have "\<Delta>1 s' vl' s1 vl1"
          using PID' s's1' ch1 l s's1 vl1 fvll  unfolding \<Delta>1_def vl v vl' by auto
          thus "?\<Delta> s' vl' s1 vl1" by simp
        qed
        thus ?thesis by simp
      next
        case False note \<phi> = False
        have vl': "vl' = vl" using \<phi> c unfolding consume_def by simp
        have \<phi>1: "\<not> \<phi> ?trn1" using step step1 ss1 \<phi> eqButPID_step_\<phi> by blast
        have ?match proof
          show "validTrans ?trn1" using step1 by auto
          show "consume ?trn1 vl1 vl1" using \<phi>1 unfolding consume_def by simp
          show "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by fact
        next
          assume "\<gamma> ?trn" note \<gamma> = this
          have ou: "(\<exists> uid p aid pid. a = COMact (comSendPost uid p aid pid) \<and> outPurge ou = outPurge ou1) \<or>
                                        ou = ou1"
          using eqButPID_step_\<gamma>_out[OF ss1 step step1 rsT T rs1 \<gamma>] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have 2[simp]: "post s1' PID  = post s1 PID"
            using step1 PID1 \<phi>1 unfolding \<phi>_def2(* [OF step1] *)
            apply(cases a)
            subgoal for x1 apply(cases x1, auto simp: all_defs) .
            subgoal for x2 apply(cases x2, auto simp: all_defs) .
            subgoal for x3 apply(cases x3, auto simp: all_defs) .
            subgoal for x4 apply(cases x4, auto simp: all_defs) .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7, auto simp: all_defs) .
            done
          have "\<Delta>1 s' vl' s1' vl1" using PID' s's1' vlvl1 l ch1
          unfolding \<Delta>1_def vl' vl1 by auto
          thus "?\<Delta> s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

lemma unwind_cont_\<Delta>2: "unwind_cont \<Delta>2 {\<Delta>2}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>2 s vl s1 vl1"
  hence PID: "PID \<in>\<in> postIDs s" and ss1: "eqButPID s s1" and vl: "vl = []" and lvl1: "list_all isPVal vl1"
  and rs: "reach s" using reachNT_reach unfolding \<Delta>2_def by auto
  have PID1: "PID \<in>\<in> postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID \<in> set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID \<in> set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof(cases vl1)
    case (Cons v1 vll1) note vl1 = Cons
    obtain pst1 where v1: "v1 = PVal pst1" and lvll1: "list_all isPVal vll1"
      using lvl1 unfolding vl1 by (cases v1) auto
    define uid where "uid \<equiv> owner s PID"  define p where "p \<equiv> pass s uid"
    define a1 where "a1 \<equiv> Uact (uPost uid p PID pst1)"
    have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid_def p_def
    using eqButPID_stateSelectors[OF ss1] by auto
    obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
    have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1_def uid1 p1 by (auto simp: u_defs)
    have uid: "uid \<notin> UIDs" unfolding uid_def using rsT reachNT_state own PID by blast
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have ?iact proof
      show "step s1 a1 = (ou1, s1')" using step1 .
    next
      show \<phi>1: "\<phi> ?trn1" unfolding \<phi>_def2(* [OF step1] *) a1_def ou1 by simp
      show "consume ?trn1 vl1 vll1"
      using \<phi>1 unfolding vl1 consume_def a1_def v1 by simp
      show "\<not> \<gamma> ?trn1" using uid unfolding a1_def by simp
    next
      have "eqButPID s1 s1'" using Uact_uPaperC_step_eqButPID[OF _ step1] a1_def by auto
      hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
      show "\<Delta>2 s vl s1' vll1"
      using PID ss1' lvll1 unfolding \<Delta>2_def vl by auto
    qed
    thus ?thesis by simp
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by fastforce
      let ?trn1 = "Trans s1 a ou1 s1'"
      have s's1': "eqButPID s' s1'" using eqButPID_step ss1 step step1 by blast
      have \<gamma>\<gamma>1: "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by simp
      have PID': "PID \<in>\<in> postIDs s'" using step rs PID using reach_postIDs_persist by blast
      have \<phi>: "\<not> \<phi> ?trn" and vl': "vl' = vl" using c unfolding vl consume_def by auto
      hence \<phi>1: "\<not> \<phi> ?trn1" using eqButPID_step_\<phi> step ss1 step1 by auto
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" using step1 by auto
          show "consume ?trn1 vl1 vl1" using \<phi>1 unfolding consume_def by simp
          show "\<gamma> ?trn \<longleftrightarrow> \<gamma> ?trn1" by fact
        next
          assume "\<gamma> ?trn" note \<gamma> = this
          have ou: "(\<exists> uid p aid pid. a = COMact (comSendPost uid p aid pid) \<and> outPurge ou = outPurge ou1) \<or>
                                        ou = ou1"
          using eqButPID_step_\<gamma>_out[OF ss1 step step1 rsT T rs1 \<gamma>] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have 2[simp]: "textPost (post s1' PID)  = textPost (post s1 PID)"
            using step1 PID1 \<phi>1 unfolding \<phi>_def2(* [OF step1] *)
            apply(cases a)
            subgoal for x1 apply(cases x1, auto simp: all_defs) .
            subgoal for x2 apply(cases x2, auto simp: all_defs) .
            subgoal for x3 apply(cases x3, auto simp: all_defs) .
            subgoal for x4 apply(cases x4, auto simp: all_defs) .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7, auto simp: all_defs) .
            done
          show "\<Delta>2 s' vl' s1' vl1" using PID' s's1' vl
          unfolding \<Delta>2_def vl1 vl' by auto
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vl1 by simp
  qed
qed

definition Gr where
"Gr =
 {
 (\<Delta>0, {\<Delta>0,\<Delta>1}),
 (\<Delta>1, {\<Delta>1,\<Delta>2}),
 (\<Delta>2, {\<Delta>2})
 }"

theorem Post_secure: secure
apply (rule unwind_decomp_secure_graph[of Gr \<Delta>0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using istate_\<Delta>0 unwind_cont_\<Delta>0 unwind_cont_\<Delta>1 unwind_cont_\<Delta>2
unfolding Gr_def by auto

end (* context Post_ISSUER *)

end


section "Auxiliary algebraic laws for abrupt designs"
theory algebraic_laws_abrupt_aux
imports "../../../theories/Abrupt/utp_abrupt_designs"

begin

named_theorems uabr_simpl and uabr_cond and uabr_comp and uabr_lens
subsection {*THM setup*}
declare design_condr[urel_cond]

subsection {*abrupt alphabet behavior*}

lemma assigns_abr_alpha:
  "(abrupt :== (\<not> &abrupt)) = (\<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R \<and>  $abrupt\<acute> =\<^sub>u (\<not>$abrupt) \<and> $ok =\<^sub>u $ok\<acute>)"
  "(ok :== (\<not> &ok)) = (\<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R \<and>  $abrupt\<acute> =\<^sub>u $abrupt \<and> $ok =\<^sub>u (\<not>$ok\<acute>))"
  by rel_auto+

lemma vwb_of_abrupt[simp]:
  "vwb_lens ok" "vwb_lens abrupt"
  by simp_all

lemma unrest_pre_out\<alpha>_abr[unrest]: "out\<alpha> \<sharp> \<lceil>b\<rceil>\<^sub>A\<^sub>B\<^sub>R\<^sub><"
  by (transfer, auto simp add: out\<alpha>_def lens_prod_def)

lemma unrest_post_in\<alpha>_abr[unrest]: "in\<alpha> \<sharp> \<lceil>b\<rceil>\<^sub>A\<^sub>B\<^sub>R\<^sub>>"
  by (transfer, auto simp add: in\<alpha>_def lens_prod_def)

lemma unrest_ok_abrupt_rel_uexpr_lift_cpa[unrest]:
  "$ok \<sharp> \<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R" "$ok\<acute> \<sharp> \<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  "$abrupt \<sharp> \<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R" "$abrupt\<acute> \<sharp> \<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  by (pred_auto)+

lemma unrest_ok_abrupt_rel_usubst_lift_cpa[unrest]:
  "$ok\<acute> \<sharp> \<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R" "$ok \<sharp> \<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R"
  "$abrupt\<acute> \<sharp> \<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R" "$abrupt \<sharp> \<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R"
  by rel_auto+

lemma unrest_in_out_rel_ok_abrupt_res_abr [unrest]:
  "$ok \<sharp> (P \<restriction>\<^sub>\<alpha> ok)" "$ok\<acute> \<sharp> (P \<restriction>\<^sub>\<alpha> ok)"
  "$abrupt \<sharp> (P \<restriction>\<^sub>\<alpha> abrupt)" "$abrupt\<acute> \<sharp> (P \<restriction>\<^sub>\<alpha> abrupt)"
  by (simp_all add: rel_var_res_def unrest)

lemma uabr_alphabet_unrest[unrest]:(*FIXEME:These laws should be generated automatically by alphabet backend since all the fields of alphabet are independant*)
  "$ok\<acute> \<sharp> $abrupt\<acute>" "$ok \<sharp> $abrupt"
  "$ok\<acute> \<sharp> $abrupt"  "$ok \<sharp> $abrupt\<acute>"
  "$abrupt\<acute> \<sharp> $ok\<acute>" "$abrupt \<sharp> $ok "
  "$abrupt \<sharp> $ok\<acute>"  "$abrupt\<acute> \<sharp> $ok"
  by pred_simp+

lemma cpa_ord [usubst]:
  "$ok \<prec>\<^sub>v $ok\<acute>" "$abrupt \<prec>\<^sub>v $abrupt\<acute>" "$ok \<prec>\<^sub>v $abrupt\<acute>"
  "$ok \<prec>\<^sub>v $abrupt" "$ok\<acute> \<prec>\<^sub>v $abrupt\<acute>" "$ok\<acute> \<prec>\<^sub>v $abrupt"
  by (simp_all add: var_name_ord_def)

lemma rel_usubst_lift_cpa_in_out_abrupt_ok[usubst]:
  "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> $abrupt = $abrupt" "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> (\<not>$abrupt) = (\<not>$abrupt)"
  "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> ($ok) = ($ok)" "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> (\<not>$ok) = (\<not>$ok)"
  "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> ($abrupt\<acute>) = (($abrupt\<acute>))" "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> (\<not>$abrupt\<acute>) = (\<not>$abrupt\<acute>)"
  "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> ($ok\<acute>) = ($ok\<acute>)"  "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> (\<not>$ok\<acute>) = (\<not>$ok\<acute>)"
  by (simp_all add: usubst unrest)

lemma abrupt_ok_simpl[uabr_comp]:
  "($abrupt ;; Simpl\<^sub>A\<^sub>B\<^sub>R P) = $abrupt" "(\<not>$ok ;; Simpl\<^sub>A\<^sub>B\<^sub>R P) = (\<not>$ok)"
  "($abrupt ;; (P \<turnstile> Q)) = $abrupt" "(\<not>$ok ;; (P \<turnstile> Q)) = (\<not>$ok)"
  "(\<not>$abrupt ;; Simpl\<^sub>A\<^sub>B\<^sub>R P) = (\<not>$abrupt)" "(\<not>$ok ;; Simpl\<^sub>A\<^sub>B\<^sub>R P) = (\<not>$ok)"
  "(\<not>$abrupt ;; (P \<turnstile> Q)) = (\<not>$abrupt)" "(\<not>$ok ;; (P \<turnstile> Q)) = (\<not>$ok)"
  "($abrupt\<acute> ;; Simpl\<^sub>A\<^sub>B\<^sub>R P) = $abrupt\<acute>"
  "(\<not>$abrupt\<acute> ;; Simpl\<^sub>A\<^sub>B\<^sub>R P) = (\<not>$abrupt\<acute>)"
  by rel_auto+

lemma simpl_abr_in_ok:
  "Simpl\<^sub>A\<^sub>B\<^sub>R ($ok) = ((\<not>$abrupt \<and> ($ok \<Rightarrow>$ok\<acute>)) \<or> (II))"
  by rel_auto

lemma  simpl_abr_our_ok:
  "Simpl\<^sub>A\<^sub>B\<^sub>R ($ok\<acute>) =
   ((\<not>$abrupt \<and> ($ok \<Rightarrow>$ok\<acute>)) \<or> (II))"
  by rel_auto

lemma simpl_abr_in_abrupt:
  "Simpl\<^sub>A\<^sub>B\<^sub>R ($abrupt) =
   ((\<not>$abrupt \<and> ($ok \<Rightarrow>($ok\<acute> \<and> $abrupt))) \<or> ($abrupt \<and> II))"
  by rel_auto

lemma simpl_abr_alr_def:
  "Simpl\<^sub>A\<^sub>B\<^sub>R (P) =
   ((\<not>$abrupt \<and> ($ok \<Rightarrow>($ok\<acute> \<and> P))) \<or> ($abrupt \<and> II))"
  by rel_auto

subsection {*Healthiness condition behavior*}

lemma rel_usubst_cpa_c3_abr[usubst]:
  assumes "$ok \<sharp> \<sigma>" "$ok\<acute> \<sharp> \<sigma> "
  shows "\<sigma> \<dagger> C3_abr(P) = (\<sigma> \<dagger> P \<triangleleft> \<sigma> \<dagger> (\<not>$abrupt) \<triangleright> (\<sigma> \<dagger> II))"
  using assms unfolding C3_abr_def
  by (simp add: usubst)

lemma Simpl_abr_idem[simp]: "Simpl\<^sub>A\<^sub>B\<^sub>R(Simpl\<^sub>A\<^sub>B\<^sub>R(P)) = Simpl\<^sub>A\<^sub>B\<^sub>R(P)"
  by (rel_auto)

lemma simpl_abr_Idempotent: "Idempotent Simpl\<^sub>A\<^sub>B\<^sub>R"
  by (simp add: Idempotent_def)

lemma Simpl_abr_mono: "P \<sqsubseteq> Q \<Longrightarrow> Simpl\<^sub>A\<^sub>B\<^sub>R(P) \<sqsubseteq> Simpl\<^sub>A\<^sub>B\<^sub>R(Q)"
  by (rel_auto)

lemma simpl_abr_Monotonic: "Monotonic Simpl\<^sub>A\<^sub>B\<^sub>R"
  by (simp add: Monotonic_def Simpl_abr_mono)

lemma simpl_abr_def:
  "Simpl\<^sub>A\<^sub>B\<^sub>R(P) = ((\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> P) \<triangleleft> \<not>$abrupt \<triangleright>  II)"
  unfolding C3_abr_def ..

lemma simpl_abr_condr[uabr_simpl]:
  "Simpl\<^sub>A\<^sub>B\<^sub>R(P \<triangleleft> b \<triangleright> Q) = (Simpl\<^sub>A\<^sub>B\<^sub>R(P) \<triangleleft> b \<triangleright> Simpl\<^sub>A\<^sub>B\<^sub>R(Q))"
  unfolding simpl_abr_def
  by (simp add: urel_cond)

lemma simpl_abr_skip_abr[uabr_simpl]:
  "Simpl\<^sub>A\<^sub>B\<^sub>R(SKIP\<^sub>A\<^sub>B\<^sub>R) = (SKIP\<^sub>A\<^sub>B\<^sub>R)"
  by (simp add: urel_cond urel_defs)

lemma simpl_abr_throw_abr:
  "Simpl\<^sub>A\<^sub>B\<^sub>R(THROW\<^sub>A\<^sub>B\<^sub>R) = ((\<not>$abrupt) \<and> ($ok \<Rightarrow>($ok\<acute> \<and> $abrupt\<acute> \<and> \<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R)) \<or> ($abrupt \<and> II))"
  by rel_auto

lemma simpl_abr_assign_abr[uabr_simpl]:
  "Simpl\<^sub>A\<^sub>B\<^sub>R(\<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R) = (\<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R)"
  by (simp add: urel_cond urel_defs)

lemma simpl_abr_throw_abr_comp_abrupt[uabr_simpl]:
  "Simpl\<^sub>A\<^sub>B\<^sub>R (THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; Simpl\<^sub>A\<^sub>B\<^sub>R Q) \<triangleleft> $abrupt \<triangleright> II)) = Simpl\<^sub>A\<^sub>B\<^sub>R Q"
   apply pred_simp
   apply rel_simp
   apply auto
done

lemma simpl_abr_throw_abr_comp_abrupt_cond_throw_abr[uabr_simpl]:
  "Simpl\<^sub>A\<^sub>B\<^sub>R (THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; THROW\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) = Simpl\<^sub>A\<^sub>B\<^sub>R THROW\<^sub>A\<^sub>B\<^sub>R"
   apply pred_simp
   apply rel_simp
   apply auto
done

lemma simpl_abr_throw_abr_comp_abrupt_cond_skip_abr[uabr_simpl]:
  "Simpl\<^sub>A\<^sub>B\<^sub>R (THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; SKIP\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) = SKIP\<^sub>A\<^sub>B\<^sub>R"
   apply pred_simp
   apply rel_simp
   apply auto
done

lemma simpl_abr_throw_abr_comp_abrupt_cond_assigns_abr[uabr_simpl]:
  "Simpl\<^sub>A\<^sub>B\<^sub>R (THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; \<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) = \<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R"
   apply pred_simp
   apply rel_simp
   apply auto
done

lemma C3_abr_throw_abr_comp_abrupt[uabr_simpl]:
  "C3_abr (THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; Simpl\<^sub>A\<^sub>B\<^sub>R Q) \<triangleleft> $abrupt \<triangleright> II)) =
    Simpl\<^sub>A\<^sub>B\<^sub>R Q"
  apply pred_simp
  apply rel_simp
  apply safe
  apply auto
done

lemma C3_abr_throw_abr_comp_abrupt_cond_skip_abr[uabr_simpl]:
  "C3_abr (THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; SKIP\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) =
    SKIP\<^sub>A\<^sub>B\<^sub>R"
  apply pred_simp
  apply rel_simp
  apply safe
  apply auto
done

lemma C3_abr_throw_abr_comp_abrupt_cond_throw_abr[uabr_simpl]:
  "C3_abr (THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; THROW\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) =
    C3_abr THROW\<^sub>A\<^sub>B\<^sub>R"
  apply pred_simp
  apply rel_simp
  apply safe
  apply auto
done

lemma C3_abr_throw_abr_comp_abrupt_cond_assigns_abr[uabr_simpl]:
  "C3_abr (THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; \<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) =
    \<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R"
  apply pred_simp
  apply rel_simp
  apply safe
  apply auto
done

(*lemma [uabr_comp]:
  "(THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; THROW\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) =
   (\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> ($abrupt\<acute> \<and> \<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R)) "
  apply pred_simp
  apply rel_simp
  apply safe
  apply auto
done

lemma throw_abr_comp_abrupt_cond_skip_abr[uabr_comp]:
  "(THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; SKIP\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) =
   (\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> (\<not>$abrupt\<acute> \<and> \<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R)) "
  apply pred_simp
  apply rel_simp
  apply safe
  apply auto
done

lemma [uabr_comp]:
  "(THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; \<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) =
   (\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> (\<not>$abrupt\<acute> \<and> \<lceil>\<langle>\<sigma>\<rangle>\<^sub>a\<rceil>\<^sub>A\<^sub>B\<^sub>R)) "
  apply pred_simp
  apply rel_simp
  apply safe
  apply auto
done*)

lemma [uabr_comp]:
  "(THROW\<^sub>A\<^sub>B\<^sub>R ;; ((abrupt:== (\<not> &abrupt) ;; \<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R) \<triangleleft> $abrupt \<triangleright> II)) = (true) "
  apply pred_simp
  apply rel_simp
  apply auto
done

lemma simpl_abr_form:
  "Simpl\<^sub>A\<^sub>B\<^sub>R(P) = (((\<not>$abrupt) \<and> (\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> (P)))  \<or> ($abrupt \<and> II))"
  by rel_auto

lemma abrupt_simpl_abr[uabr_simpl]:
  "($abrupt \<and> Simpl\<^sub>A\<^sub>B\<^sub>R(P)) = ($abrupt \<and>II)"
   by rel_auto

lemma nabrupt_simpl_abr[uabr_simpl]:
  "(\<not>$abrupt \<and> Simpl\<^sub>A\<^sub>B\<^sub>R(P)) = (\<not>$abrupt \<and> (\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> (P)))"
  by (rel_auto)

definition design_abr_sup :: "('\<alpha>,'\<beta>) rel_cpa set \<Rightarrow> ('\<alpha>,'\<beta>) rel_cpa" ("\<Sqinter>\<^sub>A\<^sub>B\<^sub>R_" [900] 900) where
"\<Sqinter>\<^sub>A\<^sub>B\<^sub>R A = (if (A = {}) then \<top>\<^sub>A\<^sub>B\<^sub>R else \<Sqinter> A)"

lemma simpl_abr_Continuous: "Continuous Simpl\<^sub>A\<^sub>B\<^sub>R"
  unfolding Continuous_def SUP_def apply rel_simp
  unfolding  SUP_def
  apply transfer apply auto
done

lemma simpl_abr_R3_conj:
  "Simpl\<^sub>A\<^sub>B\<^sub>R(P \<and> Q) = (Simpl\<^sub>A\<^sub>B\<^sub>R(P) \<and> Simpl\<^sub>A\<^sub>B\<^sub>R(Q))"
  by (rel_auto)

lemma simpl_abr_disj:
  "Simpl\<^sub>A\<^sub>B\<^sub>R(P \<or> Q) = (Simpl\<^sub>A\<^sub>B\<^sub>R(P) \<or> Simpl\<^sub>A\<^sub>B\<^sub>R(Q))"
  by (rel_auto)

lemma Simpl_abr_USUP:
  assumes "A \<noteq> {}"
  shows "Simpl\<^sub>A\<^sub>B\<^sub>R(\<Sqinter> i \<in> A \<bullet> P(i)) = (\<Sqinter> i \<in> A \<bullet> Simpl\<^sub>A\<^sub>B\<^sub>R(P(i)))"
  using assms by (rel_auto)

lemma design_abr_sup_non_empty [simp]:
  "A \<noteq> {} \<Longrightarrow> \<Sqinter>\<^sub>A\<^sub>B\<^sub>R A = \<Sqinter> A"
  by (simp add: design_abr_sup_def)

subsection {*Signature behavior*}

lemma design_top_abr:
  "(P \<turnstile> Q) \<sqsubseteq> \<top>\<^sub>A\<^sub>B\<^sub>R"
  by (rel_auto)

lemma design_abr_sup_empty [simp]:
  "\<Sqinter>\<^sub>A\<^sub>B\<^sub>R {} = \<top>\<^sub>A\<^sub>B\<^sub>R"
  by (simp add: design_abr_sup_def)

abbreviation design_inf :: "('\<alpha>, '\<beta>) rel_des set \<Rightarrow> ('\<alpha>, '\<beta>) rel_des" ("\<Squnion>\<^sub>A\<^sub>B\<^sub>R_" [900] 900) where
"\<Squnion>\<^sub>A\<^sub>B\<^sub>R A \<equiv> \<Squnion> A"

lemma design_bottom_abr:
  "\<bottom>\<^sub>A\<^sub>B\<^sub>R \<sqsubseteq> (P \<turnstile> Q)"
  by simp

lemma Simpl_abr_bottom_abr:
  "\<bottom>\<^sub>A\<^sub>B\<^sub>R \<sqsubseteq> Simpl\<^sub>A\<^sub>B\<^sub>R (P)"
  by simp

lemma Simpl_abr_UINF:
  assumes "A \<noteq> {}"
  shows "Simpl\<^sub>A\<^sub>B\<^sub>R(\<Squnion> i \<in> A \<bullet> P(i)) = (\<Squnion> i \<in> A \<bullet> Simpl\<^sub>A\<^sub>B\<^sub>R(P(i)))"
  using assms by (rel_auto)

lemma skip_cpa_def:
  "II = (\<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R \<and> $abrupt =\<^sub>u $abrupt\<acute> \<and> $ok =\<^sub>u $ok\<acute>)"
  by rel_auto

lemma skip_lift_cpa_def:
  "\<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R = ($\<Sigma>\<^sub>A\<^sub>B\<^sub>R\<acute> =\<^sub>u $\<Sigma>\<^sub>A\<^sub>B\<^sub>R)"
  by rel_auto

lemma seqr_abrupt_true [usubst]: "(P ;; Q) \<^sub>a\<^sub>t = (P \<^sub>a\<^sub>t ;; Q)"
  by (rel_auto)

lemma seqr_abrupt_false [usubst]: "(P ;; Q) \<^sub>a\<^sub>f = (P \<^sub>a\<^sub>f ;; Q)"
  by (rel_auto)

lemma rel_usubst_lift_cpa_uexpr_lift_cpa[usubst]:
  "\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> \<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R = \<lceil>\<sigma> \<dagger> P\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  by rel_auto

lemma usubst_lift_cpa_assigns_lift_cpa [usubst]:
  "\<lceil>\<sigma>\<rceil>\<^sub>s\<^sub>A\<^sub>B\<^sub>R \<dagger> \<lceil>\<langle>\<rho>\<rangle>\<^sub>a\<rceil>\<^sub>A\<^sub>B\<^sub>R = \<lceil>\<langle>\<rho> \<circ> \<sigma>\<rangle>\<^sub>a\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  by (simp add: usubst)

lemma usubst_lift_cpa_pre_uexpr_lift_cpa[usubst]:
  "\<lceil>\<sigma>\<rceil>\<^sub>s\<^sub>A\<^sub>B\<^sub>R \<dagger> \<lceil>b\<rceil>\<^sub>A\<^sub>B\<^sub>R\<^sub>< = \<lceil>\<sigma> \<dagger> b\<rceil>\<^sub>A\<^sub>B\<^sub>R\<^sub><"
  by (simp add: usubst)

lemma rel_usubst_lift_cpa_design[usubst]:
  "(\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> (Q \<turnstile> P)) = (\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> Q) \<turnstile> (\<lceil>\<sigma>\<rceil>\<^sub>S\<^sub>A\<^sub>B\<^sub>R \<dagger> P)"
  by (simp add: usubst unrest)

lemma usubst_cpa_true[usubst]: "\<sigma> \<dagger> \<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R = \<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  by rel_auto

lemma usubst_cpa_false[usubst]: "\<sigma> \<dagger> \<lceil>false\<rceil>\<^sub>A\<^sub>B\<^sub>R = \<lceil>false\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  by rel_auto

lemma rel_usubst_cpa_skip_cpa[usubst]:
  "(\<sigma> \<dagger> II) = ((\<sigma> \<dagger> \<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R) \<and> \<sigma> \<dagger> $abrupt =\<^sub>u \<sigma> \<dagger> $abrupt\<acute> \<and> \<sigma> \<dagger> $ok =\<^sub>u \<sigma> \<dagger> $ok\<acute>)"
  by (simp add: usubst unrest skip_cpa_def)

lemma usubst_lift_cpa_skip_lift_cpa[usubst]:
  "(\<lceil>\<sigma>\<rceil>\<^sub>s\<^sub>A\<^sub>B\<^sub>R \<dagger> \<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R) = \<lceil>\<langle>\<sigma>\<rangle>\<^sub>a\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  unfolding skip_r_def
  by (simp add: usubst_lift_cpa_assigns_lift_cpa)

lemma usubst_cpa_skip_cpa [usubst]:
  assumes "$ok \<sharp> \<sigma>" "$ok\<acute> \<sharp> \<sigma> "
  shows
  "(\<sigma> \<dagger> SKIP\<^sub>A\<^sub>B\<^sub>R) = (\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> (\<sigma> \<dagger> ((\<not>$abrupt\<acute>) \<and> \<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R)) \<triangleleft> \<sigma> \<dagger> (\<not>$abrupt) \<triangleright> (\<sigma> \<dagger> (II)))"
  using assms unfolding skip_abr_def
  using [[simp_trace]]
  by (simp add: usubst)

lemma usubst_cpa_throw_cpa [usubst]:
  assumes "$ok \<sharp> \<sigma>" "$ok\<acute> \<sharp> \<sigma> "
  shows
  "(\<sigma> \<dagger> THROW\<^sub>A\<^sub>B\<^sub>R) = (\<sigma> \<dagger> (\<not>$abrupt) \<turnstile> (\<sigma> \<dagger> ($abrupt\<acute> \<and> \<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R)))"
  using assms unfolding throw_abr_def
  by (simp add: usubst)

lemma usubst_cpa_assigns_cpa [usubst]:
  assumes "$ok \<sharp> \<sigma>" "$ok\<acute> \<sharp> \<sigma> "
  shows
  "\<sigma> \<dagger> \<langle>\<rho>\<rangle>\<^sub>A\<^sub>B\<^sub>R = (\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> (\<sigma> \<dagger> ((\<not>$abrupt\<acute>) \<and> \<lceil>\<langle>\<rho>\<rangle>\<^sub>a\<rceil>\<^sub>A\<^sub>B\<^sub>R)) \<triangleleft> \<sigma> \<dagger> (\<not>$abrupt) \<triangleright>  (\<sigma> \<dagger> (II)))"
  using assms unfolding assigns_abr_def
  by (simp add: usubst)

lemma simpl_comp_left_distr:
  "(C3_abr (P) ;; R) = ((P;;R) \<triangleleft> \<not>$abrupt \<triangleright> (II ;; R))"
  apply pred_simp
  apply rel_simp
  apply fastforce
done

lemma c3_abr_comp_semir:
  "(C3_abr(P) ;; C3_abr(R)) = C3_abr (P ;; C3_abr(R))"
  by rel_auto

lemma c3_abr_comp_simpl[uabr_comp]:
  "(C3_abr(P) ;; C3_abr(R)) = ((P ;; C3_abr(R)) \<triangleleft> \<not>$abrupt \<triangleright> (II))"
  by rel_auto

lemma simpl_abr_comp_semir:
  "(Simpl\<^sub>A\<^sub>B\<^sub>R(P) ;; Simpl\<^sub>A\<^sub>B\<^sub>R(R)) = Simpl\<^sub>A\<^sub>B\<^sub>R ((\<lceil>true\<rceil>\<^sub>A\<^sub>B\<^sub>R \<turnstile> P) ;; Simpl\<^sub>A\<^sub>B\<^sub>R(R))"
  by rel_auto

theorem design_top_abr_left_zero[uabr_comp]:
  "(\<top>\<^sub>A\<^sub>B\<^sub>R ;; (P \<turnstile> Q)) = \<top>\<^sub>A\<^sub>B\<^sub>R"
  by (rel_auto)

theorem Simpl_abr_top_abr_left_zero[uabr_comp]:
  "(\<top>\<^sub>A\<^sub>B\<^sub>R ;; Simpl\<^sub>A\<^sub>B\<^sub>R (P)) = \<top>\<^sub>A\<^sub>B\<^sub>R"
  by (rel_auto)

lemma assigns_lift_cpa_comp_rel_cpa[uabr_comp]:
  assumes "$ok \<sharp> P" "$abrupt \<sharp> P"
  shows  "(\<lceil>\<langle>\<sigma>\<rangle>\<^sub>a\<rceil>\<^sub>A\<^sub>B\<^sub>R ;; P) = (\<lceil>\<sigma>\<rceil>\<^sub>s\<^sub>A\<^sub>B\<^sub>R \<dagger> P)"
  apply (insert assms)
  apply pred_simp
  apply rel_blast
done

lemma lift_des_skip_dr_unit_abr [uabr_comp]:
  "(\<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R ;; \<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R) = \<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  "(\<lceil>II\<rceil>\<^sub>A\<^sub>B\<^sub>R ;; \<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R) = \<lceil>P\<rceil>\<^sub>A\<^sub>B\<^sub>R"
  by (rel_auto)+

lemma skip_cpa_left_comp_simpl[uabr_comp]:
  "(SKIP\<^sub>A\<^sub>B\<^sub>R ;; Simpl\<^sub>A\<^sub>B\<^sub>R(R)) = (Simpl\<^sub>A\<^sub>B\<^sub>R(R))"
  by rel_auto

lemma skip_cpa_right_comp_simpl[uabr_comp]:
  "(Simpl\<^sub>A\<^sub>B\<^sub>R(R) ;; SKIP\<^sub>A\<^sub>B\<^sub>R) = (Simpl\<^sub>A\<^sub>B\<^sub>R(R))"
  by rel_auto

lemma throw_cpa_left_comp_simpl[uabr_comp]:
  "(THROW\<^sub>A\<^sub>B\<^sub>R ;; Simpl\<^sub>A\<^sub>B\<^sub>R(R)) = (THROW\<^sub>A\<^sub>B\<^sub>R)"
  by rel_auto

lemma assign_abr_alt_def:
  "\<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R = Simpl\<^sub>A\<^sub>B\<^sub>R (\<not>$abrupt\<acute> \<and> \<lceil>\<lceil>\<sigma>\<rceil>\<^sub>s \<dagger> II\<rceil>\<^sub>A\<^sub>B\<^sub>R)"
  by rel_auto

lemma assign_abr_left_comp_c3[uabr_comp]:
  "\<langle>a\<rangle>\<^sub>A\<^sub>B\<^sub>R ;; C3_abr (P \<turnstile> Q) = C3_abr (\<lceil>a\<rceil>\<^sub>s\<^sub>A\<^sub>B\<^sub>R \<dagger> (P \<turnstile>  Q))"
  by rel_auto

lemma assigns_abr_comp[uabr_comp]:
  "(\<langle>f\<rangle>\<^sub>A\<^sub>B\<^sub>R ;; \<langle>g\<rangle>\<^sub>A\<^sub>B\<^sub>R) = \<langle>g \<circ> f\<rangle>\<^sub>A\<^sub>B\<^sub>R"
  by rel_auto

lemma usubst_cpa_des_cond_abr [usubst]:
  "\<lbrakk>$ok \<sharp> \<sigma>; $ok\<acute> \<sharp> \<sigma> \<rbrakk> \<Longrightarrow>
    \<sigma> \<dagger> (R \<turnstile> bif b then P else Q eif) =
    (\<sigma> \<dagger> R \<turnstile>  (\<sigma> \<dagger> P \<triangleleft> \<sigma> \<dagger> \<lceil>b\<rceil>\<^sub>A\<^sub>B\<^sub>R\<^sub>< \<triangleright> \<sigma> \<dagger> Q))"
  by (simp add: usubst)

lemma comp_cond_abr_left_distr[uabr_comp]:
  "((bif b then Simpl\<^sub>A\<^sub>B\<^sub>R P else Simpl\<^sub>A\<^sub>B\<^sub>R Q eif) ;; Simpl\<^sub>A\<^sub>B\<^sub>R R) =
    (bif b then (Simpl\<^sub>A\<^sub>B\<^sub>R P ;; Simpl\<^sub>A\<^sub>B\<^sub>R R) else (Simpl\<^sub>A\<^sub>B\<^sub>R Q ;; Simpl\<^sub>A\<^sub>B\<^sub>R R) eif)"
  apply (simp add: usubst uabr_comp)
  apply pred_simp
  apply rel_simp
  apply auto
done

lemma if_mono:
  "\<lbrakk> P\<^sub>1 \<sqsubseteq> P\<^sub>2; Q\<^sub>1 \<sqsubseteq> Q\<^sub>2 \<rbrakk> \<Longrightarrow> (bif b then P\<^sub>1 else Q\<^sub>1 eif) \<sqsubseteq> (bif b then P\<^sub>2 else Q\<^sub>2 eif)"
  by rel_auto

subsection {*While abrupt usubst*}

subsection {*block abrupt usubst*}

subsection {*Catch abrupt usubst*}

end


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

  Project: IsaNet

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

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

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

section\<open>Network Assumptions used for authorized segments.\<close>
theory Network_Assumptions
  imports
    "Network_Model"
begin

locale network_assums_generic = network_model _ auth_seg0 for
   auth_seg0 :: "('ainfo \<times> 'aahi ahi_scheme list) set" +
 assumes
\<comment> \<open>All authorized segments have valid interfaces\<close>
    ASM_if_valid: "(info, l) \<in> auth_seg0 \<Longrightarrow> ifs_valid_None l" and
\<comment> \<open>All authorized segments are rooted, i.e., they start with None\<close>
    ASM_empty [simp, intro!]: "(info, []) \<in> auth_seg0" and
    ASM_rooted: "(info, l) \<in> auth_seg0 \<Longrightarrow> rooted l" and
    ASM_terminated: "(info, l) \<in> auth_seg0 \<Longrightarrow> terminated l"

locale network_assums_undirect = network_assums_generic _ _ +
  assumes
    ASM_adversary: "\<lbrakk>\<And>hf. hf \<in> set hfs \<Longrightarrow> ASID hf \<in> bad\<rbrakk> \<Longrightarrow> (info, hfs) \<in> auth_seg0"

locale network_assums_direct = network_assums_generic _ _ +
  assumes
    ASM_singleton: "\<lbrakk>ASID hf \<in> bad\<rbrakk> \<Longrightarrow> (info, [hf]) \<in> auth_seg0" and
    ASM_extension: "\<lbrakk>(info, hf2#ys) \<in> auth_seg0; ASID hf2 \<in> bad; ASID hf1 \<in> bad\<rbrakk>
                    \<Longrightarrow> (info, hf1#hf2#ys) \<in> auth_seg0" and
    ASM_modify: "\<lbrakk>(info, hf#ys) \<in> auth_seg0; ASID hf = a; ASID hf' = a; UpIF hf' = UpIF hf; a \<in> bad\<rbrakk>
                  \<Longrightarrow> (info, hf'#ys) \<in> auth_seg0" and
    ASM_cutoff: "\<lbrakk>(info, zs@hf#ys) \<in> auth_seg0; ASID hf = a; a \<in> bad\<rbrakk> \<Longrightarrow> (info, hf#ys) \<in> auth_seg0"
begin

lemma auth_seg0_non_empty [simp, intro!]: "auth_seg0 \<noteq> {}"
  by auto

lemma auth_seg0_non_empty_frag [simp, intro!]: "\<exists> info . pfragment info [] auth_seg0"
  apply(auto simp add: pfragment_def)
  by (metis append_Nil2 ASM_empty)

text \<open>This lemma applies the extendability assumptions on @{text "auth_seg0"} to pfragments of
@{text "auth_seg0"}.\<close>
lemma extend_pfragment0:
  assumes "pfragment ainfo (hf2#xs) auth_seg0"
  assumes "ASID hf1 \<in> bad"
  assumes "ASID hf2 \<in> bad"
  shows "pfragment ainfo (hf1#hf2#xs) auth_seg0"
  using assms
  by(auto intro!: pfragmentI[of _ "[]" _ _] elim!: pfragmentE intro: ASM_cutoff intro!: ASM_extension)

text\<open>This lemma shows that the above assumptions imply that of the undirected setting\<close>
lemma "\<lbrakk>\<And>hf. hf \<in> set hfs \<Longrightarrow> ASID hf \<in> bad\<rbrakk> \<Longrightarrow> (info, hfs) \<in> auth_seg0"
  apply(induction hfs)
  using ASM_empty apply blast
  subgoal for a hfs
    apply(cases hfs)
    by(auto intro!: ASM_singleton ASM_extension)
  done

end
end