From ec9a5bac293ae85934f15567c0d7e30ec4cb4812 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 18 Jan 2022 12:04:38 +0100
Subject: [PATCH 01/37] Proto/Alpha: cleanup Slot_repr.Range

- Make the type Slot.Range.t abstract
- Use a more compact interval representation than list
- Provide some iterators (fold/fold_es)
- Remove unused elements (encodings, ...)
- Provide an additional Slot.slot type to ease interface writing
---
 src/proto_alpha/lib_protocol/alpha_context.ml |  8 +-
 .../lib_protocol/alpha_context.mli            | 13 ++-
 src/proto_alpha/lib_protocol/baking.ml        | 12 +--
 src/proto_alpha/lib_protocol/slot_repr.ml     | 82 +++++--------------
 src/proto_alpha/lib_protocol/slot_repr.mli    | 16 ++--
 5 files changed, 50 insertions(+), 81 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml
index d0987bfc0ac0..ddc7a2c10dc9 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.ml
+++ b/src/proto_alpha/lib_protocol/alpha_context.ml
@@ -49,13 +49,7 @@ module Timestamp = struct
   let predecessor = Raw_context.predecessor_timestamp
 end
 
-module Slot = struct
-  include Slot_repr
-
-  type slot_range = List.t
-
-  let slot_range ~min ~count = List.slot_range ~min ~count
-end
+module Slot = Slot_repr
 
 module Sc_rollup = struct
   include Sc_rollup_repr
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 743ad7fb7998..ba749197cab7 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -67,6 +67,8 @@ type signature = Signature.t
 module Slot : sig
   type t
 
+  type slot = t
+
   include Compare.S with type t := t
 
   val pp : Format.formatter -> t -> unit
@@ -79,9 +81,16 @@ module Slot : sig
 
   val encoding : t Data_encoding.encoding
 
-  type slot_range = private t list
+  module Range : sig
+    type t
+
+    val create : min:int -> count:int -> t tzresult
 
-  val slot_range : min:int -> count:int -> slot_range tzresult
+    val fold : ('a -> slot -> 'a) -> 'a -> t -> 'a
+
+    val fold_es :
+      ('a -> slot -> 'a tzresult Lwt.t) -> 'a -> t -> 'a tzresult Lwt.t
+  end
 
   module Map : Map.S with type key = t
 
diff --git a/src/proto_alpha/lib_protocol/baking.ml b/src/proto_alpha/lib_protocol/baking.ml
index 3c33ebda1d13..75a6a97428f3 100644
--- a/src/proto_alpha/lib_protocol/baking.ml
+++ b/src/proto_alpha/lib_protocol/baking.ml
@@ -79,13 +79,13 @@ let baking_rights c level =
 
 let endorsing_rights (ctxt : t) level =
   let consensus_committee_size = Constants.consensus_committee_size ctxt in
-  Slot.slot_range ~min:0 ~count:consensus_committee_size >>?= fun slots ->
-  List.fold_left_es
+  Slot.Range.create ~min:0 ~count:consensus_committee_size >>?= fun slots ->
+  Slot.Range.fold_es
     (fun (ctxt, acc) slot ->
       Stake_distribution.slot_owner ctxt level slot >>=? fun (ctxt, (_, pkh)) ->
       return (ctxt, (slot, pkh) :: acc))
     (ctxt, [])
-    (slots :> Slot.t list)
+    slots
   >>=? fun (ctxt, right_owners) ->
   let rights =
     List.fold_left
@@ -102,9 +102,9 @@ let endorsing_rights (ctxt : t) level =
   return (ctxt, rights)
 
 let endorsing_rights_by_first_slot ctxt level =
-  Slot.slot_range ~min:0 ~count:(Constants.consensus_committee_size ctxt)
+  Slot.Range.create ~min:0 ~count:(Constants.consensus_committee_size ctxt)
   >>?= fun slots ->
-  List.fold_left_es
+  Slot.Range.fold_es
     (fun (ctxt, (delegates_map, slots_map)) slot ->
       Stake_distribution.slot_owner ctxt level slot
       >|=? fun (ctxt, (pk, pkh)) ->
@@ -126,5 +126,5 @@ let endorsing_rights_by_first_slot ctxt level =
       in
       (ctxt, (delegates_map, slots_map)))
     (ctxt, (Signature.Public_key_hash.Map.empty, Slot.Map.empty))
-    (slots :> Slot.t list)
+    slots
   >>=? fun (ctxt, (_, slots_map)) -> return (ctxt, slots_map)
diff --git a/src/proto_alpha/lib_protocol/slot_repr.ml b/src/proto_alpha/lib_protocol/slot_repr.ml
index 45660159cea4..db7e73a3ee28 100644
--- a/src/proto_alpha/lib_protocol/slot_repr.ml
+++ b/src/proto_alpha/lib_protocol/slot_repr.ml
@@ -38,6 +38,8 @@ let () =
 
 include Compare.Int
 
+type slot = t
+
 (* TODO? should there be some assertions to verify that slots are
    never too big ? Or do that in a storage module that depends on
    constants ? *)
@@ -66,70 +68,30 @@ let succ slot = of_int (slot + 1)
 module Map = Map.Make (Compare.Int)
 module Set = Set.Make (Compare.Int)
 
-module List = struct
-  (* Expected invariant: list of increasing values *)
-  type nonrec t = t list
-
-  module Compressed = struct
-    type elt = {skip : int; take : int}
-
-    type encoded = elt list
-
-    let elt_encoding =
-      Data_encoding.(
-        conv
-          (fun {skip; take} -> (skip, take))
-          (fun (skip, take) -> {skip; take})
-          (obj2 (req "skip" uint16) (req "take" uint16)))
-
-    let encoding = Data_encoding.list elt_encoding
-
-    let encode l : encoded =
-      let rec loop_taking ~pos ~skipped ~taken l =
-        match l with
-        | [] -> if taken > 0 then [{skip = skipped; take = taken}] else []
-        | h :: t ->
-            if h = pos then
-              loop_taking ~pos:(pos + 1) ~skipped ~taken:(taken + 1) t
-            else
-              let elt = {skip = skipped; take = taken} in
-              let skipped = h - pos in
-              let taken = 1 in
-              let elts = loop_taking ~pos:(h + 1) ~skipped ~taken t in
-              elt :: elts
-      in
-      loop_taking ~pos:0 ~skipped:0 ~taken:0 l
-
-    let decode (elts : encoded) =
-      let rec loop ~pos elts =
-        match elts with
-        | [] -> Ok []
-        | elt :: elts -> (
-            let pos = pos + elt.skip in
-            match
-              List.init ~when_negative_length:() elt.take (fun i -> i + pos)
-            with
-            | Ok l -> (
-                let pos = pos + elt.take in
-                match loop ~pos elts with Ok t -> Ok (l @ t) | e -> e)
-            | Error () ->
-                Error "A compressed element contains a negative list size")
-      in
-      loop ~pos:0 elts
-  end
-
-  let encoding =
-    Data_encoding.conv_with_guard
-      Compressed.encode
-      Compressed.decode
-      Compressed.encoding
-
-  let slot_range ~min ~count =
+module Range = struct
+  (* For now, we only need full intervals. If we ever need sparse ones, we
+     could switch this representation to interval trees. *)
+  type t = Interval of {lo : int; hi : int}
+
+  let create ~min ~count =
     error_when (min < 0) (Invalid_slot min) >>? fun () ->
     error_when (min > max_value) (Invalid_slot min) >>? fun () ->
     error_when (count < 1) (Invalid_slot count) >>? fun () ->
     error_when (count > max_value) (Invalid_slot count) >>? fun () ->
     let max = min + count - 1 in
     error_when (max > max_value) (Invalid_slot max) >>? fun () ->
-    ok Misc.(min --> max)
+    ok (Interval {lo = min; hi = max})
+
+  let fold f init (Interval {lo; hi}) =
+    let rec loop ~acc ~next =
+      if next > hi then acc else loop ~acc:(f acc next) ~next:(next + 1)
+    in
+    loop ~acc:(f init lo) ~next:(lo + 1)
+
+  let fold_es f init (Interval {lo; hi}) =
+    let rec loop ~acc ~next =
+      if next > hi then return acc
+      else f acc next >>=? fun acc -> loop ~acc ~next:(next + 1)
+    in
+    f init lo >>=? fun acc -> loop ~acc ~next:(lo + 1)
 end
diff --git a/src/proto_alpha/lib_protocol/slot_repr.mli b/src/proto_alpha/lib_protocol/slot_repr.mli
index 2d460e22e73f..1f0ac4088f97 100644
--- a/src/proto_alpha/lib_protocol/slot_repr.mli
+++ b/src/proto_alpha/lib_protocol/slot_repr.mli
@@ -32,6 +32,8 @@
    max_value]. In this case it returns an [Invalid_slot] error.*)
 type t
 
+type slot = t
+
 val encoding : t Data_encoding.t
 
 (** {1 Constructors }*)
@@ -80,12 +82,14 @@ module Set : Set.S with type elt = t
 
 include Compare.S with type t := t
 
-module List : sig
-  (** A list of slot is an ordered list of increasing slot values *)
-  type nonrec t = private t list
-
-  val encoding : t Data_encoding.t
+module Range : sig
+  type t
 
   (** {3 Constructors} *)
-  val slot_range : min:int -> count:int -> t tzresult
+  val create : min:int -> count:int -> t tzresult
+
+  val fold : ('a -> slot -> 'a) -> 'a -> t -> 'a
+
+  val fold_es :
+    ('a -> slot -> 'a tzresult Lwt.t) -> 'a -> t -> 'a tzresult Lwt.t
 end
-- 
GitLab


From c7cadb673ba9366a7b32477f35efba453202fd43 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 18 Jan 2022 12:24:07 +0100
Subject: [PATCH 02/37] Proto/Alpha: document Slot.Range

Apply 1 suggestion(s) to 1 file(s)
---
 src/proto_alpha/lib_protocol/slot_repr.mli | 29 +++++++++++++++++-----
 1 file changed, 23 insertions(+), 6 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/slot_repr.mli b/src/proto_alpha/lib_protocol/slot_repr.mli
index 1f0ac4088f97..462771c2d4a2 100644
--- a/src/proto_alpha/lib_protocol/slot_repr.mli
+++ b/src/proto_alpha/lib_protocol/slot_repr.mli
@@ -43,19 +43,19 @@ val zero : t
 (** Upper bound on the value a slot index can take *)
 val max_value : t
 
-(** [of_int i] creates a slot index from integer [i]. 
+(** [of_int i] creates a slot index from integer [i].
 
-    @return [Error (Invalid_slot i)] if [i < 0 || i > max_value], and 
+    @return [Error (Invalid_slot i)] if [i < 0 || i > max_value], and
             [Ok slot] otherwise
  *)
 val of_int : int -> t tzresult
 
 (** [of_int_do_not_use_except_for_parameters i] is an unchecked construction
-   function. 
+   function.
 
    It may be used in cases where one knows [0 <= i <= max_value], e.g., when
-   creating protocol parameters. 
-   
+   creating protocol parameters.
+
    When in doubt, use [of_int] or [of_int_exn].
  *)
 val of_int_do_not_use_except_for_parameters : int -> t
@@ -82,14 +82,31 @@ module Set : Set.S with type elt = t
 
 include Compare.S with type t := t
 
+(** {2 Slot ranges} *)
 module Range : sig
+  (** An ordered range of slots, in increasing order. *)
   type t
 
-  (** {3 Constructors} *)
+  (** {3 Constructor} *)
+
+  (** [create ~min ~count] creates a full slot range starting at [min], of size
+      [count], i.e, [min, min + count - 1].
+
+      [create] errors if
+      - [min < 0]
+      - [count < 1]
+      - [min + count - 1 > max_value]
+   *)
   val create : min:int -> count:int -> t tzresult
 
+  (** {3 Iterators} *)
+
+  (** [fold f acc range] folds [f] over the values of [range], in increasing
+      order. *)
   val fold : ('a -> slot -> 'a) -> 'a -> t -> 'a
 
+  (** [fold_es f acc range] folds [f] over the values of [range], in increasing
+      order. *)
   val fold_es :
     ('a -> slot -> 'a tzresult Lwt.t) -> 'a -> t -> 'a tzresult Lwt.t
 end
-- 
GitLab


From f4c9669c27b37def42bac477ad72c08f24b75052 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Mon, 31 Jan 2022 16:13:33 +0100
Subject: [PATCH 03/37] Proto/Alpha: add rev_fold_es (reversed fold) in
 Slot_repr

---
 src/proto_alpha/lib_protocol/alpha_context.mli |  3 +++
 src/proto_alpha/lib_protocol/baking.ml         |  8 ++++++--
 src/proto_alpha/lib_protocol/slot_repr.ml      | 15 ++++++++++++---
 src/proto_alpha/lib_protocol/slot_repr.mli     |  5 +++++
 4 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index ba749197cab7..e8c57923bbc1 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -90,6 +90,9 @@ module Slot : sig
 
     val fold_es :
       ('a -> slot -> 'a tzresult Lwt.t) -> 'a -> t -> 'a tzresult Lwt.t
+
+    val rev_fold_es :
+      ('a -> slot -> 'a tzresult Lwt.t) -> 'a -> t -> 'a tzresult Lwt.t
   end
 
   module Map : Map.S with type key = t
diff --git a/src/proto_alpha/lib_protocol/baking.ml b/src/proto_alpha/lib_protocol/baking.ml
index 75a6a97428f3..bdc01b0ba19f 100644
--- a/src/proto_alpha/lib_protocol/baking.ml
+++ b/src/proto_alpha/lib_protocol/baking.ml
@@ -77,11 +77,15 @@ let baking_rights c level =
   in
   f c Round.zero
 
+type ordered_slots = Slot.t list
+
+(* Slots returned by this function are assumed by consumers to be in increasing
+   order, hence the use of [Slot.Range.rev_fold_es]. *)
 let endorsing_rights (ctxt : t) level =
   let consensus_committee_size = Constants.consensus_committee_size ctxt in
   Slot.Range.create ~min:0 ~count:consensus_committee_size >>?= fun slots ->
-  Slot.Range.fold_es
-    (fun (ctxt, acc) slot ->
+  Slot.Range.rev_fold_es
+    (fun (ctxt, map) slot ->
       Stake_distribution.slot_owner ctxt level slot >>=? fun (ctxt, (_, pkh)) ->
       return (ctxt, (slot, pkh) :: acc))
     (ctxt, [])
diff --git a/src/proto_alpha/lib_protocol/slot_repr.ml b/src/proto_alpha/lib_protocol/slot_repr.ml
index db7e73a3ee28..4cb7219bfedc 100644
--- a/src/proto_alpha/lib_protocol/slot_repr.ml
+++ b/src/proto_alpha/lib_protocol/slot_repr.ml
@@ -70,7 +70,8 @@ module Set = Set.Make (Compare.Int)
 
 module Range = struct
   (* For now, we only need full intervals. If we ever need sparse ones, we
-     could switch this representation to interval trees. *)
+     could switch this representation to interval trees. [hi] and [lo] bounds
+     are included. *)
   type t = Interval of {lo : int; hi : int}
 
   let create ~min ~count =
@@ -84,14 +85,22 @@ module Range = struct
 
   let fold f init (Interval {lo; hi}) =
     let rec loop ~acc ~next =
-      if next > hi then acc else loop ~acc:(f acc next) ~next:(next + 1)
+      if Compare.Int.(next > hi) then acc
+      else loop ~acc:(f acc next) ~next:(next + 1)
     in
     loop ~acc:(f init lo) ~next:(lo + 1)
 
   let fold_es f init (Interval {lo; hi}) =
     let rec loop ~acc ~next =
-      if next > hi then return acc
+      if Compare.Int.(next > hi) then return acc
       else f acc next >>=? fun acc -> loop ~acc ~next:(next + 1)
     in
     f init lo >>=? fun acc -> loop ~acc ~next:(lo + 1)
+
+  let rev_fold_es f init (Interval {lo; hi}) =
+    let rec loop ~acc ~next =
+      if Compare.Int.(next < lo) then return acc
+      else f acc next >>=? fun acc -> loop ~acc ~next:(next - 1)
+    in
+    f init hi >>=? fun acc -> loop ~acc ~next:(hi - 1)
 end
diff --git a/src/proto_alpha/lib_protocol/slot_repr.mli b/src/proto_alpha/lib_protocol/slot_repr.mli
index 462771c2d4a2..cccc2cf43130 100644
--- a/src/proto_alpha/lib_protocol/slot_repr.mli
+++ b/src/proto_alpha/lib_protocol/slot_repr.mli
@@ -109,4 +109,9 @@ module Range : sig
       order. *)
   val fold_es :
     ('a -> slot -> 'a tzresult Lwt.t) -> 'a -> t -> 'a tzresult Lwt.t
+
+  (** [rev_fold_es f acc range] folds [f] over the values of [range], in decreasing
+      order. *)
+  val rev_fold_es :
+    ('a -> slot -> 'a tzresult Lwt.t) -> 'a -> t -> 'a tzresult Lwt.t
 end
-- 
GitLab


From c96bb964bb4f90a101fa5484d40e89d0000d30c5 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 18 Jan 2022 14:53:06 +0100
Subject: [PATCH 04/37] Proto/Alpha: revert lost comments in Tez_repr

These comments were lost for no good reason while merging Tenderbake
---
 src/proto_alpha/lib_protocol/tez_repr.mli | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/tez_repr.mli b/src/proto_alpha/lib_protocol/tez_repr.mli
index 5a1231e2932c..50b4c79e7f0f 100644
--- a/src/proto_alpha/lib_protocol/tez_repr.mli
+++ b/src/proto_alpha/lib_protocol/tez_repr.mli
@@ -24,6 +24,14 @@
 (*                                                                           *)
 (*****************************************************************************)
 
+(** Internal representation of the Tez currency. Behaves mostly like a natural
+   number where number 1 represents 1/1,000,000 Tez (1 micro-Tez or mutez).
+   It's protected from ever becoming negative and overflowing by special
+   arithmetic functions, which fail in case something undesired would happen.
+   When divided, it's always rounded down to 1 mutez.
+
+   Internally encoded as [int64], which may be relevant to guard against
+   overflow errors. *)
 type repr
 
 (** [t] is made algebraic in order to distinguish it from the other type
-- 
GitLab


From fce2316ec47f40ae225f7c21fdfdb649c8bdb333 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 18 Jan 2022 14:56:32 +0100
Subject: [PATCH 05/37] Proto/Alpha: remove leftover now incorrect comments in
 Operation_repr

See https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_727040197
---
 src/proto_alpha/lib_protocol/operation_repr.ml | 2 --
 1 file changed, 2 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml
index d6f75bb1a9ee..98705d372423 100644
--- a/src/proto_alpha/lib_protocol/operation_repr.ml
+++ b/src/proto_alpha/lib_protocol/operation_repr.ml
@@ -658,7 +658,6 @@ module Encoding = struct
     Case
       {
         tag = 20;
-        (* Preendorsement where added after *)
         name = "preendorsement";
         encoding = consensus_content_encoding;
         select =
@@ -667,7 +666,6 @@ module Encoding = struct
         inj = (fun preendorsement -> Preendorsement preendorsement);
       }
 
-  (* Defined before endorsement encoding because this is used there *)
   let preendorsement_encoding =
     let make (Case {tag; name; encoding; select = _; proj; inj}) =
       case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x)
-- 
GitLab


From 6c08ea274de86b7a603c8d633d691a532e417ec8 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Mon, 31 Jan 2022 16:15:13 +0100
Subject: [PATCH 06/37] Proto/Alpha: fuse consecutive folds in
 Baking.endorsing_rights

---
 src/proto_alpha/lib_protocol/baking.ml | 24 ++++++++----------------
 1 file changed, 8 insertions(+), 16 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/baking.ml b/src/proto_alpha/lib_protocol/baking.ml
index bdc01b0ba19f..eb10613fe00d 100644
--- a/src/proto_alpha/lib_protocol/baking.ml
+++ b/src/proto_alpha/lib_protocol/baking.ml
@@ -87,23 +87,15 @@ let endorsing_rights (ctxt : t) level =
   Slot.Range.rev_fold_es
     (fun (ctxt, map) slot ->
       Stake_distribution.slot_owner ctxt level slot >>=? fun (ctxt, (_, pkh)) ->
-      return (ctxt, (slot, pkh) :: acc))
-    (ctxt, [])
+      let map =
+        Signature.Public_key_hash.Map.update
+          pkh
+          (function None -> Some [slot] | Some slots -> Some (slot :: slots))
+          map
+      in
+      return (ctxt, map))
+    (ctxt, Signature.Public_key_hash.Map.empty)
     slots
-  >>=? fun (ctxt, right_owners) ->
-  let rights =
-    List.fold_left
-      (fun acc (slot, pkh) ->
-        let slots =
-          match Signature.Public_key_hash.Map.find pkh acc with
-          | None -> [slot]
-          | Some slots -> slot :: slots
-        in
-        Signature.Public_key_hash.Map.add pkh slots acc)
-      Signature.Public_key_hash.Map.empty
-      right_owners
-  in
-  return (ctxt, rights)
 
 let endorsing_rights_by_first_slot ctxt level =
   Slot.Range.create ~min:0 ~count:(Constants.consensus_committee_size ctxt)
-- 
GitLab


From 29b7b5de873b57737d0ce4907f979f85f8690927 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 10:54:31 +0100
Subject: [PATCH 07/37] Proto/Alpha: minimally enforce invariant in
 `endorsing_rights`

---
 src/proto_alpha/lib_plugin/plugin.ml    |  2 +-
 src/proto_alpha/lib_protocol/baking.mli | 20 +++++++++++++-------
 2 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index c38d048429f8..a404b33372bf 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -3572,7 +3572,7 @@ module RPC = struct
       Signature.Public_key_hash.Map.fold
         (fun delegate slots acc ->
           {level = level.level; delegate; slots} :: acc)
-        rights
+        (rights :> Slot.t list Signature.Public_key_hash.Map.t)
         []
 
     let register () =
diff --git a/src/proto_alpha/lib_protocol/baking.mli b/src/proto_alpha/lib_protocol/baking.mli
index 6504712552ed..9d9281b735a3 100644
--- a/src/proto_alpha/lib_protocol/baking.mli
+++ b/src/proto_alpha/lib_protocol/baking.mli
@@ -34,17 +34,23 @@ type error +=
       consensus_threshold : int;
     }
 
-(** For a given level computes who has the right to include an
-   endorsement in the next block. It returns a mapping from the
-   delegates with such rights to their endorsing slots.  This function
-   is only used by the 'validators' RPC.  *)
+type ordered_slots = private Slot.t list
+
+(** For a given level computes who has the right to include an endorsement in
+   the next block.
+
+   @return map from delegates with such rights to their endorsing slots, in
+   increasing order.
+
+   This function is only used by the 'validators' RPC.  *)
 val endorsing_rights :
   context ->
   Level.t ->
-  (context * Slot.t list Signature.Public_key_hash.Map.t) tzresult Lwt.t
+  (context * ordered_slots Signature.Public_key_hash.Map.t) tzresult Lwt.t
+
+(** Computes endorsing rights for a given level. 
 
-(** Computes the endorsing rights for a given level. Returns a map
-   from allocated first slots to their owner's public key, public key
+   @return  map from allocated first slots to their owner's public key, public key
    hash, and endorsing power. *)
 val endorsing_rights_by_first_slot :
   context ->
-- 
GitLab


From 23b17a4d51c1b1c3335907d1143df0fb6b081a5e Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 11:36:10 +0100
Subject: [PATCH 08/37] Proto/Alpha: do not keep (Debited zero) balance

As suggested by https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_727119377
---
 src/proto_alpha/lib_protocol/receipt_repr.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/receipt_repr.ml b/src/proto_alpha/lib_protocol/receipt_repr.ml
index d9e1cd6fe9a8..d0109a96d2d9 100644
--- a/src/proto_alpha/lib_protocol/receipt_repr.ml
+++ b/src/proto_alpha/lib_protocol/receipt_repr.ml
@@ -355,7 +355,7 @@ let group_balance_updates balance_updates =
           | (Debited a, Debited b) ->
               Tez_repr.(a +? b) >>? fun update -> ok (Debited update)))
       >>? function
-      | Credited update when Tez_repr.(update = zero) ->
+      | (Credited update | Debited update) when Tez_repr.(update = zero) ->
           ok (BalanceMap.remove (b, o) acc)
       | update -> ok (BalanceMap.add (b, o) update acc))
     BalanceMap.empty
-- 
GitLab


From f83d62ef88cb95e6d2478f4eaca611b4ef64fcb1 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 14:39:02 +0100
Subject: [PATCH 09/37] Proto/Alpha: rewrite Receipt_repr.group_balance_updates

Use a dedicated monadic update function as suggested in
https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_727119368

This avoids adding then removing bindings in the map
---
 src/proto_alpha/lib_protocol/receipt_repr.ml | 62 +++++++++++++-------
 1 file changed, 40 insertions(+), 22 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/receipt_repr.ml b/src/proto_alpha/lib_protocol/receipt_repr.ml
index d0109a96d2d9..8abe1a10b3ce 100644
--- a/src/proto_alpha/lib_protocol/receipt_repr.ml
+++ b/src/proto_alpha/lib_protocol/receipt_repr.ml
@@ -246,6 +246,8 @@ let compare_balance ba bb =
 
 type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t
 
+let is_zero_update = function Debited t | Credited t -> Tez_repr.(t = zero)
+
 let balance_update_encoding =
   let open Data_encoding in
   def "operation_metadata.alpha.balance_update"
@@ -331,33 +333,49 @@ let balance_updates_encoding =
              (merge_objs balance_encoding balance_update_encoding)
              update_origin_encoding))
 
-module BalanceMap = Map.Make (struct
-  type t = balance * update_origin
+module BalanceMap = struct
+  include Map.Make (struct
+    type t = balance * update_origin
+
+    let compare (ba, ua) (bb, ub) =
+      let c = compare_balance ba bb in
+      if is_not_zero c then c else compare_update_origin ua ub
+  end)
 
-  let compare (ba, ua) (bb, ub) =
-    let c = compare_balance ba bb in
-    if is_not_zero c then c else compare_update_origin ua ub
-end)
+  let update_r key (f : 'a option -> 'b option tzresult) map =
+    f (find key map) >>? function
+    | Some v -> ok (add key v map)
+    | None -> ok (remove key map)
+end
 
 let group_balance_updates balance_updates =
   List.fold_left_e
     (fun acc (b, update, o) ->
-      (match BalanceMap.find (b, o) acc with
-      | None -> ok update
-      | Some present -> (
-          match (present, update) with
-          | (Credited a, Debited b) | (Debited b, Credited a) ->
-              if Tez_repr.(a >= b) then
-                Tez_repr.(a -? b) >>? fun update -> ok (Credited update)
-              else Tez_repr.(b -? a) >>? fun update -> ok (Debited update)
-          | (Credited a, Credited b) ->
-              Tez_repr.(a +? b) >>? fun update -> ok (Credited update)
-          | (Debited a, Debited b) ->
-              Tez_repr.(a +? b) >>? fun update -> ok (Debited update)))
-      >>? function
-      | (Credited update | Debited update) when Tez_repr.(update = zero) ->
-          ok (BalanceMap.remove (b, o) acc)
-      | update -> ok (BalanceMap.add (b, o) update acc))
+      (* Do not do anything if the update is zero *)
+      if is_zero_update update then ok acc
+      else
+        BalanceMap.update_r
+          (b, o)
+          (function
+            | None -> ok (Some update)
+            | Some balance -> (
+                match (balance, update) with
+                | (Credited a, Debited b) | (Debited b, Credited a) ->
+                    (* Remove the binding since it just fell down to zero *)
+                    if Tez_repr.(a = b) then ok None
+                    else if Tez_repr.(a > b) then
+                      Tez_repr.(a -? b) >>? fun update ->
+                      ok (Some (Credited update))
+                    else
+                      Tez_repr.(b -? a) >>? fun update ->
+                      ok (Some (Debited update))
+                | (Credited a, Credited b) ->
+                    Tez_repr.(a +? b) >>? fun update ->
+                    ok (Some (Credited update))
+                | (Debited a, Debited b) ->
+                    Tez_repr.(a +? b) >>? fun update ->
+                    ok (Some (Debited update))))
+          acc)
     BalanceMap.empty
     balance_updates
   >>? fun map ->
-- 
GitLab


From f3e8261c320479b4e17b7a24c96eaf5c1833c57f Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 15:10:41 +0100
Subject: [PATCH 10/37] Proto/Alpha: rename Balance to Spendable_balance

Follows from comment
https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_727713470
---
 .../lib_protocol/contract_delegate_storage.ml |  4 ++--
 .../lib_protocol/contract_storage.ml          | 24 ++++++++++---------
 .../lib_protocol/delegate_storage.ml          |  7 +++---
 src/proto_alpha/lib_protocol/stake_storage.ml |  2 +-
 src/proto_alpha/lib_protocol/storage.ml       |  2 +-
 src/proto_alpha/lib_protocol/storage.mli      |  2 +-
 src/proto_alpha/lib_protocol/token.ml         |  2 +-
 7 files changed, 23 insertions(+), 20 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.ml b/src/proto_alpha/lib_protocol/contract_delegate_storage.ml
index ca295af19167..5a4a0ed4ae3d 100644
--- a/src/proto_alpha/lib_protocol/contract_delegate_storage.ml
+++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.ml
@@ -44,7 +44,7 @@ let registered c delegate =
   | None -> false
 
 let link c contract delegate =
-  Storage.Contract.Balance.get c contract >>=? fun balance ->
+  Storage.Contract.Spendable_balance.get c contract >>=? fun balance ->
   Stake_storage.add_stake c delegate balance >>=? fun c ->
   Storage.Contract.Delegated.add
     (c, Contract_repr.implicit_contract delegate)
@@ -55,7 +55,7 @@ let unlink c contract =
   Storage.Contract.Delegate.find c contract >>=? function
   | None -> return c
   | Some delegate ->
-      Storage.Contract.Balance.get c contract >>=? fun balance ->
+      Storage.Contract.Spendable_balance.get c contract >>=? fun balance ->
       (* Removes the balance of the contract from the delegate *)
       Stake_storage.remove_stake c delegate balance >>=? fun c ->
       Storage.Contract.Delegated.remove
diff --git a/src/proto_alpha/lib_protocol/contract_storage.ml b/src/proto_alpha/lib_protocol/contract_storage.ml
index 5bce09cebc50..ae538e3b2dce 100644
--- a/src/proto_alpha/lib_protocol/contract_storage.ml
+++ b/src/proto_alpha/lib_protocol/contract_storage.ml
@@ -386,7 +386,7 @@ let create_base c ~prepaid_bootstrap_storage
       Storage.Contract.Global_counter.get c >>=? fun counter ->
       Storage.Contract.Counter.init c contract counter)
   >>=? fun c ->
-  Storage.Contract.Balance.init c contract balance >>=? fun c ->
+  Storage.Contract.Spendable_balance.init c contract balance >>=? fun c ->
   (match manager with
   | Some manager ->
       Contract_manager_storage.init c contract (Manager_repr.Hash manager)
@@ -443,7 +443,8 @@ let delete c contract =
       failwith "Non implicit contracts cannot be removed"
   | Some _ ->
       Contract_delegate_storage.remove c contract >>=? fun c ->
-      Storage.Contract.Balance.remove_existing c contract >>=? fun c ->
+      Storage.Contract.Spendable_balance.remove_existing c contract
+      >>=? fun c ->
       Contract_manager_storage.remove_existing c contract >>=? fun c ->
       Storage.Contract.Counter.remove_existing c contract >>=? fun c ->
       Storage.Contract.Code.remove c contract >>=? fun (c, _, _) ->
@@ -452,7 +453,7 @@ let delete c contract =
       Storage.Contract.Used_storage_space.remove c contract >|= ok
 
 let allocated c contract =
-  Storage.Contract.Balance.find c contract >>=? function
+  Storage.Contract.Spendable_balance.find c contract >>=? function
   | None -> return_false
   | Some _ -> return_true
 
@@ -532,7 +533,7 @@ let get_counter c manager =
   | Some v -> return v
 
 let get_balance c contract =
-  Storage.Contract.Balance.find c contract >>=? function
+  Storage.Contract.Spendable_balance.find c contract >>=? function
   | None -> (
       match Contract_repr.is_implicit contract with
       | Some _ -> return Tez_repr.zero
@@ -559,12 +560,13 @@ let update_script_storage c contract storage lazy_storage_diff =
   Storage.Contract.Used_storage_space.update c contract new_size
 
 let spend_only_call_from_token c contract amount =
-  Storage.Contract.Balance.find c contract >>=? fun balance ->
+  Storage.Contract.Spendable_balance.find c contract >>=? fun balance ->
   let balance = Option.value balance ~default:Tez_repr.zero in
   match Tez_repr.(balance -? amount) with
   | Error _ -> fail (Balance_too_low (contract, balance, amount))
   | Ok new_balance -> (
-      Storage.Contract.Balance.update c contract new_balance >>=? fun c ->
+      Storage.Contract.Spendable_balance.update c contract new_balance
+      >>=? fun c ->
       Contract_delegate_storage.remove_contract_stake c contract amount
       >>=? fun c ->
       if Tez_repr.(new_balance > Tez_repr.zero) then return c
@@ -584,16 +586,16 @@ let spend_only_call_from_token c contract amount =
 
 (* [Tez_repr.(amount <> zero)] is a precondition of this function. It ensures that
    no entry associating a null balance to an implicit contract exists in the map
-   [Storage.Contract.Balance]. *)
+   [Storage.Contract.Spendable_balance]. *)
 let credit_only_call_from_token c contract amount =
-  Storage.Contract.Balance.find c contract >>=? function
+  Storage.Contract.Spendable_balance.find c contract >>=? function
   | None -> (
       match Contract_repr.is_implicit contract with
       | None -> fail (Non_existing_contract contract)
       | Some manager -> create_implicit c manager ~balance:amount)
   | Some balance ->
       Tez_repr.(amount +? balance) >>?= fun balance ->
-      Storage.Contract.Balance.update c contract balance >>=? fun c ->
+      Storage.Contract.Spendable_balance.update c contract balance >>=? fun c ->
       Contract_delegate_storage.add_contract_stake c contract amount
 
 let init c =
@@ -618,9 +620,9 @@ let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space =
     >|=? fun c -> (to_pay, c)
 
 let update_balance ctxt contract f amount =
-  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  Storage.Contract.Spendable_balance.get ctxt contract >>=? fun balance ->
   f balance amount >>?= fun new_balance ->
-  Storage.Contract.Balance.update ctxt contract new_balance
+  Storage.Contract.Spendable_balance.update ctxt contract new_balance
 
 let increase_balance_only_call_from_token ctxt contract amount =
   update_balance ctxt contract Tez_repr.( +? ) amount
diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml
index 2677d68150c9..4faa0deefb73 100644
--- a/src/proto_alpha/lib_protocol/delegate_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_storage.ml
@@ -244,7 +244,7 @@ let set c contract delegate =
             else return_unit
         | None -> return_unit)
         >>=? fun () ->
-        Storage.Contract.Balance.mem c contract >>= fun exists ->
+        Storage.Contract.Spendable_balance.mem c contract >>= fun exists ->
         error_when
           (self_delegation && not exists)
           (Empty_delegate_account delegate)
@@ -466,7 +466,8 @@ let freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle
       else if Tez_repr.(current_amount < maximum_stake_to_be_deposited) then
         Tez_repr.(maximum_stake_to_be_deposited -? current_amount)
         >>?= fun desired_to_freeze ->
-        Storage.Contract.Balance.get ctxt delegate_contract >>=? fun balance ->
+        Storage.Contract.Spendable_balance.get ctxt delegate_contract
+        >>=? fun balance ->
         (* In case the delegate hasn't been slashed in this cycle,
            the following invariant holds:
            maximum_stake_to_be_deposited <= frozen_deposits + balance
@@ -532,7 +533,7 @@ let cycle_end ctxt last_cycle unrevealed_nonces =
 
 let balance ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in
-  Storage.Contract.Balance.get ctxt contract
+  Storage.Contract.Spendable_balance.get ctxt contract
 
 let frozen_deposits ctxt delegate =
   Frozen_deposits_storage.get ctxt (Contract_repr.implicit_contract delegate)
diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml
index 34d68b4538f8..9659e24e7612 100644
--- a/src/proto_alpha/lib_protocol/stake_storage.ml
+++ b/src/proto_alpha/lib_protocol/stake_storage.ml
@@ -192,7 +192,7 @@ let select_distribution_for_cycle ctxt cycle pubkey =
            let delegate_contract = Contract_repr.implicit_contract delegate in
            Storage.Contract.Frozen_deposits_limit.find ctxt delegate_contract
            >>=? fun frozen_deposits_limit ->
-           Storage.Contract.Balance.get ctxt delegate_contract
+           Storage.Contract.Spendable_balance.get ctxt delegate_contract
            >>=? fun balance ->
            Frozen_deposits_storage.get ctxt delegate_contract
            >>=? fun frozen_deposits ->
diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml
index 6eccb3d03f3b..7e4320074ba0 100644
--- a/src/proto_alpha/lib_protocol/storage.ml
+++ b/src/proto_alpha/lib_protocol/storage.ml
@@ -188,7 +188,7 @@ module Contract = struct
 
   let list = Indexed_context.keys
 
-  module Balance =
+  module Spendable_balance =
     Indexed_context.Make_map
       (struct
         let name = ["balance"]
diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli
index 8e94c44f8921..10c02d74a567 100644
--- a/src/proto_alpha/lib_protocol/storage.mli
+++ b/src/proto_alpha/lib_protocol/storage.mli
@@ -73,7 +73,7 @@ module Contract : sig
      may also possess tez in frozen deposits. Empty balances (of zero
      tez) are only allowed for originated contracts, not for implicit
      ones. *)
-  module Balance :
+  module Spendable_balance :
     Indexed_data_storage
       with type key = Contract_repr.t
        and type value = Tez_repr.t
diff --git a/src/proto_alpha/lib_protocol/token.ml b/src/proto_alpha/lib_protocol/token.ml
index beefc1a06382..5ebbb39feac6 100644
--- a/src/proto_alpha/lib_protocol/token.ml
+++ b/src/proto_alpha/lib_protocol/token.ml
@@ -68,7 +68,7 @@ let balance ctxt stored =
   | `Collected_commitments bpkh -> Commitment_storage.committed_amount ctxt bpkh
   | `Delegate_balance delegate ->
       let contract = Contract_repr.implicit_contract delegate in
-      Storage.Contract.Balance.get ctxt contract
+      Storage.Contract.Spendable_balance.get ctxt contract
   | `Frozen_deposits delegate -> (
       let contract = Contract_repr.implicit_contract delegate in
       Frozen_deposits_storage.find ctxt contract >|=? fun frozen_deposits ->
-- 
GitLab


From c0f682b9da1b911aad075b7beb459e9c4726067d Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 15:52:50 +0100
Subject: [PATCH 11/37] Proto/Alpha: fix find/update sequence in Stake_storage

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_729972763
---
 src/proto_alpha/lib_protocol/stake_storage.ml | 11 +++--------
 1 file changed, 3 insertions(+), 8 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml
index 9659e24e7612..cd9ad7089bb4 100644
--- a/src/proto_alpha/lib_protocol/stake_storage.ml
+++ b/src/proto_alpha/lib_protocol/stake_storage.ml
@@ -57,10 +57,7 @@ module Selected_distribution_for_cycle = struct
 
   let remove_existing ctxt cycle =
     let id = identifier_of_cycle cycle in
-    (Cache.find ctxt id >>=? function
-     | None -> return ctxt
-     | Some _ -> Cache.update ctxt id None |> Lwt.return)
-    >>=? fun ctxt ->
+    Cache.update ctxt id None >>?= fun ctxt ->
     Storage.Stake.Selected_distribution_for_cycle.remove_existing ctxt cycle
 end
 
@@ -98,10 +95,8 @@ module Delegate_sampler_state = struct
 
   let remove_existing ctxt cycle =
     let id = identifier_of_cycle cycle in
-    (Cache.find ctxt id >>=? function
-     | None -> return ctxt
-     | Some _ -> Cache.update ctxt id None |> Lwt.return)
-    >>=? fun ctxt -> Storage.Delegate_sampler_state.remove_existing ctxt cycle
+    Cache.update ctxt id None >>?= fun ctxt ->
+    Storage.Delegate_sampler_state.remove_existing ctxt cycle
 end
 
 let get_staking_balance = Storage.Stake.Staking_balance.get
-- 
GitLab


From 8077ec10b79bc9c1b5a11824d58e34ffe89e7844 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 16:02:18 +0100
Subject: [PATCH 12/37] Proto/Alpha: remove one context access in
 remove/add_stake

in module Stake_storage

Addresses comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_729972774
---
 src/proto_alpha/lib_protocol/stake_storage.ml | 25 +++++++++----------
 1 file changed, 12 insertions(+), 13 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml
index cd9ad7089bb4..ca2f7802df84 100644
--- a/src/proto_alpha/lib_protocol/stake_storage.ml
+++ b/src/proto_alpha/lib_protocol/stake_storage.ml
@@ -101,20 +101,21 @@ end
 
 let get_staking_balance = Storage.Stake.Staking_balance.get
 
-let ensure_stake_inited ctxt delegate =
-  Storage.Stake.Staking_balance.mem ctxt delegate >>= function
-  | true -> return ctxt
-  | false ->
+let get_initialized_stake ctxt delegate =
+  Storage.Stake.Staking_balance.find ctxt delegate >>=? function
+  | Some staking_balance -> return (staking_balance, ctxt)
+  | None ->
       Frozen_deposits_storage.init ctxt delegate >>=? fun ctxt ->
-      Storage.Stake.Staking_balance.init ctxt delegate Tez_repr.zero
+      let balance = Tez_repr.zero in
+      Storage.Stake.Staking_balance.init ctxt delegate balance >>=? fun ctxt ->
+      return (balance, ctxt)
 
 let remove_stake ctxt delegate amount =
-  ensure_stake_inited ctxt delegate >>=? fun ctxt ->
-  let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
-  get_staking_balance ctxt delegate >>=? fun staking_balance_before ->
+  get_initialized_stake ctxt delegate >>=? fun (staking_balance_before, ctxt) ->
   Tez_repr.(staking_balance_before -? amount) >>?= fun staking_balance ->
   Storage.Stake.Staking_balance.update ctxt delegate staking_balance
   >>=? fun ctxt ->
+  let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
   if Tez_repr.(staking_balance_before >= tokens_per_roll) then
     Delegate_activation_storage.is_inactive ctxt delegate >>=? fun inactive ->
     if (not inactive) && Tez_repr.(staking_balance < tokens_per_roll) then
@@ -128,12 +129,11 @@ let remove_stake ctxt delegate amount =
     return ctxt
 
 let add_stake ctxt delegate amount =
-  ensure_stake_inited ctxt delegate >>=? fun ctxt ->
-  let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
-  get_staking_balance ctxt delegate >>=? fun staking_balance_before ->
+  get_initialized_stake ctxt delegate >>=? fun (staking_balance_before, ctxt) ->
   Tez_repr.(amount +? staking_balance_before) >>?= fun staking_balance ->
   Storage.Stake.Staking_balance.update ctxt delegate staking_balance
   >>=? fun ctxt ->
+  let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
   if Tez_repr.(staking_balance >= tokens_per_roll) then
     Delegate_activation_storage.is_inactive ctxt delegate >>=? fun inactive ->
     if inactive || Tez_repr.(staking_balance_before >= tokens_per_roll) then
@@ -151,8 +151,7 @@ let deactivate_only_call_from_delegate_storage ctxt delegate =
   Storage.Stake.Active_delegate_with_one_roll.remove ctxt delegate
 
 let activate_only_call_from_delegate_storage ctxt delegate =
-  ensure_stake_inited ctxt delegate >>=? fun ctxt ->
-  get_staking_balance ctxt delegate >>=? fun staking_balance ->
+  get_initialized_stake ctxt delegate >>=? fun (staking_balance, ctxt) ->
   let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
   if Tez_repr.(staking_balance >= tokens_per_roll) then
     Storage.Stake.Active_delegate_with_one_roll.add ctxt delegate ()
-- 
GitLab


From cb3ef387f79ce6e6d7295e430b51652349511ba6 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 16:12:02 +0100
Subject: [PATCH 13/37] Proto/Alpha: extract long function body into separate
 function

This eases readability

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_734898212
---
 src/proto_alpha/lib_protocol/stake_storage.ml | 97 ++++++++++---------
 1 file changed, 50 insertions(+), 47 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml
index ca2f7802df84..e9cf9578235a 100644
--- a/src/proto_alpha/lib_protocol/stake_storage.ml
+++ b/src/proto_alpha/lib_protocol/stake_storage.ml
@@ -164,6 +164,55 @@ let snapshot ctxt =
   Storage.Stake.Staking_balance.snapshot ctxt index >>=? fun ctxt ->
   Storage.Stake.Active_delegate_with_one_roll.snapshot ctxt index
 
+let get_stakes_for_selected_index ctxt index =
+  Storage.Stake.Active_delegate_with_one_roll.fold_snapshot
+    ctxt
+    index
+    ~order:`Sorted
+    ~init:([], Tez_repr.zero)
+    ~f:(fun delegate () (acc, total_stake) ->
+      Storage.Stake.Staking_balance.Snapshot.get ctxt (index, delegate)
+      >>=? fun staking_balance ->
+      let delegate_contract = Contract_repr.implicit_contract delegate in
+      Storage.Contract.Frozen_deposits_limit.find ctxt delegate_contract
+      >>=? fun frozen_deposits_limit ->
+      Storage.Contract.Spendable_balance.get ctxt delegate_contract
+      >>=? fun balance ->
+      Frozen_deposits_storage.get ctxt delegate_contract
+      >>=? fun frozen_deposits ->
+      Tez_repr.(balance +? frozen_deposits.current_amount)
+      >>?= fun total_balance ->
+      let frozen_deposits_percentage =
+        Constants_storage.frozen_deposits_percentage ctxt
+      in
+      let stake_to_consider =
+        match frozen_deposits_limit with
+        | Some frozen_deposits_limit -> (
+            try
+              let max_mutez = Tez_repr.of_mutez_exn Int64.max_int in
+              let frozen_stake_limit =
+                if Tez_repr.(frozen_deposits_limit > div_exn max_mutez 100) then
+                  max_mutez
+                else
+                  Tez_repr.(
+                    div_exn
+                      (mul_exn frozen_deposits_limit 100)
+                      frozen_deposits_percentage)
+              in
+              Tez_repr.min staking_balance frozen_stake_limit
+            with _ -> staking_balance)
+        | None -> staking_balance
+      in
+      let max_staking_capacity =
+        Tez_repr.(
+          div_exn (mul_exn total_balance 100) frozen_deposits_percentage)
+      in
+      let stake_for_cycle =
+        Tez_repr.min stake_to_consider max_staking_capacity
+      in
+      Tez_repr.(total_stake +? stake_for_cycle) >>?= fun total_stake ->
+      return ((delegate, stake_for_cycle) :: acc, total_stake))
+
 let select_distribution_for_cycle ctxt cycle pubkey =
   Storage.Stake.Last_snapshot.get ctxt >>=? fun max_index ->
   Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed ->
@@ -175,53 +224,7 @@ let select_distribution_for_cycle ctxt cycle pubkey =
   List.fold_left_es
     (fun ctxt index ->
       (if Compare.Int.(index = selected_index) then
-       Storage.Stake.Active_delegate_with_one_roll.fold_snapshot
-         ctxt
-         index
-         ~order:`Sorted
-         ~init:([], Tez_repr.zero)
-         ~f:(fun delegate () (acc, total_stake) ->
-           Storage.Stake.Staking_balance.Snapshot.get ctxt (index, delegate)
-           >>=? fun staking_balance ->
-           let delegate_contract = Contract_repr.implicit_contract delegate in
-           Storage.Contract.Frozen_deposits_limit.find ctxt delegate_contract
-           >>=? fun frozen_deposits_limit ->
-           Storage.Contract.Spendable_balance.get ctxt delegate_contract
-           >>=? fun balance ->
-           Frozen_deposits_storage.get ctxt delegate_contract
-           >>=? fun frozen_deposits ->
-           Tez_repr.(balance +? frozen_deposits.current_amount)
-           >>?= fun total_balance ->
-           let frozen_deposits_percentage =
-             Constants_storage.frozen_deposits_percentage ctxt
-           in
-           let stake_to_consider =
-             match frozen_deposits_limit with
-             | Some frozen_deposits_limit -> (
-                 try
-                   let max_mutez = Tez_repr.of_mutez_exn Int64.max_int in
-                   let frozen_stake_limit =
-                     if Tez_repr.(frozen_deposits_limit > div_exn max_mutez 100)
-                     then max_mutez
-                     else
-                       Tez_repr.(
-                         div_exn
-                           (mul_exn frozen_deposits_limit 100)
-                           frozen_deposits_percentage)
-                   in
-                   Tez_repr.min staking_balance frozen_stake_limit
-                 with _ -> staking_balance)
-             | None -> staking_balance
-           in
-           let max_staking_capacity =
-             Tez_repr.(
-               div_exn (mul_exn total_balance 100) frozen_deposits_percentage)
-           in
-           let stake_for_cycle =
-             Tez_repr.min stake_to_consider max_staking_capacity
-           in
-           Tez_repr.(total_stake +? stake_for_cycle) >>?= fun total_stake ->
-           return ((delegate, stake_for_cycle) :: acc, total_stake))
+       get_stakes_for_selected_index ctxt index
        >>=? fun (stakes, total_stake) ->
        let stakes =
          List.sort (fun (_, x) (_, y) -> Tez_repr.compare y x) stakes
-- 
GitLab


From 0587fe207a07adccb71fe8a951232728e80ff2f4 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 16:18:15 +0100
Subject: [PATCH 14/37] Proto/Alpha: integrate stake computation into error
 monad

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_734934918
---
 src/proto_alpha/lib_protocol/stake_storage.ml | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml
index e9cf9578235a..3f1b9d464a44 100644
--- a/src/proto_alpha/lib_protocol/stake_storage.ml
+++ b/src/proto_alpha/lib_protocol/stake_storage.ml
@@ -203,10 +203,9 @@ let get_stakes_for_selected_index ctxt index =
             with _ -> staking_balance)
         | None -> staking_balance
       in
-      let max_staking_capacity =
-        Tez_repr.(
-          div_exn (mul_exn total_balance 100) frozen_deposits_percentage)
-      in
+      Tez_repr.(total_balance *? 100L) >>?= fun expanded_balance ->
+      Tez_repr.(expanded_balance /? Int64.of_int frozen_deposits_percentage)
+      >>?= fun max_staking_capacity ->
       let stake_for_cycle =
         Tez_repr.min stake_to_consider max_staking_capacity
       in
-- 
GitLab


From 62fdbb8f2ef7e1db6a295e7998e6f1ece9b74810 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 16:37:28 +0100
Subject: [PATCH 15/37] Proto/alpha: categorize tokens to make reading easier

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_735803929
---
 src/proto_alpha/lib_protocol/token.ml  | 164 ++++++++++++++-----------
 src/proto_alpha/lib_protocol/token.mli |  22 ++--
 2 files changed, 105 insertions(+), 81 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/token.ml b/src/proto_alpha/lib_protocol/token.ml
index 5ebbb39feac6..980d5a18c144 100644
--- a/src/proto_alpha/lib_protocol/token.ml
+++ b/src/proto_alpha/lib_protocol/token.ml
@@ -30,7 +30,7 @@ type container =
   | `Frozen_deposits of Signature.Public_key_hash.t
   | `Block_fees ]
 
-type source =
+type infinite_source =
   [ `Invoice
   | `Bootstrap
   | `Initial_commitments
@@ -40,15 +40,17 @@ type source =
   | `Baking_rewards
   | `Baking_bonuses
   | `Minted
-  | `Liquidity_baking_subsidies
-  | container ]
+  | `Liquidity_baking_subsidies ]
 
-type sink =
+type source = [infinite_source | container]
+
+type infinite_sink =
   [ `Storage_fees
   | `Double_signing_punishments
   | `Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool
-  | `Burned
-  | container ]
+  | `Burned ]
+
+type sink = [infinite_sink | container]
 
 let allocated ctxt stored =
   match stored with
@@ -80,77 +82,95 @@ let balance ctxt stored =
 let credit ctxt dest amount origin =
   let open Receipt_repr in
   (match dest with
-  | `Storage_fees -> return (ctxt, Storage_fees)
-  | `Double_signing_punishments -> return (ctxt, Double_signing_punishments)
-  | `Lost_endorsing_rewards (d, p, r) ->
-      return (ctxt, Lost_endorsing_rewards (d, p, r))
-  | `Burned -> return (ctxt, Burned)
-  | `Contract dest ->
-      Contract_storage.credit_only_call_from_token ctxt dest amount
-      >|=? fun ctxt -> (ctxt, Contract dest)
-  | `Collected_commitments bpkh ->
-      Commitment_storage.increase_commitment_only_call_from_token
-        ctxt
-        bpkh
-        amount
-      >|=? fun ctxt -> (ctxt, Commitments bpkh)
-  | `Delegate_balance delegate ->
-      let contract = Contract_repr.implicit_contract delegate in
-      Contract_storage.increase_balance_only_call_from_token
-        ctxt
-        contract
-        amount
-      >|=? fun ctxt -> (ctxt, Contract contract)
-  | `Frozen_deposits delegate as dest ->
-      allocated ctxt dest >>=? fun allocated ->
-      (if not allocated then Frozen_deposits_storage.init ctxt delegate
-      else return ctxt)
-      >>=? fun ctxt ->
-      Frozen_deposits_storage.credit_only_call_from_token ctxt delegate amount
-      >|=? fun ctxt -> (ctxt, Deposits delegate)
-  | `Block_fees ->
-      Raw_context.credit_collected_fees_only_call_from_token ctxt amount
-      >>?= fun ctxt -> return (ctxt, Block_fees))
+  | #infinite_sink as infinite_sink ->
+      let sink =
+        match infinite_sink with
+        | `Storage_fees -> Storage_fees
+        | `Double_signing_punishments -> Double_signing_punishments
+        | `Lost_endorsing_rewards (d, p, r) -> Lost_endorsing_rewards (d, p, r)
+        | `Burned -> Burned
+      in
+      return (ctxt, sink)
+  | #container as container -> (
+      match container with
+      | `Contract dest ->
+          Contract_storage.credit_only_call_from_token ctxt dest amount
+          >|=? fun ctxt -> (ctxt, Contract dest)
+      | `Collected_commitments bpkh ->
+          Commitment_storage.increase_commitment_only_call_from_token
+            ctxt
+            bpkh
+            amount
+          >|=? fun ctxt -> (ctxt, Commitments bpkh)
+      | `Delegate_balance delegate ->
+          let contract = Contract_repr.implicit_contract delegate in
+          Contract_storage.increase_balance_only_call_from_token
+            ctxt
+            contract
+            amount
+          >|=? fun ctxt -> (ctxt, Contract contract)
+      | `Frozen_deposits delegate as dest ->
+          allocated ctxt dest >>=? fun allocated ->
+          (if not allocated then Frozen_deposits_storage.init ctxt delegate
+          else return ctxt)
+          >>=? fun ctxt ->
+          Frozen_deposits_storage.credit_only_call_from_token
+            ctxt
+            delegate
+            amount
+          >|=? fun ctxt -> (ctxt, Deposits delegate)
+      | `Block_fees ->
+          Raw_context.credit_collected_fees_only_call_from_token ctxt amount
+          >>?= fun ctxt -> return (ctxt, Block_fees)))
   >|=? fun (ctxt, balance) -> (ctxt, (balance, Credited amount, origin))
 
 let spend ctxt src amount origin =
   let open Receipt_repr in
   (match src with
-  | `Bootstrap -> return (ctxt, Bootstrap)
-  | `Invoice -> return (ctxt, Invoice)
-  | `Initial_commitments -> return (ctxt, Initial_commitments)
-  | `Minted -> return (ctxt, Minted)
-  | `Liquidity_baking_subsidies -> return (ctxt, Liquidity_baking_subsidies)
-  | `Revelation_rewards -> return (ctxt, Nonce_revelation_rewards)
-  | `Double_signing_evidence_rewards ->
-      return (ctxt, Double_signing_evidence_rewards)
-  | `Endorsing_rewards -> return (ctxt, Endorsing_rewards)
-  | `Baking_rewards -> return (ctxt, Baking_rewards)
-  | `Baking_bonuses -> return (ctxt, Baking_bonuses)
-  | `Contract src ->
-      Contract_storage.spend_only_call_from_token ctxt src amount
-      >|=? fun ctxt -> (ctxt, Contract src)
-  | `Collected_commitments bpkh ->
-      Commitment_storage.decrease_commitment_only_call_from_token
-        ctxt
-        bpkh
-        amount
-      >>=? fun ctxt -> return (ctxt, Commitments bpkh)
-  | `Delegate_balance delegate ->
-      let contract = Contract_repr.implicit_contract delegate in
-      Contract_storage.decrease_balance_only_call_from_token
-        ctxt
-        contract
-        amount
-      >|=? fun ctxt -> (ctxt, Contract contract)
-  | `Frozen_deposits delegate ->
-      (if Tez_repr.(amount = zero) then return ctxt
-      else
-        Frozen_deposits_storage.spend_only_call_from_token ctxt delegate amount)
-      >>=? fun ctxt -> return (ctxt, Deposits delegate)
-  | `Block_fees ->
-      Raw_context.spend_collected_fees_only_call_from_token ctxt amount
-      >>?= fun ctxt -> return (ctxt, Block_fees))
+  | #infinite_source as infinite_source ->
+      let src =
+        match infinite_source with
+        | `Bootstrap -> Bootstrap
+        | `Invoice -> Invoice
+        | `Initial_commitments -> Initial_commitments
+        | `Minted -> Minted
+        | `Liquidity_baking_subsidies -> Liquidity_baking_subsidies
+        | `Revelation_rewards -> Nonce_revelation_rewards
+        | `Double_signing_evidence_rewards -> Double_signing_evidence_rewards
+        | `Endorsing_rewards -> Endorsing_rewards
+        | `Baking_rewards -> Baking_rewards
+        | `Baking_bonuses -> Baking_bonuses
+      in
+      return (ctxt, src)
+  | #container as container -> (
+      match container with
+      | `Contract src ->
+          Contract_storage.spend_only_call_from_token ctxt src amount
+          >|=? fun ctxt -> (ctxt, Contract src)
+      | `Collected_commitments bpkh ->
+          Commitment_storage.decrease_commitment_only_call_from_token
+            ctxt
+            bpkh
+            amount
+          >>=? fun ctxt -> return (ctxt, Commitments bpkh)
+      | `Delegate_balance delegate ->
+          let contract = Contract_repr.implicit_contract delegate in
+          Contract_storage.decrease_balance_only_call_from_token
+            ctxt
+            contract
+            amount
+          >|=? fun ctxt -> (ctxt, Contract contract)
+      | `Frozen_deposits delegate ->
+          (if Tez_repr.(amount = zero) then return ctxt
+          else
+            Frozen_deposits_storage.spend_only_call_from_token
+              ctxt
+              delegate
+              amount)
+          >>=? fun ctxt -> return (ctxt, Deposits delegate)
+      | `Block_fees ->
+          Raw_context.spend_collected_fees_only_call_from_token ctxt amount
+          >>?= fun ctxt -> return (ctxt, Block_fees)))
   >|=? fun (ctxt, balance) -> (ctxt, (balance, Debited amount, origin))
 
 let transfer_n ?(origin = Receipt_repr.Block_application) ctxt src dest =
diff --git a/src/proto_alpha/lib_protocol/token.mli b/src/proto_alpha/lib_protocol/token.mli
index e872b872c348..5dece551bbac 100644
--- a/src/proto_alpha/lib_protocol/token.mli
+++ b/src/proto_alpha/lib_protocol/token.mli
@@ -48,9 +48,9 @@ type container =
   | `Frozen_deposits of Signature.Public_key_hash.t
   | `Block_fees ]
 
-(** [source] is the type of token providers. Token providers that are not
-    containers are considered to have infinite capacity. *)
-type source =
+(** [infinite_source] defines types of tokens provides which are considered to be
+ ** of infinite capacity. *)
+type infinite_source =
   [ `Invoice
   | `Bootstrap
   | `Initial_commitments
@@ -60,17 +60,21 @@ type source =
   | `Baking_rewards
   | `Baking_bonuses
   | `Minted
-  | `Liquidity_baking_subsidies
-  | container ]
+  | `Liquidity_baking_subsidies ]
 
-(** [sink] is the type of token receivers. Token receivers that are not
+(** [source] is the type of token providers. Token providers that are not
     containers are considered to have infinite capacity. *)
-type sink =
+type source = [infinite_source | container]
+
+type infinite_sink =
   [ `Storage_fees
   | `Double_signing_punishments
   | `Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool
-  | `Burned
-  | container ]
+  | `Burned ]
+
+(** [sink] is the type of token receivers. Token receivers that are not
+    containers are considered to have infinite capacity. *)
+type sink = [infinite_sink | container]
 
 (** [allocated ctxt container] returns true if [balance ctxt container] is
     guaranteed not to fail, and returns false when [balance ctxt container] may
-- 
GitLab


From 552341211236cca4779b5f7a1068eb5ead29d40a Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 15:25:31 +0100
Subject: [PATCH 16/37] Store/Tests: minor typo fix

---
 src/lib_store/test/alpha_utils.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/lib_store/test/alpha_utils.ml b/src/lib_store/test/alpha_utils.ml
index 6664001c17b9..90d28cf786ad 100644
--- a/src/lib_store/test/alpha_utils.ml
+++ b/src/lib_store/test/alpha_utils.ml
@@ -369,7 +369,7 @@ let check_constants_consistency constants =
       (fun () ->
         failwith
           "Inconsistent constants : blocks per cycle must be superior than \
-           blocks per roll snapshot")
+           blocks per stake snapshot")
   in
   return_unit
 
-- 
GitLab


From b73b364389043dc262308d01af6c81322d840bb3 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 2 Feb 2022 10:58:43 +0100
Subject: [PATCH 17/37] Proto/Alpha: use monomorphic comparison in Period_repr

---
 src/proto_alpha/lib_protocol/period_repr.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/period_repr.ml b/src/proto_alpha/lib_protocol/period_repr.ml
index 1f2de5752be8..4e928de82001 100644
--- a/src/proto_alpha/lib_protocol/period_repr.ml
+++ b/src/proto_alpha/lib_protocol/period_repr.ml
@@ -118,12 +118,12 @@ module Internal : INTERNAL = struct
   let mult_ a b =
     if a <> zero then
       let res = Int64.mul a b in
-      if Int64.div res a <> b then None else Some res
+      if Compare.Int64.(Int64.div res a <> b) then None else Some res
     else Some zero
 
   let add_ a b =
     let res = Int64.add a b in
-    if res < a || res < b then None else Some res
+    if Compare.Int64.(res < a || res < b) then None else Some res
 end
 
 include Internal
-- 
GitLab


From 9ed32f406da75c848148061b568ee21f0680d186 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 2 Feb 2022 10:59:22 +0100
Subject: [PATCH 18/37] Proto/Alpha: move SMass to Internal_for_tests

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_726861124
---
 src/proto_alpha/lib_protocol/sampler.ml       |  2 +
 src/proto_alpha/lib_protocol/sampler.mli      | 48 +++++++++----------
 .../lib_protocol/test/pbt/test_sampler.ml     |  7 +--
 3 files changed, 30 insertions(+), 27 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/sampler.ml b/src/proto_alpha/lib_protocol/sampler.ml
index 1802a612eafc..235311bdfefc 100644
--- a/src/proto_alpha/lib_protocol/sampler.ml
+++ b/src/proto_alpha/lib_protocol/sampler.ml
@@ -182,6 +182,8 @@ end
 
 module Internal_for_tests = struct
   module Make = Make
+
+  module type SMass = SMass
 end
 
 module Mass : SMass with type t = int64 = struct
diff --git a/src/proto_alpha/lib_protocol/sampler.mli b/src/proto_alpha/lib_protocol/sampler.mli
index 5f1eb8e2bf23..ea27341834f7 100644
--- a/src/proto_alpha/lib_protocol/sampler.mli
+++ b/src/proto_alpha/lib_protocol/sampler.mli
@@ -28,30 +28,6 @@
       to the given measure.
   *)
 
-(** [Mass] is the module type describing the measure associated to points. *)
-module type SMass = sig
-  (** [t] is the type describing the measure associated to points. *)
-  type t
-
-  val encoding : t Data_encoding.t
-
-  val zero : t
-
-  val of_int : int -> t
-
-  val mul : t -> t -> t
-
-  val add : t -> t -> t
-
-  val sub : t -> t -> t
-
-  val ( = ) : t -> t -> bool
-
-  val ( <= ) : t -> t -> bool
-
-  val ( < ) : t -> t -> bool
-end
-
 (** [S] is the module type of a module allowing to construct samplers based
     on the alias method. *)
 module type S = sig
@@ -90,6 +66,30 @@ end
 (**/**)
 
 module Internal_for_tests : sig
+  (** [Mass] is the module type describing the measure associated to points. *)
+  module type SMass = sig
+    (** [t] is the type describing the measure associated to points. *)
+    type t
+
+    val encoding : t Data_encoding.t
+
+    val zero : t
+
+    val of_int : int -> t
+
+    val mul : t -> t -> t
+
+    val add : t -> t -> t
+
+    val sub : t -> t -> t
+
+    val ( = ) : t -> t -> bool
+
+    val ( <= ) : t -> t -> bool
+
+    val ( < ) : t -> t -> bool
+  end
+
   (** [Make(Mass)] instantiates a module allowing to creates
       samplers for [Mass]-valued finite measures. *)
   module Make : functor (Mass : SMass) -> S with type mass = Mass.t
diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_sampler.ml b/src/proto_alpha/lib_protocol/test/pbt/test_sampler.ml
index 326fe581d26f..b6cab4985567 100644
--- a/src/proto_alpha/lib_protocol/test/pbt/test_sampler.ml
+++ b/src/proto_alpha/lib_protocol/test/pbt/test_sampler.ml
@@ -143,7 +143,7 @@ let state =
     |]
 
 module Make_test (Mass : sig
-  include SMass
+  include Internal_for_tests.SMass
 
   val to_float : t -> float
 end) (S : sig
@@ -190,7 +190,8 @@ end
 
 (* Testing the alias sampler with float-valued measures *)
 
-module Probability_mass_float : SMass with type t = float = struct
+module Probability_mass_float : Internal_for_tests.SMass with type t = float =
+struct
   type t = float
 
   let encoding = Data_encoding.float
@@ -226,7 +227,7 @@ module Test_float =
 
 (* Testing the alias sampler with Z-valued measures *)
 
-module Probability_mass_z : SMass with type t = Z.t = struct
+module Probability_mass_z : Internal_for_tests.SMass with type t = Z.t = struct
   let encoding = Data_encoding.z
 
   include Z
-- 
GitLab


From d1176b1c81b7ccfbf723ef4daaebe4fc30c51a03 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 2 Feb 2022 11:23:16 +0100
Subject: [PATCH 19/37] Stdlib: add [of_list] to FallbackArray

As suggested by comment
https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_726861140

This adds a simple test too.
---
 .../sigs/v5/fallbackArray.mli                 |  5 +++
 src/lib_stdlib/fallbackArray.ml               |  8 ++++
 src/lib_stdlib/fallbackArray.mli              |  5 +++
 src/lib_stdlib/test/test_fallbackArray.ml     | 42 ++++++++++++++++---
 4 files changed, 54 insertions(+), 6 deletions(-)

diff --git a/src/lib_protocol_environment/sigs/v5/fallbackArray.mli b/src/lib_protocol_environment/sigs/v5/fallbackArray.mli
index 71dd14d3c3e7..5ad040732304 100644
--- a/src/lib_protocol_environment/sigs/v5/fallbackArray.mli
+++ b/src/lib_protocol_environment/sigs/v5/fallbackArray.mli
@@ -39,6 +39,11 @@ type 'a t
    [v]. The value [v] is the fallback value for [a]. *)
 val make : int -> 'a -> 'a t
 
+(** [of_list ~fallback ~proj l] builds a fallback array [a] of length
+    [List.length l] where each cell [i] is initialized by [proj (List.nth l i)]
+    and the fallback value is [fallback]. *)
+val of_list : fallback:'b -> proj:('a -> 'b) -> 'a list -> 'b t
+
 (** [fallback a] returns the fallback value for [a]. *)
 val fallback : 'a t -> 'a
 
diff --git a/src/lib_stdlib/fallbackArray.ml b/src/lib_stdlib/fallbackArray.ml
index d23bc1091048..aba7facfd86f 100644
--- a/src/lib_stdlib/fallbackArray.ml
+++ b/src/lib_stdlib/fallbackArray.ml
@@ -28,3 +28,11 @@ include ReadOnlyArray
 let set array idx v =
   let len = length array in
   if idx >= 0 && idx < len then Array.unsafe_set array idx v else ()
+
+let of_list ~fallback ~proj l =
+  let length = List.length l in
+  let arr = make length fallback in
+  (* the initial construction of the array guarantees that we can always use
+     unsafe_set since the condition check in set is always true. *)
+  List.iteri (fun i e -> Array.unsafe_set arr i (proj e)) l ;
+  arr
diff --git a/src/lib_stdlib/fallbackArray.mli b/src/lib_stdlib/fallbackArray.mli
index e0f66a99482b..604bec65029e 100644
--- a/src/lib_stdlib/fallbackArray.mli
+++ b/src/lib_stdlib/fallbackArray.mli
@@ -39,6 +39,11 @@ type 'a t
    [v]. The value [v] is the fallback value for [a]. *)
 val make : int -> 'a -> 'a t
 
+(** [of_list ~fallback ~proj l] builds a fallback array [a] of length
+    [List.length l] where each cell [i] is initialized by [proj (List.nth l i)]
+    and the fallback value is [fallback]. *)
+val of_list : fallback:'b -> proj:('a -> 'b) -> 'a list -> 'b t
+
 (** [fallback a] returns the fallback value for [a]. *)
 val fallback : 'a t -> 'a
 
diff --git a/src/lib_stdlib/test/test_fallbackArray.ml b/src/lib_stdlib/test/test_fallbackArray.ml
index d90b8f1d9beb..7000bbcf76b0 100644
--- a/src/lib_stdlib/test/test_fallbackArray.ml
+++ b/src/lib_stdlib/test/test_fallbackArray.ml
@@ -30,12 +30,42 @@
     Subject:      Fallback arrays
  *)
 
-module Tests = Test_arrays.Make (struct
-  include FallbackArray
+module Tests = struct
+  include Test_arrays.Make (struct
+    include FallbackArray
 
-  let set a i v =
-    set a i v ;
-    a
-end)
+    let set a i v =
+      set a i v ;
+      a
+  end)
+
+  open Alcotest
+
+  let check_of_list () =
+    let l = Array.to_list (Array.init 100 (fun i -> i)) in
+    let open FallbackArray in
+    let fallback = -1 in
+    let farr = of_list ~fallback ~proj:(fun e -> e) l in
+    let farr_fallback = FallbackArray.fallback farr in
+    if not Compare.Int.(farr_fallback = fallback) then
+      fail
+        (Printf.sprintf "fallback should be %d (is %d)" fallback farr_fallback) ;
+    let i = ref 0 in
+    iter
+      (fun e ->
+        let expected = List.nth l !i in
+        if not Compare.Int.(expected = e) then
+          fail
+            (Printf.sprintf
+               "at index %d, fallback array (%d) disagrees with original list \
+                (%d)"
+               !i
+               e
+               expected)
+        else incr i)
+      farr
+
+  let tests = ("of_list", `Quick, check_of_list) :: tests
+end
 
 let () = Alcotest.run "stdlib" [("FallbackArray", Tests.tests)]
-- 
GitLab


From 5850d5f85447eb0b3e52a3fa2faca441db83a48a Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 2 Feb 2022 11:42:47 +0100
Subject: [PATCH 20/37] Proto/Alpha: use FallbackArray.of_list in sampler

---
 src/proto_alpha/lib_protocol/sampler.ml | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/sampler.ml b/src/proto_alpha/lib_protocol/sampler.ml
index 235311bdfefc..c0099a0348a0 100644
--- a/src/proto_alpha/lib_protocol/sampler.ml
+++ b/src/proto_alpha/lib_protocol/sampler.ml
@@ -89,12 +89,8 @@ module Make (Mass : SMass) : S with type mass = Mass.t = struct
           init_loop total p alias ((qj', j) :: small') large'
         else init_loop total p alias small' ((qj', j) :: large')
 
-  let support :
-      fallback:'a -> length:int -> ('a * Mass.t) list -> 'a FallbackArray.t =
-   fun ~fallback ~length measure ->
-    let a = FallbackArray.make length fallback in
-    List.iteri (fun i (elt, _) -> FallbackArray.set a i elt) measure ;
-    a
+  let support : fallback:'a -> ('a * Mass.t) list -> 'a FallbackArray.t =
+   fun ~fallback measure -> FallbackArray.of_list ~fallback ~proj:fst measure
 
   let check_and_cleanup measure =
     let (total, measure) =
@@ -126,7 +122,7 @@ module Make (Mass : SMass) : S with type mass = Mass.t = struct
         (0, [], [])
         measure
     in
-    let support = support ~fallback ~length measure in
+    let support = support ~fallback measure in
     let p = FallbackArray.make length total in
     let alias = FallbackArray.make length (-1) in
     init_loop total p alias small large ;
-- 
GitLab


From 9f09f761992985616ecbc7bde39d66aabe4736d8 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 2 Feb 2022 14:45:50 +0100
Subject: [PATCH 21/37] Proto/Alpha: make 0 the fallback for p in
 Sampler.create

Address commment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_726861147
---
 src/proto_alpha/lib_protocol/sampler.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/sampler.ml b/src/proto_alpha/lib_protocol/sampler.ml
index c0099a0348a0..341de9b0be63 100644
--- a/src/proto_alpha/lib_protocol/sampler.ml
+++ b/src/proto_alpha/lib_protocol/sampler.ml
@@ -123,7 +123,7 @@ module Make (Mass : SMass) : S with type mass = Mass.t = struct
         measure
     in
     let support = support ~fallback measure in
-    let p = FallbackArray.make length total in
+    let p = FallbackArray.make length Mass.zero in
     let alias = FallbackArray.make length (-1) in
     init_loop total p alias small large ;
     {total; support; p; alias}
-- 
GitLab


From 664c2d4fc990681abf29281bd6a76da1b19c96e6 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 2 Feb 2022 16:31:32 +0100
Subject: [PATCH 22/37] Proto/Alpha: set Cache_repr.size default to 0

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_727713558
---
 src/proto_alpha/lib_protocol/cache_repr.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/cache_repr.ml b/src/proto_alpha/lib_protocol/cache_repr.ml
index 6f6929c6bae9..ed4590f99e2a 100644
--- a/src/proto_alpha/lib_protocol/cache_repr.ml
+++ b/src/proto_alpha/lib_protocol/cache_repr.ml
@@ -204,7 +204,7 @@ let register_exn (type cvalue)
       @@ Admin.cache_size ctxt ~cache_index:C.cache_index
 
     let size_limit ctxt =
-      Option.value ~default:max_int
+      Option.value ~default:0
       @@ Admin.cache_size_limit ctxt ~cache_index:C.cache_index
 
     let update ctxt id v =
-- 
GitLab


From 62ef58e8ed5e7b14ffa5f6638564ef1ccecc35d0 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 2 Feb 2022 16:34:14 +0100
Subject: [PATCH 23/37] Proto/Alpha: expand documentation for
 Cache_repr.value_of_key

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_727713553
---
 src/proto_alpha/lib_protocol/cache_repr.mli | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/cache_repr.mli b/src/proto_alpha/lib_protocol/cache_repr.mli
index 6480a57786ac..72826e742a45 100644
--- a/src/proto_alpha/lib_protocol/cache_repr.mli
+++ b/src/proto_alpha/lib_protocol/cache_repr.mli
@@ -115,7 +115,11 @@ module Admin : sig
   val cache_size_limit : Raw_context.t -> cache_index:int -> size option
 
   (** [value_of_key ctxt k] interprets the functions introduced by
-     [register] to construct a cacheable value for a key [k]. *)
+     [register] to construct a cacheable value for a key [k]. 
+
+     [value_of_key] is a maintenance operation: it is typically run
+     when a node reboots. For this reason, this operation is not
+     carbonated. *)
   val value_of_key :
     Raw_context.t -> Context.Cache.key -> Context.Cache.value tzresult Lwt.t
 end
-- 
GitLab


From 3e942327c0a4bfb1bb8ee7b79b0aae67a5a5ba53 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 2 Feb 2022 16:50:17 +0100
Subject: [PATCH 24/37] Proto/Alpha: homogeneized interface for
 Delegate_activation_storage

All functions now expects a Raw_context.t and a public_key_hash

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_729016465
---
 src/proto_alpha/lib_protocol/delegate_activation_storage.ml  | 5 ++++-
 src/proto_alpha/lib_protocol/delegate_activation_storage.mli | 3 ++-
 src/proto_alpha/lib_protocol/delegate_storage.ml             | 4 +---
 3 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/delegate_activation_storage.ml b/src/proto_alpha/lib_protocol/delegate_activation_storage.ml
index 2d090108f20b..1b1cf6de8159 100644
--- a/src/proto_alpha/lib_protocol/delegate_activation_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_activation_storage.ml
@@ -48,7 +48,10 @@ let grace_period ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in
   Storage.Contract.Delegate_desactivation.get ctxt contract
 
-let set_inactive = Storage.Contract.Inactive_delegate.add
+let set_inactive ctxt delegate =
+  Storage.Contract.Inactive_delegate.add
+    ctxt
+    (Contract_repr.implicit_contract delegate)
 
 let set_active ctxt delegate =
   is_inactive ctxt delegate >>=? fun inactive ->
diff --git a/src/proto_alpha/lib_protocol/delegate_activation_storage.mli b/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
index e18ca676079e..d1647388834e 100644
--- a/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
@@ -31,7 +31,8 @@ val is_inactive :
 val grace_period :
   Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t tzresult Lwt.t
 
-val set_inactive : Raw_context.t -> Contract_repr.t -> Raw_context.t Lwt.t
+val set_inactive :
+  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t Lwt.t
 
 val set_active :
   Raw_context.t ->
diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml
index 4faa0deefb73..cf0251d55ca9 100644
--- a/src/proto_alpha/lib_protocol/delegate_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_storage.ml
@@ -171,9 +171,7 @@ let () =
     (fun pkh -> Not_registered pkh)
 
 let set_inactive ctxt delegate =
-  let delegate_contract = Contract_repr.implicit_contract delegate in
-  Delegate_activation_storage.set_inactive ctxt delegate_contract
-  >>= fun ctxt ->
+  Delegate_activation_storage.set_inactive ctxt delegate >>= fun ctxt ->
   Stake_storage.deactivate_only_call_from_delegate_storage ctxt delegate >|= ok
 
 let set_active ctxt delegate =
-- 
GitLab


From 2d44142eef32e67e2d939122f0a2104fc655f93e Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 3 Feb 2022 10:29:12 +0100
Subject: [PATCH 25/37] Proto/Alpha: module/function renaming related to
 active_storage

Rename module Delegate_desactivation to Delegate_last_cycle_before_deactivation

Rename function grace_period to last_cycle_before_deactivation

As suggested by comments:
- https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_729016471
- https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_729016468
---
 src/proto_alpha/lib_protocol/alpha_context.ml |  3 ++-
 .../lib_protocol/alpha_context.mli            |  2 +-
 .../delegate_activation_storage.ml            | 19 +++++++++----------
 .../delegate_activation_storage.mli           |  8 +++++---
 .../lib_protocol/delegate_services.ml         |  4 ++--
 .../lib_protocol/delegate_storage.ml          |  4 +++-
 src/proto_alpha/lib_protocol/storage.ml       |  3 ++-
 src/proto_alpha/lib_protocol/storage.mli      |  2 +-
 8 files changed, 25 insertions(+), 20 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml
index ddc7a2c10dc9..1e08e5c79ba0 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.ml
+++ b/src/proto_alpha/lib_protocol/alpha_context.ml
@@ -353,7 +353,8 @@ module Delegate = struct
     current_amount : Tez.t;
   }
 
-  let grace_period = Delegate_activation_storage.grace_period
+  let last_cycle_before_deactivation =
+    Delegate_activation_storage.last_cycle_before_deactivation
 
   let prepare_stake_distribution = Stake_storage.prepare_stake_distribution
 
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index e8c57923bbc1..f04d56aa7b57 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -1643,7 +1643,7 @@ module Delegate : sig
   val deactivated :
     context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
-  val grace_period :
+  val last_cycle_before_deactivation :
     context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t
 
   val pubkey : context -> public_key_hash -> public_key tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/delegate_activation_storage.ml b/src/proto_alpha/lib_protocol/delegate_activation_storage.ml
index 1b1cf6de8159..296502f80389 100644
--- a/src/proto_alpha/lib_protocol/delegate_activation_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_activation_storage.ml
@@ -30,7 +30,7 @@ let is_inactive ctxt delegate =
   >>= fun inactive ->
   if inactive then return inactive
   else
-    Storage.Contract.Delegate_desactivation.find
+    Storage.Contract.Delegate_last_cycle_before_deactivation.find
       ctxt
       (Contract_repr.implicit_contract delegate)
     >|=? function
@@ -44,9 +44,9 @@ let is_inactive ctxt delegate =
              a contract. *)
         false
 
-let grace_period ctxt delegate =
+let last_cycle_before_deactivation ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in
-  Storage.Contract.Delegate_desactivation.get ctxt contract
+  Storage.Contract.Delegate_last_cycle_before_deactivation.get ctxt contract
 
 let set_inactive ctxt delegate =
   Storage.Contract.Inactive_delegate.add
@@ -63,9 +63,10 @@ let set_active ctxt delegate =
      - if the delegate is new or inactive, we give it additionally
      `preserved_cycles` because the delegate needs this number of cycles to
      receive rights, so `1 + 2 * preserved_cycles` in total. *)
-  Storage.Contract.Delegate_desactivation.find
+  let delegate_contract = Contract_repr.implicit_contract delegate in
+  Storage.Contract.Delegate_last_cycle_before_deactivation.find
     ctxt
-    (Contract_repr.implicit_contract delegate)
+    delegate_contract
   >>=? fun current_last_active_cycle ->
   let last_active_cycle =
     match current_last_active_cycle with
@@ -77,14 +78,12 @@ let set_active ctxt delegate =
         let updated = Cycle_repr.add current_cycle delay in
         Cycle_repr.max current_last_active_cycle updated
   in
-  Storage.Contract.Delegate_desactivation.add
+  Storage.Contract.Delegate_last_cycle_before_deactivation.add
     ctxt
-    (Contract_repr.implicit_contract delegate)
+    delegate_contract
     last_active_cycle
   >>= fun ctxt ->
   if not inactive then return (ctxt, inactive)
   else
-    Storage.Contract.Inactive_delegate.remove
-      ctxt
-      (Contract_repr.implicit_contract delegate)
+    Storage.Contract.Inactive_delegate.remove ctxt delegate_contract
     >>= fun ctxt -> return (ctxt, inactive)
diff --git a/src/proto_alpha/lib_protocol/delegate_activation_storage.mli b/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
index d1647388834e..84c30d3a3d8c 100644
--- a/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
@@ -26,11 +26,13 @@
 val is_inactive :
   Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
-(** [grace_period ctxt delegate] is the cycle at which the delegate is
-    scheduled to become inactive. *)
-val grace_period :
+(** [last_cycle_before_deactivation ctxt delegate] is the cycle at which
+    the delegate is scheduled to become inactive. *)
+val last_cycle_before_deactivation :
   Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t tzresult Lwt.t
 
+(** [set_inactive context delegate] adds [delegate] to the set of inactive
+ * contracts. *)
 val set_inactive :
   Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/delegate_services.ml b/src/proto_alpha/lib_protocol/delegate_services.ml
index faf698116b1e..6363728961ce 100644
--- a/src/proto_alpha/lib_protocol/delegate_services.ml
+++ b/src/proto_alpha/lib_protocol/delegate_services.ml
@@ -362,7 +362,7 @@ let register () =
       Delegate.delegated_contracts ctxt pkh >>= fun delegated_contracts ->
       Delegate.delegated_balance ctxt pkh >>=? fun delegated_balance ->
       Delegate.deactivated ctxt pkh >>=? fun deactivated ->
-      Delegate.grace_period ctxt pkh >>=? fun grace_period ->
+      Delegate.last_cycle_before_deactivation ctxt pkh >>=? fun grace_period ->
       Vote.get_voting_power_free ctxt pkh >|=? fun voting_power ->
       {
         full_balance;
@@ -404,7 +404,7 @@ let register () =
       Delegate.deactivated ctxt pkh) ;
   register1 ~chunked:false S.grace_period (fun ctxt pkh () () ->
       Delegate.check_delegate ctxt pkh >>=? fun () ->
-      Delegate.grace_period ctxt pkh) ;
+      Delegate.last_cycle_before_deactivation ctxt pkh) ;
   register1 ~chunked:false S.voting_power (fun ctxt pkh () () ->
       Delegate.check_delegate ctxt pkh >>=? fun () ->
       Vote.get_voting_power_free ctxt pkh) ;
diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml
index cf0251d55ca9..bbf20434a633 100644
--- a/src/proto_alpha/lib_protocol/delegate_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_storage.ml
@@ -274,7 +274,9 @@ let update_activity ctxt last_cycle =
         ~init:(Ok (ctxt, []))
         ~f:(fun delegate () acc ->
           acc >>?= fun (ctxt, deactivated) ->
-          Delegate_activation_storage.grace_period ctxt delegate
+          Delegate_activation_storage.last_cycle_before_deactivation
+            ctxt
+            delegate
           >>=? fun cycle ->
           if Cycle_repr.(cycle <= last_cycle) then
             set_inactive ctxt delegate >|=? fun ctxt ->
diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml
index 7e4320074ba0..3762134bee23 100644
--- a/src/proto_alpha/lib_protocol/storage.ml
+++ b/src/proto_alpha/lib_protocol/storage.ml
@@ -223,9 +223,10 @@ module Contract = struct
         let name = ["inactive_delegate"]
       end)
 
-  module Delegate_desactivation =
+  module Delegate_last_cycle_before_deactivation =
     Indexed_context.Make_map
       (struct
+        (* FIXME? Change the key name to reflect the functor's name *)
         let name = ["delegate_desactivation"]
       end)
       (Cycle_repr)
diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli
index 10c02d74a567..0aff8ac4dbff 100644
--- a/src/proto_alpha/lib_protocol/storage.mli
+++ b/src/proto_alpha/lib_protocol/storage.mli
@@ -141,7 +141,7 @@ module Contract : sig
 
   (** The last cycle where the delegate is considered active; that is,
      at the next cycle it will be considered inactive. *)
-  module Delegate_desactivation :
+  module Delegate_last_cycle_before_deactivation :
     Indexed_data_storage
       with type key = Contract_repr.t
        and type value = Cycle_repr.t
-- 
GitLab


From 86d4a0cc1e65a19e54d0d5e8cbd237d6a5ae7c76 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 3 Feb 2022 10:59:14 +0100
Subject: [PATCH 26/37] Proto/Alpha: fix stake to consider in
 get_stakes_for_selected_index

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_734934910
---
 src/proto_alpha/lib_protocol/stake_storage.ml | 26 +++++++++++--------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml
index 3f1b9d464a44..4a840e8759f3 100644
--- a/src/proto_alpha/lib_protocol/stake_storage.ml
+++ b/src/proto_alpha/lib_protocol/stake_storage.ml
@@ -189,17 +189,21 @@ let get_stakes_for_selected_index ctxt index =
         match frozen_deposits_limit with
         | Some frozen_deposits_limit -> (
             try
-              let max_mutez = Tez_repr.of_mutez_exn Int64.max_int in
-              let frozen_stake_limit =
-                if Tez_repr.(frozen_deposits_limit > div_exn max_mutez 100) then
-                  max_mutez
-                else
-                  Tez_repr.(
-                    div_exn
-                      (mul_exn frozen_deposits_limit 100)
-                      frozen_deposits_percentage)
-              in
-              Tez_repr.min staking_balance frozen_stake_limit
+              let open Tez_repr in
+              let max_mutez = of_mutez_exn Int64.max_int in
+              if frozen_deposits_limit > div_exn max_mutez 100 then
+                let frozen_deposits_limit_by_10 =
+                  mul_exn frozen_deposits_limit 10
+                in
+                if frozen_deposits_limit_by_10 < staking_balance then
+                  frozen_deposits_limit_by_10
+                else staking_balance
+              else
+                min
+                  staking_balance
+                  (div_exn
+                     (mul_exn frozen_deposits_limit 100)
+                     frozen_deposits_percentage)
             with _ -> staking_balance)
         | None -> staking_balance
       in
-- 
GitLab


From 0b37b2bdb84f99f8591d6b02309de52c84c78de1 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Mon, 7 Feb 2022 15:13:15 +0100
Subject: [PATCH 27/37] Proto/Alpha: document validation_mode application
 constructors

https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_749446459
---
 src/proto_alpha/lib_protocol/main.mli | 18 +++++++++++++++---
 1 file changed, 15 insertions(+), 3 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/main.mli b/src/proto_alpha/lib_protocol/main.mli
index 4d5e88595217..d90b5c1675c8 100644
--- a/src/proto_alpha/lib_protocol/main.mli
+++ b/src/proto_alpha/lib_protocol/main.mli
@@ -27,7 +27,7 @@
 
     This module is the  entrypoint to the protocol for shells and other
     embedders.  This signature is an instance of
-    {{!Tezos_protocol_environment_sigs.V3.T.Updater.PROTOCOL} the
+    {{!Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL} the
     [Updater.PROTOCOL] signature} from the
     {{:https://tezos.gitlab.io/shell/the_big_picture.html#the-economic-protocol-environment-and-compiler}
     Protocol Environment}.
@@ -40,6 +40,8 @@
     {{:https://tezos.gitlab.io/shell/the_big_picture.html} this overview}.
  *)
 
+(** [validation_mode] permits to differenciate [!type:validation_state]
+    values. *)
 type validation_mode =
   | Application of {
       block_header : Alpha_context.Block_header.t;
@@ -49,6 +51,8 @@ type validation_mode =
       predecessor_round : Alpha_context.Round.t;
       predecessor_level : Alpha_context.Level.t;
     }
+      (** Full Validation of a block. See
+          {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_application}**)
   | Partial_application of {
       block_header : Alpha_context.Block_header.t;
       fitness : Alpha_context.Fitness.t;
@@ -57,14 +61,19 @@ type validation_mode =
       predecessor_level : Alpha_context.Level.t;
       predecessor_round : Alpha_context.Round.t;
     }
-  (* Mempool only *)
+      (** [Partial_application] is use in chain bootstrapping - not all checks
+         are done. Special case of [Application] to allow quick rejection of bad
+         blocks. See
+         {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_partial_application}
+       *)
   | Partial_construction of {
       predecessor : Block_hash.t;
       predecessor_fitness : Fitness.t;
       predecessor_level : Alpha_context.Level.t;
       predecessor_round : Alpha_context.Round.t;
     }
-  (* Baker only *)
+      (** Shell/mempool-only construction of a virtual block. See
+          {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_construction} *)
   | Full_construction of {
       predecessor : Block_hash.t;
       payload_producer : Alpha_context.public_key_hash;
@@ -75,6 +84,9 @@ type validation_mode =
       predecessor_level : Alpha_context.Level.t;
       predecessor_round : Alpha_context.Round.t;
     }
+      (** Baker-only block construction for baking in. See
+          {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_construction}
+       *)
 
 type validation_state = {
   mode : validation_mode;
-- 
GitLab


From 4c8dea503f38acfac1fe501eb358495f08c724b4 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 9 Feb 2022 15:06:46 +0100
Subject: [PATCH 28/37] Proto/Alpha: document delegate_participation_info

Partially in reaction to
https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_737607310
---
 src/proto_alpha/lib_protocol/delegate_storage.mli | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli
index ee784b4e9895..74066a6e6de2 100644
--- a/src/proto_alpha/lib_protocol/delegate_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_storage.mli
@@ -100,6 +100,11 @@ type participation_info = {
      required minimum, then the rewards are zero. (dynamic) *)
 }
 
+(** Only use this function for RPC: this is expensive.
+
+   [delegate_participation_info] and [!val:check_delegate] forms the
+   implementation of RPC call "/context/delegates/<pkh>/participation".
+ *)
 val delegate_participation_info :
   Raw_context.t ->
   Signature.Public_key_hash.t ->
-- 
GitLab


From 3a6d36c53082202efdd03fb2853f6c9ed20c9b0e Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 10 Feb 2022 10:23:53 +0100
Subject: [PATCH 29/37] Proto/Alpha: expose Contract_delegate_storage.unlink

Address comment
https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_735803883

remove was just an alias to unlink and the presence of both remove and delete
functions was confusing (though the difference documented). Exposing unlink
instead makes the difference in semantics clearer in the naming of the functions.
---
 src/proto_alpha/lib_protocol/contract_delegate_storage.ml | 2 --
 .../lib_protocol/contract_delegate_storage.mli            | 8 ++++----
 src/proto_alpha/lib_protocol/contract_storage.ml          | 2 +-
 3 files changed, 5 insertions(+), 7 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.ml b/src/proto_alpha/lib_protocol/contract_delegate_storage.ml
index 5a4a0ed4ae3d..006b00a31d2d 100644
--- a/src/proto_alpha/lib_protocol/contract_delegate_storage.ml
+++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.ml
@@ -71,8 +71,6 @@ let delete ctxt contract =
   unlink ctxt contract >>=? fun ctxt ->
   Storage.Contract.Delegate.remove ctxt contract >|= ok
 
-let remove ctxt contract = unlink ctxt contract
-
 let set ctxt contract delegate =
   unlink ctxt contract >>=? fun ctxt ->
   Storage.Contract.Delegate.add ctxt contract delegate >>= fun ctxt ->
diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli
index 1a62d96b6ade..85ba40fc46ff 100644
--- a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli
+++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli
@@ -45,17 +45,17 @@ val init :
   Signature.Public_key_hash.t ->
   Raw_context.t tzresult Lwt.t
 
-(** [remove ctxt contract] removes contract from the list of contracts that
+(** [unlink ctxt contract] removes [contract] from the list of contracts that
     delegated to [find ctxt contract], i.e. the output of [delegated_contracts].
     This function does not affect the value of the expression
     [find ctxt contract].
 
     This function is undefined if [contract] is not allocated. *)
-val remove : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
+val unlink : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
 
-(** [delete ctxt contract] behaves as [remove ctxt contract], but in addition
+(** [delete ctxt contract] behaves as [unlink ctxt contract], but in addition
     removes the association of the [contract] to its current delegate, leaving
-    the former with no delegate.
+    the former without delegate.
 
     This function is undefined if [contract] is not allocated. *)
 val delete : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/contract_storage.ml b/src/proto_alpha/lib_protocol/contract_storage.ml
index ae538e3b2dce..97d6c4d925b5 100644
--- a/src/proto_alpha/lib_protocol/contract_storage.ml
+++ b/src/proto_alpha/lib_protocol/contract_storage.ml
@@ -442,7 +442,7 @@ let delete c contract =
       (* For non implicit contract Big_map should be cleared *)
       failwith "Non implicit contracts cannot be removed"
   | Some _ ->
-      Contract_delegate_storage.remove c contract >>=? fun c ->
+      Contract_delegate_storage.unlink c contract >>=? fun c ->
       Storage.Contract.Spendable_balance.remove_existing c contract
       >>=? fun c ->
       Contract_manager_storage.remove_existing c contract >>=? fun c ->
-- 
GitLab


From 6da9e43c51b2973c17921a65f0a79c87a764736c Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 10 Feb 2022 10:30:57 +0100
Subject: [PATCH 30/37] Proto/Alpha: document
 Stake_storage.get_total_active_stake

Address comment  https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_729972756
---
 src/proto_alpha/lib_protocol/stake_storage.mli | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/stake_storage.mli b/src/proto_alpha/lib_protocol/stake_storage.mli
index 66984a63211e..08f67604db69 100644
--- a/src/proto_alpha/lib_protocol/stake_storage.mli
+++ b/src/proto_alpha/lib_protocol/stake_storage.mli
@@ -122,5 +122,7 @@ val find_selected_distribution :
    context. *)
 val prepare_stake_distribution : Raw_context.t -> Raw_context.t tzresult Lwt.t
 
+(** [get_total_active_stake ctxt cycle] retrieves the amount in Tez of the
+    active stake at [cycle] from [ctxt]. *)
 val get_total_active_stake :
   Raw_context.t -> Cycle_repr.t -> Tez_repr.t tzresult Lwt.t
-- 
GitLab


From 8ccf644302eaa05536dbf8c47d671ab19e0f961d Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 10 Feb 2022 10:41:15 +0100
Subject: [PATCH 31/37] Proto/Alpha: document Frozen_deposits_storage

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_729972748

Apply 1 suggestion(s) to 1 file(s)

Apply 1 suggestion(s) to 1 file(s)
---
 .../lib_protocol/frozen_deposits_storage.mli  | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/frozen_deposits_storage.mli b/src/proto_alpha/lib_protocol/frozen_deposits_storage.mli
index 9371d11f61d2..f61954b9c2a5 100644
--- a/src/proto_alpha/lib_protocol/frozen_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/frozen_deposits_storage.mli
@@ -23,27 +23,46 @@
 (*                                                                           *)
 (*****************************************************************************)
 
+(** Simple abstraction from low-level storage to handle frozen deposits *)
+
+(** [init ctxt delegate] returns a new context from [ctxt] where the frozen
+   deposits of the implicit contract represented by [delegate] have been initialized to
+   {!val:Tez_repr.zero}. *)
 val init :
   Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t
 
+(** [allocated ctxt contract] checks whether [contract] has frozen deposits in
+    [ctxt]. *)
 val allocated : Raw_context.t -> Contract_repr.t -> bool Lwt.t
 
+(** [get ctxt contract] retrieves the frozen deposits of [contract] in [ctxt]. *)
 val get : Raw_context.t -> Contract_repr.t -> Storage.deposits tzresult Lwt.t
 
+(** [find ctxt contract] retrieves the frozen deposits of [contract] in
+    [ctxt], if any. *)
 val find :
   Raw_context.t -> Contract_repr.t -> Storage.deposits option tzresult Lwt.t
 
+(** [credit_only_call_from_token ctxt delegate tez] returns a new context from
+   [ctxt] where the amount of frozen deposits for the implicit contract
+   represented by [delegate] increases by [tez]. *)
 val credit_only_call_from_token :
   Raw_context.t ->
   Signature.Public_key_hash.t ->
   Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
+(** [spend_only_call_from_token ctxt delegate tez] returns a new context from
+   [ctxt] where the amount of frozen deposits for the implicit contract
+   represented by [delegate] decreases by [tez].*)
 val spend_only_call_from_token :
   Raw_context.t ->
   Signature.Public_key_hash.t ->
   Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
+(** [update_initial_amount ctxt contract tez] returns a new context from [ctxt]
+   where the initial_amount of the frozen deposits for [contract] is set to
+   [tez]. *)
 val update_initial_amount :
   Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
-- 
GitLab


From f0b5fd1f1bad44d48b9c7b156a5c802983226880 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 10 Feb 2022 10:42:12 +0100
Subject: [PATCH 32/37] Proto/Alpha: use locally defined aliases in
 Frozen_deposits_storage

---
 src/proto_alpha/lib_protocol/frozen_deposits_storage.ml | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/frozen_deposits_storage.ml b/src/proto_alpha/lib_protocol/frozen_deposits_storage.ml
index 6aa3b65aff55..99a9fb136390 100644
--- a/src/proto_alpha/lib_protocol/frozen_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/frozen_deposits_storage.ml
@@ -37,8 +37,7 @@ let find = Storage.Contract.Frozen_deposits.find
 
 let update_balance ctxt delegate f amount =
   let delegate_contract = Contract_repr.implicit_contract delegate in
-  Storage.Contract.Frozen_deposits.get ctxt delegate_contract
-  >>=? fun frozen_deposits ->
+  get ctxt delegate_contract >>=? fun frozen_deposits ->
   f frozen_deposits.current_amount amount >>?= fun new_amount ->
   Storage.Contract.Frozen_deposits.update
     ctxt
@@ -52,8 +51,7 @@ let spend_only_call_from_token ctxt delegate amount =
   update_balance ctxt delegate Tez_repr.( -? ) amount
 
 let update_initial_amount ctxt delegate_contract deposits_cap =
-  Storage.Contract.Frozen_deposits.get ctxt delegate_contract
-  >>=? fun frozen_deposits ->
+  get ctxt delegate_contract >>=? fun frozen_deposits ->
   Storage.Contract.Frozen_deposits.update
     ctxt
     delegate_contract
-- 
GitLab


From 2c633e6fd37e84669974884545b202fe2849c518 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 10 Feb 2022 10:50:15 +0100
Subject: [PATCH 33/37] Proto/Alpha: document
 Delegate_activation_storage.set_active

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_729016460
---
 src/proto_alpha/lib_protocol/delegate_activation_storage.mli | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/delegate_activation_storage.mli b/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
index 84c30d3a3d8c..28f43fcf597a 100644
--- a/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_activation_storage.mli
@@ -36,6 +36,11 @@ val last_cycle_before_deactivation :
 val set_inactive :
   Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t Lwt.t
 
+(** [set_active ctxt delegate] returns a pair [(new_ctxt, is_inactive)] where:
+    - [new_ctxt] is a new context, updated from [ctxt], where the [delegate]'s
+    last active cycle has been updated
+    - [is_inactive] represents the state of [delegate], prior to the update.
+  *)
 val set_active :
   Raw_context.t ->
   Signature.Public_key_hash.t ->
-- 
GitLab


From 5b08bfe45661df28dd078f7615ae807afa066dd9 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Tue, 1 Feb 2022 15:42:03 +0100
Subject: [PATCH 34/37] Proto/Alpha: document why Storage.Last_snapshot fits in
 UInt16

Address comment https://gitlab.com/tezos/tezos/-/merge_requests/3738#note_727713495
---
 src/proto_alpha/lib_protocol/storage.ml  | 15 +++++++++++++++
 src/proto_alpha/lib_protocol/storage.mli |  1 +
 2 files changed, 16 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml
index 3762134bee23..711bb49af20f 100644
--- a/src/proto_alpha/lib_protocol/storage.ml
+++ b/src/proto_alpha/lib_protocol/storage.ml
@@ -1049,6 +1049,21 @@ module Stake = struct
 
   module Selected_distribution_for_cycle = Cycle.Selected_stake_distribution
 
+  (* This is an index that is set to 0 by calls to
+     Stake_storage.selected_new_distribution_at_cycle_end and incremented (by 1)
+     by calls to Stake_storage.snapshot.
+
+     Stake_storage.snapshot is called in relation with constant
+     [Constants_storage.blocks_per_stake_snapshot] here in
+     [Level_storage.may_snapshot_rolls].
+
+     That is, the increment is effectively done every 512 blocks or so, and
+     reset at the end of cycles. So it goes up to around 16 (= 8192/512) for the
+     number of blocks per cycle is 8192, then comes back to 0, so that a UInt16
+     is big enough.
+
+     The ratio above (blocks_per_cycle / blocks_per_stake_snapshot) is checked
+     in {!val:Constants_repr.check_constants} to fit in a UInt16. *)
   module Last_snapshot =
     Make_single_data_storage (Registered) (Raw_context)
       (struct
diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli
index 0aff8ac4dbff..d768ec78e1c3 100644
--- a/src/proto_alpha/lib_protocol/storage.mli
+++ b/src/proto_alpha/lib_protocol/storage.mli
@@ -351,6 +351,7 @@ module Stake : sig
        and type snapshot = int
        and type t := Raw_context.t
 
+  (** TODO: document *)
   module Last_snapshot :
     Single_data_storage with type value = int and type t := Raw_context.t
 
-- 
GitLab


From dfaed609672ea4bee25fe05687d767276206f4f6 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 10 Feb 2022 11:14:55 +0100
Subject: [PATCH 35/37] Proto/Alpha: check blocks_per_cycle per
 blocks_per_stake_snapshot

Checks that it is compatible with Storage.Last_snapshot
---
 src/proto_alpha/lib_protocol/constants_repr.ml | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/constants_repr.ml b/src/proto_alpha/lib_protocol/constants_repr.ml
index bc9112cff620..52d15980645e 100644
--- a/src/proto_alpha/lib_protocol/constants_repr.ml
+++ b/src/proto_alpha/lib_protocol/constants_repr.ml
@@ -456,6 +456,17 @@ let check_constants constants =
      Compare.Int32.(remainder = 0l))
     (Invalid_protocol_constants
        "blocks_per_voting_period should be a multiple of blocks_per_cycle.")
+  >>? fun () ->
+  error_unless
+    (let snapshot_frequence =
+       Int32.div constants.blocks_per_cycle constants.blocks_per_stake_snapshot
+     in
+     Compare.Int32.(
+       snapshot_frequence > Int32.zero
+       && snapshot_frequence < Int32.of_int (1 lsl 16)))
+    (Invalid_protocol_constants
+       "The ratio blocks_per_cycle per blocks_per_stake_snapshot should be \
+        between 1 and 65535")
   >>? fun () -> Result.return_unit
 
 module Generated = struct
-- 
GitLab


From 62042b063c400ba25f1ad8d2ce94de6e4aed1263 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Thu, 10 Feb 2022 21:14:26 +0100
Subject: [PATCH 36/37] Proto/Alpha: document Storage.Stake.Last_snapshot

---
 src/proto_alpha/lib_protocol/storage.mli | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli
index d768ec78e1c3..a489e8bf40f8 100644
--- a/src/proto_alpha/lib_protocol/storage.mli
+++ b/src/proto_alpha/lib_protocol/storage.mli
@@ -351,7 +351,7 @@ module Stake : sig
        and type snapshot = int
        and type t := Raw_context.t
 
-  (** TODO: document *)
+  (** Counter of stake storage snapshots taken since last cycle *)
   module Last_snapshot :
     Single_data_storage with type value = int and type t := Raw_context.t
 
-- 
GitLab


From 7e56706823e98a5eb7e3eb2140b20b5a79e98165 Mon Sep 17 00:00:00 2001
From: Richard Bonichon <richard.bonichon@nomadic-labs.com>
Date: Wed, 16 Feb 2022 11:12:34 +0100
Subject: [PATCH 37/37] Proto/Alpha: document over/under-flow situation in
 Sampler

---
 src/proto_alpha/lib_protocol/sampler.ml  | 16 ++++++++++++++--
 src/proto_alpha/lib_protocol/sampler.mli | 15 ++++++++++++++-
 2 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/sampler.ml b/src/proto_alpha/lib_protocol/sampler.ml
index 341de9b0be63..b390b6dcf54b 100644
--- a/src/proto_alpha/lib_protocol/sampler.ml
+++ b/src/proto_alpha/lib_protocol/sampler.ml
@@ -78,8 +78,8 @@ module Make (Mass : SMass) : S with type mass = Mass.t = struct
     match (small, large) with
     | ([], _) -> List.iter (fun (_, i) -> FallbackArray.set p i total) large
     | (_, []) ->
-        (* This can only happen because of numerical inaccuracies when using
-           eg [Mass.t = float] *)
+        (* This can only happen because of numerical inaccuracies e.g. when using
+           [Mass.t = float] *)
         List.iter (fun (_, i) -> FallbackArray.set p i total) small
     | ((qi, i) :: small', (qj, j) :: large') ->
         FallbackArray.set p i qi ;
@@ -204,4 +204,16 @@ module Mass : SMass with type t = int64 = struct
   let ( < ) = Compare.Int64.( < )
 end
 
+(* This is currently safe to do that since since at this point the values for
+   [total] is 8 * 10^8 * 10^6 and the delgates [n] = 400.
+
+   Therefore [let q = Mass.mul p n ...] in [create] does not overflow since p <
+   total.
+
+   Assuming the total active stake does not increase too much, which is the case
+   at the current 5% inflation rate, this implementation can thus support around
+   10000 delegates without overflows.
+
+   If/when this happens, the implementation should be revisited.
+ *)
 include Make (Mass)
diff --git a/src/proto_alpha/lib_protocol/sampler.mli b/src/proto_alpha/lib_protocol/sampler.mli
index ea27341834f7..00cf20a7768c 100644
--- a/src/proto_alpha/lib_protocol/sampler.mli
+++ b/src/proto_alpha/lib_protocol/sampler.mli
@@ -66,7 +66,14 @@ end
 (**/**)
 
 module Internal_for_tests : sig
-  (** [Mass] is the module type describing the measure associated to points. *)
+  (** [Mass] is the module type describing the measure associated to points.
+
+      The current signature reflects the need for efficiency for the arithmetic
+      operators. As such, they do not error or add dynamic checks for
+      over-/under-flow.
+
+      One must make sure that the implementation of its arithmetic operators
+      cannot over-/under-flow under the current usage.  *)
   module type SMass = sig
     (** [t] is the type describing the measure associated to points. *)
     type t
@@ -95,4 +102,10 @@ module Internal_for_tests : sig
   module Make : functor (Mass : SMass) -> S with type mass = Mass.t
 end
 
+(** Sampler based on int64. In the current state of the protocol, this should
+    not ever over-/under-flow -- see the thought process in the .ml file.
+
+   However, should the total stake increase a lot or the number of delegates get
+   close to 10k, this might not be true anymore and this module should be
+   revisited.  *)
 include S with type mass = Int64.t
-- 
GitLab