From 2d651dd8b9dd1b12059f877ede60eda06255ddd0 Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Mon, 5 Oct 2020 19:14:00 -0300
Subject: [PATCH 01/12] Axiomatize the injectivity property of hash functions

---
 .../Ouroboros/Ouroboros_Praos_Implementation.thy    | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 3208bb0..1d3e4d1 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -83,10 +83,10 @@ text \<open>
 typedecl hash \<comment> \<open> Hash values (i.e. $\{0,1\}^w$ in the paper) \<close>
 
 axiomatization
-  where
-    hash_finite: "OFCLASS(hash, finite_class)"
-  and
-    hash_equal: "OFCLASS(hash, equal_class)"
+where
+  hash_finite: "OFCLASS(hash, finite_class)"
+and
+  hash_equal: "OFCLASS(hash, equal_class)"
 
 instance hash :: finite
   by (rule hash_finite)
@@ -94,7 +94,10 @@ instance hash :: finite
 instance hash :: equal
   by (rule hash_equal)
 
-consts \<H> :: "'a \<Rightarrow> hash" \<comment> \<open> A collision-resistant hash function \<close>
+axiomatization
+  \<H> :: "'a \<Rightarrow> hash" \<comment> \<open> A collision-resistant hash function \<close>
+where
+  hash_inj: "inj \<H>"
 
 text \<open>
   with no way of recovering @{typ 'a} from @{type hash}.

From 7b7443e5188ea985a0bc140df103f22d858f1e68 Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Mon, 5 Oct 2020 19:18:41 -0300
Subject: [PATCH 02/12] Axiomatize the property that `f` is a non-zero
 probability

---
 Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 1d3e4d1..7752bb4 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -134,7 +134,10 @@ text \<open>
     stakeholder is elected as a slot leader, that is, the probability that a slot is not empty:
 \<close>
 
-consts f :: real
+axiomatization
+  f :: real
+where
+  f_non_zero_probability: "0 < f \<and> f \<le> 1"
 
 text \<open>
   \<^item> Two special, but arbitrary, values that we use when calling the VRF in slot leader selection

From 79f667f26b095f28f151f913e5209cc387ec4450 Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Mon, 5 Oct 2020 19:30:59 -0300
Subject: [PATCH 03/12] Axiomatize the cancellation property of VRF functions

---
 .../Ouroboros_Praos_Implementation.thy        | 31 ++++++++++++-------
 1 file changed, 19 insertions(+), 12 deletions(-)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 7752bb4..f1c5b00 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -33,6 +33,13 @@ typedecl secret_key
 
 typedecl verification_key
 
+
+text \<open>
+  such that it is possible to derive the verification key from the secret key:
+\<close>
+
+consts verification_key_of :: "secret_key \<Rightarrow> verification_key"
+
 subsubsection \<open> The Semi-Synchronous model \<close>
 
 text \<open>
@@ -160,7 +167,8 @@ paragraph \<open> Functionality \<open>\<F>\<close>$_{\mathsf{VRF}}$. \<close>
 
 text \<open>
   We model the evaluation of a VRF as a function that, given an input value and a secret key,
-  produces a random value and a proof:
+  produces a random value and a proof. Also, we can verify that a particular random value was
+  produced correctly:
 \<close>
 
 typedecl vrf_output
@@ -168,10 +176,10 @@ typedecl vrf_output
 typedecl vrf_proof
 
 axiomatization
-  where
-    vrf_output_finite: "OFCLASS(vrf_output, finite_class)"
-  and
-    vrf_proof_finite: "OFCLASS(vrf_proof, finite_class)"
+where
+  vrf_output_finite: "OFCLASS(vrf_output, finite_class)"
+and
+  vrf_proof_finite: "OFCLASS(vrf_proof, finite_class)"
 
 instance vrf_output :: finite
   by (rule vrf_output_finite)
@@ -183,13 +191,12 @@ type_synonym vrf_value = "vrf_output \<times> vrf_proof"
 
 consts vrf_output_size :: nat (\<open>l\<^sub>V\<^sub>R\<^sub>F\<close>)
 
-consts evaluate_vrf :: "secret_key \<Rightarrow> 'a \<Rightarrow> vrf_value"
-
-text \<open>
-  Also, we can verify that a particular random value was produced correctly:
-\<close>
-
-consts verify_vrf :: "verification_key \<Rightarrow> 'a \<Rightarrow> vrf_value \<Rightarrow> bool"
+axiomatization
+  evaluate_vrf :: "secret_key \<Rightarrow> 'a \<Rightarrow> vrf_value"
+and
+  verify_vrf :: "verification_key \<Rightarrow> 'a \<Rightarrow> vrf_value \<Rightarrow> bool"
+where
+  vrf_eval_ver_cancellation: "verify_vrf vk x (evaluate_vrf sk x)" if "vk = verification_key_of sk"
 
 text \<open>
   Finally, we can cast a VRF output into a real number:

From f1ab8672427ff36d28b9e745f9f57c22ec8a38e5 Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Mon, 5 Oct 2020 19:36:46 -0300
Subject: [PATCH 04/12] Axiomatize the cancellation property of digital
 signatures

---
 .../Ouroboros/Ouroboros_Praos_Implementation.thy  | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index f1c5b00..adad4fb 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -212,7 +212,7 @@ text \<open>
   capability of allowing the signing key to ``evolve'' in such a way that the adversary
   cannot forge past signatures, and is used to sign blocks. Therefore, we model these two
   functionalities as a single, ordinary digital signature scheme. With this scheme, we can sign a
-  value using a secret key:
+  value using a secret key and verify that a value is properly signed using a verification key:
 \<close>
 
 typedecl signature
@@ -224,13 +224,12 @@ axiomatization
 instance signature :: finite
   by (rule signature_finite)
 
-consts sign :: "secret_key \<Rightarrow> 'a \<Rightarrow> signature"
-
-text \<open>
-  and verify that a value is properly signed using a verification key:
-\<close>
-
-consts verify :: "verification_key \<Rightarrow> 'a \<Rightarrow> signature \<Rightarrow> bool"
+axiomatization
+  sign :: "secret_key \<Rightarrow> 'a \<Rightarrow> signature"
+and
+  verify :: "verification_key \<Rightarrow> 'a \<Rightarrow> signature \<Rightarrow> bool"
+where
+  sig_ver_cancellation: "verify vk x (sign sk x)" if "vk = verification_key_of sk"
 
 paragraph \<open> Functionality \<open>\<F>\<close>$^{\tau,r}_{RLB}$. \<close>
 

From f57d1f8f37783ede38f953166d96527e16a9d6cf Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Mon, 5 Oct 2020 19:39:01 -0300
Subject: [PATCH 05/12] Document `new_epoch_rnd` function

---
 Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index adad4fb..398ab6d 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -238,7 +238,8 @@ text \<open>
   provides a fresh nonce for each epoch to (re)seed the election process. Also, this beacon is
   resettable and leaky in order to strengthen the adversary, which we evidently ignore. Finally,
   the beacon (via \<open>\<F>\<close>$_{\mathsf{INIT}}$) provides the stakeholders with the genesis block; instead
-  our implementation passes the genesis block as a parameter to each stakeholder.
+  our implementation passes the genesis block as a parameter to each stakeholder. Therefore, we
+  only provide a function to produce a fresh nonce:
 \<close>
 
 typedecl nonce

From c8e1c2f0398870c375f7544870ce56582f9f4f74 Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Mon, 5 Oct 2020 20:01:10 -0300
Subject: [PATCH 06/12] Change to finite maps to implement stake distributions

---
 Isabelle/Ouroboros/Finite_Map_Extras.thy      | 705 ++++++++++++++++++
 .../Ouroboros_Praos_Implementation.thy        |  15 +-
 Isabelle/Ouroboros/ROOT                       |   1 +
 3 files changed, 716 insertions(+), 5 deletions(-)
 create mode 100644 Isabelle/Ouroboros/Finite_Map_Extras.thy

diff --git a/Isabelle/Ouroboros/Finite_Map_Extras.thy b/Isabelle/Ouroboros/Finite_Map_Extras.thy
new file mode 100644
index 0000000..9f0e6d0
--- /dev/null
+++ b/Isabelle/Ouroboros/Finite_Map_Extras.thy
@@ -0,0 +1,705 @@
+section \<open> Extra Features for Finite Maps \<close>
+
+theory Finite_Map_Extras
+  imports "HOL-Library.Finite_Map"
+begin
+
+text \<open> Extra lemmas and syntactic sugar for \<open>fmap\<close> \<close>
+
+notation fmlookup (infixl \<open>$$\<close> 900)
+
+notation fmempty (\<open>{$$}\<close>)
+
+nonterminal fmaplets and fmaplet
+
+syntax
+  "_fmaplet"  :: "['a, 'a] \<Rightarrow> fmaplet"                        ("_ /$$:=/ _")
+  "_fmaplets" :: "['a, 'a] \<Rightarrow> fmaplet"                        ("_ /[$$:=]/ _")
+  ""          :: "fmaplet \<Rightarrow> fmaplets"                        ("_")
+  "_Fmaplets" :: "[fmaplet, fmaplets] \<Rightarrow> fmaplets"            ("_,/ _")
+  "_FmapUpd"  :: "[('a, 'b) fmap, fmaplets] \<Rightarrow> ('a, 'b) fmap" ("_/'(_')" [900, 0] 900)
+  "_Fmap"     :: "fmaplets \<Rightarrow> ('a, 'b) fmap"                  ("(1{_})")
+
+translations
+  "_FmapUpd m (_Fmaplets xy ms)"  \<rightleftharpoons> "_FmapUpd (_FmapUpd m xy) ms"
+  "_FmapUpd m (_fmaplet  x y)"    \<rightleftharpoons> "CONST fmupd x y m"
+  "_Fmap ms"                     \<rightleftharpoons> "_FmapUpd (CONST fmempty) ms"
+  "_Fmap (_Fmaplets ms1 ms2)"     \<leftharpoondown> "_FmapUpd (_Fmap ms1) ms2"
+  "_Fmaplets ms1 (_Fmaplets ms2 ms3)" \<leftharpoondown> "_Fmaplets (_Fmaplets ms1 ms2) ms3"
+
+abbreviation fmap_lookup_the (infixl \<open>$$!\<close> 900) where
+  "m $$! k \<equiv> the (m $$ k)"
+
+value "{$$}::(nat, nat) fmap"
+value "{1::nat $$:= 2::nat, 3 $$:= 4}(1 $$:= 0) $$! 1"
+
+
+lemma fmadd_singletons_comm:
+  assumes "k\<^sub>1 \<noteq> k\<^sub>2"
+  shows "{k\<^sub>1 $$:= v\<^sub>1} ++\<^sub>f {k\<^sub>2 $$:= v\<^sub>2} = {k\<^sub>2 $$:= v\<^sub>2} ++\<^sub>f {k\<^sub>1 $$:= v\<^sub>1}"
+proof (intro fmap_ext)
+  fix k
+  consider
+    (a) "k = k\<^sub>1" |
+    (b) "k = k\<^sub>2" |
+    (c) "k \<noteq> k\<^sub>1 \<and> k \<noteq> k\<^sub>2"
+    by auto
+  with assms show "({k\<^sub>1 $$:= v\<^sub>1} ++\<^sub>f {k\<^sub>2 $$:= v\<^sub>2}) $$ k = ({k\<^sub>2 $$:= v\<^sub>2} ++\<^sub>f {k\<^sub>1 $$:= v\<^sub>1}) $$ k"
+    by auto
+qed
+
+lemma fmap_singleton_comm:
+  assumes "m $$ k = None"
+  shows "m ++\<^sub>f {k $$:= v} = {k $$:= v} ++\<^sub>f m"
+  using assms
+proof (induction m arbitrary: k v)
+  case fmempty
+  then show ?case
+    by simp
+next
+  case (fmupd x y m)
+  have "m(x $$:= y) ++\<^sub>f {k $$:= v} = m ++\<^sub>f {x $$:= y} ++\<^sub>f {k $$:= v}"
+    by simp
+  also from fmupd.hyps and fmupd.IH have "\<dots> = {x $$:= y} ++\<^sub>f m ++\<^sub>f {k $$:= v}"
+    by simp
+  also from fmupd.prems and fmupd.hyps and fmupd.IH have "\<dots> = {x $$:= y} ++\<^sub>f {k $$:= v} ++\<^sub>f m"
+    by (metis fmadd_assoc fmupd_lookup)
+  also have "\<dots> = {k $$:= v} ++\<^sub>f m(x $$:= y)"
+  proof (cases "x \<noteq> k")
+    case True
+    then have "{x $$:= y} ++\<^sub>f {k $$:= v} ++\<^sub>f m = {k $$:= v} ++\<^sub>f {x $$:= y} ++\<^sub>f m"
+      using fmadd_singletons_comm by metis
+    also from fmupd.prems and fmupd.hyps and fmupd.IH have "\<dots> = {k $$:= v} ++\<^sub>f m ++\<^sub>f {x $$:= y}"
+      by (metis fmadd_assoc)
+    finally show ?thesis
+      by simp
+  next
+    case False
+    with fmupd.prems show ?thesis
+      by auto
+  qed
+  finally show ?case .
+qed
+
+lemma fmap_disj_comm:
+  assumes "fmdom' m\<^sub>1 \<inter> fmdom' m\<^sub>2 = {}"
+  shows "m\<^sub>1 ++\<^sub>f m\<^sub>2 = m\<^sub>2 ++\<^sub>f m\<^sub>1"
+  using assms
+proof (induction m\<^sub>2 arbitrary: m\<^sub>1)
+  case fmempty
+  then show ?case
+    by simp
+next
+  case (fmupd k v m\<^sub>2)
+  then show ?case
+  proof (cases "m\<^sub>1 $$ k = None")
+    case True
+    from fmupd.hyps have "m\<^sub>1 ++\<^sub>f m\<^sub>2(k $$:= v) = m\<^sub>1 ++\<^sub>f m\<^sub>2 ++\<^sub>f {k $$:= v}"
+      by simp
+    also from fmupd.prems and fmupd.hyps and fmupd.IH have "\<dots> = m\<^sub>2 ++\<^sub>f m\<^sub>1 ++\<^sub>f {k $$:= v}"
+      by simp
+    also from True have "\<dots> = m\<^sub>2 ++\<^sub>f {k $$:= v} ++\<^sub>f m\<^sub>1"
+      using fmap_singleton_comm by (metis fmadd_assoc)
+    finally show ?thesis
+      by simp
+  next
+    case False
+    with fmupd.prems show ?thesis
+      by auto
+  qed
+qed
+
+lemma fmran_singleton: "fmran {k $$:= v} = {|v|}"
+proof -
+  have "v' |\<in>| fmran {k $$:= v} \<Longrightarrow> v' = v" for v'
+  proof -
+    assume "v' |\<in>| fmran {k $$:= v}"
+    fix k'
+    have "fmdom' {k $$:= v} = {k}"
+      by simp
+    then show "v' = v"
+    proof (cases "k' = k")
+      case True
+      with \<open>v' |\<in>| fmran {k $$:= v}\<close> show ?thesis
+        using fmdom'I by fastforce
+    next
+      case False
+      with \<open>fmdom' {k $$:= v} = {k}\<close> and \<open>v' |\<in>| fmran {k $$:= v}\<close> show ?thesis
+        using fmdom'I by fastforce
+    qed
+  qed
+  moreover have "v |\<in>| fmran {k $$:= v}"
+    by (simp add: fmranI)
+  ultimately show ?thesis
+    by (simp add: fsubsetI fsubset_antisym)
+qed
+
+lemma fmmap_keys_hom:
+  assumes "fmdom' m\<^sub>1 \<inter> fmdom' m\<^sub>2 = {}"
+  shows "fmmap_keys f (m\<^sub>1 ++\<^sub>f m\<^sub>2) = fmmap_keys f m\<^sub>1 ++\<^sub>f fmmap_keys f m\<^sub>2"
+  using assms
+  by (simp add: fmap_ext)
+
+lemma map_insort_is_insort_key:
+  assumes "m $$ k = None"
+  shows "map (\<lambda>k'. (k', m(k $$:= v) $$! k')) (insort k xs) =
+    insort_key fst (k, v) (map (\<lambda>k'. (k', m(k $$:= v) $$! k')) xs)"
+  using assms by (induction xs) auto
+
+lemma sorted_list_of_fmap_is_insort_key_fst:
+  assumes "m $$ k = None"
+  shows "sorted_list_of_fmap (m(k $$:= v)) = insort_key fst (k, v) (sorted_list_of_fmap m)"
+proof -
+  have "sorted_list_of_fmap (m(k $$:= v)) =
+    map (\<lambda>k'. (k', m(k $$:= v) $$! k')) (sorted_list_of_fset (fmdom (m(k $$:= v))))"
+    unfolding sorted_list_of_fmap_def ..
+  also have "\<dots> = 	map (\<lambda>k'. (k', m(k $$:= v) $$! k')) (sorted_list_of_fset (finsert k (fmdom m)))"
+    by simp
+  also from \<open>m $$ k = None\<close> have "\<dots> =
+    map (\<lambda>k'. (k', m(k $$:= v) $$! k')) (insort k (sorted_list_of_fset (fmdom m - {|k|})))"
+    by (simp add: sorted_list_of_fset.rep_eq)
+  also from \<open>m $$ k = None\<close> have "\<dots> =
+    map (\<lambda>k'. (k', m(k $$:= v) $$! k')) (insort k (sorted_list_of_fset (fmdom m)))"
+    by (simp add: fmdom_notI)
+  also from \<open>m $$ k = None\<close> have "\<dots> =
+    insort_key fst (k, v) (map (\<lambda>k'. (k', m(k $$:= v) $$! k')) (sorted_list_of_fset (fmdom m)))"
+    using map_insort_is_insort_key by fastforce
+  also have "\<dots> = insort_key fst (k, v) (map (\<lambda>k'. (k', m $$! k')) (sorted_list_of_fset (fmdom m)))"
+  proof -
+    from \<open>m $$ k = None\<close> have "\<And>k'. k' \<in> fmdom' m \<Longrightarrow> m(k $$:= v) $$! k' = m $$! k'"
+      using fmdom'_notI by force
+    moreover from \<open>m $$ k = None\<close> have "k \<notin> set (sorted_list_of_fset (fmdom m))"
+      using fmdom'_alt_def and fmdom'_notI and in_set_member by force
+    ultimately show ?thesis
+      by (metis (mono_tags, lifting) fmdom'_alt_def map_eq_conv sorted_list_of_fset_simps(1))
+  qed
+  finally show ?thesis
+    unfolding sorted_list_of_fmap_def by simp
+qed
+
+lemma distinct_fst_inj:
+  assumes "distinct (map fst ps)"
+  and "inj f"
+  shows "distinct (map fst (map (\<lambda>(k, v). (f k, v)) ps))"
+proof -
+  have "map fst (map (\<lambda>(k, v). (f k, v)) ps) = map f (map fst ps)"
+    by (induction ps) auto
+  moreover from assms have "distinct (map f (map fst ps))"
+    by (simp add: distinct_map inj_on_def)
+  ultimately show ?thesis
+    by presburger
+qed
+
+lemma distinct_sorted_list_of_fmap:
+  shows "distinct (map fst (sorted_list_of_fmap m))"
+  unfolding sorted_list_of_fmap_def and sorted_list_of_fset_def
+  by (simp add: distinct_map inj_on_def)
+
+lemma map_inj_pair_non_membership:
+  assumes "k \<notin> set (map fst ps)"
+  and "inj f"
+  shows "f k \<notin> set (map fst (map (\<lambda>(k, v). (f k, v)) ps))"
+  using assms by (induction ps) (simp add: member_rec(2), fastforce simp add: injD)
+
+lemma map_insort_key_fst:
+  assumes "distinct (map fst ps)"
+  and "k \<notin> set (map fst ps)"
+  and "inj f"
+  and "mono f"
+  shows "map (\<lambda>(k, v). (f k, v)) (insort_key fst (k, v) ps) =
+    insort_key fst (f k, v) (map (\<lambda>(k, v). (f k, v)) ps)"
+  using assms
+proof (induction ps)
+  case Nil
+  then show ?case
+    by simp
+next
+  let ?g = "(\<lambda>(k, v). (f k, v))"
+  case (Cons p ps)
+  then show ?case
+  proof (cases "k \<le> fst p")
+    case True
+    let ?f_p = "(f (fst p), snd p)"
+    have "insort_key fst (f k, v) (map ?g (p # ps)) = insort_key fst (f k, v) (?f_p # map ?g ps)"
+      by (simp add: prod.case_eq_if)
+    moreover from Cons.prems(4) and True have "f k \<le> f (fst p)"
+      by (auto dest: monoE)
+    then have "insort_key fst (f k, v) (?f_p # map ?g ps) = (f k, v) # ?f_p # map ?g ps"
+      by simp
+    ultimately have "insort_key fst (f k, v) (map ?g (p # ps)) = (f k, v) # ?f_p # map ?g ps"
+      by simp
+    moreover from True have "map ?g (insort_key fst (k, v) (p # ps)) = (f k, v) # ?f_p # map ?g ps"
+      by (simp add: case_prod_beta')
+    ultimately show ?thesis
+      by simp
+  next
+    case False
+    let ?f_p = "(f (fst p), snd p)"
+    have "insort_key fst (f k, v) (map ?g (p # ps)) = insort_key fst (f k, v) (?f_p # map ?g ps)"
+      by (simp add: prod.case_eq_if)
+    moreover from \<open>mono f\<close> and False have "f (fst p) \<le> f k"
+      using not_le by (blast dest: mono_invE)
+    ultimately have "insort_key fst (f k, v) (map ?g (p # ps)) =
+      ?f_p # insort_key fst (f k, v) (map ?g ps)"
+      using False and \<open>inj f\<close> by (fastforce dest: injD)
+    also from Cons.IH and Cons.prems(1,2) and assms(3,4) have "\<dots> =
+      ?f_p # (map ?g (insort_key fst (k, v) ps))"
+      by (fastforce simp add: member_rec(1))
+    also have "\<dots> = map ?g (p # insort_key fst (k, v) ps)"
+      by (simp add: case_prod_beta)
+    finally show ?thesis
+      using False by simp
+  qed
+qed
+
+lemma map_sorted_list_of_fmap:
+  assumes "inj f"
+  and "mono f"
+  and "m $$ k = None"
+  shows "map (\<lambda>(k, v). (f k, v)) (sorted_list_of_fmap (m(k $$:= v))) =
+    insort_key fst (f k, v) (map (\<lambda>(k, v). (f k, v)) (sorted_list_of_fmap m))"
+proof -
+  let ?g = "(\<lambda>(k, v). (f k, v))"
+  from \<open>m $$ k = None\<close> have "map ?g (sorted_list_of_fmap (m(k $$:= v))) =
+  	map ?g (insort_key fst (k, v) (sorted_list_of_fmap m))"
+  	using sorted_list_of_fmap_is_insort_key_fst by fastforce
+  also have "\<dots> = insort_key fst (f k, v) (map ?g (sorted_list_of_fmap m))"
+  proof -
+    have "distinct (map fst (sorted_list_of_fmap m))"
+      by (simp add: distinct_sorted_list_of_fmap)
+    moreover from \<open>m $$ k = None\<close> have "k \<notin> set (map fst (sorted_list_of_fmap m))"
+      by (metis image_set map_of_eq_None_iff map_of_sorted_list)
+    ultimately show ?thesis
+      by (simp add: map_insort_key_fst assms(1,2))
+  qed
+  finally show ?thesis .
+qed
+
+lemma fmap_of_list_insort_key_fst:
+  assumes "distinct (map fst ps)"
+  and "k \<notin> set (map fst ps)"
+  shows "fmap_of_list (insort_key fst (k, v) ps) = (fmap_of_list ps)(k $$:= v)"
+  using assms
+proof (induction ps)
+  case Nil
+  then show ?case
+    by simp
+next
+  case (Cons p ps)
+  then show ?case
+  proof (cases "k \<le> fst p")
+    case True
+    then show ?thesis
+      by simp
+  next
+    case False
+    then have "fmap_of_list (insort_key fst (k, v) (p # ps)) =
+      fmap_of_list (p # insort_key fst (k, v) ps)"
+      by simp
+    also have "\<dots> = (fmap_of_list (insort_key fst (k, v) ps))(fst p $$:= snd p)"
+      by (metis fmap_of_list_simps(2) prod.collapse)
+    also from Cons.prems(1,2) and Cons.IH have "\<dots> = (fmap_of_list ps)(k $$:= v)(fst p $$:= snd p)"
+      by (fastforce simp add: member_rec(1))
+    finally show ?thesis
+    proof -
+      assume *: "fmap_of_list (insort_key fst (k, v) (p # ps)) =
+        (fmap_of_list ps)(k $$:= v)(fst p $$:= snd p)"
+      from Cons.prems(2) have "k \<notin> set (fst p # map fst ps)"
+        by simp
+      then have **: "{k $$:= v} $$ (fst p) = None"
+        by (fastforce simp add: member_rec(1))
+      have "fmap_of_list (p # ps) = (fmap_of_list ps)(fst p $$:= snd p)"
+        by (metis fmap_of_list_simps(2) prod.collapse)
+      with * and ** show ?thesis
+        using fmap_singleton_comm by (metis fmadd_fmupd fmap_of_list_simps(1,2) fmupd_alt_def)
+    qed
+  qed
+qed
+
+lemma fmap_of_list_insort_key_fst_map:
+  assumes "inj f"
+  and "m $$ k = None"
+  shows "fmap_of_list (insort_key fst (f k, v) (map (\<lambda>(k, v). (f k, v)) (sorted_list_of_fmap m))) =
+    (fmap_of_list (map (\<lambda>(k, v). (f k, v)) (sorted_list_of_fmap m)))(f k $$:= v)"
+proof -
+  let ?g = "\<lambda>(k, v). (f k, v)"
+  let ?ps = "map ?g (sorted_list_of_fmap m)"
+  from \<open>inj f\<close> have "distinct (map fst ?ps)"
+    using distinct_fst_inj and distinct_sorted_list_of_fmap by fastforce
+  moreover have "f k \<notin> set (map fst ?ps)"
+  proof -
+    from \<open>m $$ k = None\<close> have "k \<notin> set (map fst (sorted_list_of_fmap m))"
+      by (metis map_of_eq_None_iff map_of_sorted_list set_map)
+    with \<open>inj f\<close> show ?thesis
+      using map_inj_pair_non_membership by force
+  qed
+  ultimately show ?thesis
+    using fmap_of_list_insort_key_fst by fast
+qed
+
+lemma fmap_of_list_sorted_list_of_fmap:
+  fixes m :: "('a::linorder, 'b) fmap"
+  and f :: "'a \<Rightarrow> 'c::linorder"
+  assumes "inj f"
+  and "mono f"
+  and "m $$ k = None"
+  shows "fmap_of_list (map (\<lambda>(k, v). (f k, v)) (sorted_list_of_fmap (m(k $$:= v)))) =
+    (fmap_of_list (map (\<lambda>(k, v). (f k, v)) (sorted_list_of_fmap m)))(f k $$:= v)"
+proof -
+  let ?g = "\<lambda>(k, v). (f k, v)"
+  from assms(3) have "fmap_of_list (map ?g (sorted_list_of_fmap (m(k $$:= v)))) =
+    fmap_of_list (map ?g (insort_key fst (k, v) (sorted_list_of_fmap m)))"
+    by (simp add: sorted_list_of_fmap_is_insort_key_fst)
+  also from assms have "\<dots> = fmap_of_list (insort_key fst (f k, v) (map ?g (sorted_list_of_fmap m)))"
+    using calculation and map_sorted_list_of_fmap by fastforce
+  also from assms(1,3) have "\<dots> = (fmap_of_list (map ?g (sorted_list_of_fmap m)))(f k $$:= v)"
+    by (simp add: fmap_of_list_insort_key_fst_map)
+  finally show ?thesis .
+qed
+
+text \<open> Map difference \<close>
+
+lemma fsubset_antisym:
+  assumes "m \<subseteq>\<^sub>f n"
+  and "n \<subseteq>\<^sub>f m"
+  shows "m = n"
+proof -
+  from \<open>m \<subseteq>\<^sub>f n\<close> have "\<forall>k \<in> dom (($$) m). (($$) m) k = (($$) n) k"
+    by (simp add: fmsubset.rep_eq map_le_def)
+  moreover from \<open>n \<subseteq>\<^sub>f m\<close> have "\<forall>k \<in> dom (($$) n). (($$) n) k = (($$) m) k"
+    by (simp add: fmsubset.rep_eq map_le_def)
+  ultimately show ?thesis
+  proof (intro fmap_ext)
+    fix k
+    consider
+      (a) "k \<in> dom (($$) m)" |
+      (b) "k \<in> dom (($$) n)" |
+      (c) "k \<notin> dom (($$) m) \<and> k \<notin> dom (($$) n)"
+      by auto
+    then show "m $$ k = n $$ k"
+    proof cases
+      case a
+      with \<open>\<forall>k \<in> dom (($$) m). m $$ k = n $$ k\<close> show ?thesis
+        by simp
+    next
+      case b
+      with \<open>\<forall>k \<in> dom (($$) n). n $$ k = m $$ k\<close> show ?thesis
+        by simp
+    next
+      case c
+      then show ?thesis
+        by (simp add: fmdom'_notD)
+    qed
+  qed
+qed
+
+abbreviation
+  fmdiff :: "('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap" (infixl \<open>--\<^sub>f\<close> 100) where
+  "m\<^sub>1 --\<^sub>f m\<^sub>2 \<equiv> fmfilter (\<lambda>x. x \<notin> fmdom' m\<^sub>2) m\<^sub>1"
+
+lemma fmdiff_partition:
+  assumes "m\<^sub>2 \<subseteq>\<^sub>f m\<^sub>1"
+  shows "m\<^sub>2 ++\<^sub>f (m\<^sub>1 --\<^sub>f m\<^sub>2) = m\<^sub>1"
+proof -
+  have *: "m\<^sub>2 ++\<^sub>f (m\<^sub>1 --\<^sub>f m\<^sub>2) \<subseteq>\<^sub>f m\<^sub>1"
+  proof -
+    have "\<forall>k v. (m\<^sub>2 ++\<^sub>f (m\<^sub>1 --\<^sub>f m\<^sub>2)) $$ k = Some v \<longrightarrow> m\<^sub>1 $$ k = Some v"
+    proof (intro allI impI)
+      fix k v
+      assume "(m\<^sub>2 ++\<^sub>f (m\<^sub>1 --\<^sub>f m\<^sub>2)) $$ k = Some v"
+      then have **: "(if k |\<in>| fmdom (m\<^sub>1 --\<^sub>f m\<^sub>2) then (m\<^sub>1 --\<^sub>f m\<^sub>2) $$ k else m\<^sub>2 $$ k) = Some v"
+        by simp
+      then show "m\<^sub>1 $$ k = Some v"
+      proof (cases "k |\<in>| fmdom (m\<^sub>1 --\<^sub>f m\<^sub>2)")
+        case True
+        with ** show ?thesis
+          by simp
+      next
+        case False
+        with ** and \<open>m\<^sub>2 \<subseteq>\<^sub>f m\<^sub>1\<close> show ?thesis
+          by (metis (mono_tags, lifting) fmpredD fmsubset_alt_def)
+      qed
+    qed
+    then have "fmpred (\<lambda>k v. m\<^sub>1 $$ k = Some v) (m\<^sub>2 ++\<^sub>f (m\<^sub>1 --\<^sub>f m\<^sub>2))"
+      by (blast intro: fmpred_iff)
+    then show ?thesis
+      by (auto simp add: fmsubset_alt_def)
+  qed
+  then have "m\<^sub>1 \<subseteq>\<^sub>f m\<^sub>2 ++\<^sub>f (m\<^sub>1 --\<^sub>f m\<^sub>2)"
+    by (simp add: fmsubset.rep_eq map_le_def)
+  with * show ?thesis
+    by (simp add: fsubset_antisym)
+qed
+
+lemma fmdiff_fmupd:
+  assumes "m $$ k = None"
+  shows "m(k $$:= v) --\<^sub>f {k $$:= v} = m"
+proof -
+  let ?P = "(\<lambda>k'. k' \<notin> {k})"
+  have "m(k $$:= v) --\<^sub>f {k $$:= v} = fmfilter (\<lambda>x. x \<notin> fmdom' {k $$:= v}) (m(k $$:= v))" ..
+  also have "\<dots> = fmfilter ?P (m(k $$:= v))"
+    by simp
+  also have "\<dots> = (if ?P k then (fmfilter ?P m)(k $$:= v) else fmfilter ?P m)"
+    by simp
+  also have "\<dots> = fmfilter ?P m"
+    by simp
+  finally show ?thesis
+  proof -
+    from \<open>m $$ k = None\<close> have "\<And>k' v'. m $$ k' = Some v' \<Longrightarrow> ?P k'"
+      by fastforce
+    then show ?thesis
+      by simp
+  qed
+qed
+
+text \<open> Map symmetric difference \<close>
+
+abbreviation fmsym_diff :: "('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap" (infixl \<open>\<Delta>\<^sub>f\<close> 100) where
+  "m\<^sub>1 \<Delta>\<^sub>f m\<^sub>2 \<equiv> (m\<^sub>1 --\<^sub>f m\<^sub>2) ++\<^sub>f (m\<^sub>2 --\<^sub>f m\<^sub>1)"
+
+text \<open> Domain restriction \<close>
+
+abbreviation dom_res :: "'a set \<Rightarrow> ('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap" (infixl \<open>\<lhd>\<close> 150) where
+  "s \<lhd> m \<equiv> fmfilter (\<lambda>x. x \<in> s) m"
+
+text \<open> Domain exclusion \<close>
+
+abbreviation dom_exc :: "'a set \<Rightarrow> ('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap" (infixl \<open>\<lhd>'/\<close> 150) where
+  "s \<lhd>/ m \<equiv> fmfilter (\<lambda>x. x \<notin> s) m"
+
+text \<open> Intersection plus \<close>
+
+abbreviation intersection_plus :: "('a, 'b::monoid_add) fmap \<Rightarrow> ('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap"
+  (infixl \<open>\<inter>\<^sub>+\<close> 100)
+where
+  "m\<^sub>1 \<inter>\<^sub>+ m\<^sub>2 \<equiv> fmmap_keys (\<lambda>k v. v + m\<^sub>1 $$! k) (fmdom' m\<^sub>1 \<lhd> m\<^sub>2)"
+
+text \<open> Union override right \<close>
+
+abbreviation union_override_right :: "('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap"
+  (infixl \<open>\<union>\<^sub>\<rightarrow>\<close> 100)
+where
+  "m\<^sub>1 \<union>\<^sub>\<rightarrow> m\<^sub>2 \<equiv> (fmdom' m\<^sub>2 \<lhd>/ m\<^sub>1) ++\<^sub>f m\<^sub>2"
+
+text \<open> Union override left \<close>
+
+abbreviation union_override_left :: "('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap"
+  (infixl \<open>\<union>\<^sub>\<leftarrow>\<close> 100)
+where
+  "m\<^sub>1 \<union>\<^sub>\<leftarrow> m\<^sub>2 \<equiv> m\<^sub>1 ++\<^sub>f (fmdom' m\<^sub>1 \<lhd>/ m\<^sub>2)"
+
+text \<open> Union override plus \<close>
+
+abbreviation union_override_plus :: "('a, 'b::monoid_add) fmap \<Rightarrow> ('a, 'b) fmap \<Rightarrow> ('a, 'b) fmap"
+  (infixl \<open>\<union>\<^sub>+\<close> 100)
+where
+  "m\<^sub>1 \<union>\<^sub>+ m\<^sub>2 \<equiv> (m\<^sub>1 \<Delta>\<^sub>f m\<^sub>2) ++\<^sub>f (m\<^sub>1 \<inter>\<^sub>+ m\<^sub>2)"
+
+text \<open> Extra lemmas for the non-standard map operators \<close>
+
+lemma dom_res_singleton:
+  assumes "m $$ k = Some v"
+  shows "{k} \<lhd> m = {k $$:= v}"
+  using assms
+proof (induction m)
+  case fmempty
+  then show ?case
+    by simp
+next
+  case (fmupd k' v' m)
+  then show ?case
+  proof (cases "k = k'")
+    case True
+    with \<open>m(k' $$:= v') $$ k = Some v\<close> have "v = v'"
+      by simp
+    with True have "{k} \<lhd> m(k' $$:= v') = ({k} \<lhd> m)(k $$:= v)"
+      by simp
+    also from True and \<open>m $$ k' = None\<close> have "\<dots> = {$$}(k $$:= v)"
+      by (simp add: fmap_ext)
+    finally show ?thesis
+      by simp
+  next
+    case False
+    with \<open>m(k' $$:= v') $$ k = Some v\<close> have *: "m $$ k = Some v"
+      by simp
+    with False have "{k} \<lhd> m(k' $$:= v') = {k} \<lhd> m"
+      by simp
+    with * and fmupd.IH show ?thesis
+      by simp
+  qed
+qed
+
+lemma dom_res_union_distr:
+  shows "(A \<union> B) \<lhd> m = A \<lhd> m ++\<^sub>f B \<lhd> m"
+proof -
+  have "($$) ((A \<union> B) \<lhd> m) \<subseteq>\<^sub>m ($$) (A \<lhd> m ++\<^sub>f B \<lhd> m)"
+  proof (unfold map_le_def, intro ballI)
+    fix k
+    assume "k \<in> dom (($$) ((A \<union> B) \<lhd> m))"
+    then show "((A \<union> B) \<lhd> m) $$ k = (A \<lhd> m ++\<^sub>f B \<lhd> m) $$ k"
+      by auto
+  qed
+  moreover have "($$) (A \<lhd> m ++\<^sub>f B \<lhd> m) \<subseteq>\<^sub>m ($$) ((A \<union> B) \<lhd> m)"
+  proof (unfold map_le_def, intro ballI)
+    fix k
+    assume "k \<in> dom (($$) (A \<lhd> m ++\<^sub>f B \<lhd> m))"
+    then show "(A \<lhd> m ++\<^sub>f B \<lhd> m) $$ k = ((A \<union> B) \<lhd> m) $$ k"
+      by auto
+  qed
+  ultimately show ?thesis
+    using fmlookup_inject and map_le_antisym by blast
+qed
+
+lemma dom_exc_add_distr:
+  shows "s \<lhd>/ (m\<^sub>1 ++\<^sub>f m\<^sub>2) = (s \<lhd>/ m\<^sub>1) ++\<^sub>f (s \<lhd>/ m\<^sub>2)"
+  by (blast intro: fmfilter_add_distrib)
+
+lemma fmap_partition:
+  shows "m = s \<lhd>/ m ++\<^sub>f s \<lhd> m"
+proof (induction m)
+  case fmempty
+  then show ?case
+    by simp
+next
+  case (fmupd k v m)
+  from fmupd.hyps have "s \<lhd>/ m(k $$:= v) ++\<^sub>f s \<lhd> m(k $$:= v) =
+    s \<lhd>/ (m ++\<^sub>f {k $$:= v}) ++\<^sub>f s \<lhd> (m ++\<^sub>f {k $$:= v})"
+    by simp
+  also have "\<dots> = s \<lhd>/ m ++\<^sub>f s \<lhd>/ {k $$:= v} ++\<^sub>f s \<lhd> m ++\<^sub>f s \<lhd> {k $$:= v}"
+    using dom_exc_add_distr by simp
+  finally show ?case
+  proof (cases "k \<in> s")
+    case True
+    then have "s \<lhd>/ m ++\<^sub>f s \<lhd>/ {k $$:= v} ++\<^sub>f s \<lhd> m ++\<^sub>f s \<lhd> {k $$:= v} =
+      s \<lhd>/ m ++\<^sub>f {$$} ++\<^sub>f s \<lhd> m ++\<^sub>f {k $$:= v}"
+      by simp
+    also have "\<dots> = s \<lhd>/ m ++\<^sub>f s \<lhd> m ++\<^sub>f {k $$:= v}"
+      by simp
+    also from fmupd.IH have "\<dots> = m ++\<^sub>f {k $$:= v}"
+      by simp
+    finally show ?thesis using fmupd.hyps
+      by auto
+  next
+    case False
+    then have "s \<lhd>/ m ++\<^sub>f s \<lhd>/ {k $$:= v} ++\<^sub>f s \<lhd> m ++\<^sub>f s \<lhd> {k $$:= v} =
+      s \<lhd>/ m ++\<^sub>f {k $$:= v} ++\<^sub>f s \<lhd> m ++\<^sub>f {$$}"
+      by simp
+    also have "\<dots> = s \<lhd>/ m ++\<^sub>f {k $$:= v} ++\<^sub>f s \<lhd> m"
+      by simp
+    also from fmupd.hyps have "\<dots> = s \<lhd>/ m ++\<^sub>f s \<lhd> m ++\<^sub>f {k $$:= v}"
+      using fmap_singleton_comm by (metis (full_types) fmadd_assoc fmlookup_filter)
+    also from fmupd.IH have "\<dots> = m ++\<^sub>f {k $$:= v}"
+      by simp
+    finally show ?thesis
+      by auto
+  qed
+qed
+
+lemma dom_res_addition_in:
+  assumes "m\<^sub>1 $$ k = None"
+  and "m\<^sub>2 $$ k = Some v'"
+  shows "fmdom' (m\<^sub>1(k $$:= v)) \<lhd> m\<^sub>2 = fmdom' m\<^sub>1 \<lhd> m\<^sub>2 ++\<^sub>f {k $$:= v'}"
+proof -
+  from \<open>m\<^sub>1 $$ k = None\<close> have "fmdom' (m\<^sub>1(k $$:= v)) \<lhd> m\<^sub>2 = (fmdom' m\<^sub>1 \<union> {k}) \<lhd> m\<^sub>2"
+    by simp
+  also have "\<dots> = fmdom' m\<^sub>1 \<lhd> m\<^sub>2 ++\<^sub>f {k} \<lhd> m\<^sub>2"
+    using dom_res_union_distr .
+  finally show ?thesis
+    using \<open>m\<^sub>2 $$ k = Some v'\<close> and dom_res_singleton by fastforce
+qed
+
+lemma dom_res_addition_not_in:
+  assumes "m\<^sub>2 $$ k = None"
+  shows "fmdom' (m\<^sub>1(k $$:= v)) \<lhd> m\<^sub>2 = fmdom' m\<^sub>1 \<lhd> m\<^sub>2"
+proof -
+  have "fmdom' (m\<^sub>1(k $$:= v)) \<lhd> m\<^sub>2 = fmfilter (\<lambda>k'. k' = k \<or> k' \<in> fmdom' m\<^sub>1) m\<^sub>2"
+    by simp
+  also have "\<dots> = fmdom' m\<^sub>1 \<lhd> m\<^sub>2"
+  proof (intro fmfilter_cong')
+    show "m\<^sub>2 = m\<^sub>2" ..
+  next
+    from assms show "k' \<in> fmdom' m\<^sub>2 \<Longrightarrow> (k' = k \<or> k' \<in> fmdom' m\<^sub>1) = (k' \<in> fmdom' m\<^sub>1)" for k'
+    by (cases "k' = k") (simp_all add: fmdom'_notI)
+  qed
+  finally show ?thesis .
+qed
+
+lemma inter_plus_addition_in:
+  assumes "m\<^sub>1 $$ k = None"
+  and "m\<^sub>2 $$ k = Some v'"
+  shows "m\<^sub>1(k $$:= v) \<inter>\<^sub>+ m\<^sub>2 = (m\<^sub>1 \<inter>\<^sub>+ m\<^sub>2) ++\<^sub>f {k $$:= v' + v}"
+proof -
+  let ?f = "\<lambda>k' v'. v' + m\<^sub>1(k $$:= v) $$! k'"
+  from assms have "m\<^sub>1(k $$:= v) \<inter>\<^sub>+ m\<^sub>2 = fmmap_keys ?f ((fmdom' m\<^sub>1 \<lhd> m\<^sub>2) ++\<^sub>f {k $$:= v'})"
+    using dom_res_addition_in by fastforce
+  also have "\<dots> = fmmap_keys ?f (fmdom' m\<^sub>1 \<lhd> m\<^sub>2) ++\<^sub>f fmmap_keys ?f {k $$:= v'}"
+  proof -
+    from \<open>m\<^sub>1 $$ k = None\<close> have "fmdom' (fmdom' m\<^sub>1 \<lhd> m\<^sub>2) \<inter> fmdom' {k $$:= v'} = {}"
+      by (simp add: fmdom'_notI)
+    then show ?thesis
+      using fmmap_keys_hom by blast
+  qed
+  also from assms
+  have "\<dots> = fmmap_keys ?f (fmdom' m\<^sub>1 \<lhd> m\<^sub>2) ++\<^sub>f {k $$:= v' + v}"
+  proof -
+    have "fmmap_keys ?f {k $$:= v'} = {k $$:= v' + v}"
+    proof (intro fmap_ext)
+      fix k'
+      have "fmmap_keys ?f {k $$:= v'} $$ k' = map_option (?f k') ({k $$:= v'} $$ k')"
+        using fmlookup_fmmap_keys .
+      also have "\<dots> = map_option (?f k') (if k = k' then Some v' else {$$} $$ k')"
+        by simp
+      also have "\<dots> = {k $$:= v' + v} $$ k'"
+        by (cases "k' = k") simp_all
+      finally show "fmmap_keys ?f {k $$:= v'} $$ k' = {k $$:= v' + v} $$ k'" .
+    qed
+    then show ?thesis
+      by simp
+  qed
+  also have "\<dots> = fmmap_keys (\<lambda>k' v'. v' + m\<^sub>1 $$! k') (fmdom' m\<^sub>1 \<lhd> m\<^sub>2) ++\<^sub>f {k $$:= v' + v}"
+    by (simp add: fmap_ext)
+  finally show ?thesis .
+qed
+
+lemma inter_plus_addition_notin:
+  assumes "m\<^sub>1 $$ k = None"
+  and "m\<^sub>2 $$ k = None"
+  shows "m\<^sub>1(k $$:= v) \<inter>\<^sub>+ m\<^sub>2 = (m\<^sub>1 \<inter>\<^sub>+ m\<^sub>2)"
+proof -
+  let ?f = "\<lambda>k' v'. v' + m\<^sub>1(k $$:= v) $$! k'"
+  from \<open>m\<^sub>2 $$ k = None\<close>
+  have "m\<^sub>1(k $$:= v) \<inter>\<^sub>+ m\<^sub>2 = fmmap_keys ?f (fmdom' m\<^sub>1 \<lhd> m\<^sub>2)"
+    using dom_res_addition_not_in by metis
+  also have "\<dots> = fmmap_keys (\<lambda>k' v'. v' + m\<^sub>1 $$! k') (fmdom' m\<^sub>1 \<lhd> m\<^sub>2)"
+  proof (intro fmap_ext)
+    fix k'
+    have "fmmap_keys ?f (fmdom' m\<^sub>1 \<lhd> m\<^sub>2) $$ k' = map_option (?f k') ((fmdom' m\<^sub>1 \<lhd> m\<^sub>2) $$ k')"
+      using fmlookup_fmmap_keys .
+    also from \<open>m\<^sub>1 $$ k = None\<close> have "\<dots> = fmmap_keys (\<lambda>k' v'. v' + m\<^sub>1 $$! k') (fmdom' m\<^sub>1 \<lhd> m\<^sub>2) $$ k'"
+      by (cases "k' = k") (simp_all add: fmdom'_notI)
+    finally show "fmmap_keys ?f (fmdom' m\<^sub>1 \<lhd> m\<^sub>2) $$ k' =
+      fmmap_keys (\<lambda>k' v'. v' + m\<^sub>1 $$! k') (fmdom' m\<^sub>1 \<lhd> m\<^sub>2) $$ k'" .
+  qed
+  finally show ?thesis .
+qed
+
+lemma union_plus_addition_notin: (* TODO: Find nicer proofs for SMT calls. *)
+  assumes "m\<^sub>1 $$ k = None"
+  and "m\<^sub>2 $$ k = None"
+  shows "m\<^sub>1(k $$:= v) \<union>\<^sub>+ m\<^sub>2 = (m\<^sub>1 \<union>\<^sub>+ m\<^sub>2) ++\<^sub>f {k $$:= v}"
+proof -
+  from \<open>m\<^sub>2 $$ k = None\<close> have "(m\<^sub>1(k $$:= v)) \<union>\<^sub>+ m\<^sub>2 =
+    fmdom' m\<^sub>2 \<lhd>/ m\<^sub>1 ++\<^sub>f {k $$:= v} ++\<^sub>f fmdom' (m\<^sub>1(k $$:= v)) \<lhd>/ m\<^sub>2 ++\<^sub>f (m\<^sub>1(k $$:= v) \<inter>\<^sub>+ m\<^sub>2)"
+    by (simp add: fmdom'_notI)
+  also from assms have "\<dots> =
+    fmdom' m\<^sub>2 \<lhd>/ m\<^sub>1 ++\<^sub>f {k $$:= v} ++\<^sub>f fmdom' m\<^sub>1 \<lhd>/ m\<^sub>2 ++\<^sub>f (m\<^sub>1(k $$:= v) \<inter>\<^sub>+ m\<^sub>2)"
+    by (smt fmdom'_fmupd fmfilter_cong insert_iff option.distinct(1))
+  also from assms have "\<dots> = fmdom' m\<^sub>2 \<lhd>/ m\<^sub>1 ++\<^sub>f {k $$:= v} ++\<^sub>f fmdom' m\<^sub>1 \<lhd>/ m\<^sub>2 ++\<^sub>f (m\<^sub>1 \<inter>\<^sub>+ m\<^sub>2)"
+    using inter_plus_addition_notin by metis
+  also from assms have "\<dots> = fmdom' m\<^sub>2 \<lhd>/ m\<^sub>1 ++\<^sub>f fmdom' m\<^sub>1 \<lhd>/ m\<^sub>2 ++\<^sub>f (m\<^sub>1 \<inter>\<^sub>+ m\<^sub>2) ++\<^sub>f {k $$:= v}"
+    using fmap_singleton_comm
+    by (smt fmadd_assoc fmfilter_fmmap_keys fmlookup_filter fmlookup_fmmap_keys)
+  finally show ?thesis .
+qed
+
+end
diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 398ab6d..38e2403 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -3,6 +3,7 @@ section \<open> Implementation of the Ouroboros Praos protocol \<close>
 theory Ouroboros_Praos_Implementation
   imports
     Chi_Calculus.Typed_Basic_Transition_System
+    Finite_Map_Extras
     "HOL-Library.BNF_Corec"
     Complex_Main
 begin
@@ -262,7 +263,7 @@ type_synonym stakeholder_id = nat
 
 type_synonym stake = nat
 
-type_synonym stake_distr = "stakeholder_id \<rightharpoonup> stake"
+type_synonym stake_distr = "(stakeholder_id, stake) fmap"
 
 paragraph \<open> Genesis block. \<close>
 
@@ -310,7 +311,11 @@ text \<open>
 \<close>
 
 fun apply_transaction :: "transaction \<Rightarrow> stake_distr \<Rightarrow> stake_distr" where
-  "apply_transaction ((U\<^sub>i, U\<^sub>j, s), _) \<S> = \<S>(U\<^sub>i \<mapsto> the (\<S> U\<^sub>i) - s, U\<^sub>j \<mapsto> the (\<S> U\<^sub>j) + s)"
+  "apply_transaction ((U\<^sub>i, U\<^sub>j, s), _) \<S> = (
+    let
+      \<S>' = \<S>(U\<^sub>i $$:= \<S> $$! U\<^sub>i - s)
+    in
+      \<S>'(U\<^sub>j $$:= \<S>' $$! U\<^sub>j + s))"
 
 paragraph \<open> Block. \<close>
 
@@ -405,7 +410,7 @@ text \<open>
 \<close>
 
 abbreviation absolute_stake :: "stake_distr \<Rightarrow> stake" (\<open>s\<^sup>+'(_')\<close>) where
-  "s\<^sup>+(\<S>) \<equiv> \<Sum>U\<^sub>j \<in> dom \<S>. the (\<S> U\<^sub>j)"
+  "s\<^sup>+(\<S>) \<equiv> \<Sum>U\<^sub>j \<in> fmdom' \<S>. \<S> $$! U\<^sub>j"
 
 text \<open>
   and the relative stake controlled by @{emph \<open>a single\<close>} stakeholder \<open>U\<^sub>i\<close>, taken as
@@ -420,7 +425,7 @@ abbreviation
 where
   "\<alpha>\<^sup>+(U\<^sub>i, \<S>) \<equiv>
     let
-      s\<^sub>i = the (\<S> U\<^sub>i);
+      s\<^sub>i = \<S> $$! U\<^sub>i;
       s\<^sub>\<P> = s\<^sup>+(\<S>)
     in
       s\<^sub>i / s\<^sub>\<P>"
@@ -517,7 +522,7 @@ abbreviation verify_tx :: "transaction \<Rightarrow> genesis \<Rightarrow> bool"
       (vks, \<S>\<^sub>0, _) = G;
       (_, _, vk\<^sub>i) = the (vks U\<^sub>i) \<comment> \<open>\<open>U\<^sub>i\<close>'s DSIG verification key\<close>
     in
-      \<exists>s\<^sub>i s\<^sub>j. \<S>\<^sub>0 U\<^sub>i = Some s\<^sub>i \<and> \<S>\<^sub>0 U\<^sub>j = Some s\<^sub>j \<and> s\<^sub>i \<ge> s \<and> verify vk\<^sub>i txbody \<sigma>"
+      \<exists>s\<^sub>i s\<^sub>j. \<S>\<^sub>0 $$ U\<^sub>i = Some s\<^sub>i \<and> \<S>\<^sub>0 $$ U\<^sub>j = Some s\<^sub>j \<and> s\<^sub>i \<ge> s \<and> verify vk\<^sub>i txbody \<sigma>"
 
 text \<open>
   and thus we can trivially verify whether a list of transactions is valid w.r.t. a genesis block:
diff --git a/Isabelle/Ouroboros/ROOT b/Isabelle/Ouroboros/ROOT
index d8f4937..4ad2434 100644
--- a/Isabelle/Ouroboros/ROOT
+++ b/Isabelle/Ouroboros/ROOT
@@ -4,6 +4,7 @@ session Ouroboros (ouroboros) = Chi_Calculus +
   description \<open>Formalization of the Ouroboros protocol.\<close>
   theories
     Ouroboros_Praos_Implementation
+    Finite_Map_Extras
   document_files
     "root.tex"
     "root.bib"

From 479e616bc39b249221cf567235408346d929b39e Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Mon, 5 Oct 2020 20:43:49 -0300
Subject: [PATCH 07/12] Change to use `Sublist.prefix` for `is_prefix_of`

---
 .../Ouroboros/Ouroboros_Praos_Implementation.thy  | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 38e2403..4700298 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -5,6 +5,7 @@ theory Ouroboros_Praos_Implementation
     Chi_Calculus.Typed_Basic_Transition_System
     Finite_Map_Extras
     "HOL-Library.BNF_Corec"
+    "HOL-Library.Sublist"
     Complex_Main
 begin
 
@@ -369,6 +370,13 @@ text \<open>
 
 type_synonym blockchain = "block list"
 
+text \<open>
+  We let \<open>\<C>\<^sub>1 \<preceq> \<C>\<^sub>2\<close> indicate that the blockchain \<open>\<C>\<^sub>1\<close> is a prefix of the blockchain \<open>\<C>\<^sub>2\<close>:
+\<close>
+
+abbreviation is_prefix_of :: "blockchain \<Rightarrow> blockchain \<Rightarrow> bool" (infix \<open>\<preceq>\<close> 50) where
+  "\<C>\<^sub>1 \<preceq> \<C>\<^sub>2 \<equiv> prefix \<C>\<^sub>1 \<C>\<^sub>2"
+
 text \<open>
   We define a function to prune the last \<open>m\<close> blocks in a blockchain \<open>\<C>\<close>, denoted by \<open>\<C>\<^bsup>\<lceil>m\<^esup>\<close> in the
   paper:
@@ -384,13 +392,6 @@ text \<open>
 abbreviation prune_after :: "slot \<Rightarrow> blockchain \<Rightarrow> blockchain" where
   "prune_after sl \<C> \<equiv> takeWhile (\<lambda>B. bl_slot B \<le> sl) \<C>"
 
-text \<open>
-  We let \<open>\<C>\<^sub>1 \<preceq> \<C>\<^sub>2\<close> indicate that the blockchain \<open>\<C>\<^sub>1\<close> is a prefix of the blockchain \<open>\<C>\<^sub>2\<close>:
-\<close>
-
-abbreviation is_prefix_of :: "blockchain \<Rightarrow> blockchain \<Rightarrow> bool" (infixl \<open>\<preceq>\<close> 50) where
-  "\<C>\<^sub>1 \<preceq> \<C>\<^sub>2 \<equiv> \<exists>m. \<C>\<^sub>2 \<lceil>m = \<C>\<^sub>1"
-
 text \<open>
   And we can apply a blockchain \<open>\<C>\<close> to a stake distribution \<open>\<S>\<close> by sequentially applying all blocks
   in \<open>\<C>\<close> to \<open>\<S>\<close>:

From abcc5ae06e9849a7af0cb1ec1385356f325cfe4c Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Tue, 6 Oct 2020 13:03:16 -0300
Subject: [PATCH 08/12] Add sanity check for `apply_transaction`

---
 .../Ouroboros_Praos_Implementation.thy        | 33 +++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 4700298..88f8bb0 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -318,6 +318,39 @@ fun apply_transaction :: "transaction \<Rightarrow> stake_distr \<Rightarrow> st
     in
       \<S>'(U\<^sub>j $$:= \<S>' $$! U\<^sub>j + s))"
 
+text \<open>
+  Applying a transaction with the same stakeholder as sender and receiver does not change the
+  stake distribution:
+\<close>
+
+lemma self_transfer_invariancy:
+  assumes "U\<^sub>i |\<in>| fmdom \<S>"
+  and "\<S> $$! U\<^sub>i \<ge> s"
+  shows "apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S> = \<S>"
+proof (rule fsubset_antisym)
+  let ?\<S>' = "apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S>"
+  show "?\<S>' \<subseteq>\<^sub>f \<S>"
+  unfolding fmsubset.rep_eq proof (unfold map_le_def, intro ballI)
+    fix U
+    assume "U \<in> dom (($$) ?\<S>')"
+    then show "?\<S>' $$ U = \<S> $$ U"
+    proof (cases "U = U\<^sub>i")
+      case True
+      then have "?\<S>' $$ U = Some (\<S> $$! U - s + s)"
+        by simp
+      also from True and assms have "\<dots> = \<S> $$ U"
+        by auto
+      finally show ?thesis .
+    next
+      case False
+      then show ?thesis
+        by simp
+    qed
+  qed
+  then show "\<S> \<subseteq>\<^sub>f apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S>"
+    unfolding fmsubset.rep_eq and map_le_def by simp
+qed
+
 paragraph \<open> Block. \<close>
 
 text \<open>

From bc70b020738db8aae6fb86d0f11011dac37dfa34 Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Tue, 6 Oct 2020 19:13:16 -0300
Subject: [PATCH 09/12] Add sanity check for `apply_block`

---
 .../Ouroboros_Praos_Implementation.thy        | 59 ++++++++++++++++++-
 1 file changed, 58 insertions(+), 1 deletion(-)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 88f8bb0..13fb254 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -394,11 +394,68 @@ text \<open>
 abbreviation apply_block :: "block \<Rightarrow> stake_distr \<Rightarrow> stake_distr" where
   "apply_block B \<S> \<equiv> fold apply_transaction (bl_txs B) \<S>"
 
+text \<open>
+  Applying a block including only a transaction and its corresponding refund transaction does not
+  affect the stake distribution:
+\<close>
+
+lemma transaction_refund_invariancy:
+  assumes "bl_txs B = [((U\<^sub>i, U\<^sub>j, s), \<sigma>\<^sub>1), ((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)]"
+  and "{U\<^sub>i, U\<^sub>j} \<subseteq> fmdom' \<S>"
+  and "\<S> $$! U\<^sub>i \<ge> s"
+  shows "apply_block B \<S> = \<S>"
+proof -
+  let ?\<S>\<^sub>1 = "\<S>(U\<^sub>i $$:= \<S> $$! U\<^sub>i - s)"
+  let ?\<S>\<^sub>2 = "?\<S>\<^sub>1(U\<^sub>j $$:= ?\<S>\<^sub>1 $$! U\<^sub>j + s)"
+  let ?\<S>\<^sub>3 = "?\<S>\<^sub>2(U\<^sub>j $$:= ?\<S>\<^sub>2 $$! U\<^sub>j - s)"
+  let ?\<S>\<^sub>4 = "?\<S>\<^sub>3(U\<^sub>i $$:= ?\<S>\<^sub>3 $$! U\<^sub>i + s)"
+  from assms(1) have "apply_block B \<S> =
+    fold apply_transaction [((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)] (apply_transaction ((U\<^sub>i, U\<^sub>j, s), \<sigma>\<^sub>1) \<S>)"
+    by simp
+  also have "\<dots> = fold apply_transaction [((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)] ?\<S>\<^sub>2"
+    by simp
+  also have "\<dots> = ?\<S>\<^sub>4"
+    by simp
+  also have "\<dots> = \<S>"
+  proof (rule fsubset_antisym)
+    show "?\<S>\<^sub>4 \<subseteq>\<^sub>f \<S>"
+    unfolding fmsubset.rep_eq proof (unfold map_le_def, intro ballI)
+      fix U
+      assume "U \<in> dom (($$) ?\<S>\<^sub>4)"
+      consider (a) "U = U\<^sub>i" | (b) "U = U\<^sub>j" | (c) "U \<noteq> U\<^sub>i" and "U \<noteq> U\<^sub>j"
+        by auto
+      then show "?\<S>\<^sub>4 $$ U = \<S> $$ U"
+      proof cases
+        case a
+        then have "?\<S>\<^sub>4 $$ U = Some (\<S> $$! U - s + s)"
+          by simp
+        also from a and assms(2,3) have "\<dots> = \<S> $$ U"
+          by (simp add: fmlookup_dom'_iff)
+        finally show ?thesis .
+      next
+        case b
+        with assms(3) have "?\<S>\<^sub>4 $$ U = Some (\<S> $$! U + s - s)"
+          by auto
+        also from b and assms(2) have "\<dots> = \<S> $$ U"
+          by (simp add: fmlookup_dom'_iff)
+        finally show ?thesis .
+      next
+        case c
+        then show ?thesis
+          by simp
+      qed
+    qed
+    show "\<S> \<subseteq>\<^sub>f ?\<S>\<^sub>4"
+      using \<open>?\<S>\<^sub>4 \<subseteq>\<^sub>f \<S>\<close> unfolding fmsubset.rep_eq and map_le_def by auto
+  qed
+  finally show ?thesis .
+qed
+
 paragraph \<open> Blockchain. \<close>
 
 text \<open>
   A blockchain is simply a sequence of blocks. We do not record the genesis block explicitly as
-  part of the blockchain: 
+  part of the blockchain:
 \<close>
 
 type_synonym blockchain = "block list"

From b7c6d877208333cd89878073345676e3d70b81ea Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Wed, 7 Oct 2020 13:15:15 -0300
Subject: [PATCH 10/12] Add sanity check for `is_prefix_of`

---
 .../Ouroboros_Praos_Implementation.thy        | 21 +++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 13fb254..799b9ff 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -467,6 +467,27 @@ text \<open>
 abbreviation is_prefix_of :: "blockchain \<Rightarrow> blockchain \<Rightarrow> bool" (infix \<open>\<preceq>\<close> 50) where
   "\<C>\<^sub>1 \<preceq> \<C>\<^sub>2 \<equiv> prefix \<C>\<^sub>1 \<C>\<^sub>2"
 
+text \<open>
+  A prefix of a blockchain keeps all properties on its elements that hold for the original blockchain:
+\<close>
+
+lemma prefix_invariancy:
+  assumes "\<forall>i \<in> {0..<length \<C>\<^sub>2}. P (\<C>\<^sub>2 ! i)"
+  and "\<C>\<^sub>1 \<preceq> \<C>\<^sub>2"
+  shows "\<forall>i \<in> {0..<length \<C>\<^sub>1}. P (\<C>\<^sub>1 ! i)"
+  using assms
+proof (intro ballI)
+  fix i
+  assume "i \<in> {0..<length \<C>\<^sub>1}"
+  then have *: "i < length \<C>\<^sub>1"
+    by simp
+  moreover from assms(2) obtain \<C>\<^sub>3 where **: "\<C>\<^sub>2 = \<C>\<^sub>1 @ \<C>\<^sub>3" ..
+  ultimately have "P (\<C>\<^sub>2 ! i)"
+    using assms(1) by simp
+  with * and ** show "P (\<C>\<^sub>1 ! i)"
+    by (simp add: nth_append)
+qed
+
 text \<open>
   We define a function to prune the last \<open>m\<close> blocks in a blockchain \<open>\<C>\<close>, denoted by \<open>\<C>\<^bsup>\<lceil>m\<^esup>\<close> in the
   paper:

From 7e76f3daa3adb9b080283b50f971f025999e0124 Mon Sep 17 00:00:00 2001
From: Javier Diaz <jdiaz@atixlabs.com>
Date: Wed, 7 Oct 2020 13:51:07 -0300
Subject: [PATCH 11/12] Add sanity checks for `prune_chain`

---
 .../Ouroboros_Praos_Implementation.thy        | 21 ++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 799b9ff..38e7da8 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -497,7 +497,26 @@ abbreviation prune_chain :: "blockchain \<Rightarrow> nat \<Rightarrow> blockcha
   "\<C> \<lceil>m \<equiv> take (length \<C> - m) \<C>"
 
 text \<open>
-  and a function to prune the blocks in a blockchain which have slots greater than a given slot:
+  The \<open>\<C>\<^bsup>\<lceil>m\<^esup>\<close> operator satisfies some simple laws:
+\<close>
+
+lemma zero_blocks_chain_prunning_identity:
+  shows "\<C> \<lceil>0 = \<C>"
+  by simp
+
+lemma long_chain_prunning_emptiness:
+  assumes "m \<ge> length \<C>"
+  shows "\<C> \<lceil>m = []"
+  using assms
+  by simp
+
+lemma append_prune_chain_drop_identity:
+  shows "\<C> \<lceil>m @ drop (length \<C> - m) \<C> = \<C>"
+  by simp
+
+text \<open>
+  Also, we define a function to prune the blocks in a blockchain which have slots greater than a
+  given slot:
 \<close>
 
 abbreviation prune_after :: "slot \<Rightarrow> blockchain \<Rightarrow> blockchain" where

From 091199de81ca793c456ba4651e981a724485672e Mon Sep 17 00:00:00 2001
From: javierdiaz72 <javier.diaz@iohk.io>
Date: Fri, 21 Jan 2022 13:23:44 -0300
Subject: [PATCH 12/12] Save WIP in preparation for repository split

---
 .../Chi_Calculus/Basic_Transition_System.thy  |   88 +-
 Isabelle/Chi_Calculus/Core_Bisimilarities.thy |  214 +-
 .../Chi_Calculus/Proper_Transition_System.thy |   24 +-
 .../Typed_Basic_Transition_System.thy         |   32 +-
 .../Typed_Proper_Transition_System.thy        |   10 +-
 .../Ouroboros_Praos_Implementation.thy        | 2828 +++++++++++++----
 6 files changed, 2438 insertions(+), 758 deletions(-)

diff --git a/Isabelle/Chi_Calculus/Basic_Transition_System.thy b/Isabelle/Chi_Calculus/Basic_Transition_System.thy
index 6d6e248..bc8d789 100644
--- a/Isabelle/Chi_Calculus/Basic_Transition_System.thy
+++ b/Isabelle/Chi_Calculus/Basic_Transition_System.thy
@@ -25,7 +25,7 @@ subsection \<open>Residuals\<close>
 
 text \<open>
   There are two kinds of residuals in the basic transition system: acting residuals, written \<open>\<lbrace>\<alpha>\<rbrace> q\<close>
-  where \<open>\<alpha>\<close> is an action, and scope opening residuals, written \<open>\<lbrace>\<nu> a\<rbrace> Q a\<close> where \<open>a\<close> is a channel
+  where \<open>\<alpha>\<close> is an action, and scope extruding residuals, written \<open>\<lbrace>\<nu> a\<rbrace> Q a\<close> where \<open>a\<close> is a channel
   variable.
 \<close>
 
@@ -55,7 +55,7 @@ where
 
 lemmas basic_lift_intros = basic_residual.rel_intros
 lemmas acting_lift = basic_lift_intros(1)
-lemmas opening_lift = basic_lift_intros(2)
+lemmas extruding_lift = basic_lift_intros(2)
 lemmas basic_lift_cases = basic_residual.rel_cases
 
 text \<open>
@@ -117,23 +117,23 @@ where
     "a \<triangleright> x. P x \<rightarrow>\<^sub>\<flat>\<lbrace>a \<triangleright> x\<rbrace> P x" |
   communication:
     "\<lbrakk> \<eta> \<bowtie> \<mu>; p \<rightarrow>\<^sub>\<flat>\<lbrace>IO \<eta>\<rbrace> p'; q \<rightarrow>\<^sub>\<flat>\<lbrace>IO \<mu>\<rbrace> q' \<rbrakk> \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<tau>\<rbrace> p' \<parallel> q'" |
-  opening:
+  extruding:
     "\<nu> a. P a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a" |
   acting_left:
     "p \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> p' \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> p' \<parallel> q" |
   acting_right:
     "q \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> q' \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> p \<parallel> q'" |
-  opening_left:
+  extruding_left:
     "p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a \<parallel> q" |
-  opening_right:
+  extruding_right:
     "q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> Q a \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> p \<parallel> Q a" |
   scoped_acting:
     "\<lbrakk> p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> Q a; \<And>a. Q a \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> R a \<rbrakk> \<Longrightarrow> p \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> \<nu> a. R a" |
-  scoped_opening:
+  scoped_extruding:
     "\<lbrakk> p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> Q a; \<And>a. Q a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> R a b \<rbrakk> \<Longrightarrow> p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> \<nu> a. R a b"
 
 text \<open>
-  Note that \<open>scoped_acting\<close> and\<open>scoped_opening\<close> are the rules that perform closing.
+  Note that \<open>scoped_acting\<close> and\<open>scoped_extruding\<close> are the rules that perform closing.
 \<close>
 
 text \<open>
@@ -153,24 +153,24 @@ notation basic.bisimilarity (infix \<open>\<sim>\<^sub>\<flat>\<close> 50)
 subsection \<open>Fundamental Properties of the Transition System\<close>
 
 text \<open>
-  Edsko's \texttt{Com} rule can be simulated using a combination of \<open>opening_left\<close> (or, in the
-  right-to-left case, \<open>opening_right\<close>), \<open>communication\<close>, and \<open>scoped_acting\<close>. Reordering of openings
-  can be simulated using \<open>scoped_opening\<close>.
+  Edsko's \texttt{Com} rule can be simulated using a combination of \<open>extruding_left\<close> (or, in the
+  right-to-left case, \<open>extruding_right\<close>), \<open>communication\<close>, and \<open>scoped_acting\<close>. Reordering of extrudings
+  can be simulated using \<open>scoped_extruding\<close>.
 \<close>
 
 text \<open>
-  An acting and an opening version of the \texttt{Scope} rule in Edsko's definition can be derived
-  by combining \<open>opening\<close> with the closing rules.
+  An acting and an extruding version of the \texttt{Scope} rule in Edsko's definition can be derived
+  by combining \<open>extruding\<close> with the closing rules.
 \<close>
 
 lemma acting_scope: "(\<And>a. P a \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> Q a) \<Longrightarrow> \<nu> a. P a \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> \<nu> a. Q a"
-  using opening by (intro scoped_acting)
-lemma opening_scope: "(\<And>a. P a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q a b) \<Longrightarrow> \<nu> a. P a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> \<nu> a. Q a b"
-  using opening by (intro scoped_opening)
+  using extruding by (intro scoped_acting)
+lemma extruding_scope: "(\<And>a. P a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q a b) \<Longrightarrow> \<nu> a. P a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> \<nu> a. Q a b"
+  using extruding by (intro scoped_extruding)
 
 text \<open>
   No transitions are possible from~\<open>\<zero>\<close>. This is not as trivial as it might seem, because also
-  \<open>scoped_acting\<close> and \<open>scoped_opening\<close> have to be taken into account.
+  \<open>scoped_acting\<close> and \<open>scoped_extruding\<close> have to be taken into account.
 \<close>
 
 lemma no_basic_transitions_from_stop: "\<not> \<zero> \<rightarrow>\<^sub>\<flat>c"
@@ -196,7 +196,7 @@ proof -
     case scoped_acting
     then show ?case by simp
   next
-    case scoped_opening
+    case scoped_extruding
     then show ?case by simp
   qed
 qed
@@ -210,17 +210,17 @@ next
   case scoped_acting
   then show ?case by blast
 next
-  case scoped_opening
+  case scoped_extruding
   then show ?case by blast
 qed
 
 text \<open>
-  No opening transitions are possible from send and receive processes.
+  No extruding transitions are possible from send and receive processes.
 \<close>
 
-lemma no_opening_transitions_from_send: "\<not> a \<triangleleft> x \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b"
+lemma no_extruding_transitions_from_send: "\<not> a \<triangleleft> x \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b"
   using basic_transitions_from_send by blast
-lemma no_opening_transitions_from_receive: "\<not> a \<triangleright> x. P x \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b"
+lemma no_extruding_transitions_from_receive: "\<not> a \<triangleright> x. P x \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b"
   using basic_transitions_from_receive by blast
 
 subsection \<open>Proof Tools\<close>
@@ -291,7 +291,7 @@ proof -
     by smt
 qed
 
-private lemma sim_scoped_opening_intro:
+private lemma sim_scoped_extruding_intro:
   assumes with_new_channel:
     "\<And>P Q. (\<And>a. \<X> (P a) (Q a)) \<Longrightarrow> \<X> (\<nu> a. P a) (\<nu> a. Q a)"
   assumes step_1:
@@ -326,9 +326,9 @@ proof -
     with that show ?thesis by blast
   qed
   from \<open>t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T\<^sub>1 a\<close> and \<open>\<And>a. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> T\<^sub>2 a b\<close> have "t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> \<nu> a. T\<^sub>2 a b"
-    by (fact basic_transition.scoped_opening)
+    by (fact basic_transition.scoped_extruding)
   with \<open>\<And>a b. \<X> (S\<^sub>2 a b) (T\<^sub>2 a b)\<close> show ?thesis
-    using with_new_channel and opening_lift and rel_funI
+    using with_new_channel and extruding_lift and rel_funI
     by smt
 qed
 
@@ -346,7 +346,7 @@ private method solve_sim_scoped uses with_new_channel = (
     "\<exists>d\<^sub>2. _ \<rightarrow>\<^sub>\<flat>d\<^sub>2 \<and> basic_lift _ (\<lbrace>\<nu> b\<rbrace> \<nu> a. _ a b) d\<^sub>2" (cut) \<Rightarrow> \<open>
       match premises in "s \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> S\<^sub>1 a" for s and S\<^sub>1 \<Rightarrow> \<open>
         match premises in prems [thin]: _ (multi) \<Rightarrow> \<open>
-          intro sim_scoped_opening_intro [where s = s and S\<^sub>1 = S\<^sub>1],
+          intro sim_scoped_extruding_intro [where s = s and S\<^sub>1 = S\<^sub>1],
           simp add: with_new_channel,
           simp_all add: prems
         \<close>
@@ -376,7 +376,7 @@ proof (standard, intro allI, intro impI)
       unfolding basic.bisimilarity_def
       using basic_transition.receiving and acting_lift
       by (metis (no_types, lifting))
-  qed (simp_all add: no_opening_transitions_from_receive)
+  qed (simp_all add: no_extruding_transitions_from_receive)
 qed
 
 lemma basic_receive_preservation: "(\<And>x. P x \<sim>\<^sub>\<flat> Q x) \<Longrightarrow> a \<triangleright> x. P x \<sim>\<^sub>\<flat> a \<triangleright> x. Q x"
@@ -426,12 +426,12 @@ next
         by auto
     qed
   next
-    case opening
-    from opening.prems show ?case
+    case extruding
+    from extruding.prems show ?case
     proof cases
       case with_new_channel
       then show ?thesis
-        using basic_transition.opening and opening_lift and rel_funI
+        using basic_transition.extruding and extruding_lift and rel_funI
         by (metis (full_types))
     qed
   next
@@ -466,8 +466,8 @@ next
         by metis
     qed
   next
-    case (opening_left p P r t)
-    from opening_left.prems show ?case
+    case (extruding_left p P r t)
+    from extruding_left.prems show ?case
     proof cases
       case (without_new_channel q)
       from \<open>p \<sim>\<^sub>\<flat> q\<close> and \<open>p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a\<close>
@@ -475,25 +475,25 @@ next
         unfolding basic.bisimilarity_def
         by (force elim: basic.pre_bisimilarity.cases basic_lift_cases rel_funE)
       from \<open>q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> Q a\<close> have "q \<parallel> r \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> Q a \<parallel> r"
-        by (fact basic_transition.opening_left)
+        by (fact basic_transition.extruding_left)
       with \<open>t = q \<parallel> r\<close> and \<open>\<And>a. P a \<sim>\<^sub>\<flat> Q a\<close> show ?thesis
         using
           parallel_preservation_left_aux.without_new_channel and
-          opening_lift and
+          extruding_lift and
           rel_funI
         by smt
     qed
   next
-    case (opening_right r R p t)
-    from opening_right.prems show ?case
+    case (extruding_right r R p t)
+    from extruding_right.prems show ?case
     proof cases
       case (without_new_channel q)
       from \<open>r \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> R a\<close> have "q \<parallel> r \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> q \<parallel> R a"
-        by (fact basic_transition.opening_right)
+        by (fact basic_transition.extruding_right)
       from \<open>p \<sim>\<^sub>\<flat> q\<close> have "\<And>a. parallel_preservation_left_aux (p \<parallel> R a) (q \<parallel> R a)"
         by (fact parallel_preservation_left_aux.without_new_channel)
       with \<open>t = q \<parallel> r\<close> and \<open>q \<parallel> r \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> q \<parallel> R a\<close> show ?thesis
-        using opening_lift and rel_funI
+        using extruding_lift and rel_funI
         by smt
     qed
   qed (blast elim: parallel_preservation_left_aux.cases)+
@@ -551,12 +551,12 @@ next
     from communication.prems show ?case
       by cases new_channel_preservation_aux_trivial_conveyance
   next
-    case opening
-    from opening.prems show ?case
+    case extruding
+    from extruding.prems show ?case
     proof cases
       case with_new_channel
       then show ?thesis
-        using basic_transition.opening and opening_lift
+        using basic_transition.extruding and extruding_lift
         by blast
     qed new_channel_preservation_aux_trivial_conveyance
   next
@@ -568,12 +568,12 @@ next
     from acting_right.prems show ?case
       by cases new_channel_preservation_aux_trivial_conveyance
   next
-    case opening_left
-    from opening_left.prems show ?case
+    case extruding_left
+    from extruding_left.prems show ?case
       by cases new_channel_preservation_aux_trivial_conveyance
   next
-    case opening_right
-    from opening_right.prems show ?case
+    case extruding_right
+    from extruding_right.prems show ?case
       by cases new_channel_preservation_aux_trivial_conveyance
   qed
 qed
diff --git a/Isabelle/Chi_Calculus/Core_Bisimilarities.thy b/Isabelle/Chi_Calculus/Core_Bisimilarities.thy
index df75bc3..453917f 100644
--- a/Isabelle/Chi_Calculus/Core_Bisimilarities.thy
+++ b/Isabelle/Chi_Calculus/Core_Bisimilarities.thy
@@ -31,35 +31,35 @@ private method parallel_scope_extension_left_subaux_communication_conveyance =
 private method parallel_scope_extension_left_subaux_acting_left_conveyance =
   (parallel_scope_extension_left_subaux_trivial_conveyance intro: acting_left)
 
-private method parallel_scope_extension_left_subaux_opening_left_conveyance =
-  (parallel_scope_extension_left_subaux_trivial_conveyance intro: opening_left)
+private method parallel_scope_extension_left_subaux_extruding_left_conveyance =
+  (parallel_scope_extension_left_subaux_trivial_conveyance intro: extruding_left)
 
-private lemma parallel_scope_extension_left_subaux_opening_conveyance:
+private lemma parallel_scope_extension_left_subaux_extruding_conveyance:
   assumes initial_relation: "parallel_scope_extension_left_subaux q p t"
   assumes transition: "p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a"
   shows "\<exists>T. t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T a \<and> (\<forall>a. parallel_scope_extension_left_subaux q (P a) (T a))"
 using transition and initial_relation and transition
 proof (induction (no_simp) p "\<lbrace>\<nu> a\<rbrace> P a" arbitrary: P t)
-  case (opening P P' t)
-  from opening.prems show ?case
+  case (extruding P P' t)
+  from extruding.prems show ?case
   proof cases
     case with_new_channel
     with \<open>\<lbrace>\<nu> a\<rbrace> P a = \<lbrace>\<nu> a\<rbrace> P' a\<close> show ?thesis
-      using basic_transition.opening
+      using basic_transition.extruding
       by blast
-  qed parallel_scope_extension_left_subaux_opening_left_conveyance
+  qed parallel_scope_extension_left_subaux_extruding_left_conveyance
 next
-  case opening_left
-  from opening_left.prems show ?case
-    by cases parallel_scope_extension_left_subaux_opening_left_conveyance
+  case extruding_left
+  from extruding_left.prems show ?case
+    by cases parallel_scope_extension_left_subaux_extruding_left_conveyance
 next
-  case opening_right
-  from opening_right.prems show ?case
-    by cases parallel_scope_extension_left_subaux_opening_left_conveyance
+  case extruding_right
+  from extruding_right.prems show ?case
+    by cases parallel_scope_extension_left_subaux_extruding_left_conveyance
 next
-  case (scoped_opening p P\<^sub>1 P\<^sub>2 P' t)
+  case (scoped_extruding p P\<^sub>1 P\<^sub>2 P' t)
   from
-    scoped_opening.IH(1) and
+    scoped_extruding.IH(1) and
     \<open>parallel_scope_extension_left_subaux q p t\<close> and
     \<open>p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P\<^sub>1 a\<close>
   obtain T\<^sub>1 where
@@ -71,7 +71,7 @@ next
     "\<And>a b. parallel_scope_extension_left_subaux q (P\<^sub>2 a b) (T\<^sub>2 a b)"
   proof -
     from
-      scoped_opening.IH(2) and
+      scoped_extruding.IH(2) and
       \<open>\<And>a. parallel_scope_extension_left_subaux q (P\<^sub>1 a) (T\<^sub>1 a)\<close> and
       \<open>\<And>a. P\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> P\<^sub>2 a b\<close>
     have "
@@ -83,7 +83,7 @@ next
     with that show ?thesis by blast
   qed
   from \<open>t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T\<^sub>1 a\<close> and \<open>\<And>a. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> T\<^sub>2 a b\<close> have "t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> \<nu> a. T\<^sub>2 a b"
-    by (fact basic_transition.scoped_opening)
+    by (fact basic_transition.scoped_extruding)
   with
     \<open>\<lbrace>\<nu> b\<rbrace> \<nu> a. P\<^sub>2 a b = \<lbrace>\<nu> b\<rbrace> P' b\<close> and
     \<open>\<And>a b. parallel_scope_extension_left_subaux q (P\<^sub>2 a b) (T\<^sub>2 a b)\<close>
@@ -161,7 +161,7 @@ next
       obtain T\<^sub>1 where
         "t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T\<^sub>1 a" and
         "\<And>a. parallel_scope_extension_left_subaux q (P\<^sub>1 a) (T\<^sub>1 a)"
-        using parallel_scope_extension_left_subaux_opening_conveyance
+        using parallel_scope_extension_left_subaux_extruding_conveyance
         by blast
       obtain T\<^sub>2 where
         "\<And>a. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<tau>\<rbrace> T\<^sub>2 a" and
@@ -192,8 +192,8 @@ next
       using parallel_scope_extension_left_aux.without_new_channel_ltr and acting_lift
       by auto
   next
-    case (opening S t)
-    from opening.prems show ?case
+    case (extruding S t)
+    from extruding.prems show ?case
     proof cases
       case (without_new_channel_rtl q p)
       from \<open>parallel_scope_extension_left_subaux q p (\<nu> a. S a)\<close> show ?thesis
@@ -201,17 +201,17 @@ next
         case with_new_channel
         with \<open>t = p \<parallel> q\<close> show ?thesis
           using
-            basic_transition.opening and
-            opening_left and
+            basic_transition.extruding and
+            extruding_left and
             parallel_scope_extension_left_aux.without_new_channel_rtl and
-            opening_lift and
+            extruding_lift and
             rel_funI
           by (metis (mono_tags, lifting))
       qed
     next
       case with_new_channel
       then show ?thesis
-        using basic_transition.opening and opening_lift and rel_funI
+        using basic_transition.extruding and extruding_lift and rel_funI
         by metis
     qed
   next
@@ -248,7 +248,7 @@ next
       obtain T\<^sub>1 where
         "t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T\<^sub>1 a" and
         "\<And>a. parallel_scope_extension_left_subaux q (P\<^sub>1 a) (T\<^sub>1 a)"
-        using parallel_scope_extension_left_subaux_opening_conveyance
+        using parallel_scope_extension_left_subaux_extruding_conveyance
         by blast
       obtain T\<^sub>2 where
         "\<And>a. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> T\<^sub>2 a" and
@@ -302,30 +302,30 @@ next
         by metis
     qed
     then show ?case
-      using parallel_scope_extension_left_aux.without_new_channel_ltr and opening_lift
+      using parallel_scope_extension_left_aux.without_new_channel_ltr and extruding_lift
       by auto
   next
-    case (opening_left p P q t)
-    from opening_left.prems have "parallel_scope_extension_left_subaux q p t"
+    case (extruding_left p P q t)
+    from extruding_left.prems have "parallel_scope_extension_left_subaux q p t"
       by (fact parallel_scope_extension_left_aux_without_new_channel_normalization)
-    with opening_left.hyps show ?case
+    with extruding_left.hyps show ?case
       using
-        parallel_scope_extension_left_subaux_opening_conveyance and
+        parallel_scope_extension_left_subaux_extruding_conveyance and
         parallel_scope_extension_left_aux.without_new_channel_ltr and
-        opening_lift and
+        extruding_lift and
         rel_funI
       by smt
   next
-    case (opening_right q Q p t)
-    from opening_right.prems have "parallel_scope_extension_left_subaux q p t"
+    case (extruding_right q Q p t)
+    from extruding_right.prems have "parallel_scope_extension_left_subaux q p t"
       by (fact parallel_scope_extension_left_aux_without_new_channel_normalization)
-    from this and opening_right.hyps
+    from this and extruding_right.hyps
     have "\<exists>T. t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T a \<and> (\<forall>a. parallel_scope_extension_left_subaux (Q a) p (T a))"
     proof induction
       case without_new_channel
       then show ?case
         using
-          basic_transition.opening_right and
+          basic_transition.extruding_right and
           parallel_scope_extension_left_subaux.without_new_channel
         by blast
     next
@@ -337,13 +337,13 @@ next
         \<exists>T'. \<forall>a. T a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> T' a b \<and> (\<forall>b. parallel_scope_extension_left_subaux (Q b) (P a) (T' a b))"
         by (fact choice)
       then show ?case
-        using opening_scope and parallel_scope_extension_left_subaux.with_new_channel
+        using extruding_scope and parallel_scope_extension_left_subaux.with_new_channel
         by metis
     qed
     then show ?case
       using
         parallel_scope_extension_left_aux.without_new_channel_ltr and
-        opening_lift and
+        extruding_lift and
         rel_funI
       by smt
   qed (blast elim:
@@ -364,14 +364,14 @@ proof (standard, intro allI, intro impI)
   assume "\<nu> b. \<nu> a. P a b \<rightarrow>\<^sub>\<flat>c"
   then have "\<nu> a. \<nu> b. P a b \<rightarrow>\<^sub>\<flat>c"
   proof (induction "\<nu> b. \<nu> a. P a b" c)
-    case opening
-    show ?case using basic_transition.opening by (intro opening_scope)
+    case extruding
+    show ?case using basic_transition.extruding by (intro extruding_scope)
   next
     case scoped_acting
     then show ?case by (simp add: basic_transition.scoped_acting)
   next
-    case scoped_opening
-    then show ?case by (simp add: basic_transition.scoped_opening)
+    case scoped_extruding
+    then show ?case by (simp add: basic_transition.scoped_extruding)
   qed
   show "\<exists>d. \<nu> a. \<nu> b. P a b \<rightarrow>\<^sub>\<flat>d \<and> basic_lift (\<lambda>p q. p \<lesssim>\<^sub>\<flat> q \<and> q \<lesssim>\<^sub>\<flat> p) c d"
   proof -
@@ -406,7 +406,7 @@ where
 private method parallel_neutrality_left_aux_trivial_conveyance =
   (blast intro:
     acting_right
-    opening_right
+    extruding_right
     parallel_neutrality_left_aux.without_new_channel_rtl
     basic_lift_intros
   )
@@ -438,12 +438,12 @@ next
         by (simp add: no_basic_transitions_from_stop)
     qed parallel_neutrality_left_aux_trivial_conveyance
   next
-    case opening
-    from opening.prems show ?case
+    case extruding
+    from extruding.prems show ?case
     proof cases
       case with_new_channel
       then show ?thesis
-        using basic_transition.opening and opening_lift and rel_funI
+        using basic_transition.extruding and extruding_lift and rel_funI
         by metis
     qed parallel_neutrality_left_aux_trivial_conveyance
   next
@@ -464,22 +464,22 @@ next
         by auto
     qed parallel_neutrality_left_aux_trivial_conveyance
   next
-    case opening_left
-    from opening_left.prems show ?case
+    case extruding_left
+    from extruding_left.prems show ?case
     proof cases
       case without_new_channel_ltr
-      with opening_left.hyps show ?thesis
+      with extruding_left.hyps show ?thesis
         by (simp add: no_basic_transitions_from_stop)
     qed parallel_neutrality_left_aux_trivial_conveyance
   next
-    case opening_right
-    from opening_right.prems show ?case
+    case extruding_right
+    from extruding_right.prems show ?case
     proof cases
       case without_new_channel_ltr
-      with opening_right.hyps show ?thesis
+      with extruding_right.hyps show ?thesis
         using
           parallel_neutrality_left_aux.without_new_channel_ltr and
-          opening_lift and
+          extruding_lift and
           rel_funI
         by smt
     qed parallel_neutrality_left_aux_trivial_conveyance
@@ -503,45 +503,45 @@ where
     (\<And>a. nested_parallel_commutativity_subaux r (U a) (T a)) \<Longrightarrow>
     nested_parallel_commutativity_subaux r (\<nu> a. U a) (\<nu> a. T a)"
 
-private lemma nested_parallel_commutativity_subaux_opening_conveyance:
+private lemma nested_parallel_commutativity_subaux_extruding_conveyance:
   assumes initial_relation: "nested_parallel_commutativity_subaux r u t"
   assumes transition: "u \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> U a"
   shows "\<exists>T. t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T a \<and> (\<forall>a. nested_parallel_commutativity_subaux r (U a) (T a))"
 using transition and initial_relation
 proof (induction u "\<lbrace>\<nu> a\<rbrace> U a" arbitrary: U t)
-  case (opening U t)
-  from opening.prems show ?case
+  case (extruding U t)
+  from extruding.prems show ?case
   proof cases
     case with_new_channel
     then show ?thesis
-      using basic_transition.opening
+      using basic_transition.extruding
       by blast
   qed
 next
-  case (opening_left p P q t)
-  from opening_left.prems show ?case
+  case (extruding_left p P q t)
+  from extruding_left.prems show ?case
   proof cases
     case without_new_channel
     with \<open>p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a\<close> show ?thesis
       using
-        basic_transition.opening_left and
+        basic_transition.extruding_left and
         nested_parallel_commutativity_subaux.without_new_channel
       by blast
   qed
 next
-  case (opening_right q Q p t)
-  from opening_right.prems show ?case
+  case (extruding_right q Q p t)
+  from extruding_right.prems show ?case
   proof cases
     case without_new_channel
     with \<open>q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> Q a\<close> show ?thesis
       using
-        basic_transition.opening_right and
+        basic_transition.extruding_right and
         nested_parallel_commutativity_subaux.without_new_channel
       by blast
   qed
 next
-  case (scoped_opening u U\<^sub>1 U\<^sub>2 t)
-  from scoped_opening.hyps(2) and \<open>nested_parallel_commutativity_subaux r u t\<close>
+  case (scoped_extruding u U\<^sub>1 U\<^sub>2 t)
+  from scoped_extruding.hyps(2) and \<open>nested_parallel_commutativity_subaux r u t\<close>
   obtain T\<^sub>1 where
     "t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T\<^sub>1 a" and
     "\<And>a. nested_parallel_commutativity_subaux r (U\<^sub>1 a) (T\<^sub>1 a)"
@@ -550,7 +550,7 @@ next
     "\<And>a. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> T\<^sub>2 a b" and
     "\<And>a b. nested_parallel_commutativity_subaux r (U\<^sub>2 a b) (T\<^sub>2 a b)"
   proof -
-    from scoped_opening.hyps(4) and \<open>\<And>a. nested_parallel_commutativity_subaux r (U\<^sub>1 a) (T\<^sub>1 a)\<close>
+    from scoped_extruding.hyps(4) and \<open>\<And>a. nested_parallel_commutativity_subaux r (U\<^sub>1 a) (T\<^sub>1 a)\<close>
     have "
       \<forall>a. \<exists>V. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> V b \<and> (\<forall>b. nested_parallel_commutativity_subaux r (U\<^sub>2 a b) (V b))"
       by blast
@@ -560,7 +560,7 @@ next
     with that show ?thesis by blast
   qed
   from \<open>t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T\<^sub>1 a\<close> and \<open>\<And>a. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> T\<^sub>2 a b\<close> have "t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> \<nu> a. T\<^sub>2 a b"
-    by (fact basic_transition.scoped_opening)
+    by (fact basic_transition.scoped_extruding)
   with \<open>\<And>a b. nested_parallel_commutativity_subaux r (U\<^sub>2 a b) (T\<^sub>2 a b)\<close> show ?case
     using nested_parallel_commutativity_subaux.with_new_channel
     by metis
@@ -644,7 +644,7 @@ next
       obtain T\<^sub>1 where
         "t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T\<^sub>1 a" and
         "\<And>a. nested_parallel_commutativity_subaux r (U\<^sub>1 a) (T\<^sub>1 a)"
-        using nested_parallel_commutativity_subaux_opening_conveyance
+        using nested_parallel_commutativity_subaux_extruding_conveyance
         by blast
       obtain T\<^sub>2 where
         "\<And>a. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<tau>\<rbrace> T\<^sub>2 a" and
@@ -673,8 +673,8 @@ next
         acting_lift
       by auto
   next
-    case (opening S t)
-    from opening.prems show ?case
+    case (extruding S t)
+    from extruding.prems show ?case
     proof cases
       case (without_new_channel_rtl r u)
       from \<open>nested_parallel_commutativity_subaux r u (\<nu> a. S a)\<close> show ?thesis
@@ -682,17 +682,17 @@ next
         case with_new_channel
         with \<open>t = u \<parallel> r\<close> show ?thesis
           using
-            basic_transition.opening and
-            opening_left and
+            basic_transition.extruding and
+            extruding_left and
             nested_parallel_commutativity_aux.without_new_channel_rtl and
-            opening_lift and
+            extruding_lift and
             rel_funI
           by (metis (mono_tags, lifting))
       qed
     next
       case with_new_channel
       then show ?thesis
-        using basic_transition.opening and opening_lift
+        using basic_transition.extruding and extruding_lift
         by blast
     qed
   next
@@ -741,7 +741,7 @@ next
       obtain T\<^sub>1 where
         "t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T\<^sub>1 a" and
         "\<And>a. nested_parallel_commutativity_subaux r (U\<^sub>1 a) (T\<^sub>1 a)"
-        using nested_parallel_commutativity_subaux_opening_conveyance
+        using nested_parallel_commutativity_subaux_extruding_conveyance
         by blast
       obtain T\<^sub>2 where
         "\<And>a. T\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> T\<^sub>2 a" and
@@ -801,28 +801,28 @@ next
         acting_lift
       by auto
   next
-    case (opening_left u U r t)
-    from opening_left.prems have "nested_parallel_commutativity_subaux r u t"
+    case (extruding_left u U r t)
+    from extruding_left.prems have "nested_parallel_commutativity_subaux r u t"
       by (fact nested_parallel_commutativity_aux_without_new_channel_normalization)
-    with opening_left.hyps show ?case
+    with extruding_left.hyps show ?case
       using
-        nested_parallel_commutativity_subaux_opening_conveyance and
+        nested_parallel_commutativity_subaux_extruding_conveyance and
         nested_parallel_commutativity_aux.without_new_channel_ltr and
-        opening_lift and
+        extruding_lift and
         rel_funI
       by smt
   next
-    case (opening_right r R u t)
-    from opening_right.prems have "nested_parallel_commutativity_subaux r u t"
+    case (extruding_right r R u t)
+    from extruding_right.prems have "nested_parallel_commutativity_subaux r u t"
       by (fact nested_parallel_commutativity_aux_without_new_channel_normalization)
-    from this and opening_right.hyps
+    from this and extruding_right.hyps
     have "\<exists>T. t \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> T a \<and> (\<forall>a. nested_parallel_commutativity_subaux (R a) u (T a))"
     proof induction
       case without_new_channel
       then show ?case
         using
-          basic_transition.opening_right and
-          basic_transition.opening_left and
+          basic_transition.extruding_right and
+          basic_transition.extruding_left and
           nested_parallel_commutativity_subaux.without_new_channel
         by blast
     next
@@ -835,13 +835,13 @@ next
         T a \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> T' a b \<and> (\<forall>b. nested_parallel_commutativity_subaux (R b) (U a) (T' a b))"
         by (fact choice)
       then show ?case
-        using opening_scope and nested_parallel_commutativity_subaux.with_new_channel
+        using extruding_scope and nested_parallel_commutativity_subaux.with_new_channel
         by metis
     qed
     then show ?case
       using
         nested_parallel_commutativity_aux.without_new_channel_ltr and
-        opening_lift and
+        extruding_lift and
         rel_funI
       by smt
   next
@@ -913,25 +913,25 @@ proof (standard, intro allI, intro impI)
       with \<open>\<nu> b. a \<triangleright> x. P x b \<rightarrow>\<^sub>\<sharp>c\<close> show ?thesis by blast
     qed
   next
-    case (output_without_opening a x q)
+    case (output_without_extruding a x q)
     then show ?thesis
       by (blast elim: basic_transitions_from_receive)
   next
-    case output_with_opening
+    case output_with_extruding
     then show ?thesis
-      using no_opening_transitions_from_receive
+      using no_extruding_transitions_from_receive
       by simp
   qed
 qed
 
-private lemma opening_transitions_from_new_channel_receive:
+private lemma extruding_transitions_from_new_channel_receive:
   "\<nu> b. a \<triangleright> x. P x b \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b \<Longrightarrow> Q b = a \<triangleright> x . P x b"
 proof (induction "\<nu> b. a \<triangleright> x. P x b" "\<lbrace>\<nu> b\<rbrace> Q b" arbitrary: Q rule: basic_transition.induct)
-  case opening
+  case extruding
   show ?case by (fact refl)
 next
-  case scoped_opening
-  then show ?case using no_opening_transitions_from_receive by metis
+  case scoped_extruding
+  then show ?case using no_extruding_transitions_from_receive by metis
 qed
 
 private lemma pre_receive_scope_extension_rtl: "\<nu> b. a \<triangleright> x. P x b \<lesssim>\<^sub>\<sharp> a \<triangleright> x. \<nu> b. P x b"
@@ -945,7 +945,7 @@ proof (standard, intro allI, intro impI)
     proof cases
       case (scoped_acting Q R)
       from \<open>\<nu> b. a \<triangleright> x. P x b \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b\<close> have "\<And>b. Q b = a \<triangleright> x . P x b"
-        by (fact opening_transitions_from_new_channel_receive)
+        by (fact extruding_transitions_from_new_channel_receive)
       with \<open>\<And>b. Q b \<rightarrow>\<^sub>\<flat>\<lbrace>basic_action_of \<delta>\<rbrace> R b\<close>
       obtain x where "basic_action_of \<delta> = a \<triangleright> x" and "\<And>b. R b = P x b"
         using
@@ -972,30 +972,30 @@ proof (standard, intro allI, intro impI)
       qed
     qed
   next
-    case (output_without_opening a' x r)
+    case (output_without_extruding a' x r)
     from \<open>\<nu> b. a \<triangleright> x. P x b \<rightarrow>\<^sub>\<flat>\<lbrace>a' \<triangleleft> x\<rbrace> r\<close> show ?thesis
     proof cases
       case (scoped_acting Q R)
       from \<open>\<nu> b. a \<triangleright> x. P x b \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b\<close> have "\<And>b. Q b = a \<triangleright> x. P x b"
-        by (fact opening_transitions_from_new_channel_receive)
+        by (fact extruding_transitions_from_new_channel_receive)
       with \<open>\<And>b. Q b \<rightarrow>\<^sub>\<flat>\<lbrace>a' \<triangleleft> x\<rbrace> R b\<close> show ?thesis
         by (auto elim: basic_transitions_from_receive)
     qed
   next
-    case (output_with_opening Q a' K)
+    case (output_with_extruding Q a' K)
     from \<open>\<nu> b. a \<triangleright> x. P x b \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b\<close> have "\<And>b. Q b = a \<triangleright> x. P x b"
-      by (fact opening_transitions_from_new_channel_receive)
+      by (fact extruding_transitions_from_new_channel_receive)
     with \<open>\<And>b. Q b \<rightarrow>\<^sub>\<sharp>\<lparr>a' \<triangleleft> K b\<close> have "a \<triangleright> x. P x undefined \<rightarrow>\<^sub>\<sharp>\<lparr>a' \<triangleleft> K undefined"
       by simp
     then show ?thesis
     proof cases
-      case (output_without_opening x q)
+      case (output_without_extruding x q)
       then show ?thesis
         by (blast elim: basic_transitions_from_receive)
     next
-      case output_with_opening
+      case output_with_extruding
       then show ?thesis
-        using no_opening_transitions_from_receive
+        using no_extruding_transitions_from_receive
         by simp
     qed
   qed
@@ -1012,16 +1012,16 @@ end
 
 context begin
 
-private lemma opening_transitions_from_new_channel_stop: "\<nu> a. \<zero> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a \<Longrightarrow> P a = \<zero>"
+private lemma extruding_transitions_from_new_channel_stop: "\<nu> a. \<zero> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a \<Longrightarrow> P a = \<zero>"
 proof -
   fix P and a
   assume "\<nu> a. \<zero> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a"
   then show "P a = \<zero>"
   proof (induction "\<nu> a. \<zero>" "\<lbrace>\<nu> a\<rbrace> P a" arbitrary: P)
-    case opening
+    case extruding
     show ?case by (fact refl)
   next
-    case scoped_opening
+    case scoped_extruding
     then show ?case using no_basic_transitions_from_stop by metis
   qed
 qed
@@ -1034,7 +1034,7 @@ proof
   proof cases
     case (scoped_acting Q\<^sub>1 Q\<^sub>2)
     from \<open>\<nu> a. \<zero> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> Q\<^sub>1 a\<close> have "\<And>a. Q\<^sub>1 a = \<zero>"
-      by (fact opening_transitions_from_new_channel_stop)
+      by (fact extruding_transitions_from_new_channel_stop)
     with \<open>\<And>a. Q\<^sub>1 a \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> Q\<^sub>2 a\<close> show ?thesis
       by (simp add: no_basic_transitions_from_stop)
   qed
@@ -1046,9 +1046,9 @@ proof
   assume "\<nu> a. \<zero> \<rightarrow>\<^sub>\<sharp>c"
   then show False
   proof cases
-    case (output_with_opening P a K)
+    case (output_with_extruding P a K)
     from \<open>\<nu> b. \<zero> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> P b\<close> have "\<And>b. P b = \<zero>"
-      by (fact opening_transitions_from_new_channel_stop)
+      by (fact extruding_transitions_from_new_channel_stop)
     with \<open>\<And>b. P b \<rightarrow>\<^sub>\<sharp>\<lparr>a \<triangleleft> K b\<close> show ?thesis
       by (simp add: no_proper_transitions_from_stop)
   qed (simp_all add: no_acting_transitions_from_new_channel_stop)
diff --git a/Isabelle/Chi_Calculus/Proper_Transition_System.thy b/Isabelle/Chi_Calculus/Proper_Transition_System.thy
index 99cba9b..f4c55c1 100644
--- a/Isabelle/Chi_Calculus/Proper_Transition_System.thy
+++ b/Isabelle/Chi_Calculus/Proper_Transition_System.thy
@@ -26,7 +26,7 @@ primrec basic_action_of :: "proper_action \<Rightarrow> basic_action" where
 subsection \<open>Output Rests\<close>
 
 text \<open>
-  An output rest bundles the scope openings, the output value, and the target process of an output
+  An output rest bundles the scope extrudings, the output value, and the target process of an output
   transition. Its syntax is part of the syntax of output transitions.
 \<close>
 
@@ -36,7 +36,7 @@ datatype 'p output_rest =
 
 text \<open>
   Note that the definition of \<open>output_rest\<close> is actually more permissive than the verbal definition
-  of output rests above: the number of scope openings of a particular \<open>output_rest\<close> value is not
+  of output rests above: the number of scope extrudings of a particular \<open>output_rest\<close> value is not
   necessarily fixed, since the structure of a follow-up output rest in a \<open>WithOpening\<close> value can
   depend on the given channel. This is just to keep the definition simple. It does not cause any
   problems in our later proofs.
@@ -55,8 +55,8 @@ where
   "output_rest_lift \<equiv> rel_output_rest"
 
 lemmas output_rest_lift_intros = output_rest.rel_intros
-lemmas without_opening_lift = output_rest_lift_intros(1)
-lemmas with_opening_lift = output_rest_lift_intros(2)
+lemmas without_extruding_lift = output_rest_lift_intros(1)
+lemmas with_extruding_lift = output_rest_lift_intros(2)
 lemmas output_rest_lift_cases = output_rest.rel_cases
 
 text \<open>
@@ -131,9 +131,9 @@ inductive
 where
   simple:
     "p \<rightarrow>\<^sub>\<flat>\<lbrace>basic_action_of \<delta>\<rbrace> q \<Longrightarrow> p \<rightarrow>\<^sub>\<sharp>\<lparr>\<delta>\<rparr> q" |
-  output_without_opening:
+  output_without_extruding:
     "p \<rightarrow>\<^sub>\<flat>\<lbrace>a \<triangleleft> x\<rbrace> q \<Longrightarrow> p \<rightarrow>\<^sub>\<sharp>\<lparr>a \<triangleleft> x\<rparr> q" |
-  output_with_opening:
+  output_with_extruding:
     "\<lbrakk> p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b; \<And>b. Q b \<rightarrow>\<^sub>\<sharp>\<lparr>a \<triangleleft> K b \<rbrakk> \<Longrightarrow> p \<rightarrow>\<^sub>\<sharp>\<lparr>a \<triangleleft> \<nu> b. K b"
 
 text \<open>
@@ -180,7 +180,7 @@ proof proper.is_simulation_standard
     then show ?case
       by (blast intro: proper_transition.simple simple_lift)
   next
-    case (output_without_opening p a x p' q)
+    case (output_without_extruding p a x p' q)
     from \<open>p \<sim>\<^sub>\<flat> q\<close> and \<open>p \<rightarrow>\<^sub>\<flat>\<lbrace>a \<triangleleft> x\<rbrace> p'\<close>
     obtain q' where "q \<rightarrow>\<^sub>\<flat>\<lbrace>a \<triangleleft> x\<rbrace> q'" and "p' \<sim>\<^sub>\<flat> q'"
       using
@@ -191,9 +191,9 @@ proof proper.is_simulation_standard
         basic_residual.distinct(2)
       by smt
     then show ?case
-      by (blast intro: proper_transition.output_without_opening without_opening_lift output_lift)
+      by (blast intro: proper_transition.output_without_extruding without_extruding_lift output_lift)
   next
-    case (output_with_opening p P a K q)
+    case (output_with_extruding p P a K q)
     obtain Q where "q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> Q a" and "\<And>a. P a \<sim>\<^sub>\<flat> Q a"
     proof -
       from \<open>p \<sim>\<^sub>\<flat> q\<close> and \<open>p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> a\<rbrace> P a\<close>
@@ -220,7 +220,7 @@ proof proper.is_simulation_standard
     *)
     obtain L where "\<And>b. Q b \<rightarrow>\<^sub>\<sharp>\<lparr>a \<triangleleft> L b" and "\<And>b. output_rest_lift (\<sim>\<^sub>\<flat>) (K b) (L b)"
     proof -
-      from output_with_opening.IH and \<open>\<And>b. P b \<sim>\<^sub>\<flat> Q b\<close>
+      from output_with_extruding.IH and \<open>\<And>b. P b \<sim>\<^sub>\<flat> Q b\<close>
       have "\<forall>b. \<exists>l. Q b \<rightarrow>\<^sub>\<sharp>\<lparr>a \<triangleleft> l \<and> output_rest_lift (\<sim>\<^sub>\<flat>) (K b) l"
         using
           proper_lift_cases and
@@ -232,9 +232,9 @@ proof proper.is_simulation_standard
       with that show ?thesis by blast
     qed
     from \<open>q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu> b\<rbrace> Q b\<close> and \<open>\<And>b. Q b \<rightarrow>\<^sub>\<sharp>\<lparr>a \<triangleleft> L b\<close> have "q \<rightarrow>\<^sub>\<sharp>\<lparr>a \<triangleleft> \<nu> b. L b"
-      by (fact proper_transition.output_with_opening)
+      by (fact proper_transition.output_with_extruding)
     with \<open>\<And>a. output_rest_lift (\<sim>\<^sub>\<flat>) (K a) (L a)\<close> show ?case
-      using with_opening_lift and rel_funI and output_lift
+      using with_extruding_lift and rel_funI and output_lift
       by smt
   qed
 qed
diff --git a/Isabelle/Chi_Calculus/Typed_Basic_Transition_System.thy b/Isabelle/Chi_Calculus/Typed_Basic_Transition_System.thy
index bea04e1..6ca5fe9 100644
--- a/Isabelle/Chi_Calculus/Typed_Basic_Transition_System.thy
+++ b/Isabelle/Chi_Calculus/Typed_Basic_Transition_System.thy
@@ -19,18 +19,18 @@ abbreviation
 where
   "\<aa> \<triangleright>\<degree> \<xx> \<equiv> untyped_channel \<aa> \<triangleright> untyped_value \<xx>"
 
-abbreviation typed_opening :: "('a channel \<Rightarrow> 'p) \<Rightarrow> 'p basic_residual" where
-  "typed_opening \<PP> \<equiv> \<lbrace>\<nu> a\<rbrace> \<PP> (typed_channel a)"
+abbreviation typed_extruding :: "('a channel \<Rightarrow> 'p) \<Rightarrow> 'p basic_residual" where
+  "typed_extruding \<PP> \<equiv> \<lbrace>\<nu> a\<rbrace> \<PP> (typed_channel a)"
 syntax
-  "_typed_opening" :: "pttrn \<Rightarrow> process \<Rightarrow> 'p basic_residual"
+  "_typed_extruding" :: "pttrn \<Rightarrow> process \<Rightarrow> 'p basic_residual"
   (\<open>\<lbrace>\<nu>\<degree>_\<rbrace> _\<close> [0, 51] 51)
 translations
-  "\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<pp>" \<rightleftharpoons> "CONST typed_opening (\<lambda>\<aa>. \<pp>)"
+  "\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<pp>" \<rightleftharpoons> "CONST typed_extruding (\<lambda>\<aa>. \<pp>)"
 print_translation \<open>
   [
     Syntax_Trans.preserve_binder_abs_tr'
-      @{const_syntax typed_opening}
-      @{syntax_const "_typed_opening"}
+      @{const_syntax typed_extruding}
+      @{syntax_const "_typed_extruding"}
   ]
 \<close>
 (* FIXME:
@@ -48,18 +48,18 @@ lemma typed_sending: "\<aa> \<triangleleft>\<degree> \<xx> \<rightarrow>\<^sub>\
 lemma typed_receiving: "\<aa> \<triangleright>\<degree> \<xx>. \<PP> \<xx> \<rightarrow>\<^sub>\<flat>\<lbrace>\<aa> \<triangleright>\<degree> \<xx>\<rbrace> \<PP> \<xx>"
   using receiving and typed_untyped_value
   by metis
-lemma typed_opening: "\<nu>\<degree>\<aa>. \<PP> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<PP> \<aa>"
-  by (fact opening)
-lemma typed_opening_left: "p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<PP> \<aa> \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<PP> \<aa> \<parallel> q"
-  by (fact opening_left)
-lemma typed_opening_right: "q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<QQ> \<aa> \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> p \<parallel> \<QQ> \<aa>"
-  by (fact opening_right)
+lemma typed_extruding: "\<nu>\<degree>\<aa>. \<PP> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<PP> \<aa>"
+  by (fact extruding)
+lemma typed_extruding_left: "p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<PP> \<aa> \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<PP> \<aa> \<parallel> q"
+  by (fact extruding_left)
+lemma typed_extruding_right: "q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<QQ> \<aa> \<Longrightarrow> p \<parallel> q \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> p \<parallel> \<QQ> \<aa>"
+  by (fact extruding_right)
 lemma typed_scoped_acting: "\<lbrakk>p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<QQ> \<aa>; \<And>\<aa>. \<QQ> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> \<RR> \<aa>\<rbrakk> \<Longrightarrow> p \<rightarrow>\<^sub>\<flat>\<lbrace>\<alpha>\<rbrace> \<nu>\<degree>\<aa>. \<RR> \<aa>"
   by (simp add: scoped_acting)
-lemma typed_scoped_opening: "\<lbrakk>p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<QQ> \<aa>; \<And>\<aa>. \<QQ> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<RR> \<aa> \<bb>\<rbrakk> \<Longrightarrow> p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<nu>\<degree>\<aa>. \<RR> \<aa> \<bb>"
-  by (simp add: scoped_opening)
+lemma typed_scoped_extruding: "\<lbrakk>p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<aa>\<rbrace> \<QQ> \<aa>; \<And>\<aa>. \<QQ> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<RR> \<aa> \<bb>\<rbrakk> \<Longrightarrow> p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<nu>\<degree>\<aa>. \<RR> \<aa> \<bb>"
+  by (simp add: scoped_extruding)
 
-lemma typed_opening_scope: "(\<And>\<aa>. \<PP> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<QQ> \<aa> \<bb>) \<Longrightarrow> \<nu>\<degree>\<aa>. \<PP> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<nu>\<degree>\<aa>. \<QQ> \<aa> \<bb>"
-  by (simp add: opening_scope)
+lemma typed_extruding_scope: "(\<And>\<aa>. \<PP> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<QQ> \<aa> \<bb>) \<Longrightarrow> \<nu>\<degree>\<aa>. \<PP> \<aa> \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<nu>\<degree>\<aa>. \<QQ> \<aa> \<bb>"
+  by (simp add: extruding_scope)
 
 end
diff --git a/Isabelle/Chi_Calculus/Typed_Proper_Transition_System.thy b/Isabelle/Chi_Calculus/Typed_Proper_Transition_System.thy
index f7ff3c7..96471d1 100644
--- a/Isabelle/Chi_Calculus/Typed_Proper_Transition_System.thy
+++ b/Isabelle/Chi_Calculus/Typed_Proper_Transition_System.thy
@@ -21,7 +21,7 @@ primrec untyped_output_rest :: "('a::countable, 'p) typed_output_rest \<Rightarr
   "untyped_output_rest (TypedWithOpening K) = WithOpening (untyped_output_rest \<circ> K)"
 
 abbreviation
-  typed_with_opening :: "('a channel \<Rightarrow> ('b, 'p) typed_output_rest) \<Rightarrow> ('b, 'p) typed_output_rest"
+  typed_with_extruding :: "('a channel \<Rightarrow> ('b, 'p) typed_output_rest) \<Rightarrow> ('b, 'p) typed_output_rest"
   (binder "\<nu>\<degree>" 51)
 where
   "\<nu>\<degree>\<aa>. \<KK> \<aa> \<equiv> TypedWithOpening (\<KK> \<circ> typed_channel)"
@@ -32,10 +32,10 @@ abbreviation
 where
   "\<lparr>\<aa> \<triangleleft>\<degree> \<kk> \<equiv> \<lparr>untyped_channel \<aa> \<triangleleft> untyped_output_rest \<kk>"
 
-lemma typed_output_without_opening: "p \<rightarrow>\<^sub>\<flat>\<lbrace>\<aa> \<triangleleft>\<degree> \<xx>\<rbrace> q \<Longrightarrow> p \<rightarrow>\<^sub>\<sharp>\<lparr>\<aa> \<triangleleft>\<degree> \<xx>\<rparr> q"
-  by (simp add: output_without_opening)
-lemma typed_output_with_opening:
+lemma typed_output_without_extruding: "p \<rightarrow>\<^sub>\<flat>\<lbrace>\<aa> \<triangleleft>\<degree> \<xx>\<rbrace> q \<Longrightarrow> p \<rightarrow>\<^sub>\<sharp>\<lparr>\<aa> \<triangleleft>\<degree> \<xx>\<rparr> q"
+  by (simp add: output_without_extruding)
+lemma typed_output_with_extruding:
   "\<lbrakk>p \<rightarrow>\<^sub>\<flat>\<lbrace>\<nu>\<degree>\<bb>\<rbrace> \<QQ> \<bb>; \<And>\<bb>. \<QQ> \<bb> \<rightarrow>\<^sub>\<sharp>\<lparr>\<aa> \<triangleleft>\<degree> \<KK> \<bb>\<rbrakk> \<Longrightarrow> p \<rightarrow>\<^sub>\<sharp>\<lparr>\<aa> \<triangleleft>\<degree> \<nu>\<degree>\<bb>. \<KK> \<bb>"
-  by (simp add: output_with_opening)
+  by (simp add: output_with_extruding)
 
 end
diff --git a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
index 38e7da8..20caf4e 100644
--- a/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
+++ b/Isabelle/Ouroboros/Ouroboros_Praos_Implementation.thy
@@ -2,287 +2,317 @@ section \<open> Implementation of the Ouroboros Praos protocol \<close>
 
 theory Ouroboros_Praos_Implementation
   imports
-    Chi_Calculus.Typed_Basic_Transition_System
     Finite_Map_Extras
     "HOL-Library.BNF_Corec"
     "HOL-Library.Sublist"
+    Chi_Calculus.Typed_Basic_Transition_System
     Complex_Main
 begin
 
-subsection \<open> Introduction \<close>
-
 text \<open>
   In this section we present an implementation of the Ouroboros Praos protocol as defined in
   @{cite praos}. Since a security analysis of the protocol is out of scope, we do not model the
   environment \<open>\<Z>\<close>, the adversary \<open>\<A>\<close>, etc. However, we retain the use of the Universal
-  Composability (UC) framework for the sake of design modularity.
+  Composability (UC) framework for the sake of design modularity. It's important to mention that in
+  the paper the protocol is described in the so-called `hybrid model', in which the protocol assumes
+  the availability of idealized versions of some cryptographic primitives, called `ideal
+  functionalities', that can be invoked by the protocol participants, much like sub-routines. These
+  ideal functionalities can be replaced later with concrete implementations without affecting the
+  security properties of the protocol. Thus, we model these ideal functionalities as locale's.
 \<close>
 
+no_notation Sublist.parallel (infixl "\<parallel>" 50)
+
 subsection \<open> Preliminaries \<close>
 
 text \<open>
-  We let \<open>v \<bar>\<bar> w\<close> denote concatenation of ``strings'' (i.e. arbitrary values):
+  We let \<open>v \<bar>\<bar> w\<close> denote concatenation of `strings' (i.e. arbitrary values):
 \<close>
 
-abbreviation concat :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<times> 'b" (infixr \<open>\<bar>\<bar>\<close> 65) where
-  "v \<bar>\<bar> w \<equiv> (v, w)"
+consts concat :: "'a \<Rightarrow> 'b \<Rightarrow> 'a" (infixl \<open>\<bar>\<bar>\<close> 65)
+
+subsection \<open> Public-key cryptography \<close>
 
 text \<open>
-  Public-key cryptography depends on a pair of a secret key and a verification key:
+  The Praos protocol is based on a public-key cryptographic system. We define a locale with two
+  parameters: a key generation function and a function to derive the verification key from the
+  secret key. Also, we state an assumption that establishes a relationship between the two
+  parameters, namely that if we generate \<open>sk\<close> and \<open>vk\<close> using the key generation function then it
+  holds that \<open>vk\<close> is the verification key of \<open>sk\<close>. Furthermore, this locale is parametrized with the
+  type of the security parameter:
 \<close>
 
-typedecl secret_key
-
-typedecl verification_key
+locale keys =
+  fixes generate :: "'security_parameter \<Rightarrow> 'vkey \<times> 'skey"
+    and verification_key_of :: "'skey \<Rightarrow> 'vkey"
+  assumes correctness: "(vk, sk) = generate \<kappa> \<longrightarrow> verification_key_of sk = vk"
 
+subsection \<open> Cryptographic hash functions \<close>
 
 text \<open>
-  such that it is possible to derive the verification key from the secret key:
+  The paper uses the random oracle model (ROM). In the ROM a hash function is modeled as a random
+  oracle, which is basically a magical black box that implements a truly random function. As the ROM
+  is used just for the purposes of the security proof, we model a collision-free cryptographic hash
+  functions instead. To do so, we define a locale which is parametric in the type \<open>'a\<close> of values to
+  be hashed and in the type \<open>'hash\<close> of hash values. Now, theoretically, cryptographic hash functions
+  have certain properties, e.g. they are one-way functions, meaning that they are difficult to
+  invert by an efficient adversary. But, the terms `difficult' and `efficient' are probabilistic in
+  nature, so we cannot enforce these properties in the code:
 \<close>
 
-consts verification_key_of :: "secret_key \<Rightarrow> verification_key"
+locale hashable =
+  fixes \<H> :: "'a \<Rightarrow> 'hash"
+  assumes collision_resistance: "inj \<H>"
 
-subsubsection \<open> The Semi-Synchronous model \<close>
+subsection \<open> Verifiable random functions (VRFs) \<close>
 
 text \<open>
-  \label{sec:semi-sync-model-ref}
-  In the paper, a semi-synchronous model with an upper bound \<open>\<Delta>\<close> in message delay is used. Regarding
-  \<open>\<Delta>\<close>, we stress that the protocol is oblivious of \<open>\<Delta>\<close> and this bound is only used in the security
-  analysis. Hence from the protocol's point of view the network is no better than an eventual
-  delivery network (without a concrete bound), which can be modeled using our process calculus using
-  for example a reliable broadcasting server process.
-  Regarding synchrony, we simply assume that an external ``clock process'' signals each stakeholder
-  when a round (i.e. slot) ends, and that messages sent in one round are received at the onset of
-  the next round.
+  A VRF is basically a pseudorandom function such that everyone can check that the values of the
+  function were computed correctly. In particular, in the Praos protocol, the stakeholders use a VRF
+  for executing the private lottery to check whether they're slot leaders for a particular slot.
+  Also, stakeholders use a VRF to include a pseudorandom value in each block they produce.
 \<close>
 
-paragraph \<open> Time and slots. \<close>
-
 text \<open>
-  We define the concepts of epoch and slot. As defined in the paper, slots and epochs begin at 1:
+  We model the output of a VRF as a pair comprised by a pseudorandom value and a proof that the
+  value was computed correctly:
 \<close>
-
-type_synonym epoch = nat
-
-type_synonym slot = nat
-
-abbreviation first_slot :: slot where
-  "first_slot \<equiv> 1"
-
-abbreviation first_epoch :: epoch where
-  "first_epoch \<equiv> 1"
-
-paragraph \<open> The Delayed Diffuse Functionality. \<close>
+type_synonym ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o = "'vrf\<^sub>y \<times> 'vrf\<^sub>\<pi>"
 
 text \<open>
-  We do not model the network as a separate ideal functionality \textsf{DDiffuse}\<open>\<^sub>\<Delta>\<close> but rely on
-  our process calculus features for communication. In particular, a single channel is used both to
-  read the received messages from a stakeholder's ``incoming string'' (or ``mailbox'') and to
-  ``diffuse'' a message. Also, the restriction that a stakeholder is allowed to diffuse once in a
-  round is explicitly enforced by the stakeholder process implementation, see Section
-  \ref{sec:sh-process-ref}.
+  We define a locale with four parameters:
+  \<^item>  A function that, given a secret key and an input value of an arbitrary type, evaluates the VRF
+     and produces a VRF output.
+  \<^item>  A function that, given a verification key, an input value, and a VRF output, verifies that the
+     VRF value was produced correctly.
+  \<^item>  A constant that specifies the size (or length) of the VRF values.
+  \<^item>  A function that casts a VRF value into a real number.
+
+  Also, we postulate some properties on the parameters of the locale:
+  \<^item> We require that the value size be positive.
+  \<^item> We require some properties to hold for VRFs according to the definition in the paper, namely:
+    \<^descr> Uníqueness: This establishes that for any input \<open>x\<close> there exists a unique value \<open>y\<close> that can
+      be proved to be valid. That is, if we can verify the correctness of both \<open>y\<close> and \<open>y'\<close> for \<open>x\<close>
+      then \<open>y\<close> and \<open>y'\<close> must be equal.
+    \<^descr> Provability: This establishes that the value produced by evaluating the VRF can be proved to
+      be correctly computed, provided that the verification key used to check the correctness is
+      derived from the secret key used to evaluate the VRF.
+
+  Theoretically, VRFs must fulfill another property called `pseudorandomness', which is
+  probabilistic and states that it's difficult for an efficient adversary to distinguish a VRF value
+  from a truly random value. Furthermore, the paper uses a special VRF which is more secure than
+  standard VRFs, since it guarantees that VRF values cannot be predicted even if the adversary is
+  allowed to generate the secret and verification keys. Naturally, for this work, we stick to the
+  regular definition of a VRF:
 \<close>
 
-paragraph \<open> Random Oracle. \<close>
+locale vrf = keys generate verification_key_of
+  for generate :: "'security_parameter \<Rightarrow> 'vkey \<times> 'skey"
+    and verification_key_of :: "'skey \<Rightarrow> 'vkey" +
+  fixes evaluate :: "'skey \<Rightarrow> 'a \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o"
+    and verify :: "'vkey \<Rightarrow> 'a \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o \<Rightarrow> bool"
+    and value_size :: nat (\<open>l\<^sub>V\<^sub>R\<^sub>F\<close>)
+    and value_to_real :: "'vrf\<^sub>y \<Rightarrow> real"
+  assumes value_size_positivity: "value_size > 0"
+    and uniqueness: "verify vk x (y, \<pi>) = verify vk x (y', \<pi>') \<longrightarrow> y = y'"
+    and provability: "vk = verification_key_of sk \<longrightarrow> verify vk x (evaluate sk x)"
 
 text \<open>
-  We will simply assume that we can compute the hash value of any value:
+  We also model two special tags that are used as súffixes when calling the VRF: \<open>TEST\<close> is used in
+  slot leader election, and \<open>NONCE\<close> when creating and validating block nonces. The purpose of these
+  tags is to provide domain separation, i.e. that we can simulate two independent `virtual VRFs'
+  from a single VRF:
 \<close>
 
-typedecl hash \<comment> \<open> Hash values (i.e. $\{0,1\}^w$ in the paper) \<close>
-
-axiomatization
-where
-  hash_finite: "OFCLASS(hash, finite_class)"
-and
-  hash_equal: "OFCLASS(hash, equal_class)"
-
-instance hash :: finite
-  by (rule hash_finite)
-
-instance hash :: equal
-  by (rule hash_equal)
+datatype vrf_query_type = TEST | NONCE
 
-axiomatization
-  \<H> :: "'a \<Rightarrow> hash" \<comment> \<open> A collision-resistant hash function \<close>
-where
-  hash_inj: "inj \<H>"
+subsection \<open> Digital signatures \<close>
 
 text \<open>
-  with no way of recovering @{typ 'a} from @{type hash}.
+  In the paper, digital signature schemes are modeled as ideal functionalities. Moreover, the paper
+  describes two digital signature schemes: A regular digital signature scheme (denoted by
+  \<open>\<F>\<close>$_{\mathsf{DSIG}}$) which is used to sign transactions, and a digital signature scheme (denoted
+  by \<open>\<F>\<close>$_{\mathsf{KES}}$) which is used to sign blocks and has the capability of allowing the
+  signing key to evolve, in such a way that the adversary cannot forge past signatures. For our
+  purposes, though, we model a single, ordinary digital signature scheme for signing both
+  transactions and blocks. To do so, we define a locale with two parameters:
+  \<^item> A function that, given a secret key and a message of an arbitrary type, produces a signature for
+    the message.
+  \<^item> A function that, given a verification key, a message and a signature, verifies that the
+    signature is a legitimate signature for the message.
+
+
+  Also, we only require a provability property, stating that the signature produced by signing a
+  message can be proved to be valid, provided that the verification key used to check the validity
+  of the signature is derived from the secret key used to sign the message:
 \<close>
 
-subsection \<open> The Full Protocol \<close>
+locale digital_signature_scheme = keys generate verification_key_of
+  for generate :: "'security_parameter \<Rightarrow> 'vkey \<times> 'skey"
+    and verification_key_of :: "'skey \<Rightarrow> 'vkey" +
+  fixes sign :: "'skey \<Rightarrow> 'm \<Rightarrow> 'sig"
+    and verify :: "'vkey \<Rightarrow> 'm \<Rightarrow> 'sig \<Rightarrow> bool"
+  assumes provability: "vk = verification_key_of sk \<longrightarrow> verify vk x (sign sk x)"
 
-text \<open>
-  We only implement the protocol that handles the dynamic case (i.e. $\pi_{\mathrm{DPoS}}$), since
-  the static case is used as the base case in the ``inductive'' security proof.
-\<close>
-
-subsubsection \<open> Protocol parameters \<close>
+subsection \<open> Protocol parameters \<close>
 
 text \<open>
-  The protocol's implementation depends on a number of parameters. In this section we define such
-  parameters.
+  The protocol depends on a number of parameters. We use a locale for specifying those parameters
+  and some properties on them. Namely, the parameters are:
+
+  \<^item> \<open>k\<close>: Establishes how deep in the chain (in terms of number of blocks) a transaction needs to be
+    in order to be declared as stable. Must be positive.
+  \<^item> \<open>R\<close>: The length of an epoch, measured in number of slots. Must be positive.
+  \<^item> \<open>f\<close>: The `active slot coefficient'. Establishes the probability that at least one stakeholder
+    is elected as a slot leader in each slot, that is, the probability that a slot is not empty.
+    Must be a strictly positive probability.
+  \<^item> \<open>\<some>\<close>: The advantage in terms of stake of the honest stakeholders against the adversarial ones.
+    Must be a probability strictly between 0 and 1.
 \<close>
 
-text \<open>
-  \<^item> A transaction is declared stable if it is in a block more than \<open>k\<close> blocks deep in the ledger:
-\<close>
+locale protocol_parameters =
+  fixes k :: nat
+    and R :: nat
+    and f :: real
+    and honest_advantage :: real (\<open>\<some>\<close>)
+  assumes k_positivity: "k > 0"
+    and R_positivity: "R > 0"
+    and f_non_zero_probability: "f \<in> {0<..1}"
+    and honest_advantage_bounded_probability: "\<some> \<in> {0<..<1}"
 
-consts k :: nat
+subsection \<open> Slots \<close>
 
 text \<open>
-  \<^item> The length \<open>R\<close> of an epoch, measured in slots:
+  As defined in the paper, we model the concept of slot as a natural number, beginning at 1:
 \<close>
 
-consts R :: nat
+type_synonym slot = nat
 
-text \<open>
-  \<^item> The active slot coefficient $f \in (0, 1]$. Establishes the probability that at least one
-    stakeholder is elected as a slot leader, that is, the probability that a slot is not empty:
-\<close>
+abbreviation (input) first_slot :: slot where
+  "first_slot \<equiv> 1"
 
-axiomatization
-  f :: real
-where
-  f_non_zero_probability: "0 < f \<and> f \<le> 1"
+subsection \<open> Epochs \<close>
 
 text \<open>
-  \<^item> Two special, but arbitrary, values that we use when calling the VRF in slot leader selection
-    ($\mathtt{TEST}$) and block nonce creation/validation ($\mathtt{NONCE}$). They are used to
-    provide domain separation:
+  As defined in the paper, we model the concept of epoch as a natural number, beginning at 1:
 \<close>
 
-datatype vrf_query_type = TEST | NONCE
+type_synonym epoch = nat
 
-subsubsection \<open> Ideal functionalities \<close>
+abbreviation (input) first_epoch :: epoch where
+  "first_epoch \<equiv> 1"
 
 text \<open>
-  In the paper, the protocol is described with respect to ideal functionalities. In this section we
-  model the functionalities available to our protocol implementation. For the sake of simplicity,
-  we do not model the key generation algorithms for \<open>\<F>\<close>$_{\mathsf{VRF}}$, \<open>\<F>\<close>$_{\mathsf{KES}}$ and
-  \<open>\<F>\<close>$_{\mathsf{DSIG}}$ but these keys are given as parameters to each stakeholder.
+  By using basic arithmetic, we can compute the epoch to which a given slot belongs:
 \<close>
 
-paragraph \<open> Functionality \<open>\<F>\<close>$_{\mathsf{VRF}}$. \<close>
+definition (in protocol_parameters) slot_epoch :: "slot \<Rightarrow> epoch" where
+  [simp]: "slot_epoch sl = nat \<lceil>sl / R\<rceil>"
 
 text \<open>
-  We model the evaluation of a VRF as a function that, given an input value and a secret key,
-  produces a random value and a proof. Also, we can verify that a particular random value was
-  produced correctly:
+  and we can check whether a given slot is the first one in its epoch:
 \<close>
 
-typedecl vrf_output
-
-typedecl vrf_proof
-
-axiomatization
-where
-  vrf_output_finite: "OFCLASS(vrf_output, finite_class)"
-and
-  vrf_proof_finite: "OFCLASS(vrf_proof, finite_class)"
-
-instance vrf_output :: finite
-  by (rule vrf_output_finite)
-
-instance vrf_proof :: finite
-  by (rule vrf_proof_finite)
-
-type_synonym vrf_value = "vrf_output \<times> vrf_proof"
-
-consts vrf_output_size :: nat (\<open>l\<^sub>V\<^sub>R\<^sub>F\<close>)
+definition (in protocol_parameters) first_in_epoch :: "slot \<Rightarrow> bool" where
+  [simp]: "first_in_epoch sl = (R dvd (sl - 1))"
 
-axiomatization
-  evaluate_vrf :: "secret_key \<Rightarrow> 'a \<Rightarrow> vrf_value"
-and
-  verify_vrf :: "verification_key \<Rightarrow> 'a \<Rightarrow> vrf_value \<Rightarrow> bool"
-where
-  vrf_eval_ver_cancellation: "verify_vrf vk x (evaluate_vrf sk x)" if "vk = verification_key_of sk"
+subsection \<open> Stake distributions \<close>
 
 text \<open>
-  Finally, we can cast a VRF output into a real number:
+  We model a stakeholder ID as a natural number and use a special syntax to match the notation used
+  in the paper:
 \<close>
 
-consts vrf_output_to_real :: "vrf_output \<Rightarrow> real"
+datatype stakeholder_id = StakeholderId nat (\<open>U\<^bsub>_\<^esub>\<close>)
 
-paragraph \<open> Functionalities \<open>\<F>\<close>$_{\mathsf{KES}}$ and \<open>\<F>\<close>$_{\mathsf{DSIG}}$. \<close>
+instance stakeholder_id :: countable
+  by countable_datatype
 
 text \<open>
-  In the paper, the functionality \<open>\<F>\<close>$_{\mathsf{DSIG}}$ models a regular digital signature scheme
-  which is used to sign transactions. Also, the functionality \<open>\<F>\<close>$_{\mathsf{KES}}$ adds the
-  capability of allowing the signing key to ``evolve'' in such a way that the adversary
-  cannot forge past signatures, and is used to sign blocks. Therefore, we model these two
-  functionalities as a single, ordinary digital signature scheme. With this scheme, we can sign a
-  value using a secret key and verify that a value is properly signed using a verification key:
+  Now we model a stake distribution simply as a finite map from stakeholder IDs to their respective
+  stakes:
 \<close>
 
-typedecl signature
+type_synonym stake = nat
 
-axiomatization
-  where
-    signature_finite: "OFCLASS(signature, finite_class)"
+type_synonym stake_distr = "(stakeholder_id, stake) fmap"
 
-instance signature :: finite
-  by (rule signature_finite)
+text \<open>
+  Given a set \<open>X\<close> of stakeholder IDs and a stake distribution \<open>\<S>\<close>, we can calculate the absolute
+  maximum stake controlled by \<open>X\<close>, denoted by \<open>s\<^sup>+\<^bsub>X\<^esub>(\<S>)\<close>, as simply the sum of the stakes in \<open>\<S>\<close>
+  belonging to \<open>X\<close>, provided that \<open>X\<close> is included in the domain of \<open>\<S>\<close>:
+\<close>
 
-axiomatization
-  sign :: "secret_key \<Rightarrow> 'a \<Rightarrow> signature"
-and
-  verify :: "verification_key \<Rightarrow> 'a \<Rightarrow> signature \<Rightarrow> bool"
+definition
+  absolute_stake_of_set :: "stakeholder_id set \<Rightarrow> stake_distr \<Rightarrow> stake" (\<open>s\<^sup>+\<^bsub>_\<^esub>'(_')\<close>)
 where
-  sig_ver_cancellation: "verify vk x (sign sk x)" if "vk = verification_key_of sk"
-
-paragraph \<open> Functionality \<open>\<F>\<close>$^{\tau,r}_{RLB}$. \<close>
+  [simp]: "s\<^sup>+\<^bsub>X\<^esub>(\<S>) = (\<Sum>U \<in> X. \<S> $$! U)" if "X \<subseteq> fmdom' \<S>"
 
 text \<open>
-  In the paper, the functionality \<open>\<F>\<close>$^{\tau,r}_{RLB}$ models a randomness beacon that basically
-  provides a fresh nonce for each epoch to (re)seed the election process. Also, this beacon is
-  resettable and leaky in order to strengthen the adversary, which we evidently ignore. Finally,
-  the beacon (via \<open>\<F>\<close>$_{\mathsf{INIT}}$) provides the stakeholders with the genesis block; instead
-  our implementation passes the genesis block as a parameter to each stakeholder. Therefore, we
-  only provide a function to produce a fresh nonce:
+  Based on the previous definition, we define the absolute stake controlled by @{emph \<open>all\<close>}
+  stakeholders appearing in a stake distribution \<open>\<S>\<close>, denoted by \<open>s\<^sup>+\<^sub>\<P>(\<S>)\<close>:
 \<close>
 
-typedecl nonce
+abbreviation (input)
+  absolute_stake_of_univ :: "stake_distr \<Rightarrow> stake" (\<open>s\<^sup>+\<^sub>\<P>'(_')\<close>)
+where
+  "s\<^sup>+\<^sub>\<P>(\<S>) \<equiv> s\<^sup>+\<^bsub>fmdom' \<S>\<^esub>(\<S>)"
 
-consts new_epoch_rnd :: nonce
+text \<open>
+  And we define the absolute stake controlled by a @{emph \<open>single\<close>} stakeholder \<open>U\<close> appearing in a
+  stake distribution \<open>\<S>\<close>, denoted by \<open>s\<^sup>+\<^bsub>U\<^esub>(\<S>)\<close>:
+\<close>
 
-subsubsection \<open> Basic definitions \<close>
+abbreviation (input)
+  absolute_stake_of :: "stakeholder_id \<Rightarrow> stake_distr \<Rightarrow> stake" (\<open>s\<^sup>+\<^bsub>_\<^esub>'(_')\<close>)
+where
+  "s\<^sup>+\<^bsub>U\<^esub>(\<S>) \<equiv> s\<^sup>+\<^bsub>{U}\<^esub>(\<S>)"
 
 text \<open>
-  In this section we introduce basic definitions for the protocol.
+  A relative stake is simply a proportion of stake, so we define it as a real number:
 \<close>
 
-paragraph \<open> Stake Distribution. \<close>
+type_synonym relative_stake = real
 
 text \<open>
-  A stake distribution is simply a map from stakeholder labels \<open>U\<^sub>i\<close> to their respectives stakes \<open>s\<^sub>i\<close>:
+  Now, we define the relative stake controlled by a set \<open>X\<close> of stakeholder IDs w.r.t. a stake
+  distribution \<open>\<S>\<close>, namely, the proportion of stake controlled by \<open>X\<close> with respect to the whole
+  stake in \<open>\<S>\<close>, denoted by \<open>\<alpha>\<^sup>+\<^bsub>X\<^esub>(\<S>)\<close>:
 \<close>
 
-type_synonym stakeholder_id = nat
+definition
+  relative_stake_of_set :: "stakeholder_id set \<Rightarrow> stake_distr \<Rightarrow> relative_stake" (\<open>\<alpha>\<^sup>+\<^bsub>_\<^esub>'(_')\<close>)
+where
+  [simp]: "\<alpha>\<^sup>+\<^bsub>X\<^esub>(\<S>) = s\<^sup>+\<^bsub>X\<^esub>(\<S>) / s\<^sup>+\<^sub>\<P>(\<S>)" if "\<S> \<noteq> {$$}"
 
-type_synonym stake = nat
+text \<open>
+  And we define the relative stake controlled by a @{emph \<open>single\<close>} stakeholder \<open>U\<close> w.r.t. a stake
+  distribution \<open>\<S>\<close>, denoted by \<open>\<alpha>\<^sup>+\<^bsub>U\<^esub>(\<S>)\<close>:
+\<close>
 
-type_synonym stake_distr = "(stakeholder_id, stake) fmap"
+abbreviation (input)
+  relative_stake_of :: "stakeholder_id \<Rightarrow> stake_distr \<Rightarrow> relative_stake" (\<open>\<alpha>\<^sup>+\<^bsub>_\<^esub>'(_')\<close>)
+where
+  "\<alpha>\<^sup>+\<^bsub>U\<^esub>(\<S>) \<equiv> \<alpha>\<^sup>+\<^bsub>{U}\<^esub>(\<S>)"
 
-paragraph \<open> Genesis block. \<close>
+subsection \<open> Genesis block \<close>
 
 text \<open>
-  As defined in the paper, we have a genesis block associated to a blockchain:
+  As defined in the paper, we have a genesis block associated to a chain. We assume that the same
+  genesis block is used by all chains and stakeholders:
 \<close>
 
-type_synonym stakeholder_keys = "
-  verification_key \<times> \<comment> \<open> $v^\\mathrm{vrf}$ \<close>
-  verification_key \<times> \<comment> \<open> $v^\\mathrm{kes}$ \<close>
-  verification_key" \<comment> \<open> $v^\mathrm{dsig}$ \<close>
+type_synonym 'vkey stakeholder_keys = "
+  'vkey \<times> \<comment> \<open> $v^\\mathrm{vrf}$ \<close>
+  'vkey \<times> \<comment> \<open> $v^\\mathrm{kes}$ \<close>
+  'vkey" \<comment> \<open> $v^\mathrm{dsig}$ \<close>
 
-type_synonym genesis = "
-  (stakeholder_id \<rightharpoonup> stakeholder_keys) \<times> \<comment> \<open> stakeholders' verification keys \<close>
+type_synonym ('vkey, 'nonce) genesis = "
+  (stakeholder_id \<rightharpoonup> 'vkey stakeholder_keys) \<times> \<comment> \<open> stakeholders' verification keys \<close>
   stake_distr \<times> \<comment> \<open> initial stake distribution $\\mathbb{S}_0$ \<close>
-  nonce" \<comment> \<open> initial nonce \<open>\<eta>\<^sub>0\<close> \<close>
+  'nonce" \<comment> \<open> initial nonce \<open>\<eta>\<^sub>0\<close> \<close>
 
-paragraph \<open> Transactions. \<close>
+subsection \<open> Transactions \<close>
 
 text \<open>
   In the paper, the environment \<open>\<Z>\<close> issues transactions on behalf of any stakeholder \<open>U\<^sub>i\<close> by
@@ -290,7 +320,7 @@ text \<open>
   stakeholders to put them into blocks. We decide not to model transaction processing this way but
   use a more realistic approach instead: Transactions are assumed to be received by stakeholders
   through the network. A transaction body is assumed to be a simple assertion of the form
-  ``Stakeholder \<open>U\<^sub>i\<close> transfers stake \<open>s\<close> to Stakeholder \<open>U\<^sub>j\<close>'':
+  `Stakeholder \<open>U\<^sub>i\<close> transfers stake \<open>s\<close> to Stakeholder \<open>U\<^sub>j\<close>':
 \<close>
 
 type_synonym transaction_body = "
@@ -303,7 +333,7 @@ text \<open>
   signing key corresponding to \<open>U\<^sub>i\<close>:
 \<close>
 
-type_synonym transaction = "transaction_body \<times> signature"
+type_synonym 'sig transaction = "transaction_body \<times> 'sig"
 
 text \<open>
   We can apply a transaction to a stake distribution. The paper does not define how this is done,
@@ -311,411 +341,415 @@ text \<open>
   stake distribution and that the source stakeholder has enough stake for the withdrawal:
 \<close>
 
-fun apply_transaction :: "transaction \<Rightarrow> stake_distr \<Rightarrow> stake_distr" where
+fun
+  apply_transaction :: "'sig transaction \<Rightarrow> stake_distr \<Rightarrow> stake_distr"
+where
   "apply_transaction ((U\<^sub>i, U\<^sub>j, s), _) \<S> = (
     let
       \<S>' = \<S>(U\<^sub>i $$:= \<S> $$! U\<^sub>i - s)
     in
       \<S>'(U\<^sub>j $$:= \<S>' $$! U\<^sub>j + s))"
 
-text \<open>
-  Applying a transaction with the same stakeholder as sender and receiver does not change the
-  stake distribution:
-\<close>
-
-lemma self_transfer_invariancy:
-  assumes "U\<^sub>i |\<in>| fmdom \<S>"
-  and "\<S> $$! U\<^sub>i \<ge> s"
-  shows "apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S> = \<S>"
-proof (rule fsubset_antisym)
-  let ?\<S>' = "apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S>"
-  show "?\<S>' \<subseteq>\<^sub>f \<S>"
-  unfolding fmsubset.rep_eq proof (unfold map_le_def, intro ballI)
-    fix U
-    assume "U \<in> dom (($$) ?\<S>')"
-    then show "?\<S>' $$ U = \<S> $$ U"
-    proof (cases "U = U\<^sub>i")
-      case True
-      then have "?\<S>' $$ U = Some (\<S> $$! U - s + s)"
-        by simp
-      also from True and assms have "\<dots> = \<S> $$ U"
-        by auto
-      finally show ?thesis .
-    next
-      case False
-      then show ?thesis
-        by simp
-    qed
-  qed
-  then show "\<S> \<subseteq>\<^sub>f apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S>"
-    unfolding fmsubset.rep_eq and map_le_def by simp
-qed
-
-paragraph \<open> Block. \<close>
+subsection \<open> Blocks \<close>
 
 text \<open>
-  We define a block proof, denoted by \<open>B\<^sub>\<pi> = (U\<^sub>i, y, \<pi>)\<close> in the paper:
+  We define a block proof, denoted by \<open>B\<^sub>\<pi> = (U\<^sub>i, y, \<pi>)\<close> in the paper, which represents the `proof of
+  leadership' of the block creator:
 \<close>
 
-type_synonym block_proof = "
+type_synonym ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) block_proof = "
   stakeholder_id \<times> \<comment> \<open> Stakeholder who created the block \<close>
-  vrf_value" \<comment> \<open> VRF value used for slot leader selection \<close>
+  ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o" \<comment> \<open> VRF output used for slot leader election \<close>
 
 text \<open>
-  \label{sec:block-ref}
   and we distinguish between an \<open>unsigned block\<close> (a block without a signature, a concept not
   explicitly present in the paper) and a signed block. Since the latter corresponds to the concept
-  of a block in the paper, we refer to a signed block as simply a \<open>block\<close>. For the sake of
-  completeness, we include the nonce proof in a block (denoted by $\rho = (\rho_y, \rho_\pi)$ in the
-  paper), despite this datum is actually used by the protocol $\pi_{RLB}$ and not by our protocol
-  implementation:
+  of a block in the paper, we refer to a signed block as simply a \<open>block\<close>:
 \<close>
 
-type_synonym unsigned_block = "
+type_synonym ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) unsigned_block = "
   slot \<times> \<comment> \<open> Slot when the block was created \<close>
-  hash option \<times> \<comment> \<open> Previous block hash (if any), denoted by \<open>st\<close> in the paper \<close>
-  transaction list \<times> \<comment> \<open> Transaction data, denoted by \<open>d\<close> in the paper \<close>
-  block_proof \<times> \<comment> \<open> Block proof (proof of leadership), denoted by \<open>B\<^sub>\<pi>\<close> in the paper \<close>
-  vrf_value" \<comment> \<open> Nonce proof \<close>
+  'hash option \<times> \<comment> \<open> Previous block hash (if any), denoted by \<open>st\<close> in the paper \<close>
+  'sig transaction list \<times> \<comment> \<open> Transaction data, denoted by \<open>d\<close> in the paper \<close>
+  ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) block_proof \<times> \<comment> \<open> Block proof, denoted by \<open>B\<^sub>\<pi>\<close> in the paper \<close>
+  ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o" \<comment> \<open> Nonce proof, denoted by $\rho = (\rho_y, \rho_\pi)$ in the paper \<close>
 
-type_synonym block = "unsigned_block \<times> signature"
+type_synonym ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block = "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) unsigned_block \<times> 'sig"
 
-fun bl_slot :: "block \<Rightarrow> slot" where
-  "bl_slot ((sl, _, _, _), _) = sl"
+fun bl_slot :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block \<Rightarrow> slot" where
+  "bl_slot ((sl, _, _, _, _), _) = sl"
 
-fun bl_txs :: "block \<Rightarrow> transaction list" where
-  "bl_txs ((_, _, d, _), _) = d"
+fun bl_txs :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block \<Rightarrow> 'sig transaction list" where
+  "bl_txs ((_, _, d, _, _), _) = d"
+
+fun bl_nonce_proof :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o" where
+  "bl_nonce_proof ((_, _, _, _, \<rho>), _) = \<rho>"
 
 text \<open>
   We can apply a block to a stake distribution by applying all transactions in the block to the
   stake distribution:
 \<close>
 
-abbreviation apply_block :: "block \<Rightarrow> stake_distr \<Rightarrow> stake_distr" where
-  "apply_block B \<S> \<equiv> fold apply_transaction (bl_txs B) \<S>"
-
-text \<open>
-  Applying a block including only a transaction and its corresponding refund transaction does not
-  affect the stake distribution:
-\<close>
-
-lemma transaction_refund_invariancy:
-  assumes "bl_txs B = [((U\<^sub>i, U\<^sub>j, s), \<sigma>\<^sub>1), ((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)]"
-  and "{U\<^sub>i, U\<^sub>j} \<subseteq> fmdom' \<S>"
-  and "\<S> $$! U\<^sub>i \<ge> s"
-  shows "apply_block B \<S> = \<S>"
-proof -
-  let ?\<S>\<^sub>1 = "\<S>(U\<^sub>i $$:= \<S> $$! U\<^sub>i - s)"
-  let ?\<S>\<^sub>2 = "?\<S>\<^sub>1(U\<^sub>j $$:= ?\<S>\<^sub>1 $$! U\<^sub>j + s)"
-  let ?\<S>\<^sub>3 = "?\<S>\<^sub>2(U\<^sub>j $$:= ?\<S>\<^sub>2 $$! U\<^sub>j - s)"
-  let ?\<S>\<^sub>4 = "?\<S>\<^sub>3(U\<^sub>i $$:= ?\<S>\<^sub>3 $$! U\<^sub>i + s)"
-  from assms(1) have "apply_block B \<S> =
-    fold apply_transaction [((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)] (apply_transaction ((U\<^sub>i, U\<^sub>j, s), \<sigma>\<^sub>1) \<S>)"
-    by simp
-  also have "\<dots> = fold apply_transaction [((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)] ?\<S>\<^sub>2"
-    by simp
-  also have "\<dots> = ?\<S>\<^sub>4"
-    by simp
-  also have "\<dots> = \<S>"
-  proof (rule fsubset_antisym)
-    show "?\<S>\<^sub>4 \<subseteq>\<^sub>f \<S>"
-    unfolding fmsubset.rep_eq proof (unfold map_le_def, intro ballI)
-      fix U
-      assume "U \<in> dom (($$) ?\<S>\<^sub>4)"
-      consider (a) "U = U\<^sub>i" | (b) "U = U\<^sub>j" | (c) "U \<noteq> U\<^sub>i" and "U \<noteq> U\<^sub>j"
-        by auto
-      then show "?\<S>\<^sub>4 $$ U = \<S> $$ U"
-      proof cases
-        case a
-        then have "?\<S>\<^sub>4 $$ U = Some (\<S> $$! U - s + s)"
-          by simp
-        also from a and assms(2,3) have "\<dots> = \<S> $$ U"
-          by (simp add: fmlookup_dom'_iff)
-        finally show ?thesis .
-      next
-        case b
-        with assms(3) have "?\<S>\<^sub>4 $$ U = Some (\<S> $$! U + s - s)"
-          by auto
-        also from b and assms(2) have "\<dots> = \<S> $$ U"
-          by (simp add: fmlookup_dom'_iff)
-        finally show ?thesis .
-      next
-        case c
-        then show ?thesis
-          by simp
-      qed
-    qed
-    show "\<S> \<subseteq>\<^sub>f ?\<S>\<^sub>4"
-      using \<open>?\<S>\<^sub>4 \<subseteq>\<^sub>f \<S>\<close> unfolding fmsubset.rep_eq and map_le_def by auto
-  qed
-  finally show ?thesis .
-qed
-
-paragraph \<open> Blockchain. \<close>
-
-text \<open>
-  A blockchain is simply a sequence of blocks. We do not record the genesis block explicitly as
-  part of the blockchain:
-\<close>
+definition
+  apply_block :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block \<Rightarrow> stake_distr \<Rightarrow> stake_distr"
+where
+  [simp]: "apply_block B = fold apply_transaction (bl_txs B)"
 
-type_synonym blockchain = "block list"
+subsection \<open> Chains \<close>
 
 text \<open>
-  We let \<open>\<C>\<^sub>1 \<preceq> \<C>\<^sub>2\<close> indicate that the blockchain \<open>\<C>\<^sub>1\<close> is a prefix of the blockchain \<open>\<C>\<^sub>2\<close>:
+  A chain is simply a sequence of blocks. As stated earlier, we do not record the genesis block
+  explicitly as part of the chain:
 \<close>
 
-abbreviation is_prefix_of :: "blockchain \<Rightarrow> blockchain \<Rightarrow> bool" (infix \<open>\<preceq>\<close> 50) where
-  "\<C>\<^sub>1 \<preceq> \<C>\<^sub>2 \<equiv> prefix \<C>\<^sub>1 \<C>\<^sub>2"
+type_synonym ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain = "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block list"
 
 text \<open>
-  A prefix of a blockchain keeps all properties on its elements that hold for the original blockchain:
+  We let \<open>\<C>\<^sub>1 \<preceq> \<C>\<^sub>2\<close> indicate that the chain \<open>\<C>\<^sub>1\<close> is a prefix of the chain \<open>\<C>\<^sub>2\<close>:
 \<close>
 
-lemma prefix_invariancy:
-  assumes "\<forall>i \<in> {0..<length \<C>\<^sub>2}. P (\<C>\<^sub>2 ! i)"
-  and "\<C>\<^sub>1 \<preceq> \<C>\<^sub>2"
-  shows "\<forall>i \<in> {0..<length \<C>\<^sub>1}. P (\<C>\<^sub>1 ! i)"
-  using assms
-proof (intro ballI)
-  fix i
-  assume "i \<in> {0..<length \<C>\<^sub>1}"
-  then have *: "i < length \<C>\<^sub>1"
-    by simp
-  moreover from assms(2) obtain \<C>\<^sub>3 where **: "\<C>\<^sub>2 = \<C>\<^sub>1 @ \<C>\<^sub>3" ..
-  ultimately have "P (\<C>\<^sub>2 ! i)"
-    using assms(1) by simp
-  with * and ** show "P (\<C>\<^sub>1 ! i)"
-    by (simp add: nth_append)
-qed
+notation prefix (infix \<open>\<preceq>\<close> 50)
 
 text \<open>
-  We define a function to prune the last \<open>m\<close> blocks in a blockchain \<open>\<C>\<close>, denoted by \<open>\<C>\<^bsup>\<lceil>m\<^esup>\<close> in the
+  We define a function to prune the last \<open>m\<close> blocks in a chain \<open>\<C>\<close>, denoted by \<open>\<C>\<^bsup>\<lceil>m\<^esup>\<close> in the
   paper:
 \<close>
 
-abbreviation prune_chain :: "blockchain \<Rightarrow> nat \<Rightarrow> blockchain" (infixl \<open>\<lceil>\<close> 999) where
-  "\<C> \<lceil>m \<equiv> take (length \<C> - m) \<C>"
-
-text \<open>
-  The \<open>\<C>\<^bsup>\<lceil>m\<^esup>\<close> operator satisfies some simple laws:
-\<close>
-
-lemma zero_blocks_chain_prunning_identity:
-  shows "\<C> \<lceil>0 = \<C>"
-  by simp
-
-lemma long_chain_prunning_emptiness:
-  assumes "m \<ge> length \<C>"
-  shows "\<C> \<lceil>m = []"
-  using assms
-  by simp
-
-lemma append_prune_chain_drop_identity:
-  shows "\<C> \<lceil>m @ drop (length \<C> - m) \<C> = \<C>"
-  by simp
+definition
+  prune_chain :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    nat \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain"
+  (\<open>_\<^sup>\<lceil>\<^bsup>_\<^esup>\<close> [999] 999)
+where
+  [simp]: "\<C>\<^sup>\<lceil>\<^bsup>m\<^esup> = take (length \<C> - m) \<C>"
 
 text \<open>
-  Also, we define a function to prune the blocks in a blockchain which have slots greater than a
+  Also, we define a function to prune the blocks in a chain which have slots greater than a
   given slot:
 \<close>
 
-abbreviation prune_after :: "slot \<Rightarrow> blockchain \<Rightarrow> blockchain" where
-  "prune_after sl \<C> \<equiv> takeWhile (\<lambda>B. bl_slot B \<le> sl) \<C>"
+definition
+  prune_after :: "slot \<Rightarrow> ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow> ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain"
+where
+  [simp]: "prune_after sl = takeWhile (\<lambda>B. bl_slot B \<le> sl)"
 
 text \<open>
-  And we can apply a blockchain \<open>\<C>\<close> to a stake distribution \<open>\<S>\<close> by sequentially applying all blocks
+  And we can apply a chain \<open>\<C>\<close> to a stake distribution \<open>\<S>\<close> by sequentially applying all blocks
   in \<open>\<C>\<close> to \<open>\<S>\<close>:
 \<close>
 
-abbreviation apply_blockchain :: "blockchain \<Rightarrow> stake_distr \<Rightarrow> stake_distr" where
-  "apply_blockchain \<C> \<S> \<equiv> fold apply_block \<C> \<S>"
+definition
+  apply_chain :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow> stake_distr \<Rightarrow> stake_distr"
+where
+  [simp]: "apply_chain = fold apply_block"
 
-paragraph \<open> Absolute and Relative Stake. \<close>
+subsection \<open> Functionality \<open>\<F>\<close>$^{\tau,r}_{RLB}$ and subprotocol \<open>\<pi>\<close>$_{RLB}$ \<close>
 
 text \<open>
-  The paper defines the (somewhat vague) concepts of @{emph \<open>maximum\<close>} and @{emph \<open>minimum\<close>}
-  absolute stake controlled by a set of parties, as well as the concepts of
-  @{emph \<open>adversarial stake ratio\<close>} and @{emph \<open>honest stake ratio\<close>}. However, for our
-  implementation we only need the absolute @{emph \<open>maximum\<close>} stake controlled by @{emph \<open>all\<close>}
-  stakeholders, denoted by \<open>s\<^sup>+(\<S>)\<close> where \<open>\<S>\<close> is an arbitrary stake distribution:
+  In the paper, the functionality \<open>\<F>\<close>$^{\tau,r}_{RLB}$ models a randomness beacon that basically
+  provides a fresh nonce for each epoch to (re)seed the election process. Furthermore, this beacon
+  is resettable and leaky in order to strengthen the adversary. The paper also presents a
+  subprotocol \<open>\<pi>\<close>$_{RLB}$ that simulates the beacon in the \<open>\<F>\<close>$_\mathsf{INIT}$-hybrid model. So, we
+  choose to directly model \<open>\<pi>\<close>$_{RLB}$, and not explicitly model \<open>\<F>\<close>$_\mathsf{INIT}$ but instead
+  assume that each stakeholder is given the genesis block as a parameter (see Section
+  \ref{sec:sh-process-ref}):
 \<close>
 
-abbreviation absolute_stake :: "stake_distr \<Rightarrow> stake" (\<open>s\<^sup>+'(_')\<close>) where
-  "s\<^sup>+(\<S>) \<equiv> \<Sum>U\<^sub>j \<in> fmdom' \<S>. \<S> $$! U\<^sub>j"
+definition
+  fold1 :: "('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a list \<Rightarrow> 'a"
+where
+  [simp]: "fold1 f xs = foldl f (hd xs) (tl xs)"
 
-text \<open>
-  and the relative stake controlled by @{emph \<open>a single\<close>} stakeholder \<open>U\<^sub>i\<close>, taken as
-  @{emph \<open>maximum\<close>} across of the view of @{emph \<open>all\<close>} stakeholders w.r.t. a stake distribution
-  \<open>\<S>\<close>, denoted by \<open>\<alpha>\<^sup>+(U\<^sub>i, \<S>)\<close>. For this definition we assume that \<open>U\<^sub>i\<close> exists in \<open>\<S>\<close>:
-\<close>
+lemma "fold1 (\<bar>\<bar>) [a,b,c] = (a \<bar>\<bar> b) \<bar>\<bar> c"
+  by simp
 
-type_synonym relative_stake = real
+locale \<pi>\<^sub>R\<^sub>L\<^sub>B =
+  protocol_parameters +
+  hashable \<H>\<^sub>\<eta>
+  for \<H>\<^sub>\<eta> :: "'nonce \<Rightarrow> 'nonce"
+begin
 
-abbreviation
-  relative_stake_of :: "stakeholder_id \<Rightarrow> stake_distr \<Rightarrow> relative_stake" (\<open>\<alpha>\<^sup>+'(_,_')\<close>)
+function
+  next_epoch_nonce :: "'nonce \<Rightarrow> epoch \<Rightarrow> ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow> 'nonce"
 where
-  "\<alpha>\<^sup>+(U\<^sub>i, \<S>) \<equiv>
+  "next_epoch_nonce \<eta>\<^sub>p\<^sub>r\<^sub>e\<^sub>v j \<C> = (
     let
-      s\<^sub>i = \<S> $$! U\<^sub>i;
-      s\<^sub>\<P> = s\<^sup>+(\<S>)
+      sl\<^sub>e\<^sub>n\<^sub>d = (j - (first_epoch + 1)) * R + 16 * nat \<lceil>of_nat k / (1 + \<some>)\<rceil>;
+      \<C>' = prune_after sl\<^sub>e\<^sub>n\<^sub>d \<C>;
+      v = fold1 (\<bar>\<bar>) (map bl_nonce_proof \<C>')
     in
-      s\<^sub>i / s\<^sub>\<P>"
+      \<H>\<^sub>\<eta> (\<eta>\<^sub>p\<^sub>r\<^sub>e\<^sub>v \<bar>\<bar> j \<bar>\<bar> v))" if "j \<ge> first_epoch + 1"
+| "next_epoch_nonce \<eta>\<^sub>p\<^sub>r\<^sub>e\<^sub>v j \<C> = undefined \<eta>\<^sub>p\<^sub>r\<^sub>e\<^sub>v j \<C>" if "j < first_epoch + 1"
+  by (atomize, auto)
+  termination by lexicographic_order
 
-subsubsection \<open> Leader election \<close>
+end
+
+subsection \<open> Leader election \<close>
+
+text \<open>
+  In this section we model the procedure which determines whether a stakeholder is elected as a slot
+  leader or not for a given slot:
+\<close>
+
+locale leader_election =
+  protocol_parameters +
+  vrf _ _ evaluate\<^sub>V\<^sub>R\<^sub>F verify\<^sub>V\<^sub>R\<^sub>F
+  for evaluate\<^sub>V\<^sub>R\<^sub>F :: "'skey \<Rightarrow> 'nonce \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o"
+  and verify\<^sub>V\<^sub>R\<^sub>F :: "'vkey \<Rightarrow> 'nonce \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o \<Rightarrow> bool"
+begin
+
+context
+begin
 
 text \<open>
-  In this section we model the staking procedure which is used for the slot leader to compute and
-  send the next block. We define the probability \<open>\<phi>(\<alpha>)\<close> that a stakeholder with relative stake \<open>\<alpha>\<close>
-  is elected as a slot leader:
+  We define the probability \<open>\<phi>(\<alpha>)\<close> that a stakeholder with relative stake \<open>\<alpha>\<close> is elected as a slot
+  leader:
 \<close>
 
-abbreviation slot_leader_probability :: "relative_stake \<Rightarrow> real" (\<open>\<phi>'(_')\<close>) where
-  "\<phi>(\<alpha>) \<equiv> 1 - (1 - f) powr \<alpha>"
+notation powr (\<open>_\<^bsup>_\<^esup>\<close> [81,81] 80)
+
+definition
+  slot_leader_probability :: "relative_stake \<Rightarrow> real" (\<open>\<phi>'(_')\<close>)
+where
+  [simp]: "\<phi>(\<alpha>) = 1 - (1 - f)\<^bsup>\<alpha>\<^esup>"
 
 text \<open>
-  Next, given epoch \<open>j\<close>, genesis block \<open>G\<close> and blockchain \<open>\<C>\<close>, we define a function \<open>\<S>(j, G, \<C>)\<close>
-  that computes the stake distribution at the end of epoch \<open>j - 2\<close> as reflected in \<open>\<C>\<close> if \<open>j \<ge> 2\<close>;
-  otherwise returns the initial stake distribution in \<open>G\<close>:
+  Next, given epoch \<open>j\<close>, the initial stake distribution \<open>\<S>\<^sub>0\<close>, and a chain \<open>\<C>\<close>, we define a function
+  \<open>\<S>\<^bsub>j\<^esub>(\<S>\<^sub>0, \<C>)\<close> that computes the stake distribution at the end of epoch \<open>j - (first_epoch + 1)\<close> as
+  reflected in \<open>\<C>\<close> if \<open>j > first_epoch\<close>; otherwise returns \<open>\<S>\<^sub>0\<close>:
 \<close>
 
-fun epoch_stake_distr :: "epoch \<Rightarrow> genesis \<Rightarrow> blockchain \<Rightarrow> stake_distr" (\<open>\<S>'(_,_,_')\<close>) where
-  "\<S>(Suc 0, (_, \<S>\<^sub>0, _), _) = \<S>\<^sub>0" |
-  "\<S>(j, (_, \<S>\<^sub>0, _), \<C>) = (
+private function
+  epoch_stake_distr :: "
+    epoch \<Rightarrow>
+    stake_distr \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    stake_distr"
+  (\<open>\<S>\<^bsub>_\<^esub>'(_,_')\<close>)
+where
+  "\<S>\<^bsub>j\<^esub>(\<S>\<^sub>0, _) = \<S>\<^sub>0" if "j = first_epoch"
+| "\<S>\<^bsub>j\<^esub>(\<S>\<^sub>0, \<C>) = (
     let
-      sl\<^sub>e\<^sub>n\<^sub>d = (j - 2) * R;
+      sl\<^sub>e\<^sub>n\<^sub>d = (j - (Suc first_epoch)) * R;
       \<C>' = prune_after sl\<^sub>e\<^sub>n\<^sub>d \<C>
     in
-      apply_blockchain \<C>' \<S>\<^sub>0)"
+      apply_chain \<C>' \<S>\<^sub>0)" if "j > first_epoch"
+| "\<S>\<^bsub>j\<^esub>(\<S>\<^sub>0, \<C>) = undefined j \<S>\<^sub>0 \<C>" if "j < first_epoch"
+  by (auto, fastforce)
+  termination by lexicographic_order
 
 text \<open>
-  Now, given a genesis block \<open>G\<close> and a blockchain \<open>\<C>\<close>, a stakeholder \<open>U\<^sub>i\<close> is an eligible slot leader
-  for a particular slot in an epoch \<open>j\<close> if its VRF output is smaller than a threshold value, denoted
-  by \<open>T(U\<^sub>i, j, G, \<C>)\<close>, and defined as follows:
+  Now, given the initial stake distribution \<open>\<S>\<^sub>0\<close> and a chain \<open>\<C>\<close>, a stakeholder \<open>U\<close> is an eligible
+  slot leader for a particular slot in an epoch \<open>j\<close> if its VRF output is smaller than a @{emph
+  \<open>threshold value\<close>}, denoted by \<open>T\<^bsub>U\<^esub>\<^bsup>j\<^esup>(\<S>\<^sub>0, \<C>)\<close> and defined as follows:
 \<close>
 
-abbreviation slot_leader_threshold :: "
-     stakeholder_id
-  \<Rightarrow> epoch
-  \<Rightarrow> genesis
-  \<Rightarrow> blockchain
-  \<Rightarrow> real"
-  (\<open>T'(_,_,_,_')\<close>)
+private fun
+  slot_leader_threshold :: "
+    stakeholder_id \<Rightarrow>
+    epoch \<Rightarrow>
+    stake_distr \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    real"
+  (\<open>T\<^bsub>_\<^esub>\<^bsup>_\<^esup>'(_,_')\<close>)
 where
-  "T(U\<^sub>i, j, G, \<C>) \<equiv>
+  "T\<^bsub>U\<^esub>\<^bsup>j\<^esup>(\<S>\<^sub>0, \<C>) = (
     let
-      \<S>\<^sub>j = \<S>(j, G, \<C>);
-      \<alpha> = \<alpha>\<^sup>+(U\<^sub>i, \<S>\<^sub>j) 
+      \<S>\<^sub>j = \<S>\<^bsub>j\<^esub>(\<S>\<^sub>0, \<C>);
+      \<alpha> = \<alpha>\<^sup>+\<^bsub>U\<^esub>(\<S>\<^sub>j)
     in
-      2 ^ l\<^sub>V\<^sub>R\<^sub>F * \<phi>(\<alpha>)"
+      2\<^bsup>l\<^sub>V\<^sub>R\<^sub>F\<^esup> * \<phi>(\<alpha>))"
 
 text \<open>
   Finally, a stakeholder can ask if they are a slot leader for a given slot (note that stakeholders
   can only check this for themselves, not for other stakeholders):
 \<close>
 
-abbreviation is_slot_leader :: "slot \<Rightarrow> secret_key \<Rightarrow> nonce \<Rightarrow> real \<Rightarrow> vrf_value option" where
-  "is_slot_leader sl sk \<eta> T \<equiv>
+fun
+  is_slot_leader :: "
+    stakeholder_id \<Rightarrow>
+    slot \<Rightarrow>
+    'skey \<Rightarrow>
+    'nonce \<Rightarrow>
+    stake_distr \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    (('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o) option"
+where
+  "is_slot_leader U sl sk \<eta> \<S>\<^sub>0 \<C> = (
     let
-      (y, \<pi>) = evaluate_vrf sk (\<eta> \<bar>\<bar> sl \<bar>\<bar> TEST)
+      j = slot_epoch sl;
+      T = T\<^bsub>U\<^esub>\<^bsup>j\<^esup>(\<S>\<^sub>0, \<C>);
+      (y, \<pi>) = evaluate\<^sub>V\<^sub>R\<^sub>F sk (\<eta> \<bar>\<bar> sl \<bar>\<bar> TEST)
     in
-      if vrf_output_to_real y < T then Some (y, \<pi>) else None"
+      if value_to_real y < T then Some (y, \<pi>) else None)"
+
+end
+
+end
 
-subsubsection \<open> Auxiliary functions \<close>
+subsection \<open> Chain update \<close>
 
 text \<open>
-  We can compute the epoch to which a given slot belongs:
+  In this section we model the procedure by which a stakeholder decides which chain to adopt
+  given a set of alternatives received over the network in the current round (the `longest chain'
+  rule, i.e. that the intersection between the alternative chain and the current best chain is no
+  more than \<open>k\<close> blocks back, and the alternative chain is strictly longer than the current best
+  chain):
 \<close>
 
-abbreviation slot_epoch :: "slot \<Rightarrow> epoch" where
-  "slot_epoch sl \<equiv> nat \<lceil>sl / R\<rceil>"
+locale chain_selection =
+  protocol_parameters +
+  hashable \<H>\<^sub>B
+  for \<H>\<^sub>B :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block \<Rightarrow> 'block_hash"
+begin
 
 text \<open>
-  and check whether a given slot is the first one in its epoch:
+  Since the genesis block is not a proper block in a chain, we have to take care of it separately.
+  So, we need to check whether two chains are `disjoint', i.e., whether the only intersection point
+  between them is the genesis block. This amounts to checking whether their first blocks are
+  different, since, by construction, if they differ in the first block then they must necessarily
+  diverge:
 \<close>
 
-abbreviation first_in_epoch :: "slot \<Rightarrow> bool" where
-  "first_in_epoch sl \<equiv> R dvd (sl - 1)"
-
-subsubsection \<open> Verification \<close>
+definition
+  disjoint_chains :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    bool"
+where
+  [iff]: "disjoint_chains \<C> \<C>' \<longleftrightarrow> \<H>\<^sub>B (hd \<C>) \<noteq> \<H>\<^sub>B (hd \<C>')" if "\<C> \<noteq> []" and "\<C>' \<noteq> []"
 
 text \<open>
-  We can verify that a transaction is valid w.r.t. a genesis block, namely that the source and
-  target stakeholders exist in the genesis block's stake distribution, that the source stakeholder
-  has enough stake for the withdrawal, and that the signature is valid. Here we assume that the
-  given genesis block is well-formed, in particular that the domain of both maps coincide:
+  Also, we can extract the hashed, longest common prefix of two chains:
 \<close>
 
-abbreviation verify_tx :: "transaction \<Rightarrow> genesis \<Rightarrow> bool" where
-  "verify_tx tx G \<equiv>
-    let
-      (txbody, \<sigma>) = tx;
-      (U\<^sub>i, U\<^sub>j, s) = txbody;
-      (vks, \<S>\<^sub>0, _) = G;
-      (_, _, vk\<^sub>i) = the (vks U\<^sub>i) \<comment> \<open>\<open>U\<^sub>i\<close>'s DSIG verification key\<close>
-    in
-      \<exists>s\<^sub>i s\<^sub>j. \<S>\<^sub>0 $$ U\<^sub>i = Some s\<^sub>i \<and> \<S>\<^sub>0 $$ U\<^sub>j = Some s\<^sub>j \<and> s\<^sub>i \<ge> s \<and> verify vk\<^sub>i txbody \<sigma>"
+definition
+  hashed_lcp :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    'block_hash list"
+where
+  [simp]: "hashed_lcp \<C> \<C>' = Longest_common_prefix {map \<H>\<^sub>B \<C>, map \<H>\<^sub>B \<C>'}"
 
 text \<open>
-  and thus we can trivially verify whether a list of transactions is valid w.r.t. a genesis block:
+  Now, we can check whether a chain \<open>\<C>\<close> forks from another chain \<open>\<C>'\<close> at most \<open>n\<close> blocks, i.e. that
+  we should roll back at most the most recent \<open>n\<close> blocks in \<open>\<C>\<close> in order to switch to \<open>\<C>'\<close>:
 \<close>
 
-abbreviation verify_tx_data :: "transaction list \<Rightarrow> genesis \<Rightarrow> bool" where
-  "verify_tx_data txs G \<equiv> \<forall>i \<in> {0..<length txs}. verify_tx (txs ! i) G"
+definition
+  forks_at_most :: "
+    nat \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    bool"
+where
+  [iff]: "forks_at_most n \<C> \<C>' \<longleftrightarrow> (
+    if
+      disjoint_chains \<C> \<C>'
+    then
+      length \<C> \<le> n
+    else
+      length (drop (length (hashed_lcp \<C> \<C>')) \<C>) \<le> n)"
 
 text \<open>
-  A key component of block verification is verifying the block proof, i.e. that the stakeholder who
-  created the block was in the slot leader set of the slot in which the block was created:
+  For implementation purposes, we define a function that, given two chains \<open>\<C>\<close> and \<open>\<C>'\<close>, obtains
+  the suffix of \<open>\<C>\<close> after trimming its hashed longest common prefix with \<open>\<C>'\<close>:
 \<close>
 
-abbreviation
-  verify_block_proof :: "slot \<Rightarrow> verification_key \<Rightarrow> nonce \<Rightarrow> vrf_value \<Rightarrow> real \<Rightarrow> bool"
+fun
+  first_suffix :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain"
 where
-  "verify_block_proof sl vk \<eta> v T \<equiv>
-    verify_vrf vk (\<eta> \<bar>\<bar> sl \<bar>\<bar> TEST) v \<and> vrf_output_to_real (fst v) < T"
+  "first_suffix \<C> \<C>' = (
+    let
+      hlcp = longest_common_prefix (map \<H>\<^sub>B \<C>) (map \<H>\<^sub>B \<C>')
+    in
+      drop (length hlcp) \<C>)"
 
 text \<open>
-  Although the block nonce is not used (as explained in Section \ref{sec:block-ref}), we verify that
-  it was properly created nonetheless:
+  Also, we can compute the list of the longest chains in a given list of chains \<open>\<CC>\<close>:
 \<close>
 
-abbreviation verify_block_nonce :: "slot \<Rightarrow> verification_key \<Rightarrow> nonce \<Rightarrow> vrf_value \<Rightarrow> bool" where
-  "verify_block_nonce sl vk \<eta> v \<equiv> verify_vrf vk (\<eta> \<bar>\<bar> sl \<bar>\<bar> NONCE) v"
+abbreviation (input) "is_longest_chain \<C> \<CC> \<equiv> \<forall>\<C>' \<in> set \<CC>. length \<C> \<ge> length \<C>'"
+
+definition
+  longest_chains :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain list \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain list"
+where
+  "longest_chains \<CC> = [\<C> \<leftarrow> \<CC>. is_longest_chain \<C> \<CC>]"
 
 text \<open>
-  Armed with these definitions, we can now verify that a block is indeed valid:
+  Now we can define the function that implements the `longest chain' rule, namely the
+  $\mathsf{maxvalid}$ function in the paper:
 \<close>
 
-abbreviation verify_block :: "block \<Rightarrow> hash option \<Rightarrow> genesis \<Rightarrow> nonce \<Rightarrow> real \<Rightarrow> bool" where
-  "verify_block B oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v G \<eta> T \<equiv>
+fun
+  max_valid :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain list \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain"
+where
+  "max_valid \<C> \<CC> = (
     let
-      ((sl, st, d, B\<^sub>\<pi>, \<rho>), \<sigma>) = B;
-      (U\<^sub>s, y, \<pi>) = B\<^sub>\<pi>;
-      (\<rho>\<^sub>y, \<rho>\<^sub>\<pi>) = \<rho>
+      \<CC>' = [\<C>' \<leftarrow> \<C> # \<CC>. forks_at_most k \<C> \<C>']; \<comment> \<open>the \<open>k\<close> parameter\<close>
+      \<CC>'' = longest_chains \<CC>'
     in
-      verify_tx_data d G \<and> (
-      \<exists>v\<^sub>v\<^sub>r\<^sub>f v\<^sub>k\<^sub>e\<^sub>s v\<^sub>d\<^sub>s\<^sub>i\<^sub>g.
-        Some (v\<^sub>v\<^sub>r\<^sub>f, v\<^sub>k\<^sub>e\<^sub>s, v\<^sub>d\<^sub>s\<^sub>i\<^sub>g) = (fst G) U\<^sub>s \<and> \<comment> \<open> \<open>U\<^sub>s\<close>'s verification keys \<close>
-        verify_block_proof sl v\<^sub>v\<^sub>r\<^sub>f \<eta> (y, \<pi>) T \<and>
-        verify_block_nonce sl v\<^sub>v\<^sub>r\<^sub>f \<eta> (\<rho>\<^sub>y, \<rho>\<^sub>\<pi>) \<and>
-        verify v\<^sub>k\<^sub>e\<^sub>s (sl, st, d, B\<^sub>\<pi>, \<rho>) \<sigma>) \<and> (
-      case oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v of
-        None \<Rightarrow> True
-      | Some h\<^sub>p\<^sub>r\<^sub>e\<^sub>v \<Rightarrow> the st = h\<^sub>p\<^sub>r\<^sub>e\<^sub>v)" \<comment> \<open> if \<open>oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v\<close> is not \<open>None\<close> then \<open>st\<close> is not \<open>None\<close> either \<close>
+      if \<C> \<in> set \<CC>'' then \<C> else hd \<CC>'')"
+
+end
+
+subsection \<open> The semi-synchronous model \label{sec:semi-sync-model-ref} \<close>
 
 text \<open>
-  and we can verify that a blockchain is indeed valid:
+  In the paper, a semi-synchronous model with an upper bound \<open>\<Delta>\<close> in message delay is used. Regarding
+  \<open>\<Delta>\<close>, we stress the fact that the protocol is oblivious of \<open>\<Delta>\<close> and this bound is only used in the
+  security analysis. Hence, from the protocol's point of view, the network is no better than an
+  eventual delivery network (without a concrete bound), which can be modeled using our process
+  calculus, for example, as a reliable broadcasting server process. Regarding synchrony, we simply
+  assume that an external `clock process' signals each stakeholder when a round (i.e. slot) ends,
+  and that messages sent in one round are guaranteed to be received at the onset of the next round.
 \<close>
 
-abbreviation verify_chain :: "blockchain \<Rightarrow> genesis \<Rightarrow> nonce \<Rightarrow> bool" where
-  "verify_chain \<C> G \<eta> \<equiv> \<forall>i \<in> {0..<length \<C>}.
-    let
-      B = \<C> ! i; \<comment> \<open> current block \<close>
-      ((sl, _, _, B\<^sub>\<pi>, _), _) = B;
-      U\<^sub>s = fst B\<^sub>\<pi>;
-      oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v = if i = 0 then None else fst (snd (fst (\<C> ! (i - 1)))); \<comment> \<open> previous block hash \<close>
-      T\<^sub>s = T(U\<^sub>s, slot_epoch sl, G, \<C>)
-    in
-      verify_block B oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v G \<eta> T\<^sub>s"
+paragraph \<open> The Delayed Diffuse Functionality. \<close>
+
+text \<open>
+  We do not model the network as a separate ideal functionality \textsf{DDiffuse}\<open>\<^sub>\<Delta>\<close> but rely on
+  our process calculus features for communication. In particular, a single channel is used both to
+  read the received messages from a stakeholder's `incoming string' (or `mailbox') and to
+  `diffuse' a message. Also, the restriction that a stakeholder is allowed to diffuse once in a
+  round is explicitly enforced by the stakeholder process implementation, see Section
+  \ref{sec:sh-process-ref}.
+\<close>
+
+subsection \<open> Broadcast messages \<close>
+
+text \<open>
+  In addition to broadcasting transactions and chains, we also assume that there is a `clock
+  process' broadcasting the next slot at the end of each current slot, see Section
+  \ref{sec:semi-sync-model-ref}:
+\<close>
+
+datatype ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) broadcast_msg =
+    BroadcastTx (bm_tx: "'sig transaction")
+  | BroadcastChain (bm_\<C>: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain")
+  | BroadcastEndSlot (bm_sl: slot)
+
+instance broadcast_msg :: (countable, countable, countable, countable) countable
+  by countable_datatype
+
+type_synonym ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) broadcast_channel = "
+  ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) broadcast_msg channel"
+
+subsection \<open> The stakeholder process \label{sec:sh-process-ref} \<close>
+
+text \<open>
+  Now we are ready to define the process representing a stakeholder running the protocol.
+\<close>
 
 subsubsection \<open> Stakeholder state \<close>
 
@@ -724,202 +758,1848 @@ text \<open>
   in a record type:
 \<close>
 
-record stakeholder_state =
+record ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state =
   ss_id :: stakeholder_id \<comment> \<open> ID of the stakeholder in the set \<open>U\<^sub>1, ..., U\<^sub>n\<close> \<close>
-  ss_G :: genesis \<comment> \<open> genesis block \<close>
-  ss_\<C> :: blockchain \<comment> \<open> current blockchain \<close>
-  ss_\<eta> :: nonce \<comment> \<open> current epoch nonce \<open>\<eta>\<^sub>j\<close> \<close>
-  ss_\<CC> :: "blockchain list" \<comment> \<open> blockchains received during the current slot \<close>
-  ss_txs :: "transaction list" \<comment> \<open> transactions received during the current slot \<close>
-  ss_st :: "hash option" \<comment> \<open> current state, namely the hash of the head of \<open>ss_\<C>\<close> \<close>
-  ss_sk\<^sub>v\<^sub>r\<^sub>f :: secret_key \<comment> \<open> secret key for \<open>\<F>\<close>$_{\mathsf{VRF}}$ \<close>
-  ss_sk\<^sub>k\<^sub>e\<^sub>s :: secret_key \<comment> \<open> secret key for \<open>\<F>\<close>$_{\mathsf{KES}}$ \<close>
-  ss_sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g :: secret_key \<comment> \<open> secret key for \<open>\<F>\<close>$_{\mathsf{DSIG}}$ \<close>
+  ss_G :: "('vkey, 'nonce) genesis" \<comment> \<open> genesis block \<close>
+  ss_\<C> :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain" \<comment> \<open> current chain \<close>
+  ss_\<eta> :: 'nonce \<comment> \<open> current epoch nonce \<open>\<eta>\<^sub>j\<close> \<close>
+  ss_\<CC> :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain list" \<comment> \<open> chains received during the current slot \<close>
+  ss_txs :: "'sig transaction list" \<comment> \<open> transactions received during the current slot \<close>
+  ss_st :: "'hash option" \<comment> \<open> current state, namely the hash of the head of \<open>ss_\<C>\<close> \<close>
+  ss_sk\<^sub>v\<^sub>r\<^sub>f :: 'skey \<comment> \<open> secret key for \<open>\<F>\<close>$_{\mathsf{VRF}}$ \<close>
+  ss_sk\<^sub>k\<^sub>e\<^sub>s :: 'skey \<comment> \<open> secret key for \<open>\<F>\<close>$_{\mathsf{KES}}$ \<close>
+  ss_sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g :: 'skey \<comment> \<open> secret key for \<open>\<F>\<close>$_{\mathsf{DSIG}}$ \<close>
+
+locale stakeholders =
+  digital_signature_scheme _ _ sign\<^sub>K\<^sub>E\<^sub>S verify\<^sub>K\<^sub>E\<^sub>S +
+  digital_signature_scheme _ _ sign\<^sub>D\<^sub>S\<^sub>I\<^sub>G verify\<^sub>D\<^sub>S\<^sub>I\<^sub>G +
+  chain_selection _ _ _ _ \<H>\<^sub>B +
+  leader_election _ _ _ _ _ _ _ _ evaluate\<^sub>V\<^sub>R\<^sub>F verify\<^sub>V\<^sub>R\<^sub>F +
+  \<pi>\<^sub>R\<^sub>L\<^sub>B _ _ _ _ \<H>\<^sub>\<eta>
+  for sign\<^sub>K\<^sub>E\<^sub>S :: "
+    'skey \<Rightarrow>
+    ('hash::countable, 'vrf\<^sub>y::countable, 'vrf\<^sub>\<pi>::countable, 'sig::countable) unsigned_block \<Rightarrow>
+    'sig"
+  and verify\<^sub>K\<^sub>E\<^sub>S :: "'vkey \<Rightarrow> ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) unsigned_block \<Rightarrow> 'sig \<Rightarrow> bool"
+  and sign\<^sub>D\<^sub>S\<^sub>I\<^sub>G :: "'skey \<Rightarrow> transaction_body \<Rightarrow> 'sig"
+  and verify\<^sub>D\<^sub>S\<^sub>I\<^sub>G :: "'vkey \<Rightarrow> transaction_body \<Rightarrow> 'sig \<Rightarrow> bool"
+  and \<H>\<^sub>B :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block \<Rightarrow> 'hash"
+  and evaluate\<^sub>V\<^sub>R\<^sub>F :: "'skey \<Rightarrow> 'nonce \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o"
+  and verify\<^sub>V\<^sub>R\<^sub>F :: "'vkey \<Rightarrow> 'nonce \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o \<Rightarrow> bool"
+  and \<H>\<^sub>\<eta> :: "'nonce \<Rightarrow> 'nonce"
+begin
+
+context
+begin
+
+subsubsection \<open> Verification \<close>
 
 text \<open>
-  We can specify what the initial state for each stakeholder should be:
+  We can verify that a transaction is valid w.r.t. a genesis block, namely that the source and
+  target stakeholders exist in the genesis block's stake distribution, that the source stakeholder
+  has enough stake for the withdrawal, and that the signature is valid. Here we assume that the
+  given genesis block is well-formed, in particular that the domain of both maps coincide:
 \<close>
 
-abbreviation init_stakeholder_state :: "
-     stakeholder_id
-  \<Rightarrow> genesis
-  \<Rightarrow> secret_key
-  \<Rightarrow> secret_key
-  \<Rightarrow> secret_key
-  \<Rightarrow> stakeholder_state"
+private definition
+  verify_tx :: "'sig transaction \<Rightarrow> ('vkey, 'nonce) genesis \<Rightarrow> bool"
 where
-  "init_stakeholder_state U\<^sub>i G sk\<^sub>v\<^sub>r\<^sub>f sk\<^sub>k\<^sub>e\<^sub>s sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g \<equiv>
+  [iff]: "verify_tx tx G \<longleftrightarrow> (
     let
-      (_, _, \<eta>\<^sub>0) = G
+      (txbody, \<sigma>) = tx;
+      (U\<^sub>i, U\<^sub>j, s) = txbody;
+      (vks, \<S>\<^sub>0, _) = G;
+      (_, _, vk\<^sub>i) = the (vks U\<^sub>i) \<comment> \<open>\<open>U\<^sub>i\<close>'s DSIG verification key\<close>
     in
-      \<lparr>
-        ss_id = U\<^sub>i,
-        ss_G = G,
-        ss_\<C> = [],
-        ss_\<eta> = \<eta>\<^sub>0,
-        ss_\<CC> = [],
-        ss_txs = [],
-        ss_st = None,
-        ss_sk\<^sub>v\<^sub>r\<^sub>f = sk\<^sub>v\<^sub>r\<^sub>f,
-        ss_sk\<^sub>k\<^sub>e\<^sub>s = sk\<^sub>k\<^sub>e\<^sub>s,
-        ss_sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g = sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g
-      \<rparr>"
+      \<exists>s\<^sub>i s\<^sub>j. \<S>\<^sub>0 $$ U\<^sub>i = Some s\<^sub>i \<and> \<S>\<^sub>0 $$ U\<^sub>j = Some s\<^sub>j \<and> s\<^sub>i \<ge> s \<and> verify\<^sub>D\<^sub>S\<^sub>I\<^sub>G vk\<^sub>i txbody \<sigma>)"
+
+text \<open>
+  and thus we can trivially verify whether a list of transactions is valid w.r.t. a genesis block:
+\<close>
 
-subsubsection \<open> Blockchain update \<close>
+private definition
+  verify_tx_data :: "'sig transaction list \<Rightarrow> ('vkey, 'nonce) genesis \<Rightarrow> bool"
+where
+  [iff]: "verify_tx_data txs G \<longleftrightarrow> (\<forall>i \<in> {0..<length txs}. verify_tx (txs ! i) G)"
 
 text \<open>
-  In this section we model the procedure by which a stakeholder decides which blockchain to adopt
-  given a set of alternatives received over the network in the current round (the ``longest chain''
-  rule). We can check whether a blockchain forks from another at most \<open>m\<close> blocks:
+  A key component of block verification is verifying the block proof, i.e. that the stakeholder who
+  created the block was in the slot leader set of the slot in which the block was created:
 \<close>
 
-abbreviation forks_at_most :: "nat \<Rightarrow> blockchain \<Rightarrow> blockchain \<Rightarrow> bool" where
-  "forks_at_most n \<C> \<C>' \<equiv>
-    if
-      \<exists>i. \<H> (\<C> ! i) \<noteq> \<H> (\<C>' ! i)
-    then
-      length (drop (LEAST i. \<H> (\<C> ! i) \<noteq> \<H> (\<C>' ! i)) \<C>') \<le> n
-    else
-      True"
+private definition
+  verify_block_proof :: "slot \<Rightarrow> 'vkey \<Rightarrow> 'nonce \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o \<Rightarrow> real \<Rightarrow> bool"
+where
+  [iff]: "verify_block_proof sl vk \<eta> v T \<longleftrightarrow>
+    verify\<^sub>V\<^sub>R\<^sub>F vk (\<eta> \<bar>\<bar> sl \<bar>\<bar> TEST) v \<and> value_to_real (fst v) < T"
+
+text \<open>
+  Furthermore, we verify that the nonce proof in a block was properly created:
+\<close>
+
+private definition
+  verify_block_nonce :: "slot \<Rightarrow> 'vkey \<Rightarrow> 'nonce \<Rightarrow> ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o \<Rightarrow> bool"
+where
+  [iff]: "verify_block_nonce sl vk \<eta> v \<longleftrightarrow> verify\<^sub>V\<^sub>R\<^sub>F vk (\<eta> \<bar>\<bar> sl \<bar>\<bar> NONCE) v"
 
 text \<open>
-  Also, we can compute the list of the longest blockchains in a given list of blockchains:
+  Armed with these definitions, we can now verify that a block is indeed valid:
 \<close>
 
-abbreviation longest_chains :: "blockchain list \<Rightarrow> blockchain list" where
-  "longest_chains \<CC> \<equiv>
+private definition
+  verify_block :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block \<Rightarrow>
+    'hash option \<Rightarrow>
+    ('vkey, 'nonce) genesis \<Rightarrow>
+    'nonce \<Rightarrow>
+    real \<Rightarrow>
+    bool"
+where
+  [iff]: "verify_block B oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v G \<eta> T \<longleftrightarrow> (
     let
-      is_longest_chain = \<lambda>\<C> \<CC>. \<forall>\<C>' \<in> set \<CC>. length \<C> \<ge> length \<C>'
+      ((sl, st, d, B\<^sub>\<pi>, \<rho>), \<sigma>) = B;
+      (U\<^sub>s, y, \<pi>) = B\<^sub>\<pi>;
+      (\<rho>\<^sub>y, \<rho>\<^sub>\<pi>) = \<rho>
     in
-      [\<C>. \<C> \<leftarrow> \<CC>, is_longest_chain \<C> \<CC>]"
+      verify_tx_data d G \<and> (
+      \<exists>v\<^sub>v\<^sub>r\<^sub>f v\<^sub>k\<^sub>e\<^sub>s v\<^sub>d\<^sub>s\<^sub>i\<^sub>g.
+        Some (v\<^sub>v\<^sub>r\<^sub>f, v\<^sub>k\<^sub>e\<^sub>s, v\<^sub>d\<^sub>s\<^sub>i\<^sub>g) = (fst G) U\<^sub>s \<and> \<comment> \<open> \<open>U\<^sub>s\<close>'s verification keys \<close>
+        verify_block_proof sl v\<^sub>v\<^sub>r\<^sub>f \<eta> (y, \<pi>) T \<and>
+        verify_block_nonce sl v\<^sub>v\<^sub>r\<^sub>f \<eta> (\<rho>\<^sub>y, \<rho>\<^sub>\<pi>) \<and>
+        verify\<^sub>K\<^sub>E\<^sub>S v\<^sub>k\<^sub>e\<^sub>s (sl, st, d, B\<^sub>\<pi>, \<rho>) \<sigma>) \<and> (
+      case oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v of
+        None \<Rightarrow> True
+      | Some h\<^sub>p\<^sub>r\<^sub>e\<^sub>v \<Rightarrow> the st = h\<^sub>p\<^sub>r\<^sub>e\<^sub>v))" \<comment> \<open> if \<open>oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v\<close> is not \<open>None\<close> then \<open>st\<close> is not \<open>None\<close> either \<close>
 
 text \<open>
-  Now we can define the function that implements the ``longest chain'' rule, namely the
-  $\mathsf{maxvalid}$ function in the paper:
+  and we can verify that a chain is indeed valid. It is important to mention that candidate chains
+  cannot be empty since they were diffused by slot leaders, which built them on top of the genesis
+  block:
 \<close>
 
-abbreviation max_valid :: "blockchain \<Rightarrow> blockchain list \<Rightarrow> blockchain" where
-  "max_valid \<C> \<CC> \<equiv>
+private definition
+  verify_chain :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow> ('vkey, 'nonce) genesis \<Rightarrow> 'nonce \<Rightarrow> bool"
+where
+  [iff]: "verify_chain \<C> G \<eta> \<longleftrightarrow> (\<forall>i \<in> {0..<length \<C>}.
     let
-      \<CC>' = [\<C>'. \<C>' \<leftarrow> \<C> # \<CC>, forks_at_most k \<C> \<C>'];
-      \<CC>'' = longest_chains \<CC>'
+      (_, \<S>\<^sub>0, _) = G;
+      B = \<C> ! i; \<comment> \<open> current block \<close>
+      ((sl, _, _, B\<^sub>\<pi>, _), _) = B;
+      U\<^sub>s = fst B\<^sub>\<pi>;
+      oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v = if i = 0 then None else fst (snd (fst (\<C> ! (i - 1)))); \<comment> \<open> previous block hash \<close>
+      j = slot_epoch sl;
+      T\<^sub>s = T\<^bsub>U\<^sub>s\<^esub>\<^bsup>j\<^esup>(\<S>\<^sub>0, \<C>)
+    in
+      verify_block B oh\<^sub>p\<^sub>r\<^sub>e\<^sub>v G \<eta> T\<^sub>s)"
+
+text \<open>
+  Finally, we specify what the initial state for each stakeholder should be:
+\<close>
+
+fun
+  init_stakeholder_state :: "
+    stakeholder_id \<Rightarrow>
+    ('vkey, 'nonce) genesis \<Rightarrow>
+    'skey \<Rightarrow>
+    'skey \<Rightarrow>
+    'skey \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state"
+where
+  "init_stakeholder_state U\<^sub>i G sk\<^sub>v\<^sub>r\<^sub>f sk\<^sub>k\<^sub>e\<^sub>s sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g = (
+    let
+      (_, _, \<eta>\<^sub>0) = G
     in
-      if \<C> \<in> set \<CC>'' then \<C> else hd \<CC>''"
+      \<lparr>
+        ss_id = U\<^sub>i,
+        ss_G = G,
+        ss_\<C> = [],
+        ss_\<eta> = \<eta>\<^sub>0,
+        ss_\<CC> = [],
+        ss_txs = [],
+        ss_st = None,
+        ss_sk\<^sub>v\<^sub>r\<^sub>f = sk\<^sub>v\<^sub>r\<^sub>f,
+        ss_sk\<^sub>k\<^sub>e\<^sub>s = sk\<^sub>k\<^sub>e\<^sub>s,
+        ss_sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g = sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g
+      \<rparr>)"
 
-subsubsection \<open> Blockchain extension \<close>
+subsubsection \<open> Chain extension \<close>
 
 text \<open>
   In this section we model the procedure by which a stakeholder elected as a slot leader extends its
-  current blockchain. We define a function that constructs a new block containing the transactions
+  current chain. We define a function that constructs a new block containing the transactions
   in the stakeholder's current state:
 \<close>
 
-abbreviation make_block :: "stakeholder_state \<Rightarrow> slot \<Rightarrow> vrf_value \<Rightarrow> block" where
-  "make_block ss sl v \<equiv>
+private fun
+  make_block :: "
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow>
+    slot \<Rightarrow>
+    ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+where
+  "make_block ss sl v = (
     let
-      U\<^sub>i = ss_id ss;
+      U = ss_id ss;
       \<eta> = ss_\<eta> ss;
-      st = if ss_\<C> ss = [] then None else Some (\<H> (last (ss_\<C> ss)));
+      st = if ss_\<C> ss = [] then None else Some (\<H>\<^sub>B (last (ss_\<C> ss)));
       d = ss_txs ss;
-      B\<^sub>\<pi> = (U\<^sub>i, v);
-      \<rho> = evaluate_vrf (ss_sk\<^sub>v\<^sub>r\<^sub>f ss) (\<eta> \<bar>\<bar> sl \<bar>\<bar> NONCE);
+      B\<^sub>\<pi> = (U, v);
+      \<rho> = evaluate\<^sub>V\<^sub>R\<^sub>F (ss_sk\<^sub>v\<^sub>r\<^sub>f ss) (\<eta> \<bar>\<bar> sl \<bar>\<bar> NONCE);
       uB = (sl, st, d, B\<^sub>\<pi>, \<rho>);
-      \<sigma> = sign (ss_sk\<^sub>k\<^sub>e\<^sub>s ss) uB
+      \<sigma> = sign\<^sub>K\<^sub>E\<^sub>S (ss_sk\<^sub>k\<^sub>e\<^sub>s ss) uB
     in
-      (uB, \<sigma>)"
+      (uB, \<sigma>))"
 
 text \<open>
-  We can extend a stakeholder's current blockchain simply by appending a newly constructed block to
-  it and updating its current state to the hash of this block:
+  We can extend a stakeholder's current chain simply by appending a newly constructed block to
+  it and updating its current `state' to the hash of this block:
 \<close>
 
-abbreviation extend_chain :: "stakeholder_state \<Rightarrow> block \<Rightarrow> stakeholder_state" where
-  "extend_chain ss B\<^sub>n\<^sub>e\<^sub>w \<equiv> ss\<lparr>ss_\<C> := ss_\<C> ss @ [B\<^sub>n\<^sub>e\<^sub>w], ss_st := Some (\<H> B\<^sub>n\<^sub>e\<^sub>w)\<rparr>"
-
-subsubsection \<open> Broadcast messages \<close>
+private fun
+  extend_chain :: "
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow>
+    slot \<Rightarrow>
+    ('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state"
+where
+  "extend_chain ss sl v = (
+    let
+      B\<^sub>n\<^sub>e\<^sub>w = make_block ss sl v
+    in
+      ss
+        \<lparr>
+          ss_\<C> := ss_\<C> ss @ [B\<^sub>n\<^sub>e\<^sub>w],
+          ss_st := Some (\<H>\<^sub>B B\<^sub>n\<^sub>e\<^sub>w),
+          ss_txs := []
+        \<rparr>)"
 
 text \<open>
-  In addition to broadcasting transactions and blockchains, we also assume that there is a ``clock
-  process'' broadcasting the next slot at the end of each current slot, see Section
-  \ref{sec:semi-sync-model-ref}:
+  We can easily define a function to store a given transaction in the transactions mempool of a
+  stakeholder's state:
 \<close>
 
-datatype broadcast_msg =
-    BroadcastTx (bm_tx: transaction)
-  | BroadcastChain (bm_\<C>: blockchain)
-  | BroadcastEndSlot (bm_sl: slot)
+private definition
+  store_tx :: "
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow>
+    'sig transaction \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state"
+where
+  [simp]: "store_tx ss tx = ss\<lparr>ss_txs := tx # ss_txs ss\<rparr>"
 
-instance broadcast_msg :: countable
-  by countable_datatype
+text \<open>
+  Also, we define a function to store a given chain in the chains mempool of a stakeholder's state,
+  after pruning blocks belonging to future slots in the chain, and provided that the pruned chain
+  is valid:
+\<close>
+
+private fun
+  store_chain :: "
+    slot \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state"
+where
+  "store_chain sl \<C> ss = (
+    let
+      \<C>\<^sub>p = prune_after sl \<C>
+    in
+      if
+        verify_chain \<C>\<^sub>p (ss_G ss) (ss_\<eta> ss)
+      then
+        ss\<lparr>ss_\<CC> := \<C>\<^sub>p # ss_\<CC> ss\<rparr>
+      else
+        ss)"
 
-type_synonym broadcast_channel = "broadcast_msg channel"
+text \<open>
+  We define a function to compute the new epoch nonce and store it in the stakeholder's state:
+\<close>
 
-subsubsection \<open> The stakeholder process \<close>
+private fun
+  compute_new_epoch_randomness :: "
+    slot \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state"
+where
+  "compute_new_epoch_randomness sl\<^sub>n\<^sub>e\<^sub>x\<^sub>t ss = (
+    let
+      j = slot_epoch sl\<^sub>n\<^sub>e\<^sub>x\<^sub>t
+    in
+      ss\<lparr>ss_\<eta> := next_epoch_nonce (ss_\<eta> ss) j (ss_\<C> ss)\<rparr>)"
 
 text \<open>
-  \label{sec:sh-process-ref}
-  Now we are ready to define the process representing a stakeholder running the protocol:
+  We define a function to update the current best chain in a stakeholder's state to the longest
+  chain seen so far by the stakeholder:
 \<close>
 
-corec (friend) start_of_slot :: "
-     broadcast_channel
-  \<Rightarrow> stakeholder_state
-  \<Rightarrow> slot
-  \<Rightarrow> (broadcast_channel \<Rightarrow> stakeholder_state \<Rightarrow> slot \<Rightarrow> process)
-  \<Rightarrow> process"
+private fun
+  update_local_chain :: "
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state"
 where
-  "start_of_slot bc ss sl cont = (
+  "update_local_chain ss = (
     let
-      T\<^sub>i = T(ss_id ss, slot_epoch sl, ss_G ss, ss_\<C> ss)
+      \<C>\<^sub>m\<^sub>a\<^sub>x = max_valid (ss_\<C> ss) (ss_\<CC> ss)
     in
-      case is_slot_leader sl (ss_sk\<^sub>v\<^sub>r\<^sub>f ss) (ss_\<eta> ss) T\<^sub>i of
-          None \<Rightarrow> \<zero> \<parallel> cont bc ss sl \<comment> \<open>\<open>\<zero> \<parallel>\<close> is added to fulfill corecursive function requirements\<close>
+      ss\<lparr>
+          ss_\<C> := \<C>\<^sub>m\<^sub>a\<^sub>x,
+          ss_st := Some (\<H>\<^sub>B (last \<C>\<^sub>m\<^sub>a\<^sub>x)), \<comment> \<open> update `state' with hash of best chain's head \<close>
+          ss_\<CC> := [] \<comment> \<open> empty chains mempool \<close>
+        \<rparr>)"
+
+text \<open>
+  We define a process that is executed when an end-of-slot signal is received and that basically
+  checks whether the associated stakeholder is a slot leader for the current slot, and, if so,
+  extends its current chain, broadcasts it to the network, and runs a continuation process:
+\<close>
+
+private abbreviation
+  start_of_slot :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) broadcast_channel \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow>
+    slot \<Rightarrow>
+    (('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) broadcast_channel \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow> slot \<Rightarrow> process) \<Rightarrow>
+    process"
+where
+  "start_of_slot bc ss sl \<K> \<equiv> (
+    let
+      (U, sk\<^sub>v\<^sub>r\<^sub>f, \<eta>, (_, \<S>\<^sub>0, _), \<C>) = (ss_id ss, ss_sk\<^sub>v\<^sub>r\<^sub>f ss, ss_\<eta> ss, ss_G ss, ss_\<C> ss)
+    in (
+      case is_slot_leader U sl sk\<^sub>v\<^sub>r\<^sub>f \<eta> \<S>\<^sub>0 \<C> of
+          None \<Rightarrow>
+            \<zero> \<parallel> \<K> bc ss sl \<comment> \<open>\<open>\<zero> \<parallel>\<close> is added to fulfill corecursive function requirements\<close>
         | Some v \<Rightarrow>
           let
-            B\<^sub>n\<^sub>e\<^sub>w = make_block ss sl v;
-            ss' = extend_chain ss B\<^sub>n\<^sub>e\<^sub>w;
-            ss'' = ss'\<lparr>ss_txs := []\<rparr>
+            ss' = extend_chain ss sl v
           in
-            bc \<triangleleft>\<degree> BroadcastChain (ss_\<C> ss'') \<parallel> cont bc ss'' sl)"
+            bc \<triangleleft>\<degree> BroadcastChain (ss_\<C> ss') \<parallel> \<K> bc ss' sl))"
+
+text \<open>
+  Then we define a process that executes the `main loop' of the protocol:
+\<close>
 
-corec main_loop :: "broadcast_channel \<Rightarrow> stakeholder_state \<Rightarrow> slot \<Rightarrow> process" where
+private corec
+  main_loop :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) broadcast_channel \<Rightarrow>
+    ('skey, 'vkey, 'hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig, 'nonce) stakeholder_state \<Rightarrow>
+    slot \<Rightarrow>
+    process"
+where
   "main_loop bc ss sl =
     bc \<triangleright>\<degree> msg. (
       case msg of
         BroadcastTx tx \<Rightarrow> (
+         \<comment> \<open>Store new transaction\<close>
           let
-            ss' = ss\<lparr>ss_txs := tx # ss_txs ss\<rparr>
+            ss' = store_tx ss tx
           in
             main_loop bc ss' sl)
       | BroadcastChain \<C> \<Rightarrow> (
+         \<comment> \<open>Store new chain\<close>
           let
-            \<C>\<^sub>p = prune_after sl \<C>; \<comment> \<open>pruned blocks belonging to future slots\<close>
-            ss' = if verify_chain \<C>\<^sub>p (ss_G ss) (ss_\<eta> ss) then ss\<lparr>ss_\<CC> := \<C>\<^sub>p # ss_\<CC> ss\<rparr> else ss
+            ss' = store_chain sl \<C> ss
           in
             main_loop bc ss' sl)
       | BroadcastEndSlot sl\<^sub>n\<^sub>e\<^sub>x\<^sub>t \<Rightarrow> (
           let
-            \<comment> \<open>If new epoch, compute epoch randomness\<close>
-            ss' = if first_in_epoch sl\<^sub>n\<^sub>e\<^sub>x\<^sub>t then ss\<lparr>ss_\<eta> := new_epoch_rnd\<rparr> else ss;
+            \<comment> \<open>If new epoch, compute and store new epoch randomness\<close>
+            ss' = if first_in_epoch sl\<^sub>n\<^sub>e\<^sub>x\<^sub>t then compute_new_epoch_randomness sl\<^sub>n\<^sub>e\<^sub>x\<^sub>t ss else ss;
             \<comment> \<open>Update local chain\<close>
-            \<C>\<^sub>m\<^sub>a\<^sub>x = max_valid (ss_\<C> ss') (ss_\<CC> ss');
-            ss'' = ss'\<lparr>ss_\<C> := \<C>\<^sub>m\<^sub>a\<^sub>x, ss_st := Some (\<H> (last \<C>\<^sub>m\<^sub>a\<^sub>x)), ss_\<CC> := []\<rparr>
+            ss' = update_local_chain ss'
           in
-            start_of_slot bc ss'' sl\<^sub>n\<^sub>e\<^sub>x\<^sub>t main_loop))"
-
-abbreviation stakeholder :: "
-     stakeholder_id
-  \<Rightarrow> genesis
-  \<Rightarrow> secret_key
-  \<Rightarrow> secret_key
-  \<Rightarrow> secret_key
-  \<Rightarrow> broadcast_channel
-  \<Rightarrow> process"
-where
-  "stakeholder U\<^sub>i G sk\<^sub>v\<^sub>r\<^sub>f sk\<^sub>k\<^sub>e\<^sub>s sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g bc \<equiv>
+            start_of_slot bc ss' sl\<^sub>n\<^sub>e\<^sub>x\<^sub>t main_loop))"
+
+text \<open>
+  Finally, we define a process that implements a stakeholder running the protocol:
+\<close>
+
+fun
+  stakeholder :: "
+    stakeholder_id \<Rightarrow>
+    ('vkey, 'nonce) genesis \<Rightarrow>
+    'skey \<Rightarrow>
+    'skey \<Rightarrow>
+    'skey \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) broadcast_channel \<Rightarrow>
+    process"
+where
+  "stakeholder U\<^sub>i G sk\<^sub>v\<^sub>r\<^sub>f sk\<^sub>k\<^sub>e\<^sub>s sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g bc = (
     let
       ss\<^sub>i\<^sub>n\<^sub>i\<^sub>t = init_stakeholder_state U\<^sub>i G sk\<^sub>v\<^sub>r\<^sub>f sk\<^sub>k\<^sub>e\<^sub>s sk\<^sub>d\<^sub>s\<^sub>i\<^sub>g
     in
-      start_of_slot bc ss\<^sub>i\<^sub>n\<^sub>i\<^sub>t first_slot main_loop"
+      start_of_slot bc ss\<^sub>i\<^sub>n\<^sub>i\<^sub>t first_slot main_loop)"
+
+end
+
+end
+
+subsection \<open> Proofs \<close>
+
+subsubsection \<open> Slots and epochs \<close>
+
+context protocol_parameters
+begin
+
+text \<open>
+  A given epoch \<open>e\<^sub>j\<close> contains the interval of slots \<open>[(e\<^sub>j - 1) * R + 1, e\<^sub>j * R]\<close>:
+\<close>
+
+lemma slot_epoch_bounds:
+  fixes n :: nat
+  assumes "sl \<in> {n * R + 1..<Suc n * R + 1}"
+  shows "slot_epoch sl = Suc n"
+proof -
+  let ?x = "sl / R"
+  have "\<lceil>?x\<rceil> = Suc n \<longleftrightarrow> Suc n - 1 < ?x \<and> ?x \<le> Suc n"
+    by (simp add: ceiling_eq_iff)
+  moreover have "Suc n - 1 < ?x"
+  proof -
+    have "(n * R + 1) / R \<le> ?x"
+    proof -
+      have "0 < real R \<longrightarrow> real (n * R + 1) \<le> real sl"
+      proof -
+        have "(\<not> 0 < real R) = (real R \<le> 0)"
+          by simp
+        with assms show ?thesis
+          by force
+      qed
+      then show ?thesis
+        by (simp add: divide_le_cancel)
+    qed
+    moreover have "Suc n - 1 < (n * R + 1) / R"
+      using R_positivity by (simp add: pos_less_divide_eq)
+    ultimately show ?thesis
+      by simp
+  qed 
+  moreover have "?x \<le> Suc n"
+  proof -
+    from assms have "sl \<le> Suc n * R"
+      by simp
+    then have "((of_nat sl)::real) \<le> of_nat ((Suc n) * R)"
+      by (blast intro: of_nat_mono)
+    also have "\<dots> = of_nat (Suc n) * of_nat R"
+      by (blast intro: of_nat_mult)
+    finally have "((of_nat sl)::real) \<le> of_nat (Suc n) * of_nat R" .
+    moreover have "(0::real) < of_nat R"
+      by (simp add: R_positivity)
+    ultimately show ?thesis
+      by (simp add: pos_divide_le_eq) 
+  qed
+  ultimately show ?thesis
+    by simp
+qed
+
+notepad
+begin
+  assume "R = 2"
+  then have "slot_epoch 1 = 1"
+    and "slot_epoch 2 = 1"
+    and "slot_epoch 3 = Suc 1"
+    and "slot_epoch 4 = Suc 1"
+    using slot_epoch_bounds by simp_all
+end
+
+end
+
+subsubsection \<open> Stake distributions \<close>
+
+context
+begin
+
+notepad
+begin
+
+  fix \<S> :: stake_distr and X :: "stakeholder_id set"
+  assume a\<^sub>\<S>: "\<S> = {U\<^bsub>1\<^esub> $$:= 10, U\<^bsub>2\<^esub> $$:= 5, U\<^bsub>3\<^esub> $$:= 10}" and a\<^sub>X: "X = {U\<^bsub>1\<^esub>, U\<^bsub>3\<^esub>}"
+  from a\<^sub>\<S> have "s\<^sup>+\<^sub>\<P>(\<S>) = 25"
+  proof -
+    from a\<^sub>\<S> have "fmdom' \<S> = {U\<^bsub>1\<^esub>, U\<^bsub>2\<^esub>, U\<^bsub>3\<^esub>}"
+      by auto
+    with a\<^sub>\<S> show ?thesis
+      by simp
+  qed
+  moreover have "s\<^sup>+\<^bsub>X\<^esub>(\<S>) = 20"
+  proof -
+    from a\<^sub>\<S> and a\<^sub>X have "X \<subseteq> fmdom' \<S>"
+      by simp
+    with a\<^sub>\<S> and a\<^sub>X show ?thesis
+      by simp
+  qed
+  moreover have "s\<^sup>+\<^bsub>U\<^bsub>1\<^esub>\<^esub>(\<S>) = 10"
+  proof -
+    from a\<^sub>\<S> have "{U\<^bsub>1\<^esub>} \<subseteq> fmdom' \<S>"
+      by simp
+    with a\<^sub>\<S> show ?thesis
+      by simp
+  qed
+  ultimately have "\<alpha>\<^sup>+\<^bsub>U\<^bsub>1\<^esub>\<^esub>(\<S>) = 10/25" and "\<alpha>\<^sup>+\<^bsub>X\<^esub>(\<S>) = 20/25"
+    using a\<^sub>\<S> by simp_all
+
+end
+
+end
+
+subsubsection \<open> Transactions \<close>
+
+context
+begin
+
+inductive
+  tx_sts :: "
+    stake_distr \<Rightarrow>
+    'sig transaction \<Rightarrow>
+    stake_distr \<Rightarrow>
+    bool"
+  (\<open>_ \<rightarrow>{_} _\<close> [51, 0, 51] 50)
+where
+  tx_sts_base:
+    "\<S> \<rightarrow>{tx} \<S>'"
+      if "((U\<^sub>i, U\<^sub>j, s), _) = tx"
+      and "{U\<^sub>i, U\<^sub>j} \<subseteq> fmdom' \<S>"
+      and "\<S> $$! U\<^sub>i \<ge> s"
+      \<comment> \<open>\<open>\<S>\<close>''\<close>
+      and "fmdom' \<S>'' = fmdom' \<S>"
+      and "\<S>'' $$! U\<^sub>i = \<S> $$! U\<^sub>i - s"
+      and "\<forall>U \<in> fmdom' \<S>''. U \<noteq> U\<^sub>i \<longrightarrow> \<S>'' $$! U = \<S> $$! U"
+      \<comment> \<open>\<open>\<S>\<close>'\<close>
+      and "fmdom' \<S>' = fmdom' \<S>"
+      and "\<S>' $$! U\<^sub>j = \<S>'' $$! U\<^sub>j + s"
+      and "\<forall>U \<in> fmdom' \<S>'. U \<noteq> U\<^sub>j \<longrightarrow> \<S>' $$! U = \<S>'' $$! U"
+
+lemma apply_transaction_soundness:
+  assumes "apply_transaction tx \<S> = \<S>'"
+  and "((U\<^sub>i, U\<^sub>j, s), \<sigma>) = tx"
+  and "{U\<^sub>i, U\<^sub>j} \<subseteq> fmdom' \<S>"
+  and "\<S> $$! U\<^sub>i \<ge> s"
+  shows "\<S> \<rightarrow>{tx} \<S>'"
+proof -
+  let ?\<S>'' = "\<S>(U\<^sub>i $$:= \<S> $$! U\<^sub>i - s)"
+  from assms(3) have "fmdom' ?\<S>'' = fmdom' \<S>"
+    by auto
+  moreover have "?\<S>'' $$! U\<^sub>i = \<S> $$! U\<^sub>i - s"
+    by simp
+  moreover have "?\<S>'' $$! U = \<S> $$! U" if "U \<in> fmdom' ?\<S>''" and "U \<noteq> U\<^sub>i" for U
+    using \<open>U \<noteq> U\<^sub>i\<close> by auto
+  moreover from assms have "fmdom' \<S>' = fmdom' \<S>"
+    by auto
+  moreover from assms have "\<S>' $$! U\<^sub>j = ?\<S>'' $$! U\<^sub>j + s"
+    by auto
+  moreover from assms have "\<S>' $$! U = ?\<S>'' $$! U" if "U \<in> fmdom' \<S>'" and "U \<noteq> U\<^sub>j" for U
+    using \<open>U \<noteq> U\<^sub>j\<close> by auto
+  ultimately show ?thesis
+    using assms(2-4) and tx_sts.simps[of \<S> tx \<S>'] by metis
+qed
+
+lemma apply_transaction_completeness:
+  assumes "\<S> \<rightarrow>{tx} \<S>'"
+  shows "apply_transaction tx \<S> = \<S>'"
+proof -
+  from assms show ?thesis
+  proof cases
+    case (tx_sts_base U\<^sub>i U\<^sub>j s _ \<S>'')
+    then show ?thesis
+    proof (intro fsubset_antisym)
+      show "apply_transaction tx \<S> \<subseteq>\<^sub>f \<S>'"
+      unfolding fmsubset.rep_eq proof (unfold map_le_def, intro ballI)
+        fix U
+        assume *: "U \<in> dom (($$) (apply_transaction tx \<S>))"
+        then show "apply_transaction tx \<S> $$ U = \<S>' $$ U"
+        proof (cases "U \<in> dom (($$) \<S>)")
+          case True
+          from tx_sts_base(1,2,3) have "apply_transaction tx \<S> $$ U =
+            (let \<S>\<^sub>1 = \<S>(U\<^sub>i $$:= \<S> $$! U\<^sub>i - s) in \<S>\<^sub>1(U\<^sub>j $$:= \<S>\<^sub>1 $$! U\<^sub>j + s)) $$ U"
+            by auto
+          also have "\<dots> = Some (\<S>' $$! U)"
+          proof -
+            consider (a) "U = U\<^sub>i" | (b) "U = U\<^sub>j" | (c) "U \<noteq> U\<^sub>i" and "U \<noteq> U\<^sub>j"
+              by auto
+            then show ?thesis
+              using True and tx_sts_base(4-9) by cases (auto simp add: fmlookup_dom'_iff)
+          qed
+          also have "\<dots> = \<S>' $$ U"
+          proof -
+            from True and tx_sts_base(7) have "U \<in> fmdom' \<S>'"
+              by simp
+            then show ?thesis
+              by (simp add: fmlookup_dom'_iff)
+          qed
+          finally show "apply_transaction tx \<S> $$ U = \<S>' $$ U" .
+        next
+          case False
+          with * and tx_sts_base(1,2,3) show ?thesis
+            by auto
+        qed
+      qed
+      then show "\<S>' \<subseteq>\<^sub>f apply_transaction tx \<S>"
+      unfolding fmsubset.rep_eq proof (unfold map_le_def, intro ballI)
+        fix U
+        assume *: "U \<in> dom (($$) \<S>')"
+        then show "\<S>' $$ U = apply_transaction tx \<S> $$ U"
+        proof -
+          from tx_sts_base(1,2,3) have "dom (($$) (apply_transaction tx \<S>)) =
+            insert U\<^sub>j (fmdom' (\<S>(U\<^sub>i $$:= \<S> $$! U\<^sub>i - s)))"
+            by auto
+          with * and tx_sts_base(7) have "U \<in> dom (($$) (apply_transaction tx \<S>))"
+            by simp
+          with \<open>apply_transaction tx \<S> \<subseteq>\<^sub>f \<S>'\<close> show ?thesis
+            by (simp add: fmsubset.rep_eq map_le_def)
+        qed
+      qed
+    qed
+  qed
+qed
+
+text \<open>
+  Applying a transaction with the same stakeholder as sender and recipient does not change the
+  stake distribution:
+\<close>
+
+lemma self_transfer_invariancy:
+  assumes "U\<^sub>i \<in> fmdom' \<S>"
+  and "\<S> $$! U\<^sub>i \<ge> s"
+  shows "apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S> = \<S>"
+  using assms
+proof (intro fsubset_antisym)
+  let ?\<S>' = "apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S>"
+  show "?\<S>' \<subseteq>\<^sub>f \<S>"
+  unfolding fmsubset.rep_eq proof (unfold map_le_def, intro ballI)
+    fix U
+    assume "U \<in> dom (($$) ?\<S>')"
+    then show "?\<S>' $$ U = \<S> $$ U"
+    proof (cases "U = U\<^sub>i")
+      case True
+      with assms have "?\<S>' $$ U = Some (\<S> $$! U - s + s)"
+        by simp
+      also from True and assms have "\<dots> = \<S> $$ U"
+        by (simp add: fmlookup_dom'_iff)
+      finally show ?thesis .
+    next
+      case False
+      with assms show ?thesis
+        by simp
+    qed
+  qed
+  with assms show "\<S> \<subseteq>\<^sub>f apply_transaction ((U\<^sub>i, U\<^sub>i, s), \<sigma>) \<S>"
+    unfolding fmsubset.rep_eq and map_le_def by simp
+qed
+
+end
+
+subsubsection \<open> Blocks \<close>
+
+context
+begin
+
+inductive
+  txs_sts :: "
+    stake_distr \<Rightarrow>
+    'sig transaction list \<Rightarrow>
+    stake_distr \<Rightarrow>
+    bool"
+  (\<open>_ \<rightarrow>\<^sup>*{_} _\<close> [51, 0, 51] 50)
+where
+  txs_sts_base:
+    "\<S> \<rightarrow>\<^sup>*{[]} \<S>"
+| txs_sts_ind:
+    "\<S> \<rightarrow>\<^sup>*{txs @ [tx]} \<S>'"
+      if "\<S> \<rightarrow>\<^sup>*{txs} \<S>''"
+      and "\<S>'' \<rightarrow>{tx} \<S>'"
+
+abbreviation
+  bl_sts :: "
+    stake_distr \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block \<Rightarrow>
+    stake_distr \<Rightarrow>
+    bool"
+  (\<open>_ \<rightarrow>\<^sub>b{_} _\<close> [51, 0, 51] 50)
+where
+  "\<S> \<rightarrow>\<^sub>b{B} \<S>' \<equiv> \<S> \<rightarrow>\<^sup>*{bl_txs B} \<S>'"
+
+definition
+  are_applicable_txs :: "'sig transaction list \<Rightarrow> stake_distr \<Rightarrow> bool"
+where
+  [iff]: "are_applicable_txs txs \<S> \<longleftrightarrow> (\<forall>\<S>'' U\<^sub>i U\<^sub>j s. \<forall>i \<in> {0..<length txs}.
+    (U\<^sub>i, U\<^sub>j, s) = fst (txs ! i) \<and> \<S> \<rightarrow>\<^sup>*{take i txs} \<S>'' \<longrightarrow> \<S>'' $$! U\<^sub>i \<ge> s)"
+
+lemma txs_init_is_applicable:
+  assumes "are_applicable_txs txs \<S>"
+  shows "are_applicable_txs (butlast txs) \<S>"
+  using assms
+proof (unfold are_applicable_txs_def, intro allI ballI impI, elim conjE)
+  fix \<S>'' U\<^sub>i U\<^sub>j s i
+  let ?txs' = "butlast txs"
+  assume a\<^sub>1: "i \<in> {0..<length ?txs'}"
+     and a\<^sub>2: "(U\<^sub>i, U\<^sub>j, s) = fst (?txs' ! i)"
+     and a\<^sub>3: "\<S> \<rightarrow>\<^sup>*{take i ?txs'} \<S>''"
+  from a\<^sub>1 have *: "i \<in> {0..<length txs}"
+    by simp
+  moreover from * and a\<^sub>1 and a\<^sub>2 have "(U\<^sub>i, U\<^sub>j, s) = fst (txs ! i)"
+    by (simp add: nth_butlast)
+  moreover from * and a\<^sub>3 have "\<S> \<rightarrow>\<^sup>*{take i txs} \<S>''"
+    by (simp add: take_butlast)
+  ultimately show "\<S>'' $$! U\<^sub>i \<ge> s"
+    using assms by blast
+qed
+
+abbreviation
+  are_known_stakeholders :: "'sig transaction list \<Rightarrow> stake_distr \<Rightarrow> bool"
+where
+  "are_known_stakeholders txs \<S> \<equiv> \<forall>((U\<^sub>i, U\<^sub>j, _), _) \<in> set txs. {U\<^sub>i, U\<^sub>j} \<subseteq> fmdom' \<S>"
+
+lemma fold_apply_transaction_fmdom':
+  assumes "are_known_stakeholders txs \<S>"
+  shows "fmdom' (fold apply_transaction txs \<S>) = fmdom' \<S>"
+  using assms
+proof (induction txs arbitrary: \<S>)
+  case Nil
+  then show ?case
+    by simp
+next
+  case (Cons tx txs)
+  let ?\<S>' = "apply_transaction tx \<S>"
+  obtain U\<^sub>i U\<^sub>j s \<sigma> where *: "tx = ((U\<^sub>i, U\<^sub>j, s), \<sigma>)"
+    by (metis prod.collapse)
+  have "fmdom' (fold apply_transaction (tx # txs) \<S>) = fmdom' (fold apply_transaction txs ?\<S>')"
+    by simp
+  also from Cons.prems and Cons.IH and * have "\<dots> = fmdom' \<S>"
+    by (simp add: insert_absorb)
+  finally show ?case .
+qed
+
+lemma fold_apply_transaction_soundness:
+  assumes "fold apply_transaction txs \<S> = \<S>'"
+  and "are_applicable_txs txs \<S>"
+  and "are_known_stakeholders txs \<S>"
+  shows "\<S> \<rightarrow>\<^sup>*{txs} \<S>'"
+  using assms
+proof (induction txs arbitrary: \<S>' rule: rev_induct)
+  case Nil
+  then show ?case
+    by (simp add: txs_sts_base)
+next
+  case (snoc tx txs)
+  let ?\<S>'' = "fold apply_transaction txs \<S>"
+  have f\<^sub>1: "\<S> \<rightarrow>\<^sup>*{txs} ?\<S>''"
+  proof -
+    from snoc.prems(2) have "are_applicable_txs txs \<S>"
+      using txs_init_is_applicable[of "txs @ [tx]" \<S>] by fastforce
+    moreover from snoc.prems(3) have "are_known_stakeholders txs \<S>"
+      by simp
+    ultimately show ?thesis
+      using snoc.IH by simp
+  qed
+  moreover have "?\<S>'' \<rightarrow>{tx} \<S>'"
+  proof -
+    obtain U\<^sub>i U\<^sub>j s \<sigma> where f\<^sub>2: "tx = ((U\<^sub>i, U\<^sub>j, s), \<sigma>)"
+      by (metis prod.collapse)
+    moreover from snoc.prems(1) have "apply_transaction tx ?\<S>'' = \<S>'"
+      by simp
+    moreover have "{U\<^sub>i, U\<^sub>j} \<subseteq> fmdom' ?\<S>''"
+    proof -
+      from f\<^sub>2 and snoc.prems(3) have "{U\<^sub>i, U\<^sub>j} \<subseteq> fmdom' \<S>"
+        by simp
+      with snoc.prems(3) show ?thesis
+        by (simp add: fold_apply_transaction_fmdom')
+    qed
+    moreover have "?\<S>'' $$! U\<^sub>i \<ge> s"
+    proof -
+      let ?txs = "txs @ [tx]"
+      let ?i = "length ?txs - 1"
+      have "?i \<in> {0..<length ?txs}"
+        by simp
+      moreover from f\<^sub>2 have "(U\<^sub>i, U\<^sub>j, s) = fst (?txs ! ?i)"
+        by simp
+      moreover from f\<^sub>1 have "\<S> \<rightarrow>\<^sup>*{take ?i ?txs} ?\<S>''"
+        by simp
+      ultimately show ?thesis
+        using snoc.prems(2) by blast
+    qed
+    ultimately show ?thesis
+      by (simp add: apply_transaction_soundness)
+  qed
+  ultimately show ?case
+    by (blast intro: txs_sts_ind)
+qed
+
+corollary apply_block_soundness:
+  assumes "apply_block B \<S> = \<S>'"
+  and "txs = bl_txs B"
+  and "are_applicable_txs txs \<S>"
+  and "are_known_stakeholders txs \<S>"
+  shows "\<S> \<rightarrow>\<^sub>b{B} \<S>'"
+  using assms and fold_apply_transaction_soundness by simp
+
+lemma fold_apply_transaction_completeness:
+  assumes "\<S> \<rightarrow>\<^sup>*{txs} \<S>'"
+  shows "fold apply_transaction txs \<S> = \<S>'"
+  using assms
+  by induction (simp_all add: apply_transaction_completeness)
+
+corollary apply_block_completeness:
+  assumes "\<S> \<rightarrow>\<^sub>b{B} \<S>'"
+  shows "apply_block B \<S> = \<S>'"
+  using assms and fold_apply_transaction_completeness unfolding apply_block_def by blast
+
+text \<open>
+  Applying a block including only a transaction and its corresponding refund transaction does not
+  affect the stake distribution:
+\<close>
+
+lemma transaction_refund_invariancy:
+  assumes "bl_txs B = [((U\<^sub>i, U\<^sub>j, s), \<sigma>\<^sub>1), ((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)]"
+  and "{U\<^sub>i, U\<^sub>j} \<subseteq> fmdom' \<S>"
+  and "\<S> $$! U\<^sub>i \<ge> s"
+  shows "apply_block B \<S> = \<S>"
+proof -
+  let ?\<S>\<^sub>1 = "\<S>(U\<^sub>i $$:= \<S> $$! U\<^sub>i - s)"
+  let ?\<S>\<^sub>2 = "?\<S>\<^sub>1(U\<^sub>j $$:= ?\<S>\<^sub>1 $$! U\<^sub>j + s)"
+  let ?\<S>\<^sub>3 = "?\<S>\<^sub>2(U\<^sub>j $$:= ?\<S>\<^sub>2 $$! U\<^sub>j - s)"
+  let ?\<S>\<^sub>4 = "?\<S>\<^sub>3(U\<^sub>i $$:= ?\<S>\<^sub>3 $$! U\<^sub>i + s)"
+  from assms(1) have "apply_block B \<S> =
+    fold apply_transaction [((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)] (apply_transaction ((U\<^sub>i, U\<^sub>j, s), \<sigma>\<^sub>1) \<S>)"
+    by simp
+  also have "\<dots> = fold apply_transaction [((U\<^sub>j, U\<^sub>i, s), \<sigma>\<^sub>2)] ?\<S>\<^sub>2"
+    by simp
+  also have "\<dots> = ?\<S>\<^sub>4"
+    by simp
+  also have "\<dots> = \<S>"
+  proof (rule fsubset_antisym)
+    show "?\<S>\<^sub>4 \<subseteq>\<^sub>f \<S>"
+    unfolding fmsubset.rep_eq proof (unfold map_le_def, intro ballI)
+      fix U
+      assume "U \<in> dom (($$) ?\<S>\<^sub>4)"
+      consider (a) "U = U\<^sub>i" | (b) "U = U\<^sub>j" | (c) "U \<noteq> U\<^sub>i" and "U \<noteq> U\<^sub>j"
+        by auto
+      then show "?\<S>\<^sub>4 $$ U = \<S> $$ U"
+      proof cases
+        case a
+        then have "?\<S>\<^sub>4 $$ U = Some (\<S> $$! U - s + s)"
+          by simp
+        also from a and assms(2,3) have "\<dots> = \<S> $$ U"
+          by (simp add: fmlookup_dom'_iff)
+        finally show ?thesis .
+      next
+        case b
+        with assms(3) have "?\<S>\<^sub>4 $$ U = Some (\<S> $$! U + s - s)"
+          by auto
+        also from b and assms(2) have "\<dots> = \<S> $$ U"
+          by (simp add: fmlookup_dom'_iff)
+        finally show ?thesis .
+      next
+        case c
+        then show ?thesis
+          by simp
+      qed
+    qed
+    show "\<S> \<subseteq>\<^sub>f ?\<S>\<^sub>4"
+      using \<open>?\<S>\<^sub>4 \<subseteq>\<^sub>f \<S>\<close> unfolding fmsubset.rep_eq and map_le_def by auto
+  qed
+  finally show ?thesis .
+qed
+
+end
+
+subsubsection \<open> Chains \<close>
+
+inductive
+  chain_sts :: "
+    stake_distr \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    stake_distr \<Rightarrow>
+    bool"
+  (\<open>_ \<rightarrow>\<^sub>c{_} _\<close> [51, 0, 51] 50)
+where
+  chain_sts_base:
+    "\<S> \<rightarrow>\<^sub>c{[]} \<S>"
+| chain_sts_ind:
+    "\<S> \<rightarrow>\<^sub>c{\<C> @ [B]} \<S>'"
+      if "\<S> \<rightarrow>\<^sub>c{\<C>} \<S>''"
+      and "\<S>'' \<rightarrow>\<^sub>b{B} \<S>'"
+
+abbreviation chain_txs :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow> ('sig transaction) list" where
+  "chain_txs \<equiv> List.concat \<circ> map bl_txs"
+
+lemma apply_chain_txs_is_apply_chain:
+  shows "fold apply_transaction (chain_txs \<C>) \<S> = apply_chain \<C> \<S>"
+  by (induction \<C> arbitrary: \<S>) (unfold apply_block_def apply_chain_def, simp_all)
+
+lemma fold_apply_block_fmdom':
+  assumes "\<forall>B \<in> set \<C>. are_known_stakeholders (bl_txs B) \<S>"
+  shows "fmdom' (fold apply_block \<C> \<S>) = fmdom' \<S>"
+  using assms
+proof (induction \<C> arbitrary: \<S>)
+  case Nil
+  then show ?case
+    by simp
+next
+  case (Cons B \<C>)
+  let ?\<S>' = "apply_block B \<S>"
+  have "fmdom' (fold apply_block (B # \<C>) \<S>) = fmdom' (fold apply_block \<C> ?\<S>')"
+    by simp
+  also from Cons.prems and Cons.IH have "\<dots> = fmdom' \<S>"
+    unfolding apply_block_def by (simp add: fold_apply_transaction_fmdom')
+  finally show ?case .
+qed
+
+lemma tx_append_applicability:
+  assumes "are_applicable_txs [tx] (fold apply_transaction txs \<S>)"
+    and "are_applicable_txs txs \<S>"
+  shows "are_applicable_txs (txs @ [tx]) \<S>"
+  using assms
+proof (unfold are_applicable_txs_def, intro allI ballI impI, elim conjE)
+  fix \<S>'' U\<^sub>i U\<^sub>j s i
+  assume a\<^sub>1: "i \<in> {0..<length (txs @ [tx])}"
+     and a\<^sub>2: "(U\<^sub>i, U\<^sub>j, s) = fst ((txs @ [tx]) ! i)"
+     and a\<^sub>3: "\<S> \<rightarrow>\<^sup>*{take i (txs @ [tx])} \<S>''"
+  then show "s \<le> \<S>'' $$! U\<^sub>i"
+  proof (cases "i < length txs")
+    case True
+    from True have "i \<in> {0..<length txs}"
+      by simp
+    moreover from True and a\<^sub>2 have "(U\<^sub>i, U\<^sub>j, s) = fst (txs ! i)"
+      by (simp add: nth_append)
+    moreover from True and a\<^sub>3 have "\<S> \<rightarrow>\<^sup>*{take i txs} \<S>''"
+      by simp
+    ultimately show ?thesis
+      using assms(2) by blast
+  next
+    case False
+    from False and a\<^sub>1 and a\<^sub>2 have "(U\<^sub>i, U\<^sub>j, s) = fst tx"
+      by (simp add: less_Suc_eq)
+    moreover from False and a\<^sub>1 and a\<^sub>3 have "\<S> \<rightarrow>\<^sup>*{txs} \<S>''"
+      by simp
+    then have "fold apply_transaction txs \<S> = \<S>''"
+      by (rule fold_apply_transaction_completeness)
+    then have "fold apply_transaction txs \<S> \<rightarrow>\<^sup>*{[]} \<S>''"
+      using fold_apply_transaction_soundness and txs_sts_base by simp
+    ultimately show ?thesis
+      using assms(1) and a\<^sub>1 by auto
+  qed
+qed
+
+lemma last_tx_applicability:
+  assumes "are_applicable_txs (txs @ [tx]) \<S>"
+    and "are_known_stakeholders txs \<S>"
+  shows "are_applicable_txs [tx] (fold apply_transaction txs \<S>)"
+  using assms
+proof (unfold are_applicable_txs_def, intro allI ballI impI, elim conjE)
+  fix \<S>'' U\<^sub>i U\<^sub>j s i
+  assume a\<^sub>1: "i \<in> {0..<length [tx]}"
+     and a\<^sub>2: "(U\<^sub>i, U\<^sub>j, s) = fst ([tx] ! i)"
+     and a\<^sub>3: "fold apply_transaction txs \<S> \<rightarrow>\<^sup>*{take i [tx]} \<S>''"
+  from a\<^sub>1 have f\<^sub>1: "i = 0"
+    by simp
+  moreover from a\<^sub>2 and f\<^sub>1 have f\<^sub>2: "(U\<^sub>i, U\<^sub>j, s) = fst tx"
+    by simp
+  moreover from a\<^sub>3 and f\<^sub>1 have "fold apply_transaction txs \<S> \<rightarrow>\<^sup>*{[]} \<S>''"
+    using fold_apply_transaction_completeness and txs_sts_base by fastforce
+  then have f\<^sub>3: "fold apply_transaction txs \<S> = \<S>''"
+    using fold_apply_transaction_completeness by force
+  ultimately have "\<S> \<rightarrow>\<^sup>*{txs} \<S>''"
+  proof -
+    from assms(1) have "are_applicable_txs txs \<S>"
+      using txs_init_is_applicable by fastforce 
+    moreover from assms(2) have "are_known_stakeholders txs \<S>"
+      by blast
+    ultimately show ?thesis
+      using f\<^sub>3 and fold_apply_transaction_soundness by simp
+  qed
+  with assms(1) and f\<^sub>2 show "s \<le> \<S>'' $$! U\<^sub>i"
+    by force
+qed
+
+lemma txs_prefix_applicability:
+  assumes "are_applicable_txs txs \<S>"
+    and "n \<in> {0..length txs}"
+  shows "are_applicable_txs (take n txs) \<S>"
+  using assms
+proof (unfold are_applicable_txs_def, intro allI ballI impI, elim conjE)
+  fix \<S>'' U\<^sub>i U\<^sub>j s i
+  assume a\<^sub>1: "i \<in> {0..<length (take n txs)}"
+     and a\<^sub>2: "(U\<^sub>i, U\<^sub>j, s) = fst ((take n txs) ! i)"
+     and a\<^sub>3: "\<S> \<rightarrow>\<^sup>*{take i (take n txs)} \<S>''"
+  then show "s \<le> \<S>'' $$! U\<^sub>i"
+  proof (cases "i < n")
+    case True
+    then show ?thesis
+    proof -
+      from True and a\<^sub>2 have "(U\<^sub>i, U\<^sub>j, s) = fst (txs ! i)"
+        by simp
+      moreover from a\<^sub>1 have "i < length txs"
+        by simp
+      moreover from True and a\<^sub>3 have "\<S> \<rightarrow>\<^sup>*{take i txs} \<S>''"
+        by (simp add: min.strict_order_iff)
+      ultimately show ?thesis
+        using assms(1) by fastforce
+    qed
+  next
+    case False
+    with a\<^sub>1 show ?thesis
+      by simp 
+  qed
+qed
+
+lemma singleton_last_block_applicability:
+  assumes "bl_txs B = [tx]"
+    and "are_applicable_txs (chain_txs (\<C> @ [B])) \<S>"
+    and "are_known_stakeholders (chain_txs \<C>) \<S>"
+  shows "are_applicable_txs [tx] (fold apply_block \<C> \<S>)"
+proof -
+  from assms(1,2) have "are_applicable_txs (chain_txs \<C> @ [tx]) \<S>"
+    by simp
+  with assms(2,3) have "are_applicable_txs [tx] (fold apply_transaction (chain_txs \<C>) \<S>)"
+    using last_tx_applicability by metis
+  then show ?thesis
+    using apply_chain_txs_is_apply_chain unfolding apply_chain_def by metis
+qed
+
+lemma last_tx_in_last_block_applicability:
+  fixes txs :: "'sig transaction list"
+    and B :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+  assumes "bl_txs B = txs @ [tx]"
+    and "are_applicable_txs (chain_txs (\<C> @ [B])) \<S>"
+    and "are_known_stakeholders (chain_txs (\<C> @ [B])) \<S>"
+  shows "are_applicable_txs [tx] (fold apply_transaction txs (fold apply_block \<C> \<S>))"
+  using assms
+proof (induction txs arbitrary: B \<C>)
+  case Nil
+  from Nil.prems(1) have "bl_txs B = [tx]"
+    by simp
+  moreover from Nil.prems(3) have "are_known_stakeholders (chain_txs \<C>) \<S>"
+    by simp
+  ultimately have "are_applicable_txs [tx] (fold apply_block \<C> \<S>)"
+    using Nil.prems(2) and singleton_last_block_applicability by metis
+  then show ?case
+    by (metis fold_simps(1))
+next
+  case (Cons tx' txs')
+  let ?\<S>' = "fold apply_block \<C> \<S>"
+  obtain B' :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block" where f1: "bl_txs B' = txs' @ [tx]"
+    by force
+  obtain B'' :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block" where f2: "bl_txs B'' = [tx']"
+    by force
+  from f2 have "fold apply_transaction (tx' # txs') ?\<S>' =
+    fold apply_transaction txs' (apply_block B'' ?\<S>')"
+    by simp
+  also have "\<dots> = fold apply_transaction txs' (fold apply_block (\<C> @ [B'']) \<S>)"
+    by simp
+  finally have "are_applicable_txs [tx] (fold apply_transaction (tx' # txs') ?\<S>') =
+    are_applicable_txs [tx] (fold apply_transaction txs' (fold apply_block (\<C> @ [B'']) \<S>))"
+    by simp
+  moreover from Cons.prems(1,2) and f1 and f2
+  have "are_applicable_txs (chain_txs ((\<C> @ [B'']) @ [B'])) \<S>"
+    by simp
+  moreover from Cons.prems(1,3) and f1 and f2
+  have "are_known_stakeholders (chain_txs (((\<C> @ [B'']) @ [B']))) \<S>"
+    by simp
+  ultimately show ?case
+    using f1 and Cons.IH by presburger
+qed
+
+lemma last_block_applicability:
+  fixes txs :: "'sig transaction list"
+    and B :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+  assumes "bl_txs B = txs" 
+    and "are_applicable_txs (chain_txs (\<C> @ [B])) \<S>"
+    and "are_known_stakeholders (chain_txs (\<C> @ [B])) \<S>"
+  shows "are_applicable_txs txs (fold apply_block \<C> \<S>)"
+  using assms
+proof (induction txs arbitrary: B rule: rev_induct)
+  case Nil
+  then show ?case
+    unfolding are_applicable_txs_def by simp
+next
+  case (snoc tx txs)
+  obtain B' :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block" where f1: "txs = bl_txs B'"
+    by force
+  have "are_applicable_txs [tx] (fold apply_transaction txs (fold apply_block \<C> \<S>))"
+  proof -
+    from snoc.prems(3) have "are_known_stakeholders (chain_txs (\<C> @ [B])) \<S>"
+      by simp
+    with snoc.prems(1,2) show ?thesis
+      using last_tx_in_last_block_applicability by metis
+  qed
+  moreover have "are_applicable_txs txs (fold apply_block \<C> \<S>)"
+  proof -
+    from snoc.prems(1,2) and f1 have "are_applicable_txs (chain_txs (\<C> @ [B'])) \<S>"
+      using txs_init_is_applicable[of "chain_txs \<C> @ txs @ [tx]" \<S>]
+      by (simp add: butlast_append)
+    moreover from snoc.prems(1,3) and f1 have "are_known_stakeholders (chain_txs (\<C> @ [B'])) \<S>"
+      by simp
+    ultimately show ?thesis
+      using snoc.IH and f1 by blast
+  qed
+  ultimately show ?case
+    using tx_append_applicability by metis
+qed
+
+theorem apply_chain_soundness:
+  assumes "apply_chain \<C> \<S> = \<S>'"
+    and "are_applicable_txs (List.concat (map bl_txs \<C>)) \<S>"
+    and "are_known_stakeholders (List.concat (map bl_txs \<C>)) \<S>"
+  shows "\<S> \<rightarrow>\<^sub>c{\<C>} \<S>'"
+  using assms
+proof (induction \<C> arbitrary: \<S>' rule: rev_induct)
+  case Nil
+  then show ?case
+    using chain_sts_base by simp
+next
+  case (snoc B \<C>)
+  let ?\<S>'' = "apply_chain \<C> \<S>"
+  have "\<S> \<rightarrow>\<^sub>c{\<C>} ?\<S>''"
+  proof -
+    have "are_applicable_txs (chain_txs \<C>) \<S>"
+    proof -
+      from snoc.prems(2) have "are_applicable_txs (chain_txs \<C> @ bl_txs B) \<S>"
+        by simp
+      moreover have "length (chain_txs \<C>) \<in> {0..length (chain_txs \<C> @ bl_txs B)}"
+        by simp
+      ultimately have "are_applicable_txs (take (length (chain_txs \<C>)) (chain_txs \<C> @ bl_txs B)) \<S>"
+        using txs_prefix_applicability by metis
+      then show ?thesis
+        by simp
+    qed
+    moreover from snoc.prems(3) have "are_known_stakeholders (chain_txs \<C>) \<S>"
+      by simp
+    ultimately show ?thesis
+      using snoc.IH by simp
+  qed
+  moreover have "?\<S>'' \<rightarrow>\<^sub>b{B} \<S>'"
+  proof -
+    from snoc(2) have "apply_block B ?\<S>'' = \<S>'"
+      by simp
+    moreover from snoc.prems(2,3) have "are_applicable_txs (bl_txs B) ?\<S>''"
+      unfolding apply_chain_def using last_block_applicability by (metis comp_apply) 
+    moreover have "are_known_stakeholders (bl_txs B) ?\<S>''"
+    proof -
+      from snoc.prems(3) have "are_known_stakeholders (chain_txs \<C>) \<S>"
+        by simp
+      then have "fmdom' (fold apply_transaction (chain_txs \<C>) \<S>) = fmdom' \<S>"
+        using fold_apply_transaction_fmdom' by blast
+      then have "fmdom' (apply_chain \<C> \<S>) = fmdom' \<S>"
+        using apply_chain_txs_is_apply_chain by metis
+      with snoc.prems(3) show ?thesis
+        by simp
+    qed
+    ultimately show ?thesis
+      by (simp add: apply_block_soundness)
+  qed
+  ultimately show ?case
+    using chain_sts_ind by blast
+qed
+
+corollary apply_chain_completeness:
+  assumes "\<S> \<rightarrow>\<^sub>c{\<C>} \<S>'"
+  shows "apply_chain \<C> \<S> = \<S>'"
+  using assms unfolding apply_chain_def 
+proof induction
+  case chain_sts_base
+  then show ?case
+    by simp
+next
+  case (chain_sts_ind \<S> _ \<S>'' B \<S>')
+  from \<open>\<S>'' \<rightarrow>\<^sub>b{B} \<S>'\<close> have "apply_block B \<S>'' = \<S>'"
+    by (rule apply_block_completeness)
+  with chain_sts_ind.IH show ?case
+    by simp
+qed
+
+text \<open>
+  For the sake of simplicity, we regard a chain as @{emph \<open>valid\<close>} whenever it contains a
+  strictly increasing sequence of slots:
+\<close>
+
+abbreviation
+  is_slot_increasing :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow> bool"
+where
+  "is_slot_increasing \<C> \<equiv> sorted_wrt (\<lambda>B B'. bl_slot B < bl_slot B') \<C>"
+
+abbreviation
+  is_valid_chain :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow> bool"
+where
+  "is_valid_chain \<C> \<equiv> is_slot_increasing \<C>"
+
+text \<open>
+  A prefix of a valid chain is a valid chain:
+\<close>
+
+lemma chain_prefix_validity:
+  assumes "is_valid_chain \<C>\<^sub>2"
+    and "\<C>\<^sub>1 \<preceq> \<C>\<^sub>2"
+  shows "is_valid_chain \<C>\<^sub>1"
+  using assms and sorted_wrt_append unfolding prefix_def by blast
+
+text \<open>
+  A prefix of a chain keeps all properties on its elements that hold for the original chain:
+\<close>
+
+lemma prefix_invariancy:
+  assumes "\<forall>B \<in> set \<C>\<^sub>2. P B"
+  and "\<C>\<^sub>1 \<preceq> \<C>\<^sub>2"
+  shows "\<forall>B \<in> set \<C>\<^sub>1. P B"
+  using assms
+proof (intro ballI)
+  fix B
+  assume "B \<in> set \<C>\<^sub>1"
+  from assms(2) have "\<exists>\<C>\<^sub>3. \<C>\<^sub>2 = \<C>\<^sub>1 @ \<C>\<^sub>3"
+    by (blast dest: prefixE)
+  with \<open>B \<in> set \<C>\<^sub>1\<close> have "B \<in> set \<C>\<^sub>2"
+    by auto
+  with assms(1) show "P B"
+    by simp
+qed
+
+text \<open>
+  The \<open>\<C>\<^bsup>\<lceil>m\<^esup>\<close> operator satisfies some simple laws:
+\<close>
+
+lemma zero_blocks_chain_prunning_identity:
+  shows "\<C>\<^sup>\<lceil>\<^bsup>0\<^esup> = \<C>"
+  by simp
+
+lemma long_chain_prunning_emptiness:
+  assumes "m \<ge> length \<C>"
+  shows "\<C>\<^sup>\<lceil>\<^bsup>m\<^esup> = []"
+  using assms by simp
+
+lemma append_prune_chain_drop_identity:
+  shows "\<C>\<^sup>\<lceil>\<^bsup>m\<^esup> @ drop (length \<C> - m) \<C> = \<C>"
+  by simp
+
+text \<open>
+  Now we prove some properties about @{const prune_after}. As expected, chain validity is
+  preserved by @{const prune_after}:
+\<close>
+
+lemma prune_after_validity_invariancy:
+  assumes "is_valid_chain \<C>"
+  shows "is_valid_chain (prune_after sl \<C>)"
+  using assms unfolding prune_after_def
+  by (metis (no_types, lifting) sorted_wrt_append takeWhile_dropWhile_id)
+
+text \<open>
+  And the pruned chain returned by @{const prune_after} is obviously a prefix of the original chain:
+\<close>
+
+lemma prune_after_is_prefix:
+  shows "prune_after sl \<C> \<preceq> \<C>"
+proof -
+  let ?P = "\<lambda>B. bl_slot B \<le> sl"
+  have "\<C> = takeWhile ?P \<C> @ dropWhile ?P \<C>"
+    by simp
+  then have "\<exists>\<C>'. \<C> = prune_after sl \<C> @ \<C>'"
+    unfolding prune_after_def by blast
+  then show ?thesis
+    by (blast intro: prefixI)
+qed
+
+text \<open>
+  Now, we define two auxiliary predicates: One predicate to check whether the slots in a chain are
+  bounded by a given slot, and another predicate to check whether a chain is both a prefix of a
+  given chain and bounded by a given slot:
+\<close>
+
+abbreviation
+  is_slot_bounded_chain :: "('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow> slot \<Rightarrow> bool" (infix \<open>\<unlhd>\<close> 50)
+where
+  "\<C> \<unlhd> sl \<equiv> \<forall>B \<in> set \<C>. bl_slot B \<le> sl"
+
+abbreviation
+  is_slot_bounded_prefix :: "
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    slot \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    bool"
+where
+  "is_slot_bounded_prefix \<C>\<^sub>1 sl \<C>\<^sub>2 \<equiv> \<C>\<^sub>1 \<preceq> \<C>\<^sub>2 \<and> \<C>\<^sub>1 \<unlhd> sl"
+
+text \<open>
+  Any chain \<open>\<C>\<^sub>1\<close> which is a subsequence of another chain \<open>\<C>\<^sub>2\<close> that is slot-bounded by \<open>sl\<close> is also
+  slot-bounded by \<open>sl\<close>:
+\<close>
+
+lemma subseq_is_slot_bounded:
+  assumes "subseq \<C>\<^sub>1 \<C>\<^sub>2"
+    and "\<C>\<^sub>2 \<unlhd> sl"
+  shows "\<C>\<^sub>1 \<unlhd> sl"
+  using assms
+  by (metis (mono_tags, lifting) list_emb_set)
+
+text \<open>
+  The tail of a chain that is slot-bounded by \<open>sl\<close> is also slot-bounded by \<open>sl\<close>:
+\<close>
+
+lemma tail_is_slot_bounded:
+  assumes "\<C> \<unlhd> sl"
+  shows "tl \<C> \<unlhd> sl"
+  using assms and subseq_is_slot_bounded by blast
+
+text \<open>
+  Armed with these predicates, we can prove more complex properties. For example, given a slot \<open>sl\<close>
+  \<open>prune_after sl \<C>\<close> is bounded by any slot \<open>sl'\<close> such that \<open>sl \<le> sl'\<close>:
+\<close>
+
+lemma prune_after_is_slot_bounded:
+  assumes "sl \<le> sl'"
+  shows "prune_after sl \<C> \<unlhd> sl'"
+  using assms by (induction \<C>) (simp, fastforce)
+
+text \<open>
+  Any \<open>sl\<close>-bounded prefix \<open>\<C>'\<close> of a chain \<open>\<C>\<close> is a prefix of \<open>\<C>\<close> when pruned after \<open>sl\<close>:
+\<close>
+
+lemma prune_after_includes_slot_bounded_prefix:
+  assumes "is_slot_bounded_prefix \<C>' sl \<C>"
+  shows "\<C>' \<preceq> prune_after sl \<C>"
+  using assms unfolding prefix_def by auto
+
+text \<open>
+  A chain \<open>\<C>\<close>, when pruned after \<open>sl\<close>, is a \<open>sl\<close>-bounded prefix of \<open>\<C>\<close>:
+\<close>
+
+lemma prune_after_is_slot_bounded_prefix:
+  shows "is_slot_bounded_prefix (prune_after sl \<C>) sl \<C>"
+  using prune_after_is_prefix and prune_after_is_slot_bounded by fastforce
+
+text \<open>
+  A chain \<open>\<C>\<close>, when pruned after \<open>sl\<close>, is the longest \<open>sl\<close>-bounded prefix of \<open>\<C>\<close>
+\<close>
+
+lemma prune_after_is_longest_slot_bounded_prefix:
+  assumes "is_slot_bounded_prefix \<C>\<^sub>l sl \<C>"
+    and "\<forall>\<C>'. is_slot_bounded_prefix \<C>' sl \<C> \<longrightarrow> \<not> length \<C>\<^sub>l < length \<C>'"
+  shows "prune_after sl \<C> = \<C>\<^sub>l"
+proof -
+  from assms(1) have "\<C>\<^sub>l \<preceq> prune_after sl \<C>"
+    by (rule prune_after_includes_slot_bounded_prefix)
+  moreover have "prune_after sl \<C> \<preceq> \<C>\<^sub>l"
+  proof -
+    from assms(2) have "length (prune_after sl \<C>) \<le> length \<C>\<^sub>l"
+      using prune_after_is_slot_bounded_prefix and not_less by metis
+    with \<open>\<C>\<^sub>l \<preceq> prune_after sl \<C>\<close> show ?thesis
+      by (blast intro: prefix_length_prefix)
+  qed
+  ultimately show ?thesis
+    by (simp add: prefix_order.antisym)
+qed
+
+text \<open>
+  TODO: Complete.
+\<close>
+
+lemma prune_after_longer_than_slot_bounded_prefix:
+  assumes "is_slot_bounded_prefix \<C>' sl \<C>"
+  shows "\<not> length \<C>' > length (prune_after sl \<C>)"
+proof -
+  from assms have "\<C>' \<preceq> prune_after sl \<C>"
+    by (rule prune_after_includes_slot_bounded_prefix)
+  then have "length \<C>' \<le> length (prune_after sl \<C>)"
+    by (simp add: prefix_length_le)
+  then show ?thesis
+    by simp
+qed
+
+text \<open>
+  We define the specification of @{const \<open>prune_after\<close>}: The longest prefix of a given chain that
+  is slot-bounded by a given slot:
+\<close>
+
+definition
+  prune_after_spec :: "
+    slot \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain \<Rightarrow>
+    ('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain"
+where
+  [simp]: "prune_after_spec sl \<C> = (ARG_MAX length \<C>'. is_slot_bounded_prefix \<C>' sl \<C>)"
+
+text \<open>
+  TODO: Complete.
+\<close>
+
+lemma prune_after_spec_satisfaction:
+  shows "prune_after_spec sl \<C> = prune_after sl \<C>"
+  unfolding prune_after_spec_def
+  using
+    prune_after_is_slot_bounded_prefix and
+    prune_after_longer_than_slot_bounded_prefix and
+    prune_after_is_longest_slot_bounded_prefix[symmetric]
+    by (rule arg_maxI)
+
+subsubsection \<open> Leader election \<close>
+
+context leader_election
+begin
+
+notepad
+begin
+
+  fix oh\<^sub>1 oh\<^sub>2 oh\<^sub>3 oh\<^sub>4 oh\<^sub>5 oh\<^sub>6 :: "'hash option"
+    and t\<sigma>\<^sub>1\<^sub>1 t\<sigma>\<^sub>1\<^sub>2 t\<sigma>\<^sub>2 t\<sigma>\<^sub>3 t\<sigma>\<^sub>4 t\<sigma>\<^sub>5 t\<sigma>\<^sub>6 B\<sigma>\<^sub>1 B\<sigma>\<^sub>2 B\<sigma>\<^sub>3 B\<sigma>\<^sub>4 B\<sigma>\<^sub>5 B\<sigma>\<^sub>6 :: 'sig
+    and B\<^sub>\<pi>\<^sub>1 B\<^sub>\<pi>\<^sub>2 B\<^sub>\<pi>\<^sub>3 B\<^sub>\<pi>\<^sub>4 B\<^sub>\<pi>\<^sub>5 B\<^sub>\<pi>\<^sub>6 :: "('vrf\<^sub>y, 'vrf\<^sub>\<pi>) block_proof"
+    and \<rho>\<^sub>1 \<rho>\<^sub>2 \<rho>\<^sub>3 \<rho>\<^sub>4 \<rho>\<^sub>5 \<rho>\<^sub>6 :: "('vrf\<^sub>y, 'vrf\<^sub>\<pi>) vrf\<^sub>o"
+
+  let ?\<S>\<^sub>0 = "{U\<^bsub>1\<^esub> $$:= 10, U\<^bsub>2\<^esub> $$:= 20}::stake_distr"
+  let ?tx\<^sub>1\<^sub>1 = "((U\<^bsub>1\<^esub>, U\<^bsub>2\<^esub>, 1), t\<sigma>\<^sub>1\<^sub>1)::'sig transaction"
+  let ?tx\<^sub>1\<^sub>2 = "((U\<^bsub>1\<^esub>, U\<^bsub>2\<^esub>, 1), t\<sigma>\<^sub>1\<^sub>2)::'sig transaction"
+  let ?tx\<^sub>2 = "((U\<^bsub>2\<^esub>, U\<^bsub>1\<^esub>, 1), t\<sigma>\<^sub>2)::'sig transaction"
+  let ?tx\<^sub>3 = "((U\<^bsub>2\<^esub>, U\<^bsub>1\<^esub>, 5), t\<sigma>\<^sub>3)::'sig transaction"
+  let ?tx\<^sub>4 = "((U\<^bsub>1\<^esub>, U\<^bsub>2\<^esub>, 2), t\<sigma>\<^sub>4)::'sig transaction"
+  let ?tx\<^sub>5 = "((U\<^bsub>1\<^esub>, U\<^bsub>2\<^esub>, 1), t\<sigma>\<^sub>5)::'sig transaction"
+  let ?tx\<^sub>6 = "((U\<^bsub>2\<^esub>, U\<^bsub>1\<^esub>, 2), t\<sigma>\<^sub>6)::'sig transaction"
+  let ?B\<^sub>1 = "((1, oh\<^sub>1, [?tx\<^sub>1\<^sub>1, ?tx\<^sub>1\<^sub>2], B\<^sub>\<pi>\<^sub>1, \<rho>\<^sub>1), B\<sigma>\<^sub>1)::('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+  let ?B\<^sub>2 = "((3, oh\<^sub>2, [?tx\<^sub>2], B\<^sub>\<pi>\<^sub>2, \<rho>\<^sub>2), B\<sigma>\<^sub>2)::('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+  let ?B\<^sub>3 = "((4, oh\<^sub>3, [?tx\<^sub>3], B\<^sub>\<pi>\<^sub>3, \<rho>\<^sub>3), B\<sigma>\<^sub>3)::('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+  let ?B\<^sub>4 = "((6, oh\<^sub>4, [?tx\<^sub>4], B\<^sub>\<pi>\<^sub>4, \<rho>\<^sub>4), B\<sigma>\<^sub>4)::('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+  let ?B\<^sub>5 = "((7, oh\<^sub>5, [?tx\<^sub>5], B\<^sub>\<pi>\<^sub>5, \<rho>\<^sub>5), B\<sigma>\<^sub>5)::('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+  let ?B\<^sub>6 = "((8, oh\<^sub>6, [?tx\<^sub>6], B\<^sub>\<pi>\<^sub>6, \<rho>\<^sub>6), B\<sigma>\<^sub>6)::('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) block"
+  let ?\<C> = "[?B\<^sub>1, ?B\<^sub>2, ?B\<^sub>3, ?B\<^sub>4, ?B\<^sub>5, ?B\<^sub>6]::('hash, 'vrf\<^sub>y, 'vrf\<^sub>\<pi>, 'sig) chain"
+
+  have "\<S>\<^bsub>1\<^esub>(?\<S>\<^sub>0, ?\<C>) = ?\<S>\<^sub>0"
+    by simp
+
+  have "\<S>\<^bsub>2\<^esub>(?\<S>\<^sub>0, ?\<C>) = ?\<S>\<^sub>0"
+  proof -
+    have "prune_after 0 ?\<C> = []"
+      by simp
+    then have "apply_chain [] ?\<S>\<^sub>0 = ?\<S>\<^sub>0"
+      by simp
+    with \<open>prune_after 0 ?\<C> = []\<close> show ?thesis
+      by simp
+  qed
+
+  let ?\<S>\<^sub>3 = "{U\<^bsub>1\<^esub> $$:= 8, U\<^bsub>2\<^esub> $$:= 22}::stake_distr"
+
+  assume "R = 2"
+  have "\<S>\<^bsub>3\<^esub>(?\<S>\<^sub>0, ?\<C>) = ?\<S>\<^sub>3"
+  proof -
+    have "\<S>\<^bsub>Suc (Suc 1)\<^esub>(?\<S>\<^sub>0, ?\<C>) = apply_chain (prune_after (Suc 1) ?\<C>) ?\<S>\<^sub>0"
+    proof -
+      from \<open>R = 2\<close> have "Suc 1 = R"
+        by simp
+      then show ?thesis
+        by simp
+    qed
+    moreover have "prune_after (Suc 1) ?\<C> = [?B\<^sub>1]"
+      by simp
+    moreover have "apply_chain [?B\<^sub>1] ?\<S>\<^sub>0 = ?\<S>\<^sub>3"
+    proof -
+      let ?\<S> = "{U\<^bsub>1\<^esub> $$:= 9, U\<^bsub>2\<^esub> $$:= 21}::stake_distr"
+      have "apply_transaction ?tx\<^sub>1\<^sub>1 ?\<S>\<^sub>0 = ?\<S>"
+      proof -
+        let ?\<S>' = "?\<S>\<^sub>0(U\<^bsub>1\<^esub> $$:= (?\<S>\<^sub>0 $$! U\<^bsub>1\<^esub>) - 1)"
+        have "?\<S>' = ({U\<^bsub>1\<^esub> $$:= 9, U\<^bsub>2\<^esub> $$:= 20}::stake_distr)"
+          by eval
+        have "?\<S>'(U\<^bsub>2\<^esub> $$:= ?\<S>' $$! U\<^bsub>2\<^esub> + 1) = ?\<S>"
+          by eval
+        then show ?thesis
+          by simp
+      qed
+      moreover have "apply_transaction ?tx\<^sub>1\<^sub>2 ?\<S> = ?\<S>\<^sub>3"
+      proof -
+        let ?\<S>' = "?\<S>(U\<^bsub>1\<^esub> $$:= (?\<S> $$! U\<^bsub>1\<^esub>) - 1)"
+        have "?\<S>' = ({U\<^bsub>1\<^esub> $$:= 8, U\<^bsub>2\<^esub> $$:= 21}::stake_distr)"
+          by eval
+        have "?\<S>'(U\<^bsub>2\<^esub> $$:= ?\<S>' $$! U\<^bsub>2\<^esub> + 1) = ?\<S>\<^sub>3"
+          by eval
+        then show ?thesis
+          by simp
+      qed
+      ultimately have "apply_block ?B\<^sub>1 ?\<S>\<^sub>0 = ?\<S>\<^sub>3"
+        by simp
+      then show ?thesis
+        by simp
+    qed
+    ultimately show ?thesis
+      by simp
+  qed
+
+  assume "f = 1/2"
+  have "\<phi>(1/3) = 1 - (1/2)\<^bsup>(1/3)\<^esup>"
+  proof -
+    from \<open>f = 1/2\<close> have "1 - f = f"
+      by simp
+    with \<open>f = 1/2\<close> show ?thesis
+      unfolding slot_leader_probability_def by presburger
+  qed
+
+end
+
+lemma independent_aggregation_aux:
+  assumes "finite A"
+    and "\<alpha> \<notin> A"
+  shows "\<phi>(\<alpha>) * \<phi>(\<Sum>A) = \<phi>(\<alpha>) - (1 - f)\<^bsup>\<Sum>A\<^esup> + (1 - f)\<^bsup>\<Sum>({\<alpha>} \<union> A)\<^esup>"
+proof -
+  have "\<phi>(\<alpha>) * \<phi>(\<Sum>A) = \<phi>(\<alpha>) * (1 - (1 - f)\<^bsup>\<Sum>A\<^esup>)"
+    unfolding slot_leader_probability_def ..
+  also have "\<dots> = \<phi>(\<alpha>) - \<phi>(\<alpha>) * (1 - f)\<^bsup>\<Sum>A\<^esup>"
+    by (simp add: right_diff_distrib')
+  also have "\<dots> = \<phi>(\<alpha>) - (1 - (1 - f)\<^bsup>\<alpha>\<^esup>) * (1 - f)\<^bsup>\<Sum>A\<^esup>"
+    unfolding slot_leader_probability_def ..
+  also have "\<dots> = \<phi>(\<alpha>) - ((1 - f)\<^bsup>\<Sum>A\<^esup> - (1 - f)\<^bsup>\<alpha>\<^esup> * (1 - f)\<^bsup>\<Sum>A\<^esup>)"
+    by (simp add: left_diff_distrib)
+  also have "\<dots> = \<phi>(\<alpha>) - ((1 - f)\<^bsup>\<Sum>A\<^esup> - (1 - f)\<^bsup>(\<alpha> + \<Sum>A)\<^esup>)"
+    by (simp add: powr_add)
+  also from assms have "\<dots> = \<phi>(\<alpha>) - (1 - f)\<^bsup>\<Sum>A\<^esup> + (1 - f)\<^bsup>\<Sum>({\<alpha>} \<union> A)\<^esup>"
+    by simp
+  finally show ?thesis .
+qed
+
+theorem independent_aggregation:
+  assumes "finite A"
+    and "A \<noteq> {}"
+  shows "1 - \<phi>(\<Sum>\<alpha> \<in> A. \<alpha>) = (\<Prod>\<alpha> \<in> A. (1 - \<phi>(\<alpha>)))"
+  using assms
+proof induction
+  case empty
+  then show ?case
+    by simp
+next
+  case (insert \<alpha>' A')
+  from insert.hyps show ?case
+  proof cases
+    case emptyI
+    then show ?thesis
+      by simp
+  next
+    case insertI
+    let ?A = "A' \<union> {\<alpha>'}"
+    from insert.hyps(1,2) have "(\<Prod>\<alpha> \<in> ?A. (1 - \<phi>(\<alpha>))) = (1 - \<phi>(\<alpha>')) * (\<Prod>\<alpha> \<in> A'. (1 - \<phi>(\<alpha>)))"
+      by simp
+    also from insert.IH and insertI(1) have "\<dots> = (1 - \<phi>(\<alpha>')) * (1 - \<phi>(\<Sum>A'))"
+      by simp
+    also have "\<dots> = 1 - \<phi>(\<Sum>A') - \<phi>(\<alpha>') + \<phi>(\<alpha>') * \<phi>(\<Sum>A')"
+      by argo
+    also from insert.hyps(1,2)
+    have "\<dots> = 1 - \<phi>(\<Sum>A') - \<phi>(\<alpha>') + \<phi>(\<alpha>') - (1 - f)\<^bsup>\<Sum>A'\<^esup> + (1 - f)\<^bsup>\<Sum>?A\<^esup>"
+      using independent_aggregation_aux by simp
+    \<comment> \<open>for clarity:\<close>
+    also have "\<dots> = 1 - 1 + (1 - f)\<^bsup>\<Sum>A'\<^esup> - \<phi>(\<alpha>') + \<phi>(\<alpha>') - (1 - f)\<^bsup>\<Sum>A'\<^esup> + (1 - f)\<^bsup>\<Sum>?A\<^esup>"
+      by simp
+    also have "\<dots> = 1 - 1 + (1 - f)\<^bsup>\<Sum>?A\<^esup>" \<comment> \<open>for clarity\<close>
+      by simp
+    finally show ?thesis 
+      by simp
+  qed
+qed
+
+end
+
+subsubsection \<open> Chain selection \<close>
+
+context chain_selection
+begin
+
+lemma first_suffix_eq_chains:
+  shows "first_suffix \<C> \<C> = []"
+proof -
+  have "longest_common_prefix (map \<H>\<^sub>B \<C>) (map \<H>\<^sub>B \<C>) = map \<H>\<^sub>B \<C>"
+    by (simp add: longest_common_prefix_max_prefix longest_common_prefix_prefix1
+        prefix_order.eq_iff)
+  then show ?thesis
+    by simp
+qed
+
+lemma longest_chains_shorter_element:
+  assumes "\<not> is_longest_chain \<C> \<CC>"
+  shows "longest_chains (\<C> # \<CC>) = longest_chains \<CC>"
+proof -
+  from assms have "[\<C>' \<leftarrow> \<CC>. is_longest_chain \<C>' (\<C> # \<CC>)] = [\<C>' \<leftarrow> \<CC>. is_longest_chain \<C>' \<CC>]"
+    by (metis (mono_tags, hide_lams) dual_order.trans le_cases list.set_intros(2) set_ConsD)
+  with assms show ?thesis
+    unfolding longest_chains_def by auto
+qed
+
+lemma longest_chains_empty:
+  shows "longest_chains [] = []"
+  unfolding longest_chains_def by simp
+
+lemma longest_chains_elem_is_longest:
+  assumes "is_longest_chain \<C> \<CC>"
+  shows "\<C> \<in> set (longest_chains (\<C> # \<CC>))"
+proof -
+  have "\<C> \<in> set (\<C> # \<CC>)"
+    by simp
+  moreover from assms have "is_longest_chain \<C> (\<C> # \<CC>)"
+    by simp
+  ultimately show ?thesis
+    unfolding longest_chains_def by simp
+qed
+
+lemma longest_chains_singleton:
+  shows "longest_chains [\<C>] = [\<C>]"
+  unfolding longest_chains_def by simp
+
+lemma trimmed_hashed_lcp_is_first_suffix:
+  assumes "\<not> disjoint_chains \<C> \<C>'"
+  shows "drop (length (hashed_lcp \<C> \<C>')) \<C> = first_suffix \<C> \<C>'"
+  using assms
+proof (induction \<C> \<C>' rule: longest_common_prefix.induct)
+  case (1 B \<C> B' \<C>')
+  from \<open>\<not> disjoint_chains (B # \<C>) (B' # \<C>')\<close> have "\<H>\<^sub>B B = \<H>\<^sub>B B'"
+    by simp
+  have "hashed_lcp (B # \<C>) (B' # \<C>') = \<H>\<^sub>B B # hashed_lcp \<C> \<C>'"
+  proof -
+    from \<open>\<H>\<^sub>B B = \<H>\<^sub>B B'\<close>
+    have "{map \<H>\<^sub>B (B # \<C>), map \<H>\<^sub>B (B' # \<C>')} = (#) (\<H>\<^sub>B B) ` {map \<H>\<^sub>B \<C>, map \<H>\<^sub>B \<C>'}"
+      by simp
+    then show ?thesis
+      unfolding hashed_lcp_def by (metis Longest_common_prefix_image_Cons insert_not_empty)
+  qed
+  then
+    have "drop (length (hashed_lcp (B # \<C>) (B' # \<C>'))) (B # \<C>) = drop (length (hashed_lcp \<C> \<C>')) \<C>"
+    by simp
+  also have "\<dots> = first_suffix \<C> \<C>'"
+  proof (cases "\<not> disjoint_chains \<C> \<C>'")
+    case True
+    from \<open>\<H>\<^sub>B B = \<H>\<^sub>B B'\<close> have "B = B'"
+      using collision_resistance by (meson inj_eq)
+    with True and "1.IH" show ?thesis
+      by simp
+  next
+    case False
+    then show ?thesis
+    proof (induction \<C> \<C>' rule: longest_common_prefix.induct)
+      case (1 B \<C> B' \<C>')
+      have "\<H>\<^sub>B B # map \<H>\<^sub>B \<C> \<in> {map \<H>\<^sub>B (B # \<C>), map \<H>\<^sub>B (B' # \<C>')}"
+        by simp
+      moreover have "\<H>\<^sub>B B' # map \<H>\<^sub>B \<C>' \<in> {map \<H>\<^sub>B (B # \<C>), map \<H>\<^sub>B (B' # \<C>')}"
+        by simp
+      moreover from "1.prems" have "\<H>\<^sub>B B \<noteq> \<H>\<^sub>B B'"
+        by simp
+      ultimately have "Longest_common_prefix {map \<H>\<^sub>B (B # \<C>), map \<H>\<^sub>B (B' # \<C>')} = []"
+        by (metis Longest_common_prefix_eq_Nil)
+      with \<open>\<H>\<^sub>B B \<noteq> \<H>\<^sub>B B'\<close> show ?case
+        by simp
+    next
+      case ("2_1" \<C>')
+      then show ?case
+        by simp
+    next
+      case ("2_2" \<C>)
+      then show ?case
+        by (simp add: Longest_common_prefix_Nil)
+    qed
+  qed
+  finally show ?case
+    using \<open>\<H>\<^sub>B B = \<H>\<^sub>B B'\<close> by simp
+next
+  case ("2_1" \<C>')
+  then show ?case
+    by simp
+next
+  case ("2_2" \<C>)
+  then show ?case
+    by (simp add: Longest_common_prefix_Nil) 
+qed
+
+lemma first_chain_length_bound:
+  assumes "disjoint_chains \<C> \<C>'"
+    and "length (first_suffix \<C> \<C>') \<le> n"
+  shows "length \<C> \<le> n"
+proof -
+  from \<open>disjoint_chains \<C> \<C>'\<close> have "first_suffix \<C> \<C>' = \<C>"
+    by (induction \<C> \<C>' rule: longest_common_prefix.induct) simp_all
+  with \<open>length (first_suffix \<C> \<C>') \<le> n\<close> show ?thesis
+    by (simp del: first_suffix.simps)
+qed
+
+lemma forks_at_most_impl [code]:
+  shows "forks_at_most n \<C> \<C>' \<longleftrightarrow> length (first_suffix \<C> \<C>') \<le> n"
+proof (intro iffI)
+  assume "forks_at_most n \<C> \<C>'"
+  show "length (first_suffix \<C> \<C>') \<le> n"
+  proof (cases "disjoint_chains \<C> \<C>'")
+    case True
+    with \<open>forks_at_most n \<C> \<C>'\<close> show ?thesis
+      by simp
+  next
+    case False
+    with \<open>forks_at_most n \<C> \<C>'\<close> show ?thesis
+      using trimmed_hashed_lcp_is_first_suffix by force 
+  qed
+next
+  assume "length (first_suffix \<C> \<C>') \<le> n"
+  show "forks_at_most n \<C> \<C>'"
+  proof (cases "disjoint_chains \<C> \<C>'")
+    case True
+    with \<open>length (first_suffix \<C> \<C>') \<le> n\<close> show ?thesis
+      using first_chain_length_bound unfolding forks_at_most_def by presburger
+  next
+    case False
+    with \<open>length (first_suffix \<C> \<C>') \<le> n\<close> show ?thesis
+      using trimmed_hashed_lcp_is_first_suffix by simp
+  qed
+qed
+
+lemma forks_at_mostI [intro]:
+  shows "forks_at_most k \<C> \<C>"
+  using first_suffix_eq_chains and forks_at_most_impl by simp
+
+lemma max_valid_no_candidates:
+  shows "max_valid \<C> [] = \<C>"
+proof -
+  have "longest_chains [\<C>] = [\<C>]"
+    by (rule longest_chains_singleton)
+  moreover have "forks_at_most k \<C> \<C>"
+    by (intro forks_at_mostI)
+  ultimately show ?thesis
+    by auto
+qed
+
+lemma max_valid_local_bias:
+  assumes "is_longest_chain \<C> \<CC>"
+  shows "max_valid \<C> \<CC> = \<C>"
+proof -
+  from assms have "\<C> \<in> set (longest_chains (\<C> # [\<C>' \<leftarrow> \<CC>. forks_at_most k \<C> \<C>']))"
+    using longest_chains_elem_is_longest by auto
+  moreover have "forks_at_most k \<C> \<C>"
+    by (intro forks_at_mostI)
+  ultimately have "\<C> \<in> set (longest_chains [\<C>' \<leftarrow> \<C> # \<CC>. forks_at_most k \<C> \<C>'])"
+    by auto
+  then show ?thesis
+    by (simp del: forks_at_most_def)
+qed
+
+lemma max_valid_preserves_order:
+  assumes "\<not> is_longest_chain \<C> [\<C>' \<leftarrow> \<CC>. forks_at_most k \<C> \<C>']"
+    and "\<CC>\<^sub>m\<^sub>a\<^sub>x = longest_chains [\<C>' \<leftarrow> \<CC>. forks_at_most k \<C> \<C>']"
+    and "\<CC>\<^sub>m\<^sub>a\<^sub>x \<noteq> []"
+  shows "max_valid \<C> \<CC> = hd \<CC>\<^sub>m\<^sub>a\<^sub>x"
+proof -
+  from assms have "\<CC>\<^sub>m\<^sub>a\<^sub>x = longest_chains [\<C>' \<leftarrow> \<C> # \<CC>. forks_at_most k \<C> \<C>']"
+    using longest_chains_shorter_element by simp
+  moreover from assms have "\<C> \<notin> set \<CC>\<^sub>m\<^sub>a\<^sub>x"
+    unfolding longest_chains_def by simp
+  ultimately show ?thesis
+    by (simp del: forks_at_most_def)
+qed
+
+end
+
+text \<open>
+  Now we will test the chain selection rule algorithm using a test interpretation of
+  @{locale chain_selection}, in which blocks are  basically `empty' except for the slot number, and
+  the block hash function is simply the identity function:
+\<close>
+
+abbreviation (input) test_k :: nat where "test_k \<equiv> 2"
+abbreviation (input) test_R :: nat where "test_R \<equiv> 4" \<comment> \<open>unused\<close>
+abbreviation (input) test_f :: real where "test_f \<equiv> 1/2" \<comment> \<open>unused\<close>
+abbreviation (input) test_ha :: real where "test_ha \<equiv> 3/4" \<comment> \<open>unused\<close>
+
+type_synonym test_block = "(unit, unit, unit, unit) block"
+type_synonym test_chain = "(unit, unit, unit, unit) chain"
+
+abbreviation test_\<H>\<^sub>B :: "test_block \<Rightarrow> test_block" where "test_\<H>\<^sub>B \<equiv> id"
+
+definition "test_forks_at_most = chain_selection.forks_at_most test_\<H>\<^sub>B"
+definition "test_first_suffix = chain_selection.first_suffix test_\<H>\<^sub>B"
+definition "test_max_valid = chain_selection.max_valid test_k test_\<H>\<^sub>B"
+definition test_longest_chains :: "test_chain list \<Rightarrow> test_chain list" where
+  "test_longest_chains = chain_selection.longest_chains"
+
+interpretation test_chain_selection: chain_selection test_k test_R test_f test_ha test_\<H>\<^sub>B
+  rewrites "chain_selection.forks_at_most test_\<H>\<^sub>B = test_forks_at_most"
+    and "chain_selection.first_suffix test_\<H>\<^sub>B = test_first_suffix"
+    and "chain_selection.longest_chains = test_longest_chains"
+    and "chain_selection.max_valid test_k test_\<H>\<^sub>B = test_max_valid"
+  unfolding test_forks_at_most_def
+    and test_first_suffix_def
+    and test_longest_chains_def
+    and test_max_valid_def
+  by unfold_locales simp_all
+
+lemmas [code] = test_chain_selection.longest_chains_def
+
+abbreviation make_test_block :: "slot \<Rightarrow> test_block" ("B\<^bsub>_\<^esub>") where
+  "B\<^bsub>sl\<^esub> \<equiv> ((sl, None, [], (U\<^bsub>0\<^esub>, ((), ())), ((), ())), ())"
+
+abbreviation make_test_chain :: "slot list \<Rightarrow> test_chain" ("\<langle>_\<rangle>") where
+  "\<langle>ss\<rangle> \<equiv> map make_test_block ss"
+
+notepad
+begin
+
+  let ?is_valid_fork = "\<lambda>n \<C> \<C>'. test_chain_selection.forks_at_most n \<C> \<C>'"
+
+  text \<open>
+    In this part we test the correctness of @{const chain_selection.forks_at_most}. To do so, we
+    check that the following graphs represent @{emph \<open>valid\<close>} forks, with the chain at the top of
+    each graph being the current local chain and the chain below the candidate chain:
+
+    For \<open>k = 2\<close>: @{verbatim "
+    
+      G-0-1        G-0-1      G-0-1          G-0-1-2-3
+      |              |            |              |
+       -2-3-4         -2-3         -2-3           -4-5
+    "}
+  \<close>
+  value "?is_valid_fork 2 \<langle>[0, 1]\<rangle> \<langle>[2, 3, 4]\<rangle>"
+  value "?is_valid_fork 2 \<langle>[0, 1]\<rangle> \<langle>[0, 2, 3]\<rangle>"
+  value "?is_valid_fork 2 \<langle>[0, 1]\<rangle> \<langle>[0, 1, 2, 3]\<rangle>"
+  value "?is_valid_fork 2 \<langle>[0, 1, 2, 3]\<rangle> \<langle>[0, 1, 4, 5]\<rangle>"
+
+  text \<open>
+    And we check that the following graphs represent @{emph \<open>invalid\<close>} forks:
+
+    For \<open>k = 2\<close>: @{verbatim "
+    
+      G-0-1-2        G-0-1-2-3
+      |                |
+       -3-4             -4-5
+    "}
+
+    For \<open>k = 1\<close>: @{verbatim "
+    
+      G-0-1
+      |
+       -2-3-4
+    "}
+  \<close>
+  value "\<not> ?is_valid_fork 2 \<langle>[0, 1, 2]\<rangle> \<langle>[3, 4]\<rangle>"
+  value "\<not> ?is_valid_fork 2 \<langle>[0, 1, 2, 3]\<rangle> \<langle>[0, 4, 5]\<rangle>"
+  value "\<not> ?is_valid_fork 1 \<langle>[0, 1]\<rangle> \<langle>[2, 3, 4]\<rangle>"
+
+  text \<open>
+    Now we test the correctness of the @{const chain_selection.max_valid} function using the
+    following test cases:
+  \<close>
+
+  \<comment> \<open>No candidate chains were broadcast during the current slot, so the local chain is not updated:\<close>
+  value "test_chain_selection.max_valid \<langle>[0, 1]\<rangle> [] = \<langle>[0, 1]\<rangle>"
+
+  \<comment> \<open>The only candidate chain is longer than the local chain and is a valid fork, so it is adopted:\<close>
+  value "test_chain_selection.max_valid \<langle>[0, 1]\<rangle> [\<langle>[0, 1, 2]\<rangle>] = \<langle>[0, 1, 2]\<rangle>"
+
+  \<comment> \<open>
+    The only candidate chain is shorter than the local chain and a is valid fork, so it's not
+    adopted:
+  \<close>
+  value "test_chain_selection.max_valid \<langle>[0, 1, 2]\<rangle> [\<langle>[0, 1]\<rangle>] = \<langle>[0, 1, 2]\<rangle>"
+
+  \<comment> \<open>
+    The only candidate chain is equal length as the local chain and is a valid fork, so it's not
+    adopted (bias towards the local chain):
+  \<close>
+  value "test_chain_selection.max_valid \<langle>[0, 1]\<rangle> [\<langle>[3, 4]\<rangle>] = \<langle>[0, 1]\<rangle>"
+
+  \<comment> \<open>
+    The only candidate chain is longer than the local chain but is an invalid fork, so it's not
+    adopted:
+  \<close>
+  value "test_chain_selection.max_valid \<langle>[0, 1, 2]\<rangle> [\<langle>[3, 4, 5, 6]\<rangle>] = \<langle>[0, 1, 2]\<rangle>"
+
+  \<comment> \<open>The longest candidate is adopted:\<close>
+  value "test_chain_selection.max_valid \<langle>[0, 1]\<rangle> [\<langle>[3, 4, 5, 6]\<rangle>, \<langle>[0, 1, 2]\<rangle>] = \<langle>[3, 4, 5, 6]\<rangle>"
+
+  \<comment> \<open>The first longest candidate is adopted:\<close>
+  value "test_chain_selection.max_valid \<langle>[0, 1]\<rangle> [\<langle>[0, 1, 2]\<rangle>, \<langle>[0, 1, 3]\<rangle>] = \<langle>[0, 1, 2]\<rangle>"
+
+  \<comment> \<open>Invalid forks are filtered out:\<close>
+  value "test_chain_selection.max_valid \<langle>[0, 1, 2]\<rangle> [\<langle>[3, 4, 5, 6]\<rangle>, \<langle>[0, 1, 2, 3]\<rangle>] = \<langle>[0, 1, 2, 3]\<rangle>"
+
+  code_thms test_chain_selection.forks_at_most test_chain_selection.max_valid
+
+end
 
 end