theory PartialityTest_Test_E1
imports "$HETS_LIB/Isabelle/MainHC"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize [\"Ax1\", \"Ax1_1\"]"

theorem restrict1 : "restrictOp (restrictOp a (defOp b)) c = restrictOp (restrictOp a c) (defOp (restrictOp b c))"
apply (case_tac c)
apply (simp add: restrictOp_def)
apply (simp add: restrictOp_def)
done

theorem restrict_trivial_rule[simp]: "b ==> restrictOp t b = t"
apply (simp add: restrictOp_def)
done

theorem restrict_trivial [simp]: "restrictOp t True = t"
apply (simp)
done

theorem restrict_assoc[simp] : "restrictOp a (defOp (restrictOp b c)) = restrictOp (restrictOp a (defOp b)) c"
apply (case_tac c)
apply (simp add: restrictOp_def)
apply (simp add: restrictOp_def noneOp_def defOp.simps undefinedOp_def)
done

theorem restrict_out[simp] : "restrictOp (t b) b = restrictOp (t True) b"
apply (case_tac "b")
apply (simp add: restrictOp_def)
apply (simp add: restrictOp_def)
done

theorem mkpartial_cancel [simp]: "makeTotal(makePartial x) = x"
apply (simp add: makeTotal_def makePartial_def)
done

theorem mkpartial_cancel2 [simp]: "defOp(x) ==> makePartial(makeTotal x) = x"
apply (simp add: makeTotal_def makePartial_def)
apply (case_tac x)
apply (simp)
apply (simp)
done

theorem mkpartial_cancel3 [simp] : "((makePartial x) = (makePartial y)) = (x = y)"
apply (simp add: makePartial_def)
done

theorem defOp_trivial [simp]: "defOp(makePartial x) = True"
apply (simp add: makePartial_def makeTotal_def)
done

(* Some more stuff about removing extraneous restrictions *)

theorem total_restrict2 [simp]:
"(c ==> b) ==> restrictOp (t (makeTotal  (restrictOp a b))) c =
	   restrictOp (t (makeTotal a)) c"
apply (simp add: makeTotal_def restrictOp_def defOp.simps undefinedOp_def)
done

theorem def_restrict [simp]:
"defOp (restrictOp a b) = (defOp a & b)"
apply (simp add:  restrictOp_def defOp.simps undefinedOp_def split: split_if)
done

theorem total_restrict [simp]:
"restrictOp (t (makeTotal  (restrictOp a b))) (defOp (restrictOp a b)) =
	   restrictOp (t (makeTotal a)) (defOp a & b)"
apply simp
done

lemma restrictOp_cong [cong]:
  "b = b' ==> (b' ==> a = a') ==> restrictOp a b = restrictOp a' b'"
  apply (simp add: restrictOp_def defOp.simps undefinedOp_def)
done

thm conj_cong
declare conj_cong[cong]
(*lemma conj_cong*)

typedecl a

consts
f :: "(a * a ) => a partial"

axioms
Ax1 [rule_format] :
"ALL x.
 ALL y.
 ALL z.
 defOp (f(x, y)) & defOp (f(y, z)) -->
 restrictOp (f(x, makeTotal (f(y, z)))) (defOp (f(y, z))) =
 restrictOp (f(makeTotal (f(x, y)), z)) (defOp (f(x, y)))"

Ax1_monad [rule_format] :
"ALL x.
 ALL y.
 ALL z.
 defOp (lift2partial f (pair x y)) &
 defOp (lift2partial f (pair y z)) -->
 lift2partial f (pair x (lift2partial f (pair y z))) =
 lift2partial f (pair (lift2partial f (pair x y)) z)"

Ax1_monad_unsound [rule_format] :
"ALL x.
 ALL y.
 ALL z.
 lift2partial f (pair x (lift2partial f (pair y z))) =
 lift2partial f (pair (lift2partial f (pair x y)) z)"

lemma assoc_dom : "defOp (f(x, y)) & defOp (f(y, z)) ==>
  (defOp (f(x, makeTotal (f(y, z)))) & defOp (f(y, z))) =
  (defOp (f(makeTotal (f(x, y)), z)) & defOp (f(x, y)))"
apply (frule Ax1)
apply (simp)
done

lemma assoc_eq : "defOp (f(x, y)) & defOp (f(y, z)) ==>
  f(x, makeTotal (f(y, z))) = f(makeTotal (f(x, y)), z)"
apply (frule Ax1)
apply (simp)
done

theorem Ax1_1_monadic:
"ALL w.
 ALL x.
 ALL y.
 ALL z.
 defOp (lift2partial f (pair x (lift2partial f (pair y z)))) &
 defOp (lift2partial f (pair y (lift2partial f (pair z w)))) -->
 lift2partial f (pair (lift2partial f (pair x (lift2partial f (pair y z)))) w)
 =
 lift2partial f (pair x (lift2partial f (pair y (lift2partial f (pair z w)))))"
apply (clarify)
sorry
(* apply (simp add: Ax1_monad) *)

theorem Ax1_1 :
"ALL w.
 ALL x.
 ALL y.
 ALL z.
 defOp (restrictOp (f(x, makeTotal (f(y, z)))) (defOp (f(y, z)))) &
 defOp
 (restrictOp (f(y, makeTotal (f(z, w)))) (defOp (f(z, w)))) -->
 restrictOp (f(makeTotal (f(x, makeTotal (f(y, z)))), w))
 (defOp (f(x, makeTotal (f(y, z)))) & defOp (f(y, z))) =
 restrictOp (f(x, makeTotal (f(y, makeTotal (f(z, w))))))
 (defOp (f(y, makeTotal (f(z, w)))) & defOp (f(z, w)))"
apply (auto)
apply (simp add: assoc_eq assoc_dom)
done

ML "Header.record \"Ax1_1\""

end


theory SINVAR_SubnetsInGW
imports"../TopoS_Helper"
begin

subsection {* SecurityInvariant SubnetsInGW *}

datatype subnets = Member | InboundGateway | Unassigned

definition default_node_properties :: "subnets"
  where  "default_node_properties \<equiv> Unassigned"

fun allowed_subnet_flow :: "subnets \<Rightarrow> subnets \<Rightarrow> bool" where
  "allowed_subnet_flow Member _ = True" |
  "allowed_subnet_flow InboundGateway _ = True" |
  "allowed_subnet_flow Unassigned Unassigned = True" |
  "allowed_subnet_flow Unassigned InboundGateway = True"|
  "allowed_subnet_flow Unassigned Member = False"

fun sinvar :: "'v graph \<Rightarrow> ('v \<Rightarrow> subnets)  \<Rightarrow> bool" where
  "sinvar G nP = (\<forall> (e1,e2) \<in> edges G. allowed_subnet_flow (nP e1) (nP e2))"

definition receiver_violation :: "bool" where "receiver_violation = False"

subsubsection {*Preliminaries*}

subsubsection{*ENF*}
  lemma Unassigned_not_to_Member: "\<not> allowed_subnet_flow Unassigned Member"
    by(simp)
  lemma All_to_Unassigned: "allowed_subnet_flow e1 Unassigned"
    by (case_tac e1, simp_all)
  lemma Member_to_All: "allowed_subnet_flow Member e2"
    by (case_tac e2, simp_all)
  lemma Unassigned_default_candidate: "\<forall> nP e1 e2. \<not> allowed_subnet_flow (nP e1) (nP e2) \<longrightarrow> \<not> allowed_subnet_flow Unassigned (nP e2)"
    apply(rule allI)+
    apply(case_tac "nP e2")
      apply simp
     apply(case_tac "nP e1")
       apply(simp_all)[3]
    by(simp add: All_to_Unassigned)
  lemma allowed_subnet_flow_refl: "allowed_subnet_flow e e"
    by(case_tac e, simp_all)
  lemma SubnetsInGW_ENF: "SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form sinvar allowed_subnet_flow"
    unfolding SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form_def
    by simp
  lemma SubnetsInGW_ENF_refl: "SecurityInvariant_withOffendingFlows.ENF_refl sinvar allowed_subnet_flow"
    unfolding SecurityInvariant_withOffendingFlows.ENF_refl_def
    apply(rule conjI)
     apply(simp add: SubnetsInGW_ENF)
    apply(simp add: allowed_subnet_flow_refl)
  done

  definition SubnetsInGW_offending_set:: "'v graph \<Rightarrow> ('v \<Rightarrow> subnets) \<Rightarrow> ('v \<times> 'v) set set" where
  "SubnetsInGW_offending_set G nP = (if sinvar G nP then
      {}
     else
      { {e \<in> edges G. case e of (e1,e2) \<Rightarrow> \<not> allowed_subnet_flow (nP e1) (nP e2)} })"
  lemma SubnetsInGW_offending_set:
  "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = SubnetsInGW_offending_set"
    apply(simp only: fun_eq_iff ENF_offending_set[OF SubnetsInGW_ENF] SubnetsInGW_offending_set_def)
    apply(rule allI)+
    apply(rename_tac G nP)
    apply(auto)
  done

interpretation SubnetsInGW: SecurityInvariant_ACS
where default_node_properties = SINVAR_SubnetsInGW.default_node_properties
and sinvar = SINVAR_SubnetsInGW.sinvar
rewrites "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = SubnetsInGW_offending_set"
  unfolding SINVAR_SubnetsInGW.default_node_properties_def
  apply unfold_locales

    apply(rule ballI)
    thm SecurityInvariant_withOffendingFlows.ENF_fsts_refl_instance[OF SubnetsInGW_ENF_refl Unassigned_default_candidate]
    apply(rule SecurityInvariant_withOffendingFlows.ENF_fsts_refl_instance[OF SubnetsInGW_ENF_refl Unassigned_default_candidate])
      apply(simp_all)[2]

   apply(erule default_uniqueness_by_counterexample_ACS)
   apply (simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_def)
   apply (simp add:graph_ops)
   apply (simp split: prod.split_asm prod.split)
   apply(rule_tac x="\<lparr> nodes={vertex_1,vertex_2}, edges = {(vertex_1,vertex_2)} \<rparr>" in exI, simp)
   apply(rule conjI)
    apply(simp add: wf_graph_def)
   apply(case_tac otherbot, simp_all)
   apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := Member)" in exI, simp)
    apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
   apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := Member)" in exI, simp)
   apply(rule_tac x="vertex_1" in exI, simp)
   apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)

  apply(fact SubnetsInGW_offending_set)
  done

  lemma TopoS_SubnetsInGW: "SecurityInvariant sinvar default_node_properties receiver_violation"
  unfolding receiver_violation_def by unfold_locales

hide_fact (open) sinvar_mono
hide_const (open) sinvar receiver_violation default_node_properties

end


theory prop_40
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun take :: "Nat => 'a list => 'a list" where
  "take (Z) y = Nil2"
  | "take (S z) (Nil2) = Nil2"
  | "take (S z) (Cons2 x2 x3) = Cons2 x2 (take z x3)"
  (*hipster take *)

  theorem x0 :
    "(take Z xs) = (Nil2)"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end