section \<open> Buffer Z Machine \<close>

theory Buffer_Z
  imports "Z_Machines.Z_Machine"
begin lit_vars

consts VAL :: "integer set"

zstore Buffer_state =
  buf :: "integer list"
  where "set buf \<subseteq> VAL"

zoperation Input =
  over Buffer_state
  params v \<in> VAL
  update "[buf \<leadsto> buf @ [v]]"

lemma Input_inv [hoare_lemmas]: "Input v preserves Buffer_state_inv"
  by zpog_full

zoperation Output =
  over Buffer_state
  params v \<in> VAL
  pre "length buf > 0"
  update "[buf \<leadsto> tl buf]"
  where "v = hd buf"

lemma Output_inv [hoare_lemmas]: "Output v preserves Buffer_state_inv"
  by zpog_full (meson in_mono list.set_sel(2))

zoperation State =
  over Buffer_state
  params st \<in> "{buf}"

lemma State_inv [hoare_lemmas]: "State st preserves Buffer_state_inv"
  by zpog_full

zmachine Buffer =
  init "[buf \<leadsto> []]"
  invariant "Buffer_state_inv"
  operations Input Output State

lemma Buffer_deadlock_free: "VAL \<noteq> {} \<Longrightarrow> deadlock_free Buffer"
  by deadlock_free

def_consts VAL = "{0,1,2,3}"

animate Buffer

end


theory TheoremD7
imports TheoremD6
begin

context LocalLexing begin

lemma Derives1_keep_first_terminal: "Derives1 (x#u) i r (y#v) \<Longrightarrow> is_terminal x \<Longrightarrow> x = y"
  by (metis Derives1_leftmost Derives1_take leftmost_cons_terminal list.sel(1) not_le take_Cons')

lemma Derives1_nonterminal_head:
  assumes "Derives1 u i r (N#v)"
  assumes "is_nonterminal N"
  shows "\<exists> u' M. u = M#u' \<and> is_nonterminal M"
proof -
  from assms have nonempty_u: "u \<noteq> []"
    by (metis Derives1_bound less_nat_zero_code list.size(3))
  have "\<exists> u' M. u = M#u'"
    using count_terminals.cases nonempty_u by blast
  then obtain u' M where split_u: "u = M#u'" by blast
  have is_sentence_u: "is_sentence u" using assms
    using Derives1_sentence1 by blast
  then have "is_terminal M \<or> is_nonterminal M"
    using is_sentence_cons is_symbol_distinct split_u by blast
  then show ?thesis
  proof (induct rule: disjCases2)
    case 1
      have "is_terminal N"
        using "1.hyps" Derives1_keep_first_terminal
        assms(1) split_u by blast
      with assms have "False" using is_terminal_nonterminal by blast
      then show ?case by blast
  next
    case 2 with split_u show ?case by blast
  qed
qed

lemma sentence_starts_with_nonterminal:
  assumes "is_nonterminal N"
  assumes "derives u []"
  shows "\<exists> X r. u@[N] = X#r \<and> is_nonterminal X"
proof (cases "u = []")
  case True thus ?thesis using assms(1) by blast
next
  case False
  then have "\<exists> X r. u = X#r" using count_terminals.cases by blast
  then obtain X r where Xr: "u = X#r" by blast
  then have "is_nonterminal X"
    by (metis False assms(2) count_terminals.simps derives_count_terminals_leq
      derives_is_sentence is_sentence_cons is_symbol_distinct not_le zero_less_Suc)
  with Xr show ?thesis by auto
qed

lemma Derives1_nonterminal_head':
  assumes "Derives1 u i r (v1@[N]@v2)"
  assumes "is_nonterminal N"
  assumes "derives v1 []"
  shows "\<exists> u' M. u = M#u' \<and> is_nonterminal M"
proof -
  from sentence_starts_with_nonterminal[OF assms(2,3)]
  obtain X r where "v1 @ [N] = X # r \<and> is_nonterminal X" by blast
  then show ?thesis
    by (metis Derives1_nonterminal_head append_Cons append_assoc assms(1))
qed

lemma thmD7_helper:
  assumes "LeftDerivation [\<SS>] D (N#v)"
  assumes "is_nonterminal N"
  assumes "\<SS> \<noteq> N"
  shows "\<exists> n M a a1 a2 w. n < length D \<and> (M, a) \<in> \<RR> \<and> LeftDerivation [\<SS>] (take n D) (M#w) \<and>
    a = a1 @ [N] @ a2 \<and> derives a1 []"
proof -
  have "\<exists> n u v. LeftDerivation [\<SS>] (take n D) (u@[N]@v) \<and> derives u []"
    apply (rule_tac x="length D" in exI)
    apply (rule_tac x="[]" in exI)
    apply (rule_tac x="v" in exI)
    using assms by simp
  then show ?thesis
  proof (induct rule: ex_minimal_witness)
    case (Minimal K)
      have nonzero_K: "K \<noteq> 0"
      proof (cases "K = 0")
        case True
          with Minimal have "\<exists> u v. [\<SS>] = u@[N]@v"
            using LeftDerivation.simps(1) take_0 by auto
          with assms have "False" by (simp add: Cons_eq_append_conv)
          then show ?thesis by simp
      next
        case False
          then show ?thesis by arith
      qed
      from Minimal(1)
      obtain u v where uv: "LeftDerivation [\<SS>] (take K D) (u @ [N] @ v) \<and> derives u []" by blast
      from nonzero_K have "take K D \<noteq> []"
        using Minimal.hyps(2) less_nat_zero_code nat_neq_iff take_eq_Nil uv by force
      then have "\<exists> E e. (take K D) = E@[e]" using rev_exhaust by blast
      then obtain E e where Ee: "take K D = E@[e]" by blast
      with uv have "\<exists> x. LeftDerivation [\<SS>] E x \<and> LeftDerives1 x (fst e) (snd e) (u @ [N] @ v)"
        by (simp add: LeftDerivation_append)
      then obtain x where x: "LeftDerivation [\<SS>] E x \<and> LeftDerives1 x (fst e) (snd e) (u @ [N] @ v)"
        by blast
      then have "\<exists> w M. x = M#w \<and> is_nonterminal M"
        using Derives1_nonterminal_head' LeftDerives1_implies_Derives1 assms(2) uv by blast
      then obtain w M where split_x: "x = M#w" and is_nonterminal_M: "is_nonterminal M" by blast
      from Ee nonzero_K have E: "E = take (K - 1) D"
        by (metis Minimal.hyps(2) butlast_snoc butlast_take dual_order.strict_implies_order
          le_less_linear take_all uv)
      have "leftmost (fst e) (M#w)" using x LeftDerives1_def split_x by blast
      with is_nonterminal_M have fst_e: "fst e = 0"
        by (simp add: leftmost_cons_nonterminal leftmost_unique)
      have Derives1: "Derives1 x 0 (snd e) (u @ [N] @ v)"
        using LeftDerives1_implies_Derives1 fst_e x by auto
      have x_splits_at: "splits_at x 0 [] M w"
        by (simp add: split_x splits_at_def)
      from Derives1 x_splits_at
      have pq: "\<exists>p q. u = [] @ p \<and> v = q @ w \<and> snd (snd e) = p @ [N] @ q"
      proof (induct rule: Derives1_X_is_part_of_rule)
        case (Suffix \<alpha>) thus ?case by blast
      next
        case (Prefix \<beta>)
          then have derives_\<beta>: "derives \<beta> []"
            using Derives1_implies_derives1 derives1_implies_derives derives_trans uv by blast
          with Prefix(1) x Minimal E nonzero_K show "False"
            by (meson diff_less less_nat_zero_code less_one nat_neq_iff)
      qed
      from this[simplified] obtain q where q: "v = q @ w \<and> snd (snd e) = u @ N # q" by blast
      have M_def: "fst (snd e) = M"
        using Derives1 Derives1_nonterminal x_splits_at by blast
      show ?case
        apply (rule_tac x="K-1" in exI)
        apply (rule_tac x="M" in exI)
        apply (rule_tac x="snd (snd e)" in exI)
        apply (rule_tac x="u" in exI)
        apply (rule_tac x="q" in exI)
        apply (rule_tac x="w" in exI)
        by (metis Derives1 Derives1_rule E Ee M_def One_nat_def Suc_pred pq append_Nil
          append_same_eq dual_order.strict_implies_order le_less_linear nonzero_K not_Cons_self2
          not_gr0 not_less_eq prod.collapse q self_append_conv split_x take_all uv x)
  qed
qed

lemma head_of_item_\<beta>_is_next_symbol:
  "wellformed_item x \<Longrightarrow> item_\<beta> x = t#\<delta> \<Longrightarrow> next_symbol x = Some t"
  using next_symbol_def next_symbol_starts_item_\<beta> wellformed_complete_item_\<beta> by fastforce

lemma next_symbol_predicts: "next_symbol x = Some N \<Longrightarrow> (N, a) \<in> \<RR> \<Longrightarrow> k = item_end x \<Longrightarrow>
  init_item (N, a) k \<in> Predict k {x}"
using Predict_def bin_def by auto

lemma thmD7_LeftDerivation: "LeftDerivation [\<SS>] D (N#\<gamma>) \<Longrightarrow> is_nonterminal N \<Longrightarrow> (N, \<alpha>) \<in> \<RR> \<Longrightarrow>
  init_item (N, \<alpha>) 0 \<in> \<pi> 0 {} Init"
proof (induct "length D" arbitrary: D N \<gamma> \<alpha> rule: less_induct)
  case less
    let ?trivial = "\<SS> = N"
    have "?trivial \<or> \<not> ?trivial" by blast
    then show ?case
    proof (induct rule: disjCases2)
      case 1
        then have "init_item (N, \<alpha>) 0 \<in> Init"
          apply (subst Init_def)
          by (auto simp add: less)
        then show ?case
          by (meson \<pi>_regular contra_subsetD regular_implies_setmonotone subset_setmonotone)
    next
      case 2
        from thmD7_helper[OF less(2) less(3) 2]
        obtain n M a a1 a2 w where "n < length D" and  "(M, a) \<in> \<RR>" and
          "LeftDerivation [\<SS>] (take n D) (M # w)" and "a = a1 @ [N] @ a2" and "derives a1 []"
          by blast
        note M = this
        let ?x = "init_item (M, a) 0"
        have x_dom: "?x \<in> \<pi> 0 {} Init"
          apply (rule less(1)[OF _ M(3) _ M(2)])
          using M(1) apply simp
          using M(2) by simp
        have wellformed_x: "wellformed_item ?x" by (simp add: M(2))
        let ?y = "inc_dot (length a1) ?x"
        have "?y \<in> \<pi> 0 {} {?x}"
          apply (rule thmD6[where \<omega>="[N] @ a2"])
          using wellformed_x by (auto simp add: M)
        with x_dom have y_dom: "?y \<in> \<pi> 0 {} Init"
          using \<pi>_subset_elem_trans empty_subsetI insert_subset by blast
        have wellformed_y: "wellformed_item ?y"
          using M(4) wellformed_inc_dot wellformed_x by auto
        have "item_\<beta> ?y = N#a2" by (simp add: M(4) item_\<beta>_def)
        then have next_symbol_y: "next_symbol ?y = Some N"
          by (simp add: head_of_item_\<beta>_is_next_symbol wellformed_y)
        let ?z = "init_item (N, \<alpha>) 0"
        have "?z \<in> Predict 0 {?y}"
          by (simp add: less.prems(3) next_symbol_predicts next_symbol_y)
        then have "?z \<in> \<pi> 0 {} {?y}" using Predict_subset_\<pi> by auto
        with y_dom show "?z \<in> \<pi> 0 {} Init"
          using \<pi>_subset_elem_trans empty_subsetI insert_subset by blast
    qed
qed

theorem thmD7: "is_derivation (N#\<gamma>) \<Longrightarrow> is_nonterminal N \<Longrightarrow> (N, \<alpha>) \<in> \<RR> \<Longrightarrow>
  init_item (N, \<alpha>) 0 \<in> \<pi> 0 {} Init"
by (metis \<L>\<^sub>P_is_word derives_implies_leftderives_cons empty_in_\<L>\<^sub>P is_derivation_def
  leftderives_implies_LeftDerivation self_append_conv2 thmD7_LeftDerivation)

end

end


theory I8_SSH_Landscape
imports "../TopoS_Impl"
begin

definition I8SSHgraph :: "nat list_graph" where
    "I8SSHgraph \<equiv> \<lparr> nodesL = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23],
    edgesL = [(7, 3), (16, 9), (19, 4), (22, 19), (20, 7), (18, 19), (21, 6), (8, 5), (9, 0), (10, 7), (11, 22), (14, 1),
      (12, 17), (15, 4), (13, 20), (3, 2), (4, 5), (16, 0), (6, 23), (19, 13), (7, 22), (20, 14), (18, 10), (23, 19), (21, 15),
        (8, 12), (22, 12), (9, 9), (23, 9), (10, 14), (8, 18), (11, 15), (9, 19), (14, 8), (12, 8), (15, 13), (13, 13), (2, 18), (0, 14),
        (3, 11), (4, 12), (2, 12), (5, 1), (3, 17), (16, 7), (6, 14), (19, 18), (17, 6), (7, 15), (18, 5), (21, 8), (22, 7), (23, 6), (10, 9),
        (11, 4), (9, 20), (14, 19), (12, 7), (10, 19), (15, 10), (13, 6), (0, 5), (4, 11), (2, 7), (5, 10), (3, 22), (6, 1), (4, 17), (7, 4), (5, 20),
        (16, 20), (21, 17), (19, 1), (8, 0), (15, 19), (11, 19), (12, 20), (16, 11), (6, 18), (19, 6), (22, 17), (23, 20), (21, 4), (8, 7), (22, 11), (9, 6),
        (10, 5), (11, 8), (0, 19), (14, 7), (12, 19), (15, 6), (13, 18), (0, 9), (3, 4), (4, 7), (5, 6), (16, 2), (6, 21), (19, 15), (17, 3), (7, 16), (21, 13),
        (8, 14), (22, 2), (9, 15), (23, 11), (10, 12), (8, 20), (11, 1), (9, 17), (14, 14), (12, 10), (10, 22), (15, 15), (13, 11), (2, 16), (3, 13), (4, 14), (2, 10),
        (5, 15), (3, 19), (6, 12), (4, 20), (19, 20), (7, 9), (18, 3), (21, 22), (22, 5), (23, 0), (11, 6), (14, 17), (12, 1), (10, 17), (15, 20), (13, 4), (1, 6), (2, 5),
        (5, 8), (6, 7), (4, 19), (7, 6), (5, 18), (16, 22), (19, 3), (8, 2), (9, 3), (11, 21), (14, 2), (12, 22), (13, 23), (3, 1), (16, 13), (6, 16), (19, 8), (7, 21), (22, 23),
        (20, 3), (23, 22), (21, 2), (8, 9), (22, 9), (9, 4), (23, 12), (10, 3), (11, 10), (14, 5), (12, 13), (15, 0), (13, 16), (2, 23), (0, 11), (3, 6), (4, 1), (5, 4), (16, 4),
        (6, 11), (19, 17), (7, 18), (18, 6), (21, 11), (22, 0), (9, 13), (23, 5), (10, 10), (8, 22), (11, 3), (9, 23), (14, 12), (12, 4), (10, 20), (15, 9), (13, 9), (3, 15), (1, 3),
        (4, 8), (2, 8), (5, 13), (3, 21), (6, 2), (4, 22), (19, 22), (7, 11), (5, 23), (16, 17), (21, 20), (23, 2), (14, 23), (12, 3), (15, 22), (13, 2), (2, 3), (6, 5), (7, 0), (5, 16),
        (16, 8), (19, 5), (22, 18), (20, 6), (21, 7), (8, 4), (9, 1), (10, 6), (11, 23), (14, 0), (12, 16), (15, 5), (13, 21), (3, 3), (4, 4), (16, 15), (6, 22), (19, 10), (17, 14), (7, 23),
        (22, 21), (23, 16), (21, 0), (8, 11), (22, 15), (9, 10), (23, 14), (10, 1), (8, 17), (11, 12), (14, 11), (12, 15), (15, 2), (13, 14), (2, 21), (3, 8), (4, 3), (2, 15), (5, 2),
        (16, 6), (6, 9), (19, 19), (17, 7), (7, 12), (21, 9), (22, 6), (23, 7), (10, 8), (11, 5), (9, 21), (14, 18), (12, 6), (10, 18), (15, 11), (13, 7), (4, 10), (2, 6), (5, 11),
        (3, 23), (6, 0), (4, 16), (7, 5), (5, 21), (20, 19), (16, 19), (21, 18), (14, 21), (15, 16), (13, 0), (11, 16), (2, 1), (7, 2), (16, 10), (19, 7), (17, 11), (22, 16),
        (23, 21), (21, 5), (8, 6), (22, 10), (9, 7), (10, 4), (11, 9), (14, 6), (12, 18), (1, 19), (15, 7), (13, 19), (3, 5), (4, 6), (5, 7), (16, 1), (6, 20), (19, 12), (7, 17),
        (18, 11), (23, 18), (21, 14), (8, 13), (22, 13), (9, 8), (23, 8), (10, 15), (8, 19), (11, 14), (9, 18), (14, 9), (12, 9), (15, 12), (13, 12), (2, 19), (3, 10), (1, 14), (4, 13),
        (2, 13), (5, 0), (3, 16), (6, 15), (19, 21), (17, 5), (7, 14), (21, 23), (22, 4), (23, 1), (11, 7), (14, 16), (12, 0), (10, 16), (15, 21), (13, 5), (0, 6), (1, 7), (2, 4),
        (5, 9), (6, 6), (4, 18), (7, 7), (5, 19), (16, 21), (21, 16), (19, 0), (8, 1), (15, 18), (11, 18), (12, 21), (16, 12), (6, 19), (19, 9), (17, 9), (22, 22), (18, 14),
        (23, 23), (21, 3), (8, 8), (22, 8), (9, 5), (23, 13), (10, 2), (11, 11), (14, 4), (12, 12), (15, 1), (13, 17), (2, 22), (3, 7), (1, 11), (4, 0), (5, 5), (16, 3),
        (6, 10), (19, 14), (7, 19), (20, 9), (18, 9), (21, 12), (8, 15), (22, 3), (9, 14), (23, 10), (10, 13), (8, 21), (11, 0), (9, 16), (14, 15), (12, 11), (10, 23),
        (15, 14), (13, 10), (2, 17), (3, 12), (4, 15), (2, 11), (5, 14), (3, 18), (6, 13), (4, 21), (19, 23), (7, 8), (16, 16), (21, 21), (23, 3), (14, 22), (12, 2),
        (15, 23), (13, 3), (1, 5), (2, 2), (6, 4), (7, 1), (5, 17), (16, 23), (19, 2), (20, 5), (8, 3), (9, 2), (11, 20), (14, 3), (12, 23), (13, 22), (3, 0), (16, 14),
        (6, 17), (19, 11), (7, 20), (22, 20), (23, 17), (21, 1), (8, 10), (22, 14), (9, 11), (23, 15), (10, 0), (8, 16), (11, 13), (14, 10), (12, 14), (15, 3), (13, 15),
        (2, 20), (3, 9), (1, 9), (4, 2), (2, 14), (5, 3), (16, 5), (6, 8), (19, 16), (7, 13), (20, 11), (18, 7), (21, 10), (22, 1), (9, 12), (23, 4), (10, 11), (8, 23),
        (11, 2), (9, 22), (14, 13), (12, 5), (10, 21), (15, 8), (13, 8), (0, 3), (3, 14), (4, 9), (2, 9), (5, 12), (3, 20), (6, 3), (4, 23), (7, 10), (5, 22), (16, 18),
        (21, 19), (17, 19), (14, 20), (15, 17), (13, 1), (11, 17), (2, 0)] \<rparr>"

value "(0, 20) \<in> set (edgesL I8SSHgraph)"
value "[(s,r) \<leftarrow> (edgesL I8SSHgraph). r = 2]"

  lemma "valid_list_graph I8SSHgraph" by eval

definition Confidentiality1::"(nat SecurityInvariant)" where
      "Confidentiality1 \<equiv> new_configured_list_SecurityInvariant SINVAR_BLPtrusted_impl.SINVAR_LIB_BLPtrusted \<lparr>
          node_properties = [0 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         1 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         2 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         3 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         4 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         5 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         6 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         7 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         8 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         9 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         10 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         11 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         12 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         13 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         14 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         15 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         16 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         17 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         18 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         19 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         20 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         21 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         22 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>,
         23 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>],
          model_global_properties = ()
          \<rparr>"

definition "Subnet1 \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_SubnetsInGW \<lparr>
          node_properties = [0 \<mapsto> Unassigned,
         1 \<mapsto> Unassigned,
         2 \<mapsto> Member,
         3 \<mapsto> InboundGateway,
         4 \<mapsto> Member,
         5 \<mapsto> InboundGateway,
         6 \<mapsto> InboundGateway,
         7 \<mapsto> InboundGateway,
         8 \<mapsto> InboundGateway,
         9 \<mapsto> InboundGateway,
         10 \<mapsto> Member,
         11 \<mapsto> InboundGateway,
         12 \<mapsto> InboundGateway,
         13 \<mapsto> InboundGateway,
         14 \<mapsto> InboundGateway,
         15 \<mapsto> InboundGateway,
         16 \<mapsto> InboundGateway,
         17 \<mapsto> Unassigned,
         18 \<mapsto> Member,
         19 \<mapsto> InboundGateway,
         20 \<mapsto> Unassigned,
         21 \<mapsto> InboundGateway,
         22 \<mapsto> InboundGateway,
         23 \<mapsto> Member],
          model_global_properties = ()
          \<rparr>"

    definition "PrintingSink \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_Sink \<lparr>
          node_properties = [3 \<mapsto> Sink],
          model_global_properties = ()
          \<rparr>"

definition "I8Requirements = [ Confidentiality1, Subnet1]"

value "implc_get_offending_flows I8Requirements I8SSHgraph"

value "implc_offending_flows PrintingSink I8SSHgraph"

ML{*
vizualize_graph @{context} @{term "I8Requirements"} @{term "I8SSHgraph"};
*}

lemma "all_security_requirements_fulfilled I8Requirements I8SSHgraph" by eval

lemma "set (filter_IFS_no_violations I8SSHgraph I8Requirements) = set (edgesL I8SSHgraph)" by eval

value "filter_compliant_stateful_ACS I8SSHgraph I8Requirements"

text{*noBiFlows is the list of flows where not already a bidirectional flows is allowed.
      That is, the list of flows we might wish to be stateful to enhance connectivity. *}
definition "noBiFlows = [e \<leftarrow> edgesL I8SSHgraph. case e of (s,r) \<Rightarrow> \<not> ((s,r) \<in> set (edgesL I8SSHgraph) \<and> (r,s) \<in> set (edgesL I8SSHgraph)) ]"
lemma "set noBiFlows = set (filter_compliant_stateful_ACS I8SSHgraph I8Requirements)" by eval

value "generate_valid_stateful_policy_IFSACS I8SSHgraph I8Requirements"

text{*even the order of the list is preserved!!*}
lemma "flows_stateL (generate_valid_stateful_policy_IFSACS I8SSHgraph I8Requirements) = noBiFlows" by eval

lemma "set (flows_stateL (generate_valid_stateful_policy_IFSACS I8SSHgraph I8Requirements)) = set noBiFlows" by eval

end


(*  Title:      Presburger-Automata/Exec.thy
    Author:     Stefan Berghofer, TU Muenchen, 2008-2009
*)

theory Exec
imports Presburger_Automata "HOL-Library.Code_Target_Numeral"
begin

declare gen_dfs_simps [code]

lemma [code_unfold]: "(\<longrightarrow>) = (\<lambda>P. (\<or>) (\<not> P))"
  by (simp add: fun_eq_iff)

lemma "\<forall>x. (\<exists>xa. int xa - int x = 5) \<or> (\<forall>xa xb. \<not> 6 \<le> int xb \<longrightarrow> int xb + (6 * int xa - int x) = 0 \<longrightarrow> int xa = 1)"
proof -
  have "?thesis = eval_pf (Forall (Exist (Or (Eq [1, -1] 5)
    (Forall (Forall (Imp (Neg (Le [-1, 0] (- 6))) (Imp (Eq [1, 6, 0, -1] 0) (Eq [0, 1] 1)))))))) []"
    (is "_ = eval_pf ?P []")
    by simp
  also have "\<dots> = dfa_accepts (dfa_of_pf 0 ?P) []"
    by (simp add: dfa_of_pf_correctness del: dfa_of_pf.simps)
  also have "\<dots>" by eval
  finally show ?thesis .
qed

lemma "\<forall>x xa xb. \<not> 2 \<le> int xb \<longrightarrow> int xb + (2 * int xa - int x) = 1 \<longrightarrow>
  (\<forall>xb xc. \<not> 2 \<le> int xc \<longrightarrow> int xc + (2 * int xb - int x) = 0 \<longrightarrow> (\<exists>xa. 2 * int xa = int x) \<longrightarrow> xb = xa)"
proof -
  have "?thesis = eval_pf (Forall (Forall (Forall (Imp (Neg (Le [-1] (- 2)))
    (Imp (Eq [1, 2, -1] 1) (Forall (Forall (Imp (Neg (Le [-1] (- 2)))
      (Imp (Eq [1, 2, 0, 0, -1] 0) (Imp (Exist (Eq [2, 0, 0, 0, 0, -1] 0)) (Eq [0, 1, 0, -1] 0))))))))))) []"
    (is "_ = eval_pf ?P []")
    by simp
  also have "\<dots> = dfa_accepts (dfa_of_pf 0 ?P) []"
    by (simp add: dfa_of_pf_correctness del: dfa_of_pf.simps)
  also have "\<dots>" by eval
  finally show ?thesis .
qed

definition "mk_dfa = dfa_of_pf 0"

definition "stamp = Forall (Imp (Le [-1] (- 8)) (Exist (Exist (Eq [5, 3, -1] 0))))"
definition "stamp_false = Forall (Imp (Le [-1] (- 7)) (Exist (Exist (Eq [5, 3, -1] 0))))"
definition "example = Forall (Exist (Or (Eq [1, -1] 5)
  (Forall (Forall (Imp (Neg (Le [-1, 0] (- 6))) (Imp (Eq [1, 6, 0, -1] 0) (Eq [0, 1] 1)))))))"
definition "example2 = Forall (Forall (Forall (Imp (Neg (Le [-1] (- 2)))
  (Imp (Eq [1, 2, -1] 1) (Forall (Forall (Imp (Neg (Le [-1] (- 2)))
    (Imp (Eq [1, 2, 0, 0, -1] 0) (Imp (Exist (Eq [2, 0, 0, 0, 0, -1] 0)) (Eq [0, 1, 0, -1] 0))))))))))"
definition "example2_false = Forall (Forall (Forall (Imp (Neg (Le [-1] (- 2)))
  (Imp (Eq [1, 2, -1] 1) (Forall (Forall (Imp (Neg (Le [-1] (- 2)))
    (Imp (Eq [1, 2, 0, 0, -1] 0) (Imp (Exist (Eq [3, 0, 0, 0, 0, -1] 0)) (Eq [0, 1, 0, -1] 0))))))))))"
definition "harrison1 = Exist (Forall (Imp (Le [-1, 1] 0) (Exist (Exist
  (And (Le [0, -1] 0) (And (Le [-1] 0) (Eq [8, 3, -1] 0)))))))"
definition "harrison2 = Exist (Forall (Imp (Le [-1, 1] 0) (Exist (Exist
  (And (Le [0, -1] 0) (And (Le [-1] 0) (Eq [8, 7, -1] 0)))))))"

value "mk_dfa stamp"
value "min_dfa (mk_dfa stamp)"
value "mk_dfa stamp_false"
value "mk_dfa example"
value "mk_dfa example2"
value "mk_dfa example2_false"
value "mk_dfa harrison1"
value "mk_dfa harrison2"

end


theory More_Missing_Multiset
  imports
    "HOL-Combinatorics.Permutations"
    Polynomial_Factorization.Missing_Multiset
begin

lemma rel_mset_free:
  assumes rel: "rel_mset rel X Y" and xs: "mset xs = X"
  shows "\<exists>ys. mset ys = Y \<and> list_all2 rel xs ys"
proof-
  from rel[unfolded rel_mset_def] obtain xs' ys'
    where xs': "mset xs' = X" and ys': "mset ys' = Y" and xsys': "list_all2 rel xs' ys'" by auto
  from xs' xs have "mset xs = mset xs'" by auto
  from mset_eq_permutation[OF this]
  obtain f where perm: "f permutes {..<length xs'}" and xs': "permute_list f xs' = xs".
  then have [simp]: "length xs' = length xs" by auto
  from permute_list_nth[OF perm, unfolded xs'] have *: "\<And>i. i < length xs \<Longrightarrow> xs ! i = xs' ! f i" by auto
  note [simp] = list_all2_lengthD[OF xsys',symmetric]
  note [simp] = atLeast0LessThan[symmetric]
  note bij =  permutes_bij[OF perm]
  define ys where "ys \<equiv> map (nth ys' \<circ> f) [0..<length ys']"
  then have [simp]: "length ys = length ys'" by auto
  have "mset ys = mset (map (nth ys') (map f [0..<length ys']))"
   unfolding ys_def by auto
  also have "... = image_mset (nth ys') (image_mset f (mset [0..<length ys']))"
    by (simp add: multiset.map_comp)
  also have "(mset [0..<length ys']) = mset_set {0..<length ys'}"
    by (metis mset_sorted_list_of_multiset sorted_list_of_mset_set sorted_list_of_set_range)
  also have "image_mset f (...) = mset_set (f ` {..<length ys'})"
    using subset_inj_on[OF bij_is_inj[OF bij]] by (subst image_mset_mset_set, auto)
  also have "... = mset [0..<length ys']" using perm by (simp add: permutes_image)
  also have "image_mset (nth ys') ... = mset ys'" by(fold mset_map, unfold map_nth, auto)
  finally have "mset ys = Y" using ys' by auto
  moreover have "list_all2 rel xs ys"
  proof(rule list_all2_all_nthI)
    fix i assume i: "i < length xs"
    with * have "xs ! i = xs' ! f i" by auto
    also from i permutes_in_image[OF perm]
    have "rel (xs' ! f i) (ys' ! f i)" by (intro list_all2_nthD[OF xsys'], auto)
    finally show "rel (xs ! i) (ys ! i)" unfolding ys_def using i by simp
  qed simp
  ultimately show ?thesis by auto
qed

lemma rel_mset_split:
  assumes rel: "rel_mset rel (X1+X2) Y"
  shows "\<exists>Y1 Y2. Y = Y1 + Y2 \<and> rel_mset rel X1 Y1 \<and> rel_mset rel X2 Y2"
proof-
  obtain xs1 where xs1: "mset xs1 = X1" using ex_mset by auto
  obtain xs2 where xs2: "mset xs2 = X2" using ex_mset by auto
  from xs1 xs2 have "mset (xs1 @ xs2) = X1 + X2" by auto
  from rel_mset_free[OF rel this] obtain ys
    where ys: "mset ys = Y" "list_all2 rel (xs1 @ xs2) ys" by auto
  then obtain ys1 ys2
    where ys12: "ys = ys1 @ ys2"
      and xs1ys1: "list_all2 rel xs1 ys1"
      and xs2ys2: "list_all2 rel xs2 ys2"
    using list_all2_append1 by blast
  from ys12 ys have "Y = mset ys1 + mset ys2" by auto
  moreover from xs1 xs1ys1 have "rel_mset rel X1 (mset ys1)" unfolding rel_mset_def by auto
  moreover from xs2 xs2ys2 have "rel_mset rel X2 (mset ys2)" unfolding rel_mset_def by auto
  ultimately show ?thesis by (subst exI[of _ "mset ys1"], subst exI[of _ "mset ys2"],auto)
qed

lemma rel_mset_OO:
  assumes AB: "rel_mset R A B" and BC: "rel_mset S B C"
  shows "rel_mset (R OO S) A C"
proof-
  from AB obtain as bs where A_as: "A = mset as" and B_bs: "B = mset bs" and as_bs: "list_all2 R as bs"
    by (auto simp: rel_mset_def)
  from rel_mset_free[OF BC] B_bs obtain cs where C_cs: "C = mset cs" and bs_cs: "list_all2 S bs cs"
    by auto
  from list_all2_trans[OF _ as_bs bs_cs, of "R OO S"] A_as C_cs
  show ?thesis by (auto simp: rel_mset_def)
qed

(* a variant for "right" *)

  define ysa where "ysa = take j ys' @ drop (Suc j) ys'"
  have "mset ys' = {#y#} + mset ysa"
    unfolding ysa_def using j_len nth_j
    by (metis Cons_nth_drop_Suc union_mset_add_mset_right add_mset_remove_trivial add_diff_cancel_left'
        append_take_drop_id mset.simps(2) mset_append)
  hence ms_y: "mset ysa = mset ys"
    by (simp add: Cons.prems)
  then obtain xsa where
    len_a: "length ysa = length xsa" and ms_a: "mset (zip xsa ysa) = mset (zip xs ys)"
    using Cons.hyps(2) by blast

  define xs' where "xs' = take j xsa @ x # drop j xsa"
  have ys': "ys' = take j ysa @ y # drop j ysa"
    using ms_y j_len nth_j Cons.prems ysa_def
    by (metis append_eq_append_conv append_take_drop_id diff_Suc_Suc Cons_nth_drop_Suc length_Cons
      length_drop size_mset)
  have j_len': "j \<le> length ysa"
    using j_len ys' ysa_def
    by (metis add_Suc_right append_take_drop_id length_Cons length_append less_eq_Suc_le not_less)
  have "length ys' = length xs'"
    unfolding xs'_def using Cons.prems len_a ms_y
    by (metis add_Suc_right append_take_drop_id length_Cons length_append mset_eq_length)
  moreover have "mset (zip xs' ys') = mset (zip (x # xs) (y # ys))"
    unfolding ys' xs'_def
    apply (rule HOL.trans[OF mset_zip_take_Cons_drop_twice])
    using j_len' by (auto simp: len_a ms_a)
  ultimately show ?case
    by blast
qed

lemma list_all2_reorder_right_invariance:
  assumes rel: "list_all2 R xs ys" and ms_y: "mset ys' = mset ys"
  shows "\<exists>xs'. list_all2 R xs' ys' \<and> mset xs' = mset xs"
proof -
  have len: "length xs = length ys"
    using rel list_all2_conv_all_nth by auto
  obtain xs' where
    len': "length xs' = length ys'" and ms_xy: "mset (zip xs' ys') = mset (zip xs ys)"
    using len ms_y by (metis ex_mset_zip_right)
  have "list_all2 R xs' ys'"
    using assms(1) len' ms_xy unfolding list_all2_iff by (blast dest: mset_eq_setD)
  moreover have "mset xs' = mset xs"
    using len len' ms_xy map_fst_zip mset_map by metis
  ultimately show ?thesis
    by blast
qed

lemma rel_mset_via_perm: "rel_mset rel (mset xs) (mset ys) \<longleftrightarrow> (\<exists>zs. mset xs = mset zs \<and> list_all2 rel zs ys)"
proof (unfold rel_mset_def, intro iffI, goal_cases)
  case 1
  then obtain zs ws where zs: "mset zs = mset xs" and ws: "mset ws = mset ys" and zsws: "list_all2 rel zs ws" by auto
  note list_all2_reorder_right_invariance[OF zsws ws[symmetric], unfolded zs]
  then show ?case by (auto dest: sym)
next
  case 2
  from this show ?case by force
qed

end


theory LastVotingProof
imports LastVotingDefs "../Majorities" "../Reduction"
begin

subsection {* Preliminary Lemmas *}

text {*
  We begin by proving some simple lemmas about the utility functions
  used in the model of \emph{LastVoting}. We also specialize the induction
  rules of the generic CHO model for this particular algorithm.
*}

lemma timeStampsRcvdFinite:
  "finite {ts . \<exists>q v. (msgs::Proc \<rightharpoonup> 'val msg) q = Some (ValStamp v ts)}"
  (is "finite ?ts")
proof -
  have "?ts = stamp ` the ` msgs ` (valStampsRcvd msgs)"
    by (force simp add: valStampsRcvd_def image_def)
  thus ?thesis by auto
qed

lemma highestStampRcvd_exists:
  assumes nempty: "valStampsRcvd msgs \<noteq> {}"
  obtains p v where "msgs p = Some (ValStamp v (highestStampRcvd msgs))"
proof -
  let ?ts = "{ts . \<exists>q v. msgs q = Some (ValStamp v ts)}"
  from nempty have "?ts \<noteq> {}" by (auto simp add: valStampsRcvd_def)
  with timeStampsRcvdFinite
  have "highestStampRcvd msgs \<in> ?ts"
    unfolding highestStampRcvd_def by (rule Max_in)
  then obtain p v where "msgs p = Some (ValStamp v (highestStampRcvd msgs))"
    by (auto simp add: highestStampRcvd_def)
  with that show thesis .
qed

lemma highestStampRcvd_max:
  assumes "msgs p = Some (ValStamp v ts)"
  shows "ts \<le> highestStampRcvd msgs"
  using assms unfolding highestStampRcvd_def
  by (blast intro: Max_ge timeStampsRcvdFinite)

lemma phase_Suc:
  "phase (Suc r) = (if step r = 3 then Suc (phase r)
                   else phase r)"
  unfolding step_def phase_def by presburger

text {*
  Many proofs are by induction on runs of the LastVoting algorithm, and
  we derive a specific induction rule to support these proofs.
*}

lemma LV_induct:
  assumes run: "CHORun LV_M rho HOs coords"
  and init: "\<forall>p. CinitState LV_M p (rho 0 p) (coords 0 p) \<Longrightarrow> P 0"
  and step0: "\<And>r.
                  \<lbrakk> step r = 0; P r; phase (Suc r) = phase r; step (Suc r) = 1;
                    \<forall>p. next0 r p (rho r p)
                              (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                              (coords (Suc r) p)
                              (rho (Suc r) p) \<rbrakk>
                  \<Longrightarrow> P (Suc r)"
  and step1: "\<And>r.
                  \<lbrakk> step r = 1; P r; phase (Suc r) = phase r; step (Suc r) = 2;
                    \<forall>p. next1 r p (rho r p)
                              (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                              (coords (Suc r) p)
                              (rho (Suc r) p) \<rbrakk>
                  \<Longrightarrow> P (Suc r)"
  and step2: "\<And>r.
                  \<lbrakk> step r = 2; P r; phase (Suc r) = phase r; step (Suc r) = 3;
                    \<forall>p. next2 r p (rho r p)
                              (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                              (coords (Suc r) p)
                              (rho (Suc r) p) \<rbrakk>
                  \<Longrightarrow> P (Suc r)"
  and step3: "\<And>r.
                  \<lbrakk> step r = 3; P r; phase (Suc r) = Suc (phase r); step (Suc r) = 0;
                    \<forall>p. next3 r p (rho r p)
                              (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                              (coords (Suc r) p)
                              (rho (Suc r) p) \<rbrakk>
                  \<Longrightarrow> P (Suc r)"
  shows "P n"
proof (rule CHORun_induct[OF run])
  assume "CHOinitConfig LV_M (rho 0) (coords 0)"
  thus "P 0" by (auto simp add: CHOinitConfig_def init)
next
  fix r
  assume ih: "P r"
    and nxt: "CHOnextConfig LV_M r (rho r) (HOs r)
                                 (coords (Suc r)) (rho (Suc r))"
  have "step r \<in> {0,1,2,3}" by (auto simp add: step_def)
  thus "P (Suc r)"
  proof auto
    assume stp: "step r = 0"
    hence "step (Suc r) = 1"
      by (auto simp add: step_def mod_Suc)
    with ih nxt stp show ?thesis
      by (intro step0)
         (auto simp: LV_CHOMachine_def CHOnextConfig_eq
                     LV_nextState_def LV_sendMsg_def phase_Suc)
  next
    assume stp: "step r = Suc 0"
    hence "step (Suc r) = 2"
      by (auto simp add: step_def mod_Suc)
    with ih nxt stp show ?thesis
      by (intro step1)
         (auto simp: LV_CHOMachine_def CHOnextConfig_eq
                     LV_nextState_def LV_sendMsg_def phase_Suc)
  next
    assume stp: "step r = 2"
    hence "step (Suc r) = 3"
      by (auto simp add: step_def mod_Suc)
    with ih nxt stp show ?thesis
      by (intro step2)
         (auto simp: LV_CHOMachine_def CHOnextConfig_eq
                     LV_nextState_def LV_sendMsg_def phase_Suc)
  next
    assume stp: "step r = 3"
    hence "step (Suc r) = 0"
      by (auto simp add: step_def mod_Suc)
    with ih nxt stp show ?thesis
      by (intro step3)
         (auto simp: LV_CHOMachine_def CHOnextConfig_eq
                     LV_nextState_def LV_sendMsg_def phase_Suc)
  qed
qed

text {*
  The following rule similarly establishes a property of two successive
  configurations of a run by case distinction on the step that was executed.
*}

lemma LV_Suc:
  assumes run: "CHORun LV_M rho HOs coords"
  and step0: "\<lbrakk> step r = 0; step (Suc r) = 1; phase (Suc r) = phase r;
                \<forall>p. next0 r p (rho r p)
                          (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                          (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
              \<Longrightarrow> P r"
  and step1: "\<lbrakk> step r = 1; step (Suc r) = 2; phase (Suc r) = phase r;
                \<forall>p. next1 r p (rho r p)
                          (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                          (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
              \<Longrightarrow> P r"
  and step2: "\<lbrakk> step r = 2; step (Suc r) = 3; phase (Suc r) = phase r;
                \<forall>p. next2 r p (rho r p)
                          (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                          (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
              \<Longrightarrow> P r"
  and step3: "\<lbrakk> step r = 3; step (Suc r) = 0; phase (Suc r) = Suc (phase r);
                \<forall>p. next3 r p (rho r p)
                          (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                          (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
              \<Longrightarrow> P r"
  shows "P r"
proof -
  from run
  have nxt: "CHOnextConfig LV_M r (rho r) (HOs r)
                                  (coords (Suc r)) (rho (Suc r))"
    by (auto simp add: CHORun_eq)
  have "step r \<in> {0,1,2,3}" by (auto simp add: step_def)
  thus "P r"
  proof (auto)
    assume stp: "step r = 0"
    hence "step (Suc r) = 1"
      by (auto simp add: step_def mod_Suc)
    with nxt stp show ?thesis
      by (intro step0)
         (auto simp: LV_CHOMachine_def CHOnextConfig_eq
                     LV_nextState_def LV_sendMsg_def phase_Suc)
  next
    assume stp: "step r = Suc 0"
    hence "step (Suc r) = 2"
      by (auto simp add: step_def mod_Suc)
    with nxt stp show ?thesis
      by (intro step1)
         (auto simp: LV_CHOMachine_def CHOnextConfig_eq
                     LV_nextState_def LV_sendMsg_def phase_Suc)
  next
    assume stp: "step r = 2"
    hence "step (Suc r) = 3"
      by (auto simp add: step_def mod_Suc)
    with nxt stp show ?thesis
      by (intro step2)
         (auto simp: LV_CHOMachine_def CHOnextConfig_eq
                     LV_nextState_def LV_sendMsg_def phase_Suc)
  next
    assume stp: "step r = 3"
    hence "step (Suc r) = 0"
      by (auto simp add: step_def mod_Suc)
    with nxt stp show ?thesis
      by (intro step3)
         (auto simp: LV_CHOMachine_def CHOnextConfig_eq
                     LV_nextState_def LV_sendMsg_def phase_Suc)
  qed
qed

text {*
  Sometimes the assertion to prove talks about a specific process and follows
  from the next-state relation of that particular process. We prove corresponding
  variants of the induction and case-distinction rules. When these variants are
  applicable, they help automating the Isabelle proof.
*}

lemma LV_induct':
  assumes run: "CHORun LV_M rho HOs coords"
  and init: "CinitState LV_M p (rho 0 p) (coords 0 p) \<Longrightarrow> P p 0"
  and step0: "\<And>r. \<lbrakk> step r = 0; P p r; phase (Suc r) = phase r; step (Suc r) = 1;
                     next0 r p (rho r p)
                           (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                           (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
                  \<Longrightarrow> P p (Suc r)"
  and step1: "\<And>r. \<lbrakk> step r = 1; P p r; phase (Suc r) = phase r; step (Suc r) = 2;
                     next1 r p (rho r p)
                           (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                           (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
                  \<Longrightarrow> P p (Suc r)"
  and step2: "\<And>r. \<lbrakk> step r = 2; P p r; phase (Suc r) = phase r; step (Suc r) = 3;
                     next2 r p (rho r p)
                           (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                           (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
                  \<Longrightarrow> P p (Suc r)"
  and step3: "\<And>r. \<lbrakk> step r = 3; P p r; phase (Suc r) = Suc (phase r); step (Suc r) = 0;
                     next3 r p (rho r p)
                           (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                           (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
                  \<Longrightarrow> P p (Suc r)"
  shows "P p n"
  by (rule LV_induct[OF run])
     (auto intro: init step0 step1 step2 step3)

lemma LV_Suc':
  assumes run: "CHORun LV_M rho HOs coords"
  and step0: "\<lbrakk> step r = 0; step (Suc r) = 1; phase (Suc r) = phase r;
                next0 r p (rho r p)
                      (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                      (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
              \<Longrightarrow> P p r"
  and step1: "\<lbrakk> step r = 1; step (Suc r) = 2; phase (Suc r) = phase r;
                next1 r p (rho r p)
                      (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                      (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
              \<Longrightarrow> P p r"
  and step2: "\<lbrakk> step r = 2; step (Suc r) = 3; phase (Suc r) = phase r;
                next2 r p (rho r p)
                      (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                      (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
              \<Longrightarrow> P p r"
  and step3: "\<lbrakk> step r = 3; step (Suc r) = 0; phase (Suc r) = Suc (phase r);
                next3 r p (rho r p)
                      (HOrcvdMsgs LV_M r p (HOs r p) (rho r))
                      (coords (Suc r) p) (rho (Suc r) p) \<rbrakk>
              \<Longrightarrow> P p r"
  shows "P p r"
  by (rule LV_Suc[OF run])
     (auto intro: step0 step1 step2 step3)

subsection {* Boundedness and Monotonicity of Timestamps *}

text {*
  The timestamp of any process is bounded by the current phase.
*}

lemma LV_timestamp_bounded:
  assumes run: "CHORun LV_M rho HOs coords"
  shows "timestamp (rho n p) \<le> (if step n < 2 then phase n else Suc (phase n))"
        (is "?P p n")
  by (rule LV_induct' [OF run, where P="?P"])
     (auto simp: LV_CHOMachine_def LV_initState_def
                 next0_def next1_def next2_def next3_def)

text {*
  Moreover, timestamps can only grow over time.
*}

lemma LV_timestamp_increasing:
  assumes run: "CHORun LV_M rho HOs coords"
  shows "timestamp (rho n p) \<le> timestamp (rho (Suc n) p)"
    (is "?P p n" is "?ts \<le> _")
proof (rule LV_Suc'[OF run, where P="?P"])
  txt {* The case of @{text next1} is the only interesting one because the
    timestamp may change: here we use the previously established fact that
    the timestamp is bounded by the phase number. *}
  assume stp: "step n = 1"
     and nxt: "next1 n p (rho n p)
                     (HOrcvdMsgs LV_M n p (HOs n p) (rho n))
                     (coords (Suc n) p) (rho (Suc n) p)"
  from stp have "?ts \<le> phase n"
    using LV_timestamp_bounded[OF run, where n=n, where p=p] by auto
  with nxt show ?thesis by (auto simp add: next1_def)
qed (auto simp add: next0_def next2_def next3_def)

lemma LV_timestamp_monotonic:
  assumes run: "CHORun LV_M rho HOs coords" and le: "m \<le> n"
  shows "timestamp (rho m p) \<le> timestamp (rho n p)"
    (is "?ts m \<le> _")
proof -
  from le obtain k where k: "n = m+k"
    by (auto simp add: le_iff_add)
  have "?ts m \<le> ?ts (m+k)" (is "?P k")
  proof (induct k)
    case 0 show "?P 0" by simp
  next
    fix k
    assume ih: "?P k"
    from run have "?ts (m+k) \<le> ?ts (m + Suc k)"
      by (auto simp add: LV_timestamp_increasing)
    with ih show "?P (Suc k)" by simp
  qed
  with k show ?thesis by simp
qed

text {*
  The following definition collects the set of processes whose timestamp
  is beyond a given bound at a system state.
*}

definition procsBeyondTS where
  "procsBeyondTS ts cfg \<equiv> { p . ts \<le> timestamp (cfg p) }"

text {*
  Since timestamps grow monotonically, so does the set of processes
  that are beyond a certain bound.
*}

lemma procsBeyondTS_monotonic:
  assumes run: "CHORun LV_M rho HOs coords"
      and p: "p \<in> procsBeyondTS ts (rho m)" and le: "m \<le> n"
  shows "p \<in> procsBeyondTS ts (rho n)"
proof -
  from p have "ts \<le> timestamp (rho m p)" (is "_ \<le> ?ts m")
    by (simp add: procsBeyondTS_def)
  moreover
  from run le have "?ts m \<le> ?ts n" by (rule LV_timestamp_monotonic)
  ultimately show ?thesis
    by (simp add: procsBeyondTS_def)
qed

subsection {* Obvious Facts About the Algorithm *}

text {*
  The following lemmas state some very obvious facts that follow
  ``immediately'' from the definition of the algorithm. We could
  prove them in one fell swoop by defining a big invariant, but it
  appears more readable to prove them separately.
*}

text {*
  Coordinators change only at step 3.
*}

lemma notStep3EqualCoord:
  assumes run: "CHORun LV_M rho HOs coords" and stp:"step r \<noteq> 3"
  shows "coord\<Phi> (rho (Suc r) p) = coord\<Phi> (rho r p)" (is "?P p r")
  by (rule LV_Suc'[OF run, where P="?P"])
     (auto simp: stp next0_def next1_def next2_def)

lemma coordinators:
assumes run: "CHORun LV_M rho HOs coords"
shows "coord\<Phi> (rho r p) = coords (4*(phase r)) p"
proof -
  let ?r0 = "(4*(phase r) - 1)"
  let ?r1 = "(4*(phase r))"
  have "coord\<Phi> (rho ?r1 p) = coords ?r1 p"
  proof (cases "phase r > 0")
    case False
    hence "phase r = 0" by auto
    with run show ?thesis
      by (auto simp: LV_CHOMachine_def CHORun_eq CHOinitConfig_def
                     LV_initState_def)
  next
    case True
    hence "step (Suc ?r0) = 0" by (auto simp: step_def)
    hence "step ?r0 = 3" by (auto simp: mod_Suc step_def)
    moreover
    from run
    have "LV_nextState ?r0 p (rho ?r0 p)
                  (HOrcvdMsgs LV_M ?r0 p (HOs ?r0 p) (rho ?r0))
                  (coords (Suc ?r0) p) (rho (Suc ?r0) p)"
      by (auto simp: LV_CHOMachine_def CHORun_eq CHOnextConfig_eq)
    ultimately
    have nxt: "next3 ?r0 p (rho ?r0 p)
                      (HOrcvdMsgs LV_M ?r0 p (HOs ?r0 p) (rho ?r0))
                      (coords (Suc ?r0) p) (rho (Suc ?r0) p)"
      by (auto simp: LV_nextState_def)
    hence "coord\<Phi> (rho (Suc ?r0) p) = coords (Suc ?r0) p"
      by (auto simp: next3_def)
    with True show ?thesis by auto
  qed
  moreover
  from run
  have "coord\<Phi> (rho (Suc (Suc (Suc ?r1))) p) = coord\<Phi> (rho ?r1 p)
        \<and> coord\<Phi> (rho (Suc (Suc ?r1)) p) = coord\<Phi> (rho ?r1 p)
        \<and> coord\<Phi> (rho (Suc ?r1) p) = coord\<Phi> (rho ?r1 p)"
    by (auto simp: notStep3EqualCoord step_def phase_def mod_Suc)
  moreover
  have "r \<in> {?r1, Suc ?r1, Suc (Suc ?r1), Suc (Suc (Suc ?r1))}"
    by (auto simp: step_def phase_def mod_Suc)
  ultimately
  show ?thesis by auto
qed

text {*
  Votes only change at step 0.
*}

lemma notStep0EqualVote [rule_format]:
  assumes run: "CHORun LV_M rho HOs coords"
  shows "step r \<noteq> 0 \<longrightarrow> vote (rho (Suc r) p) = vote (rho r p)" (is "?P p r")
  by (rule LV_Suc'[OF run, where P="?P"])
     (auto simp: next0_def next1_def next2_def next3_def)

text {*
  Commit status only changes at steps 0 and 3.
*}

lemma notStep03EqualCommit [rule_format]:
  assumes run: "CHORun LV_M rho HOs coords"
  shows "step r \<noteq> 0 \<and> step r \<noteq> 3 \<longrightarrow> commt (rho (Suc r) p) = commt (rho r p)"
        (is "?P p r")
  by (rule LV_Suc'[OF run, where P="?P"])
     (auto simp: next0_def next1_def next2_def next3_def)

text {*
  Timestamps only change at step 1.
*}

lemma notStep1EqualTimestamp [rule_format]:
  assumes run: "CHORun LV_M rho HOs coords"
  shows "step r \<noteq> 1 \<longrightarrow> timestamp (rho (Suc r) p) = timestamp (rho r p)"
        (is "?P p r")
  by (rule LV_Suc'[OF run, where P="?P"])
     (auto simp: next0_def next1_def next2_def next3_def)

text {*
  The @{text x} field only changes at step 1.
*}

lemma notStep1EqualX [rule_format]:
  assumes run: "CHORun LV_M rho HOs coords"
  shows "step r \<noteq> 1 \<longrightarrow> x (rho (Suc r) p) = x (rho r p)" (is "?P p r")
  by (rule LV_Suc'[OF run, where P="?P"])
     (auto simp: next0_def next1_def next2_def next3_def)

text {*
  A process $p$ has its @{text commt} flag set only if the following conditions hold:
  \begin{itemize}
  \item the step number is at least $1$,
  \item $p$ considers itself to be the coordinator,
  \item $p$ has a non-null @{text vote},
  \item a majority of processes consider $p$ as their coordinator.
  \end{itemize}
*}

lemma commitE:
  assumes run: "CHORun LV_M rho HOs coords" and cmt: "commt (rho r p)"
  and conds: "\<lbrakk> 1 \<le> step r; coord\<Phi> (rho r p) = p; vote (rho r p) \<noteq> None;
                card {q . coord\<Phi> (rho r q) = p} > N div 2
              \<rbrakk> \<Longrightarrow> A"
  shows "A"
proof -
  have "commt (rho r p) \<longrightarrow>
          1 \<le> step r
        \<and> coord\<Phi> (rho r p) = p
        \<and> vote (rho r p) \<noteq> None
        \<and> card {q . coord\<Phi> (rho r q) = p} > N div 2"
    (is "?P p r" is "_ \<longrightarrow> ?R r")
  proof (rule LV_induct'[OF run, where P="?P"])
    -- {* the only interesting step is step 0 *}
    fix n
    assume nxt: "next0 n p (rho n p) (HOrcvdMsgs LV_M n p (HOs n p) (rho n))
                           (coords (Suc n) p) (rho (Suc n) p)"
       and ph: "phase (Suc n) = phase n"
       and stp: "step n = 0" and stp': "step (Suc n) = 1"
       and ih: "?P p n"
    show "?P p (Suc n)"
    proof
      assume cm': "commt (rho (Suc n) p)"
      from stp ih have cm: "\<not> commt (rho n p)" by simp
      with nxt cm'
      have "coord\<Phi> (rho n p) = p
            \<and> vote (rho (Suc n) p) \<noteq> None
            \<and> card (valStampsRcvd (HOrcvdMsgs LV_M n p (HOs n p) (rho n)))
                 > N div 2"
        by (auto simp add: next0_def)
      moreover
      from stp
      have "valStampsRcvd (HOrcvdMsgs LV_M n p (HOs n p) (rho n))
             \<subseteq> {q . coord\<Phi> (rho n q) = p}"
        by (auto simp: valStampsRcvd_def LV_CHOMachine_def
                       HOrcvdMsgs_def  LV_sendMsg_def send0_def)
      hence "card (valStampsRcvd (HOrcvdMsgs LV_M n p (HOs n p)  (rho n)))
              \<le> card {q . coord\<Phi> (rho n q) = p}"
        by (auto intro: card_mono)
      moreover
      note stp stp' run
      ultimately
      show "?R (Suc n)" by (auto simp: notStep3EqualCoord)
    qed
  -- {* the remaining cases are all solved by expanding the definitions *}
  qed (auto simp: LV_CHOMachine_def LV_initState_def next1_def next2_def
                  next3_def notStep3EqualCoord[OF run])
  with cmt show ?thesis by (intro conds, auto)
qed

text {*
  A process has a current timestamp only if:
  \begin{itemize}
  \item it is at step 2 or beyond,
  \item its coordinator has committed,
  \item its @{text x} value is the @{text vote} of its coordinator.
  \end{itemize}
*}

lemma currentTimestampE:
  assumes run: "CHORun LV_M rho HOs coords"
  and ts: "timestamp (rho r p) = Suc (phase r)"
  and conds: "\<lbrakk> 2 \<le> step r;
                commt (rho r (coord\<Phi> (rho r p)));
                x (rho r p) = the (vote (rho r (coord\<Phi> (rho r p))))
              \<rbrakk> \<Longrightarrow> A"
  shows "A"
proof -
  let "?ts n" = "timestamp (rho n p)"
  let "?crd n" = "coord\<Phi> (rho n p)"
  have "?ts r = Suc (phase r) \<longrightarrow>
           2 \<le> step r
         \<and> commt (rho r (?crd r))
         \<and> x (rho r p) = the (vote (rho r (?crd r)))"
    (is "?Q p r" is "_ \<longrightarrow> ?R r")
  proof (rule LV_induct'[OF run, where P="?Q"])
    -- {* The assertion is trivially true initially because the timestamp is 0. *}
    assume "CinitState LV_M p (rho 0 p) (coords 0 p)" thus "?Q p 0"
      by (auto simp: LV_CHOMachine_def LV_initState_def)
  next
    txt {* The assertion is trivially preserved by step 0 because the timestamp in the
          post-state cannot be current (cf. lemma @{text LV_timestamp_bounded}). *}
    fix n
    assume stp': "step (Suc n) = 1"
    with run LV_timestamp_bounded[where n="Suc n"]
    have "?ts (Suc n) \<le> phase (Suc n)" by auto
    thus "?Q p (Suc n)" by simp
  next
    txt {* Step 1 establishes the assertion by definition of the transition relation. *}
    fix n
    assume stp: "step n = 1" and stp':"step (Suc n) = 2"
       and ph: "phase (Suc n) = phase n"
       and nxt: "next1 n p (rho n p) (HOrcvdMsgs LV_M n p (HOs n p) (rho n))
                           (coords (Suc n) p) (rho (Suc n) p)"
    show "?Q p (Suc n)"
    proof
      assume ts: "?ts (Suc n) = Suc (phase (Suc n))"
      from run stp LV_timestamp_bounded[where n=n]
      have "?ts n \<le> phase n" by auto
      moreover
      from run stp
      have "vote (rho (Suc n) (?crd (Suc n))) = vote (rho n (?crd n))"
        by (auto simp: notStep3EqualCoord notStep0EqualVote)
      moreover
      from run stp
      have "commt (rho (Suc n) (?crd (Suc n))) = commt (rho n (?crd n))"
        by (auto simp: notStep3EqualCoord notStep03EqualCommit)
      moreover
      note ts nxt stp stp' ph
      ultimately
      show "?R (Suc n)"
        by (auto simp: LV_CHOMachine_def HOrcvdMsgs_def LV_sendMsg_def
                       next1_def send1_def isVote_def)
    qed
  next
    txt {* For step 2, the assertion follows from the induction hypothesis,
          observing that none of the relevant state components change. *}
    fix n
    assume stp: "step n = 2" and stp': "step (Suc n) = 3"
       and ph: "phase (Suc n) = phase n"
       and ih: "?Q p n"
       and nxt: "next2 n p (rho n p) (HOrcvdMsgs LV_M n p (HOs n p) (rho n))
                           (coords (Suc n) p) (rho (Suc n) p)"
    show "?Q p (Suc n)"
    proof
      assume ts: "?ts (Suc n) = Suc (phase (Suc n))"
      from run stp
      have vt: "vote (rho (Suc n) (?crd (Suc n))) = vote (rho n (?crd n))"
        by (auto simp add: notStep3EqualCoord notStep0EqualVote)
      from run stp
      have cmt: "commt (rho (Suc n) (?crd (Suc n))) = commt (rho n (?crd n))"
        by (auto simp add: notStep3EqualCoord notStep03EqualCommit)
      with vt ts ph stp stp' ih nxt
      show "?R (Suc n)"
        by (auto simp add: next2_def)
    qed
  next
    txt {* The assertion is trivially preserved by step 3 because the timestamp in the
          post-state cannot be current (cf. lemma @{text LV_timestamp_bounded}). *}
    fix n
    assume stp': "step (Suc n) = 0"
    with run LV_timestamp_bounded[where n="Suc n"]
    have "?ts (Suc n) \<le> phase (Suc n)" by auto
    thus "?Q p (Suc n)" by simp
  qed
  with ts show ?thesis by (intro conds) auto
qed

text {*
  If a process @{text p} has its @{text ready} bit set then:
  \begin{itemize}
  \item it is at step 3,
  \item it considers itself to be the coordinator of that phase and
  \item a majority of processes considers @{text p} to be the coordinator
    and has a current timestamp.
  \end{itemize}
*}

lemma readyE:
  assumes run: "CHORun LV_M rho HOs coords" and rdy: "ready (rho r p)"
  and conds: "\<lbrakk> step r = 3; coord\<Phi> (rho r p) = p;
                card { q . coord\<Phi> (rho r q) = p
                         \<and> timestamp (rho r q) = Suc (phase r) } > N div 2
              \<rbrakk> \<Longrightarrow> P"
  shows P
proof -
  let "?qs n" = "{ q . coord\<Phi> (rho n q) = p
                     \<and> timestamp (rho n q) = Suc (phase n) }"
  have "ready (rho r p) \<longrightarrow>
          step r = 3
        \<and> coord\<Phi> (rho r p) = p
        \<and> card (?qs r) > N div 2"
    (is "?Q p r"  is "_ \<longrightarrow> ?R p r")
  proof (rule LV_induct'[OF run, where P="?Q"])
    -- {* the interesting case is step 2 *}
    fix n
    assume stp: "step n = 2" and stp': "step (Suc n) = 3"
       and ih: "?Q p n" and ph: "phase (Suc n) = phase n"
       and nxt: "next2 n p (rho n p) (HOrcvdMsgs LV_M n p (HOs n p) (rho n))
                           (coords (Suc n) p) (rho (Suc n) p)"
    show "?Q p (Suc n)"
    proof
      assume rdy: "ready (rho (Suc n) p)"
      from stp ih have nrdy: "\<not> ready (rho n p)" by simp
      with rdy nxt have "coord\<Phi> (rho n p) = p"
        by (auto simp: next2_def)
      with run stp have coord: "coord\<Phi> (rho (Suc n) p) = p"
        by (simp add: notStep3EqualCoord)
      let ?acks = "acksRcvd (HOrcvdMsgs LV_M n p (HOs n p) (rho n))"
      from nrdy rdy nxt have aRcvd: "card ?acks > N div 2"
        by (auto simp: next2_def)
      have "?acks \<subseteq> ?qs (Suc n)"
      proof (clarify)
        fix q
        assume q: "q \<in> ?acks"
        with stp
        have n: "coord\<Phi> (rho n q) = p \<and> timestamp (rho n q) = Suc (phase n)"
          by (auto simp: LV_CHOMachine_def HOrcvdMsgs_def LV_sendMsg_def
                         acksRcvd_def send2_def isAck_def)
        with run stp ph
        show "coord\<Phi> (rho (Suc n) q) = p
              \<and> timestamp (rho (Suc n) q) = Suc (phase (Suc n))"
          by (simp add: notStep3EqualCoord notStep1EqualTimestamp)
      qed
      hence "card ?acks \<le> card (?qs (Suc n))"
        by (intro card_mono) auto
      with stp' coord aRcvd show "?R p (Suc n)"
        by auto
    qed
    -- {* the remaining steps are all solved trivially *}
  qed (auto simp: LV_CHOMachine_def LV_initState_def
                  next0_def next1_def next3_def)
  with rdy show ?thesis by (blast intro: conds)
qed

text {*
  A process decides only if the following conditions hold:
  \begin{itemize}
  \item it is at step 3,
  \item its coordinator votes for the value the process decides on,
  \item the coordinator has its @{text ready} and @{text commt} bits set.
  \end{itemize}
*}

lemma decisionE:
  assumes run: "CHORun LV_M rho HOs coords"
  and dec: "decide (rho (Suc r) p) \<noteq> decide (rho r p)"
  and conds: "\<lbrakk>
        step r = 3;
        decide (rho (Suc r) p) = Some (the (vote (rho r (coord\<Phi> (rho r p)))));
        ready (rho r (coord\<Phi> (rho r p))); commt (rho r (coord\<Phi> (rho r p)))
      \<rbrakk> \<Longrightarrow> P"
  shows P
proof -
  let ?cfg = "rho r"
  let ?cfg' = "rho (Suc r)"
  let "?crd p" = "coord\<Phi> (?cfg p)"
  let ?dec' = "decide (?cfg' p)"
  txt {* Except for the assertion about the @{text commt} field, the assertion can be
         proved directly from the next-state relation. *}
  have 1: "step r = 3
           \<and> ?dec' = Some (the (vote (?cfg (?crd p))))
           \<and> ready (?cfg (?crd p))"
    (is "?Q p r")
    proof (rule LV_Suc'[OF run, where P="?Q"])
    -- {* for step 3, we prove the thesis by expanding the relevant definitions *}
    assume "next3 r p (?cfg p) (HOrcvdMsgs LV_M r p (HOs r p) ?cfg)
                      (coords (Suc r) p) (?cfg' p)"
       and "step r = 3"
    with dec show ?thesis
      by (auto simp: next3_def send3_def isVote_def LV_CHOMachine_def
                     HOrcvdMsgs_def LV_sendMsg_def)
  next
    -- {* the other steps don't change the decision *}
    assume "next0 r p (?cfg p) (HOrcvdMsgs LV_M r p (HOs r p) ?cfg)
                      (coords (Suc r) p) (?cfg' p)"
    with dec show ?thesis by (auto simp: next0_def)
  next
    assume "next1 r p (?cfg p) (HOrcvdMsgs LV_M r p (HOs r p) ?cfg)
                      (coords (Suc r) p) (?cfg' p)"
    with dec show ?thesis by (auto simp: next1_def)
  next
    assume "next2 r p (?cfg p) (HOrcvdMsgs LV_M r p (HOs r p) ?cfg)
                      (coords (Suc r) p) (?cfg' p)"
    with dec show ?thesis by (auto simp: next2_def)
  qed
  hence "ready (?cfg (?crd p))" by blast
  txt {* Because the coordinator is ready, there is a majority of processes that
         consider it to be the coordinator and that have a current timestamp. *}
  with run
  have "card {q . ?crd q = ?crd p \<and> timestamp (?cfg q) = Suc (phase r)}
          > N div 2" by (rule readyE)
  -- {* Hence there is at least one such process \ldots *}
  hence "card {q . ?crd q = ?crd p \<and> timestamp (?cfg q) = Suc (phase r)} \<noteq> 0"
    by arith  (** auto simplifies too much **)
  then obtain q where "?crd q = ?crd p" and "timestamp (?cfg q) = Suc (phase r)"
    by auto
  -- {* \ldots\ and by a previous lemma the coordinator must have committed. *}
  with run have "commt (?cfg (?crd p))"
    by (auto elim: currentTimestampE)
  with 1 show ?thesis by (blast intro: conds)
qed

subsection {* Proof of Integrity *}

text {*
  Integrity is proved using a standard invariance argument that asserts
  that only values present in the initial state appear in the relevant
  fields.
*}

(*
  The proof mainly relies on lemmas @{text notStep1EqualX},
  @{text notStep0EqualVote}, @{text commitE} and @{text decisionE}.
*)

lemma lv_integrityInvariant:
  assumes run: "CHORun LV_M rho HOs coords"
  and inv: "\<lbrakk> range (x \<circ> (rho n)) \<subseteq> range (x \<circ> (rho 0));
              range (vote \<circ> (rho n)) \<subseteq> {None} \<union> Some ` range (x \<circ> (rho 0));
              range (decide \<circ> (rho n)) \<subseteq> {None} \<union> Some ` range (x \<circ> (rho 0))
       \<rbrakk> \<Longrightarrow> A"
  shows "A"
proof -
  let ?x0 = "range (x \<circ> rho 0)"
  let ?x0opt = "{None} \<union> Some ` ?x0"
  have "range (x \<circ> rho n) \<subseteq> ?x0
        \<and> range (vote \<circ> rho n) \<subseteq> ?x0opt
        \<and> range (decide \<circ> rho n) \<subseteq> ?x0opt"
    (is "?Inv n" is "?X n \<and> ?Vote n \<and> ?Decide n")
  proof (induct n)
    from run show "?Inv 0"
      by (auto simp: CHORun_eq CHOinitConfig_def LV_CHOMachine_def
                     LV_initState_def)
  next
    fix n
    assume ih: "?Inv n" thus "?Inv (Suc n)"
    proof (clarify)
      assume x: "?X n" and vt: "?Vote n" and dec: "?Decide n"

      txt {* Proof of first conjunct *}
      have x': "?X (Suc n)"
      proof (clarsimp)
        fix p
        from run
        show "x (rho (Suc n) p) \<in> range (\<lambda>q. x (rho 0 q))" (is "?P p n")
        proof (rule LV_Suc'[where P="?P"])
          -- {* only @{text step1} is of interest *}
          assume stp: "step n = 1"
             and nxt: "next1 n p (rho n p)
                             (HOrcvdMsgs LV_M n p (HOs n p) (rho n))
                             (coords (Suc n) p) (rho (Suc n) p)"
          show ?thesis
          proof (cases "rho (Suc n) p = rho n p")
            case True
            with x show ?thesis by auto
          next
            case False
            with stp nxt have cmt: "commt (rho n (coord\<Phi> (rho n p)))"
              and xp: "x (rho (Suc n) p) = the (vote (rho n (coord\<Phi> (rho n p))))"
            by (auto simp: next1_def LV_CHOMachine_def HOrcvdMsgs_def
                           LV_sendMsg_def send1_def isVote_def)
            from run cmt have "vote (rho n (coord\<Phi> (rho n p))) \<noteq> None"
              by (rule commitE)
            moreover
            from vt have "vote (rho n (coord\<Phi> (rho n p))) \<in> ?x0opt"
              by (auto simp add: image_def)
            moreover
            note xp
            ultimately
            show ?thesis by (force simp add: image_def)
          qed
          -- {* the other steps don't change @{text x} *}
        next
          assume "step n = 0"
          with run have "x (rho (Suc n) p) = x (rho n p)"
            by (simp add: notStep1EqualX)
          with x show ?thesis by auto
        next
          assume "step n = 2"
          with run have "x (rho (Suc n) p) = x (rho n p)"
            by (simp add: notStep1EqualX)
          with x show ?thesis by auto
        next
          assume "step n = 3"
          with run have "x (rho (Suc n) p) = x (rho n p)"
            by (simp add: notStep1EqualX)
          with x show ?thesis by auto
        qed
      qed

      txt {* Proof of second conjunct *}
      have vt': "?Vote (Suc n)"
      proof (clarsimp simp: image_def)
        fix p v
        assume v: "vote (rho (Suc n) p) = Some v"
        from run
        have "vote (rho (Suc n) p) = Some v \<longrightarrow> v \<in> ?x0" (is "?P p n")
        proof (rule LV_Suc'[where P="?P"])
          -- {* here only @{text step0} is of interest *}
          assume stp: "step n = 0"
             and nxt: "next0 n p (rho n p)
                             (HOrcvdMsgs LV_M n p (HOs n p) (rho n))
                             (coords (Suc n) p) (rho (Suc n) p)"
          show ?thesis
          proof  (cases "rho (Suc n) p = rho n p")
            case True
            from vt have "vote (rho n p) \<in> ?x0opt"
              by (auto simp: image_def)
            with True show ?thesis by auto
          next
            case False
            from nxt stp False v obtain q where "v = x (rho n q)"
              by (auto simp: next0_def send0_def LV_CHOMachine_def
                             HOrcvdMsgs_def LV_sendMsg_def)
            with x show ?thesis by (auto simp: image_def)
          qed
          -- {* the other cases don't change the vote *}
        next
          assume "step n = 1"
          with run have "vote (rho (Suc n) p) = vote (rho n p)"
            by (simp add: notStep0EqualVote)
          moreover
          from vt have "vote (rho n p) \<in> ?x0opt"
            by (auto simp: image_def)
          ultimately
          show ?thesis by auto
        next
          assume "step n = 2"
          with run have "vote (rho (Suc n) p) = vote (rho n p)"
            by (simp add: notStep0EqualVote)
          moreover
          from vt have "vote (rho n p) \<in> ?x0opt"
            by (auto simp: image_def)
          ultimately
          show ?thesis by auto
        next
          assume "step n = 3"
          with run have "vote (rho (Suc n) p) = vote (rho n p)"
            by (simp add: notStep0EqualVote)
          moreover
          from vt have "vote (rho n p) \<in> ?x0opt"
            by (auto simp: image_def)
          ultimately
          show ?thesis by auto
        qed
        with v show "\<exists>q. v = x (rho 0 q)" by auto
      qed

      txt {* Proof of third conjunct *}
      have dec': "?Decide (Suc n)"
      proof (clarsimp simp: image_def)
        fix p v
        assume v: "decide (rho (Suc n) p) = Some v"
        show "\<exists>q. v = x (rho 0 q)"
        proof (cases "decide (rho (Suc n) p) = decide (rho n p)")
          case True
          with dec True v show ?thesis by (auto simp: image_def)
        next
          case False
          let ?crd = "coord\<Phi> (rho n p)"
          from False run
          have d': "decide (rho (Suc n) p) = Some (the (vote (rho n ?crd)))"
            and cmt: "commt (rho n ?crd)"
            by (auto elim: decisionE)
          from vt have vtc: "vote (rho n ?crd) \<in> ?x0opt"
            by (auto simp: image_def)
          from run cmt have "vote (rho n ?crd) \<noteq> None"
            by (rule commitE)
          with d' v vtc show ?thesis by auto
        qed
      qed
      from x' vt' dec' show ?thesis by simp
    qed
  qed
  with inv show ?thesis by simp
qed

text {*
  Integrity now follows immediately.
*}

theorem lv_integrity:
  assumes run: "CHORun LV_M rho HOs coords"
      and dec: "decide (rho n p) = Some v"
  shows "\<exists>q. v = x (rho 0 q)"
proof -
  from run have "decide (rho n p) \<in> {None} \<union> Some ` (range (x \<circ> (rho 0)))"
    by (rule lv_integrityInvariant) (auto simp: image_def)
  with dec show ?thesis by (auto simp: image_def)
qed

subsection {* Proof of Agreement and Irrevocability *}

text {*
  The following lemmas closely follow a hand proof provided by
  Bernadette Charron-Bost.

  If a process decides, then a majority of processes have a current
  timestamp.
*}
(*
  The proof mainly relies on lemmas @{text decisionE}, @{text readyE}
  and @{text LV_timestamp_bounded}.
*)

lemma decisionThenMajorityBeyondTS:
  assumes run: "CHORun LV_M rho HOs coords"
  and dec: "decide (rho (Suc r) p) \<noteq> decide (rho r p)"
  shows "card (procsBeyondTS (Suc (phase r)) (rho r)) > N div 2"
  using run dec proof (rule decisionE)
  txt {* Lemma @{text decisionE} tells us that we are at step 3 and
    that the coordinator is ready. *}
  let ?crd = "coord\<Phi> (rho r p)"
  let ?qs = "{ q . coord\<Phi> (rho r q) = ?crd
                 \<and> timestamp (rho r q) = Suc (phase r) }"
  assume stp: "step r = 3" and rdy: "ready (rho r ?crd)"
  txt {* Now, lemma @{text readyE} implies that a majority of processes
    have a recent timestamp. *}
  from run rdy have "card ?qs > N div 2" by (rule readyE)
  moreover
  from stp LV_timestamp_bounded[OF run, where n=r]
  have "\<forall>q. timestamp (rho r q) \<le> Suc (phase r)" by auto
  hence "?qs \<subseteq> procsBeyondTS (Suc (phase r)) (rho r)"
    by (auto simp: procsBeyondTS_def)
  hence "card ?qs \<le> card (procsBeyondTS (Suc (phase r)) (rho r))"
    by (intro card_mono) auto
  ultimately show ?thesis by simp
qed

text {*
  No two different processes have their \emph{commit} flag set at any state.
*}

lemma committedProcsEqual:
  assumes run: "CHORun LV_M rho HOs coords"
  and cmt: "commt (rho r p)" and cmt': "commt (rho r p')"
  shows "p = p'"
proof -
  from run cmt have "card {q . coord\<Phi> (rho r q) = p} > N div 2"
    by (blast elim: commitE)
  moreover
  from run cmt' have "card {q . coord\<Phi> (rho r q) = p'} > N div 2"
    by (blast elim: commitE)
  ultimately
  obtain q where "coord\<Phi> (rho r q) = p" and "p' = coord\<Phi> (rho r q)"
    by (auto elim: majoritiesE')
  thus ?thesis by simp
qed

text {*
  No two different processes have their \emph{ready} flag set at any state.
*}

lemma readyProcsEqual:
  assumes run: "CHORun LV_M rho HOs coords"
  and rdy: "ready (rho r p)" and rdy': "ready (rho r p')"
  shows "p = p'"
proof -
  let "?C p" = "{q . coord\<Phi> (rho r q) = p \<and> timestamp (rho r q) = Suc (phase r)}"
  from run rdy have "card (?C p) > N div 2"
    by (blast elim: readyE)
  moreover
  from run rdy' have "card (?C p') > N div 2"
    by (blast elim: readyE)
  ultimately
  obtain q where "coord\<Phi> (rho r q) = p" and "p' = coord\<Phi> (rho r q)"
    by (auto elim: majoritiesE')
  thus ?thesis by simp
qed

text {*
  The following lemma asserts that whenever a process @{text p} commits
  at a state where a majority of processes have a timestamp beyond @{text ts},
  then @{text p} votes for a value held by some process whose timestamp is
  beyond @{text ts}.
*}
(*
  The proof mainly relies on lemmas @{text commitE}, @{text highestStampRcvd_max},
  @{text notStep1EqualTimestamp}, @{text notStep1EqualX} and then on
  lemmas @{text notStep03EqualCommit}, @{text notStep0EqualVote}, @{text commitE},
  @{text committedProcsEqual} and @{text LV_timestamp_monotonic}.
*)

lemma commitThenVoteRecent:
  assumes run: "CHORun LV_M rho HOs coords"
  and maj: "card (procsBeyondTS ts (rho r)) > N div 2"
  and cmt: "commt (rho r p)"
  shows "\<exists>q \<in> procsBeyondTS ts (rho r). vote (rho r p) = Some (x (rho r q))"
        (is "?Q r")
proof -
  let "?bynd n" = "procsBeyondTS ts (rho n)"
  have "card (?bynd r) > N div 2 \<and> commt (rho r p) \<longrightarrow> ?Q r" (is "?P p r")
  proof (rule LV_induct[OF run])
    txt {* @{text next0} establishes the property *}
    fix n
    assume stp: "step n = 0"
       and nxt: "\<forall>q. next0 n q (rho n q)
                             (HOrcvdMsgs LV_M n q (HOs n q) (rho n))
                             (coords (Suc n) q)
                             (rho (Suc n) q)"
              (is "\<forall>q. ?nxt q")
    from nxt have nxp: "?nxt p" ..
    show "?P p (Suc n)"
    proof (clarify)
      assume mj: "card (?bynd (Suc n)) > N div 2"
         and ct: "commt (rho (Suc n) p)"
      show "?Q (Suc n)"
      proof -
        let ?msgs = "HOrcvdMsgs LV_M n p (HOs n p) (rho n)"
        from stp run have "\<not> commt (rho n p)" by (auto elim: commitE)
        with nxp ct obtain q v where
          v: "?msgs q = Some (ValStamp v (highestStampRcvd ?msgs))" and
          vote: "vote (rho (Suc n) p) = Some v" and
          rcvd: "card (valStampsRcvd ?msgs) > N div 2"
          by (auto simp: next0_def)
        from mj rcvd obtain q' where
          q1': "q' \<in> ?bynd (Suc n)" and q2': "q' \<in> valStampsRcvd ?msgs"
          by (rule majoritiesE')
        have "timestamp (rho n q') \<le> timestamp (rho n q)"
        proof -
          from q2' obtain v' ts'
            where ts': "?msgs q' = Some (ValStamp v' ts')"
            by (auto simp: valStampsRcvd_def)
          hence "ts' \<le> highestStampRcvd ?msgs"
            by (rule highestStampRcvd_max)
          moreover
          from ts' stp have "timestamp (rho n q') = ts'"
            by (auto simp: LV_CHOMachine_def HOrcvdMsgs_def
                           LV_sendMsg_def send0_def)
          moreover
          from v stp have "timestamp (rho n q) = highestStampRcvd ?msgs"
            by (auto simp: LV_CHOMachine_def HOrcvdMsgs_def
                           LV_sendMsg_def send0_def)
          ultimately
          show ?thesis by simp
        qed
        moreover
        from run stp
        have "timestamp (rho (Suc n) q') = timestamp (rho n q')"
          by (simp add: notStep1EqualTimestamp)
        moreover
        from run stp
        have "timestamp (rho (Suc n) q) = timestamp (rho n q)"
          by (simp add: notStep1EqualTimestamp)
        moreover
        note q1'
        ultimately
        have "q \<in> ?bynd (Suc n)"
          by (simp add: procsBeyondTS_def)
        moreover
        from v vote stp
        have "vote (rho (Suc n) p) = Some (x (rho n q))"
          by (auto simp: LV_CHOMachine_def HOrcvdMsgs_def
                         LV_sendMsg_def send0_def)
        moreover
        from run stp have "x (rho (Suc n) q) = x (rho n q)"
          by (simp add: notStep1EqualX)
        ultimately
        show ?thesis by force
      qed
    qed

  next
    txt {* We now prove that @{text next1} preserves the property.
      Observe that @{text next1} may establish a majority of processes
      with current timestamps, so we cannot just refer to the induction
      hypothesis. However, if that happens, there is at least one process
      with a fresh timestamp that copies the vote of the (only) committed
      coordinator, thus establishing the property. *}
    fix n
    assume stp: "step n = 1"
       and nxt: "\<forall>q. next1 n q (rho n q)
                               (HOrcvdMsgs LV_M n q (HOs n q) (rho n))
                               (coords (Suc n) q)
                               (rho (Suc n) q)"
               (is "\<forall>q. ?nxt q")
       and ih: "?P p n"
    from nxt have nxp: "?nxt p" ..
    show "?P p (Suc n)"
    proof (clarify)
      assume mj': "card (?bynd (Suc n)) > N div 2"
         and ct': "commt (rho (Suc n) p)"
      from run stp ct' have ct: "commt (rho n p)"
        by (simp add: notStep03EqualCommit)
      from run stp have vote': "vote (rho (Suc n) p) = vote (rho n p)"
        by (simp add: notStep0EqualVote)
      show "?Q (Suc n)"
      proof (cases "\<exists>q \<in> ?bynd (Suc n). rho (Suc n) q \<noteq> rho n q")
        case True
        txt {* in this case the property holds because @{text q} updates
          its @{text x} field to the vote *}
        then obtain q where
          q1: "q \<in> ?bynd (Suc n)" and q2: "rho (Suc n) q \<noteq> rho n q" ..
        from nxt have "?nxt q" ..
        with q2 stp
        have  x': "x (rho (Suc n) q) = the (vote (rho n (coord\<Phi> (rho n q))))"
          and coord: "commt (rho n (coord\<Phi> (rho n q)))"
          by (auto simp: next1_def send1_def LV_CHOMachine_def HOrcvdMsgs_def
                         LV_sendMsg_def isVote_def)
        from run ct have vote: "vote (rho n p) \<noteq> None"
          by (rule commitE)
        from run coord ct have "coord\<Phi> (rho n q) = p"
          by (rule committedProcsEqual)
        with q1 x' vote vote' show ?thesis by auto
      next
        case False
        txt {* if no relevant process moves then @{text procsBeyondTS} doesn't
          change and we invoke the induction hypothesis *}
        hence bynd: "?bynd (Suc n) = ?bynd n"
        proof (auto simp: procsBeyondTS_def)
          fix r
          assume ts: "ts \<le> timestamp (rho n r)"
          from run have "timestamp (rho n r) \<le> timestamp (rho (Suc n) r)"
            by (simp add: LV_timestamp_monotonic)
          with ts show "ts \<le> timestamp (rho (Suc n) r)" by simp
        qed
        with mj' have mj: "card (?bynd n) > N div 2" by simp
        with ct ih obtain q where
          "q \<in> ?bynd n" and "vote (rho n p) = Some (x (rho n q))"
          by blast
        with vote' bynd False show ?thesis by auto
      qed
    qed

  next
    txt {* @{text step2} preserves the property, via the induction hypothesis. *}
    fix n
    assume stp: "step n = 2"
       and nxt: "\<forall>q. next2 n q (rho n q)
                               (HOrcvdMsgs LV_M n q (HOs n q) (rho n))
                               (coords (Suc n) q)
                               (rho (Suc n) q)"
               (is "\<forall>q. ?nxt q")
       and ih: "?P p n"
    from nxt have nxp: "?nxt p" ..
    show "?P p (Suc n)"
    proof (clarify)
      assume mj': "card (?bynd (Suc n)) > N div 2"
         and ct': "commt (rho (Suc n) p)"
      from run stp ct' have ct: "commt (rho n p)"
        by (simp add: notStep03EqualCommit)
      from run stp have vote': "vote (rho (Suc n) p) = vote (rho n p)"
        by (simp add: notStep0EqualVote)
      from run stp have "\<forall>q. timestamp (rho (Suc n) q) = timestamp (rho n q)"
        by (simp add: notStep1EqualTimestamp)
      hence bynd': "?bynd (Suc n) = ?bynd n"
        by (auto simp add: procsBeyondTS_def)
      from run stp have "\<forall>q. x (rho (Suc n) q) = x (rho n q)"
        by (simp add: notStep1EqualX)
      with bynd' vote' ct mj' ih show "?Q (Suc n)"
        by auto
    qed

  txt {* the initial state and the @{text step3} transition are trivial
    because the @{text commt} flag cannot be set. *}
  qed (auto elim: commitE[OF run])
  with maj cmt show ?thesis by simp
qed

text {*
  The following lemma gives the crucial argument for agreement:
  after some process @{text p} has decided, all processes whose
  timestamp is beyond the timestamp at the point of decision contain
  the decision value in their @{text x} field.
*}
(*
  The proof mainly relies on lemmas @{text LV_timestamp_bounded},
  @{text currentTimestampE}, @{text committedProcsEqual},
  @{text decisionThenMajorityBeyondTS}, @{text procsBeyondTS_monotonic}
  @{text commitThenVoteRecent}, @{text  notStep1EqualX}
  and @{text notStep1EqualTimestamp}.
*)

lemma XOfTimestampBeyondDecision:
  assumes run: "CHORun LV_M rho HOs coords"
      and dec: "decide (rho (Suc r) p) \<noteq> decide (rho r p)"
  shows "\<forall>q \<in> procsBeyondTS (Suc (phase r)) (rho (r+k)).
              x (rho (r+k) q) = the (decide (rho (Suc r) p))"
  (is "\<forall>q \<in> ?bynd k. _ = ?v" is "?P p k")
proof (induct k)
  -- {* base step *}
  show "?P p 0"
  proof (clarify)
    fix q
    assume q: "q \<in> ?bynd 0"
    txt {* use preceding lemmas about the decision value and the
      @{text x} field of processes with fresh timestamps *}
    from run dec
    have  stp: "step r = 3"
      and v: "decide (rho (Suc r) p) = Some (the (vote (rho r (coord\<Phi> (rho r p)))))"
      and cmt: "commt (rho r (coord\<Phi> (rho r p)))"
      by (auto elim: decisionE)
    from stp LV_timestamp_bounded[OF run, where n=r]
    have "timestamp (rho r q) \<le> Suc (phase r)" by simp
    with q have "timestamp (rho r q) = Suc (phase r)"
      by (simp add: procsBeyondTS_def)
    with run
    have  x: "x (rho r q) = the (vote (rho r (coord\<Phi> (rho r q))))"
      and cmt': "commt (rho r (coord\<Phi> (rho r q)))"
      by (auto elim: currentTimestampE)
    from run cmt cmt' have "coord\<Phi> (rho r p) = coord\<Phi> (rho r q)"
      by (rule committedProcsEqual)
    with x v show "x (rho (r+0) q) = ?v" by simp
  qed
  next
  -- {* induction step *}
  fix k
  assume ih: "?P p k"
  show "?P p (Suc k)"
  proof (clarify)
    fix q
    assume q: "q \<in> ?bynd (Suc k)"
    -- {* distinguish the kind of transition---only @{text step1} is interesting *}
    have "x (rho (Suc (r + k)) q) = ?v" (is "?X q (r+k)")
    proof (rule LV_Suc'[OF run, where P="?X"])
      assume stp: "step (r + k) = 1"
      and nxt: "next1 (r+k) q (rho (r+k) q)
                      (HOrcvdMsgs LV_M (r+k) q (HOs (r+k) q) (rho (r+k)))
                      (coords (Suc (r+k)) q)
                      (rho (Suc (r+k)) q)"
      show ?thesis
      proof (cases "rho (Suc (r+k)) q = rho (r+k) q")
        case True
        with q ih show ?thesis by (auto simp: procsBeyondTS_def)
      next
        case False
        from run dec have "card (?bynd 0) > N div 2"
          by (simp add: decisionThenMajorityBeyondTS)
        moreover
        have "?bynd 0 \<subseteq> ?bynd k"
          by (auto elim: procsBeyondTS_monotonic[OF run])
        hence "card (?bynd 0) \<le> card (?bynd k)"
          by (auto intro: card_mono)
        ultimately
        have maj: "card (?bynd k) > N div 2" by simp
        let ?crd = "coord\<Phi> (rho (r+k) q)"
        from False stp nxt have
          cmt: "commt (rho (r+k) ?crd)" and
          x: "x (rho (Suc (r+k)) q) = the (vote (rho (r+k) ?crd))"
          by (auto simp: next1_def LV_CHOMachine_def HOrcvdMsgs_def
                         LV_sendMsg_def send1_def isVote_def)
        from run maj cmt stp obtain q'
          where q1': "q' \<in> ?bynd k"
            and q2': "vote (rho (r+k) ?crd) = Some (x (rho (r+k) q'))"
          by (blast dest: commitThenVoteRecent)
        with x ih show ?thesis by auto
      qed
    next
      -- {* all other steps hold by induction hypothesis *}
      assume "step (r+k) = 0"
      with run have x: "x (rho (Suc (r+k)) q) = x (rho (r+k) q)"
        and ts: "timestamp (rho (Suc (r+k)) q) = timestamp (rho (r+k) q)"
        by (auto simp: notStep1EqualX notStep1EqualTimestamp)
      from ts q have "q \<in> ?bynd k"
        by (auto simp: procsBeyondTS_def)
      with x ih show ?thesis by auto
    next
      assume "step (r+k) = 2"
      with run have x: "x (rho (Suc (r+k)) q) = x (rho (r+k) q)"
        and ts: "timestamp (rho (Suc (r+k)) q) = timestamp (rho (r+k) q)"
        by (auto simp: notStep1EqualX notStep1EqualTimestamp)
      from ts q have "q \<in> ?bynd k"
        by (auto simp: procsBeyondTS_def)
      with x ih show ?thesis by auto
    next
      assume "step (r+k) = 3"
      with run have x: "x (rho (Suc (r+k)) q) = x (rho (r+k) q)"
        and ts: "timestamp (rho (Suc (r+k)) q) = timestamp (rho (r+k) q)"
        by (auto simp: notStep1EqualX notStep1EqualTimestamp)
      from ts q have "q \<in> ?bynd k"
        by (auto simp: procsBeyondTS_def)
      with x ih show ?thesis by auto
    qed
    thus "x (rho (r + Suc k) q) = ?v" by simp
  qed
qed

text {*
  We are now in position to prove Agreement: if some process decides
  at step @{text r} and another (or possibly the same) process decides
  at step @{text "r+k"} then they decide the same value.
*}

(*
  The proof mainly relies on lemmas @{text decisionE},
  @{text decisionThenMajorityBeyondTS}, @{text procsBeyondTS_monotonic}
  @{text commitThenVoteRecent} and @{text XOfTimestampBeyondDecision}.
*)

lemma laterProcessDecidesSameValue:
  assumes run: "CHORun LV_M rho HOs coords"
  and p: "decide (rho (Suc r) p) \<noteq> decide (rho r p)"
  and q: "decide (rho (Suc (r+k)) q) \<noteq> decide (rho (r+k) q)"
  shows "decide (rho (Suc (r+k)) q) = decide (rho (Suc r) p)"
proof -
  let "?bynd k" = "procsBeyondTS (Suc (phase r)) (rho (r+k))"
  let ?qcrd = "coord\<Phi> (rho (r+k) q)"
  from run p have notNone: "decide (rho (Suc r) p) \<noteq> None"
    by (auto elim: decisionE)
  -- {* process @{text q} decides on the vote of its coordinator *}
  from run q
  have dec: "decide (rho (Suc (r+k)) q) = Some (the (vote (rho (r+k) ?qcrd)))"
   and cmt: "commt (rho (r+k) ?qcrd)"
    by (auto elim: decisionE)
  -- {* that vote is the @{text x} field of some process @{text "q'"} with a recent timestamp *}
  from run p have "card (?bynd 0) > N div 2"
    by (simp add: decisionThenMajorityBeyondTS)
  moreover
  from run have "?bynd 0 \<subseteq> ?bynd k"
    by (auto elim: procsBeyondTS_monotonic)
  hence "card (?bynd 0) \<le> card (?bynd k)"
    by (auto intro: card_mono)
  ultimately
  have maj: "card (?bynd k) > N div 2" by simp
  from run maj cmt obtain q'
    where q'1: "q' \<in> ?bynd k"
      and q'2: "vote (rho (r+k) ?qcrd) = Some (x (rho (r+k) q'))"
    by (auto dest: commitThenVoteRecent)
  -- {* the @{text x} field of process @{text "q'"} is the value @{text p} decided on *}
  from run p q'1
  have "x (rho (r+k) q') = the (decide (rho (Suc r) p))"
    by (auto dest: XOfTimestampBeyondDecision)
  -- {* which proves the assertion *}
  with dec q'2 notNone show ?thesis by auto
qed

text {*
  A process that holds some decision @{text v} has decided @{text v}
  sometime in the past.
*}

lemma decisionNonNullThenDecided:
  assumes run: "CHORun LV_M rho HOs coords"
      and dec: "decide (rho n p) = Some v"
  shows "\<exists>m<n. decide (rho (Suc m) p) \<noteq> decide (rho m p)
             \<and> decide (rho (Suc m) p) = Some v"
proof -
  let "?dec k" = "decide (rho k p)"
  have "(\<forall>m<n. ?dec (Suc m) \<noteq> ?dec m \<longrightarrow> ?dec (Suc m) \<noteq> Some v)
         \<longrightarrow> ?dec n \<noteq> Some v"
    (is "?P n" is "?A n \<longrightarrow> _")
  proof (induct n)
    from run show "?P 0"
      by (auto simp: CHORun_eq LV_CHOMachine_def
                     CHOinitConfig_def LV_initState_def)
  next
    fix n
    assume ih: "?P n"
    show "?P (Suc n)"
    proof (clarify)
      assume p: "?A (Suc n)" and v: "?dec (Suc n) = Some v"
      from p have "?A n" by simp
      with ih have "?dec n \<noteq> Some v" by simp
      moreover
      from p
      have "?dec (Suc n) \<noteq> ?dec n \<longrightarrow> ?dec (Suc n) \<noteq> Some v" by simp
      ultimately
      have "?dec (Suc n) \<noteq> Some v" by auto
      with v show "False" by simp
    qed
  qed
  with dec show ?thesis by auto
qed

text {*
  Irrevocability and Agreement are straightforward consequences
  of the two preceding lemmas.
*}
(*
  The proof mainly relies on lemmas @{text decisionNonNullThenDecided}
  and @{text laterProcessDecidesSameValue}.
*)

theorem lv_irrevocability:
  assumes run: "CHORun LV_M rho HOs coords"
      and p: "decide (rho m p) = Some v"
  shows "decide (rho (m+k) p) = Some v"
proof -
  from run p obtain n where
    n1: "n < m" and
    n2: "decide (rho (Suc n) p) \<noteq> decide (rho n p)" and
    n3: "decide (rho (Suc n) p) = Some v"
    by (auto dest: decisionNonNullThenDecided)
  have "\<forall>i. decide (rho (Suc (n+i)) p) = Some v" (is "\<forall>i. ?dec i")
  proof
    fix i
    show "?dec i"
    proof (induct i)
      from n3 show "?dec 0" by simp
    next
      fix j
      assume ih: "?dec j"
      show "?dec (Suc j)"
      proof (rule ccontr)
        assume ctr: "\<not> (?dec (Suc j))"
        with ih
        have "decide (rho (Suc (n + Suc j)) p) \<noteq> decide (rho (n + Suc j) p)"
          by simp
        with run n2
        have "decide (rho (Suc (n + Suc j)) p) = decide (rho (Suc n) p)"
          by (rule laterProcessDecidesSameValue)
        with ctr n3 show "False" by simp
      qed
    qed
  qed
  moreover
  from n1 obtain j where "m+k = Suc(n+j)"
    by (auto dest: less_imp_Suc_add)
  ultimately
  show ?thesis by auto
qed

theorem lv_agreement:
  assumes run: "CHORun LV_M rho HOs coords"
      and p: "decide (rho m p) = Some v"
      and q: "decide (rho n q) = Some w"
  shows "v = w"
proof -
  from run p obtain k
    where k1: "decide (rho (Suc k) p) \<noteq> decide (rho k p)"
      and k2: "decide (rho (Suc k) p) = Some v"
    by (auto dest: decisionNonNullThenDecided)
  from run q obtain l
    where l1: "decide (rho (Suc l) q) \<noteq> decide (rho l q)"
      and l2: "decide (rho (Suc l) q) = Some w"
    by (auto dest: decisionNonNullThenDecided)
  show ?thesis
  proof (cases "k \<le> l")
    case True
    then obtain m where m: "l = k+m" by (auto simp: le_iff_add)
    from run k1 l1 m
    have "decide (rho (Suc l) q) = decide (rho (Suc k) p)"
      by (auto elim: laterProcessDecidesSameValue)
    with k2 l2 show ?thesis by simp
  next
    case False
    hence "l \<le> k" by simp
    then obtain m where m: "k = l+m" by (auto simp: le_iff_add)
    from run l1 k1 m
    have "decide (rho (Suc k) p) = decide (rho (Suc l) q)"
      by (auto elim: laterProcessDecidesSameValue)
    with l2 k2 show ?thesis by simp
  qed
qed

subsection {* Proof of Termination *}

text{*
  The proof of termination relies on the communication predicate,
  which stipulates the existence of some phase
  during which there is a single coordinator that (a) receives a majority
  of messages and (b) is heard by everybody. Therefore, all processes
  successfully execute the protocol, deciding at step $3$ of that phase.
*}
(*
  The proof mainly relies on lemmas @{text notStep3EqualCoord},
  @{text commitE} and @{text readyE}.
*)

theorem lv_termination:
  assumes run: "CHORun LV_M rho HOs coords"
      and commG:"CHOcommGlobal LV_M HOs coords"
  shows "\<exists>r. \<forall>p. decide (rho r p) \<noteq> None"
proof -
  txt {* The communication predicate implies the existence of a ``successful'' phase
    @{text ph}, coordinated by some process @{text c} for all processes. *}
  from commG obtain ph c
    where c: "\<forall>p. coords (4*ph) p = c"
    and maj0: "card (HOs (4*ph) c) > N div 2"
    and maj2: "card (HOs (4*ph+2) c) > N div 2"
    and rcv1: "\<forall>p. c \<in> HOs (4*ph+1) p"
    and rcv3: "\<forall>p. c \<in> HOs (4*ph+3) p"
    by (auto simp: LV_CHOMachine_def LV_commGlobal_def)
  let ?r0 = "4*ph"
  let ?r1 = "Suc ?r0"
  let ?r2 = "Suc ?r1"
  let ?r3 = "Suc ?r2"
  let ?r4 = "Suc ?r3"

  txt {* Process @{text c} is the coordinator of all steps of phase @{text ph}. *}
  from run c have c':"\<forall>p. coord\<Phi> (rho ?r p) = c"
    by (auto simp add: phase_def coordinators)
  with run have c1: "\<forall>p. coord\<Phi> (rho ?r1 p) = c"
    by (auto simp add: step_def mod_Suc notStep3EqualCoord)
  with run have c2: "\<forall>p. coord\<Phi> (rho ?r2 p) = c"
    by (auto simp add: step_def mod_Suc notStep3EqualCoord)
  with run have c3: "\<forall>p. coord\<Phi> (rho ?r3 p) = c"
    by (auto simp add: step_def mod_Suc notStep3EqualCoord)

  txt {* The coordinator receives @{text ValStamp} messages from a majority of
    processes at step $0$ of phase @{text ph} and therefore commits during the
    transition at the end of step $0$. *}
  have 1: "commt (rho ?r1 c)" (is "?P c (4*ph)")
  proof (rule LV_Suc'[OF run, where P="?P"], auto simp: step_def)
    assume "next0 ?r c (rho ?r c) (HOrcvdMsgs LV_M ?r c (HOs ?r c) (rho ?r))
                  (coords (Suc ?r) c) (rho (Suc ?r) c)"
    with c' maj0 show "commt (rho (Suc ?r) c)"
      by (auto simp: step_def next0_def send0_def valStampsRcvd_def
                     LV_CHOMachine_def HOrcvdMsgs_def LV_sendMsg_def)
  qed

  txt {* All processes receive the vote of @{text c} at step 1 and therefore
    update their time stamps during the transition at the end of step $1$. *}
  have 2: "\<forall>p. timestamp (rho ?r2 p) = Suc ph"
  proof
    fix p
    let ?msgs = "HOrcvdMsgs LV_M ?r1 p (HOs ?r1 p) (rho ?r1)"
    let ?crd = "coord\<Phi> (rho ?r1 p)"
    from run 1 c1 rcv1
    have cnd: "?msgs ?crd \<noteq> None \<and> isVote (the (?msgs ?crd))"
      by (auto elim: commitE
               simp: step_def LV_CHOMachine_def HOrcvdMsgs_def
                     LV_sendMsg_def send1_def isVote_def)
    show "timestamp (rho ?r2 p) = Suc ph" (is "?P p (Suc (4*ph))")
    proof (rule LV_Suc'[OF run, where P="?P"], auto simp: step_def mod_Suc)
      assume "next1 ?r1 p (rho ?r1 p) ?msgs (coords (Suc ?r1) p) (rho ?r2 p)"
      with cnd show ?thesis by (auto simp: next1_def phase_def)
    qed
  qed

  txt {* The coordinator receives acknowledgements from a majority of processes
    at step $2$ and sets its @{text ready} flag during the transition at the
    end of step $2$. *}
  have 3: "ready (rho ?r3 c)" (is "?P c (Suc (Suc (4*ph)))")
  proof (rule LV_Suc'[OF run, where P="?P"], auto simp: step_def mod_Suc)
    assume "next2 ?r2 c (rho ?r2 c)
                      (HOrcvdMsgs LV_M ?r2 c (HOs ?r2 c) (rho ?r2))
                      (coords (Suc ?r2) c) (rho ?r3 c)"
    with 2 c2 maj2 show ?thesis
      by (auto simp: mod_Suc step_def LV_CHOMachine_def HOrcvdMsgs_def
                     LV_sendMsg_def next2_def send2_def acksRcvd_def
                     isAck_def phase_def)
  qed

  txt {* All processes receive the vote of the coordinator during step $3$
    and decide during the transition at the end of that step. *}
  have 4: "\<forall>p. decide (rho ?r4 p) \<noteq> None"
  proof
    fix p
    let ?msgs = "HOrcvdMsgs LV_M ?r3 p (HOs ?r3 p) (rho ?r3)"
    let ?crd = "coord\<Phi> (rho ?r3 p)"
    from run 3 c3 rcv3
    have cnd: "?msgs ?crd \<noteq> None \<and> isVote (the (?msgs ?crd))"
      by (auto elim: readyE
               simp: step_def mod_Suc LV_CHOMachine_def HOrcvdMsgs_def
                     LV_sendMsg_def send3_def isVote_def numeral_3_eq_3)
    show "decide (rho ?r4 p) \<noteq> None" (is "?P p (Suc (Suc (Suc (4*ph))))")
    proof (rule LV_Suc'[OF run, where P="?P"], auto simp: step_def mod_Suc)
      assume "next3 ?r3 p (rho ?r3 p) ?msgs (coords (Suc ?r3) p) (rho ?r4 p)"
      with cnd show "\<exists>v. decide (rho ?r4 p) = Some v"
        by (auto simp: next3_def)
    qed
  qed

  txt {* This immediately proves the assertion. *}
  from 4 show ?thesis ..
qed

subsection {* \emph{LastVoting} Solves Consensus *}

text {*
  Summing up, all (coarse-grained) runs of \emph{LastVoting} for
  HO collections that satisfy the communication predicate satisfy
  the Consensus property.
*}

theorem lv_consensus:
  assumes run: "CHORun LV_M rho HOs coords"
      and commG: "CHOcommGlobal LV_M HOs coords"
  shows "consensus (x \<circ> (rho 0)) decide rho"
proof -
  -- {* the above statement of termination is stronger than what we need *}
  from lv_termination[OF assms]
  obtain r where "\<forall>p. decide (rho r p) \<noteq> None" ..
  hence "\<forall>p. \<exists>r. decide (rho r p) \<noteq> None" by blast
  with lv_integrity[OF run] lv_agreement[OF run]
  show ?thesis by (auto simp: consensus_def image_def)
qed

text {*
  By the reduction theorem, the correctness of the algorithm carries over
  to the fine-grained model of runs.
*}

theorem lv_consensus_fg:
  assumes run: "fg_run LV_M rho HOs HOs coords"
      and commG: "CHOcommGlobal LV_M HOs coords"
  shows "consensus (\<lambda>p. x (state (rho 0) p)) decide (state \<circ> rho)"
    (is "consensus ?inits _ _")
proof (rule local_property_reduction[OF run consensus_is_local])
  fix crun
  assume crun: "CSHORun LV_M crun HOs HOs coords"
     and init: "crun 0 = state (rho 0)"
  from crun have "CHORun LV_M crun HOs coords"
    by (unfold CHORun_def SHORun_def)
  from this commG have "consensus (x \<circ> (crun 0)) decide crun"
    by (rule lv_consensus)
  with init show "consensus ?inits decide crun"
    by (simp add: o_def)
qed

end