From babf1c398679e0065b9d3b02b00dbabd31f09263 Mon Sep 17 00:00:00 2001
From: Albin Coquereau <albin.coquereau@nomadic-labs.com>
Date: Mon, 2 Sep 2024 11:20:28 +0200
Subject: [PATCH 1/4] alpha/baker: move round_of_shell_header function to
 actions

---
 src/proto_alpha/lib_delegate/baking_actions.ml | 10 +++++++++-
 src/proto_alpha/lib_delegate/baking_state.ml   |  8 --------
 src/proto_alpha/lib_delegate/baking_state.mli  |  2 --
 3 files changed, 9 insertions(+), 11 deletions(-)

diff --git a/src/proto_alpha/lib_delegate/baking_actions.ml b/src/proto_alpha/lib_delegate/baking_actions.ml
index ecb2dc9a5dbe..92a1ff06e2c5 100644
--- a/src/proto_alpha/lib_delegate/baking_actions.ml
+++ b/src/proto_alpha/lib_delegate/baking_actions.ml
@@ -178,6 +178,14 @@ let generate_seed_nonce_hash config delegate level =
     return_some seed_nonce
   else return_none
 
+let round_of_shell_header shell_header =
+  let open Result_syntax in
+  let* fitness =
+    Environment.wrap_tzresult
+    @@ Fitness.from_raw shell_header.Tezos_base.Block_header.fitness
+  in
+  return (Fitness.round fitness)
+
 let sign_block_header global_state proposer unsigned_block_header =
   let open Lwt_result_syntax in
   let cctxt = global_state.cctxt in
@@ -192,7 +200,7 @@ let sign_block_header global_state proposer unsigned_block_header =
       (shell, contents)
   in
   let level = shell.level in
-  let*? round = Baking_state.round_of_shell_header shell in
+  let*? round = round_of_shell_header shell in
   let open Baking_highwatermarks in
   let* result =
     cctxt#with_lock (fun () ->
diff --git a/src/proto_alpha/lib_delegate/baking_state.ml b/src/proto_alpha/lib_delegate/baking_state.ml
index abf0ef3d64a8..acac20805df4 100644
--- a/src/proto_alpha/lib_delegate/baking_state.ml
+++ b/src/proto_alpha/lib_delegate/baking_state.ml
@@ -186,14 +186,6 @@ let block_info_encoding =
        (req "quorum" (list (dynamic_size Operation.encoding)))
        (req "payload" Operation_pool.payload_encoding))
 
-let round_of_shell_header shell_header =
-  let open Result_syntax in
-  let* fitness =
-    Environment.wrap_tzresult
-    @@ Fitness.from_raw shell_header.Tezos_base.Block_header.fitness
-  in
-  return (Fitness.round fitness)
-
 module SlotMap : Map.S with type key = Slot.t = Map.Make (Slot)
 
 type delegate_slot = {
diff --git a/src/proto_alpha/lib_delegate/baking_state.mli b/src/proto_alpha/lib_delegate/baking_state.mli
index 689b85c0b009..a99d193a633d 100644
--- a/src/proto_alpha/lib_delegate/baking_state.mli
+++ b/src/proto_alpha/lib_delegate/baking_state.mli
@@ -98,8 +98,6 @@ type block_to_bake = {
 
 val block_info_encoding : block_info Data_encoding.t
 
-val round_of_shell_header : Block_header.shell_header -> Round.t tzresult
-
 module SlotMap : Map.S with type key = Slot.t
 
 (** A delegate slot consists of the delegate's consensus key, its public key
-- 
GitLab


From 90c6b60032ed356048401fcf8d3d6309a6d77532 Mon Sep 17 00:00:00 2001
From: Albin Coquereau <albin.coquereau@nomadic-labs.com>
Date: Mon, 2 Sep 2024 11:42:40 +0200
Subject: [PATCH 2/4] alpha/baker: remove trailing whitespace in baking_nonces

---
 src/proto_alpha/lib_delegate/baking_nonces.ml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/proto_alpha/lib_delegate/baking_nonces.ml b/src/proto_alpha/lib_delegate/baking_nonces.ml
index 2cd8adf11b34..2cf75bd8b1df 100644
--- a/src/proto_alpha/lib_delegate/baking_nonces.ml
+++ b/src/proto_alpha/lib_delegate/baking_nonces.ml
@@ -305,9 +305,9 @@ let try_migrate_legacy_nonces state =
   | Error _ -> return_unit
 
 (** [partition_unrevealed_nonces state nonces current_cycle current_level] partitions
-    nonces into 2 groups: 
+    nonces into 2 groups:
      - nonces that need to be re/revealed
-     - nonces that are live 
+     - nonces that are live
     Nonces that are not relevant can be dropped.
 *)
 let partition_unrevealed_nonces {cctxt; chain; _} nonces
@@ -424,7 +424,7 @@ let register_nonce (cctxt : #Protocol_client_context.full) ~chain_id block_hash
   in
   return_unit
 
-(** [inject_seed_nonce_revelation cctxt ~chain ~block ~branch nonces] forges one 
+(** [inject_seed_nonce_revelation cctxt ~chain ~block ~branch nonces] forges one
     [Seed_nonce_revelation] operation per each nonce to be revealed, together with
     a signature and then injects these operations. *)
 let inject_seed_nonce_revelation (cctxt : #Protocol_client_context.full) ~chain
@@ -459,7 +459,7 @@ let inject_seed_nonce_revelation (cctxt : #Protocol_client_context.full) ~chain
           return_unit)
         nonces
 
-(** [reveal_potential_nonces state new_proposal] updates the internal [state] 
+(** [reveal_potential_nonces state new_proposal] updates the internal [state]
     of the worker each time a proposal with a new predecessor is received; this means
     revealing the necessary nonces. *)
 let reveal_potential_nonces state new_proposal =
-- 
GitLab


From 30ae3d70a522b7ce5ee7fed9aab043d68f7754f4 Mon Sep 17 00:00:00 2001
From: Albin Coquereau <albin.coquereau@nomadic-labs.com>
Date: Mon, 2 Sep 2024 11:43:02 +0200
Subject: [PATCH 3/4] alpha/baker: reorganize baking state mli file

---
 .../lib_delegate/baking_actions.ml            |   5 +-
 src/proto_alpha/lib_delegate/baking_nonces.ml |   2 +-
 src/proto_alpha/lib_delegate/baking_state.mli | 359 ++++++++++--------
 src/proto_alpha/lib_delegate/forge_worker.ml  |   2 +-
 .../lib_delegate/state_transitions.ml         |   3 +-
 5 files changed, 198 insertions(+), 173 deletions(-)

diff --git a/src/proto_alpha/lib_delegate/baking_actions.ml b/src/proto_alpha/lib_delegate/baking_actions.ml
index 92a1ff06e2c5..0c8565da6e3e 100644
--- a/src/proto_alpha/lib_delegate/baking_actions.ml
+++ b/src/proto_alpha/lib_delegate/baking_actions.ml
@@ -569,7 +569,8 @@ let authorized_consensus_votes global_state
         (* Record all consensus votes new highwatermarks as one batch *)
         let delegates =
           List.map
-            (fun {delegate = ck, _; _} -> ck.public_key_hash)
+            (fun ({delegate = ck, _; _} : unsigned_consensus_vote) ->
+              ck.public_key_hash)
             authorized_votes
         in
         let record_all_consensus_vote =
@@ -862,7 +863,7 @@ let start_waiting_for_attestation_quorum state =
     ~get_slot_voting_power
     candidate
 
-let compute_round proposal round_durations =
+let compute_round (proposal : proposal) round_durations =
   let open Protocol in
   let open Baking_state in
   let timestamp = Time.System.now () |> Time.System.to_protocol in
diff --git a/src/proto_alpha/lib_delegate/baking_nonces.ml b/src/proto_alpha/lib_delegate/baking_nonces.ml
index 2cf75bd8b1df..b1309f6cfe70 100644
--- a/src/proto_alpha/lib_delegate/baking_nonces.ml
+++ b/src/proto_alpha/lib_delegate/baking_nonces.ml
@@ -462,7 +462,7 @@ let inject_seed_nonce_revelation (cctxt : #Protocol_client_context.full) ~chain
 (** [reveal_potential_nonces state new_proposal] updates the internal [state]
     of the worker each time a proposal with a new predecessor is received; this means
     revealing the necessary nonces. *)
-let reveal_potential_nonces state new_proposal =
+let reveal_potential_nonces state (new_proposal : Baking_state.proposal) =
   let open Lwt_result_syntax in
   let {
     cctxt;
diff --git a/src/proto_alpha/lib_delegate/baking_state.mli b/src/proto_alpha/lib_delegate/baking_state.mli
index a99d193a633d..0861aa8d3bb1 100644
--- a/src/proto_alpha/lib_delegate/baking_state.mli
+++ b/src/proto_alpha/lib_delegate/baking_state.mli
@@ -26,6 +26,8 @@
 open Protocol
 open Alpha_context
 
+(** {2 Consensus key type and functions} *)
+
 type consensus_key = {
   alias : string option;
   public_key : Signature.public_key;
@@ -45,60 +47,7 @@ val consensus_key_and_delegate_encoding :
 val pp_consensus_key_and_delegate :
   Format.formatter -> consensus_key_and_delegate -> unit
 
-(** The validation mode specifies whether the baker (filters and) validates
-    mempool operations via an RPC to the node, or if it does so "locally", by
-    using the context. *)
-type validation_mode = Node | Local of Abstract_context_index.t
-
-type prequorum = {
-  level : int32;
-  round : Round.t;
-  block_payload_hash : Block_payload_hash.t;
-  preattestations : Kind.preattestation operation list;
-}
-
-type block_info = {
-  hash : Block_hash.t;
-  shell : Block_header.shell_header;
-  payload_hash : Block_payload_hash.t;
-  payload_round : Round.t;
-  round : Round.t;
-  prequorum : prequorum option;
-  quorum : Kind.attestation operation list;
-  payload : Operation_pool.payload;
-}
-
-type cache = {
-  known_timestamps : Timestamp.time Baking_cache.Timestamp_of_round_cache.t;
-  round_timestamps :
-    (Timestamp.time * Round.t * consensus_key_and_delegate)
-    Baking_cache.Round_timestamp_interval_cache.t;
-}
-
-type block_kind =
-  | Fresh of Operation_pool.pool
-  | Reproposal of {
-      consensus_operations : packed_operation list;
-      payload_hash : Block_payload_hash.t;
-      payload_round : Round.t;
-      payload : Operation_pool.payload;
-    }
-
-type block_to_bake = {
-  predecessor : block_info;
-  round : Round.t;
-  delegate : consensus_key_and_delegate;
-  kind : block_kind;
-  force_apply : bool;
-      (** if true, while baking the block, try and apply the block and its
-          operations instead of only validating them. this can be permanently
-          set using the [--force-apply] flag (see [force_apply_switch_arg] in
-          [baking_commands.ml]). *)
-}
-
-val block_info_encoding : block_info Data_encoding.t
-
-module SlotMap : Map.S with type key = Slot.t
+(** {2 Delegates slots type and functions} *)
 
 (** A delegate slot consists of the delegate's consensus key, its public key
     hash, its first slot, and its attesting power at some level. *)
@@ -108,6 +57,8 @@ type delegate_slot = {
   attesting_power : int;
 }
 
+val pp_delegate_slot : Format.formatter -> delegate_slot -> unit
+
 module Delegate_slots : sig
   (** Information regarding the slot distribution at some level. *)
   type t
@@ -128,46 +79,16 @@ end
 
 type delegate_slots = Delegate_slots.t
 
-type proposal = {block : block_info; predecessor : block_info}
-
-val proposal_encoding : proposal Data_encoding.t
-
-(** Identify the first block of the protocol, ie. the block that
-    activates the current protocol.
-
-    This block should be baked by the baker of the previous protocol
-    (that's why this same block is also referred to as the last block
-    of the previous protocol). It is always considered final and
-    therefore is not attested.*)
-val is_first_block_in_protocol : proposal -> bool
-
-type locked_round = {payload_hash : Block_payload_hash.t; round : Round.t}
-
-val locked_round_encoding : locked_round Data_encoding.t
-
-type attestable_payload = {proposal : proposal; prequorum : prequorum}
-
-val attestable_payload_encoding : attestable_payload Data_encoding.t
-
-type elected_block = {
-  proposal : proposal;
-  attestation_qc : Kind.attestation operation list;
-}
+val pp_delegate_slots : Format.formatter -> delegate_slots -> unit
 
-type prepared_block = {
-  signed_block_header : block_header;
-  round : Round.t;
-  delegate : consensus_key_and_delegate;
-  operations : Tezos_base.Operation.t list list;
-  baking_votes : Per_block_votes_repr.per_block_votes;
-}
+(** {2 Consensus operations types functions} *)
 
 type consensus_vote_kind = Attestation | Preattestation
 
-val pp_consensus_vote_kind : Format.formatter -> consensus_vote_kind -> unit
-
 val consensus_vote_kind_encoding : consensus_vote_kind Data_encoding.t
 
+val pp_consensus_vote_kind : Format.formatter -> consensus_vote_kind -> unit
+
 type unsigned_consensus_vote = {
   vote_kind : consensus_vote_kind;
   vote_consensus_content : consensus_content;
@@ -212,8 +133,6 @@ type signed_consensus_vote_batch = private {
   signed_consensus_votes : signed_consensus_vote list;
 }
 
-type error += Mismatch_signed_consensus_vote_in_batch
-
 val make_signed_consensus_vote_batch :
   consensus_vote_kind ->
   batch_content ->
@@ -224,6 +143,74 @@ val make_signed_consensus_vote_batch :
 val make_singleton_consensus_vote_batch :
   signed_consensus_vote -> signed_consensus_vote_batch
 
+(** {2 Block info types and functions}  *)
+
+type prequorum = {
+  level : int32;
+  round : Round.t;
+  block_payload_hash : Block_payload_hash.t;
+  preattestations : Kind.preattestation operation list;
+}
+
+type block_info = {
+  hash : Block_hash.t;
+  shell : Block_header.shell_header;
+  payload_hash : Block_payload_hash.t;
+  payload_round : Round.t;
+  round : Round.t;
+  prequorum : prequorum option;
+  quorum : Kind.attestation operation list;
+  payload : Operation_pool.payload;
+}
+
+val block_info_encoding : block_info Data_encoding.t
+
+val pp_block_info : Format.formatter -> block_info -> unit
+
+(** {2 Proposal type and functions}  *)
+
+type proposal = {block : block_info; predecessor : block_info}
+
+val proposal_encoding : proposal Data_encoding.t
+
+val pp_proposal : Format.formatter -> proposal -> unit
+
+(** {2 Elected block type and functions} *)
+
+type elected_block = {
+  proposal : proposal;
+  attestation_qc : Kind.attestation operation list;
+}
+
+val pp_elected_block : Format.formatter -> elected_block -> unit
+
+(** Identify the first block of the protocol, ie. the block that
+    activates the current protocol.
+
+    This block should be baked by the baker of the previous protocol
+    (that's why this same block is also referred to as the last block
+    of the previous protocol). It is always considered final and
+    therefore is not attested.*)
+val is_first_block_in_protocol : proposal -> bool
+
+(** {2 Locked_round type and functions} *)
+
+type locked_round = {payload_hash : Block_payload_hash.t; round : Round.t}
+
+val locked_round_encoding : locked_round Data_encoding.t
+
+val pp_locked_round : Format.formatter -> locked_round -> unit
+
+(** {2 Attestable_payload type and functions} *)
+
+type attestable_payload = {proposal : proposal; prequorum : prequorum}
+
+val attestable_payload_encoding : attestable_payload Data_encoding.t
+
+val pp_attestable_payload : Format.formatter -> attestable_payload -> unit
+
+(** {2 Level_state type and functions} *)
+
 type level_state = {
   current_level : int32;
   latest_proposal : proposal;
@@ -236,6 +223,10 @@ type level_state = {
   next_level_proposed_round : Round.t option;
 }
 
+val pp_level_state : Format.formatter -> level_state -> unit
+
+(** {2 Round_state type and functions} *)
+
 type phase =
   | Idle
   | Awaiting_preattestations
@@ -244,6 +235,8 @@ type phase =
 
 val phase_encoding : phase Data_encoding.t
 
+val pp_phase : Format.formatter -> phase -> unit
+
 type round_state = {
   current_round : Round.t;
   current_phase : phase;
@@ -252,12 +245,30 @@ type round_state = {
   awaiting_unlocking_pqc : bool;
 }
 
-(** [forge_event] type used to return the result of a task completion
-    in the forge worker. *)
-type forge_event =
-  | Block_ready of prepared_block
-  | Preattestation_ready of signed_consensus_vote
-  | Attestation_ready of signed_consensus_vote
+val pp_round_state : Format.formatter -> round_state -> unit
+
+(** {2 Forge types and functions} *)
+
+type block_kind =
+  | Fresh of Operation_pool.pool
+  | Reproposal of {
+      consensus_operations : packed_operation list;
+      payload_hash : Block_payload_hash.t;
+      payload_round : Round.t;
+      payload : Operation_pool.payload;
+    }
+
+type block_to_bake = {
+  predecessor : block_info;
+  round : Round.t;
+  delegate : consensus_key_and_delegate;
+  kind : block_kind;
+  force_apply : bool;
+      (** if true, while baking the block, try and apply the block and its
+          operations instead of only validating them. this can be permanently
+          set using the [--force-apply] flag (see [force_apply_switch_arg] in
+          [baking_commands.ml]). *)
+}
 
 (** [forge_request] type used to push a concurrent forging task in the
     forge worker. *)
@@ -270,6 +281,27 @@ type forge_request =
       unsigned_attestations : unsigned_consensus_vote_batch;
     }
 
+type prepared_block = {
+  signed_block_header : block_header;
+  round : Round.t;
+  delegate : consensus_key_and_delegate;
+  operations : Tezos_base.Operation.t list list;
+  baking_votes : Per_block_votes_repr.per_block_votes;
+}
+
+val pp_prepared_block : Format.formatter -> prepared_block -> unit
+
+(** [forge_event] type used to return the result of a task completion
+    in the forge worker. *)
+type forge_event =
+  | Block_ready of prepared_block
+  | Preattestation_ready of signed_consensus_vote
+  | Attestation_ready of signed_consensus_vote
+
+val forge_event_encoding : forge_event Data_encoding.t
+
+val pp_forge_event : Format.formatter -> forge_event -> unit
+
 (** [forge_worker_hooks] type that allows interactions with the forge
     worker. Hooks are needed in order to break a circular dependency. *)
 type forge_worker_hooks = {
@@ -278,6 +310,24 @@ type forge_worker_hooks = {
   cancel_all_pending_tasks : unit -> unit;
 }
 
+(** {2 Global_state types and functions} *)
+
+(** The validation mode specifies whether the baker (filters and) validates
+    mempool operations via an RPC to the node, or if it does so "locally", by
+    using the context. *)
+type validation_mode = Node | Local of Abstract_context_index.t
+
+val pp_validation_mode : Format.formatter -> validation_mode -> unit
+
+type cache = {
+  known_timestamps : Timestamp.time Baking_cache.Timestamp_of_round_cache.t;
+  round_timestamps :
+    (Timestamp.time * Round.t * consensus_key_and_delegate)
+    Baking_cache.Round_timestamp_interval_cache.t;
+}
+
+val create_cache : unit -> cache
+
 type global_state = {
   cctxt : Protocol_client_context.full;
   chain_id : Chain_id.t;
@@ -292,6 +342,8 @@ type global_state = {
   dal_node_rpc_ctxt : Tezos_rpc.Context.generic option;
 }
 
+val pp_global_state : Format.formatter -> global_state -> unit
+
 type state = {
   global_state : global_state;
   level_state : level_state;
@@ -300,54 +352,31 @@ type state = {
 
 type t = state
 
-val update_current_phase : t -> phase -> t
-
-(** Returns, among our *own* delegates, the delegate (and its attesting slot)
-    that has a proposer slot at the given round and the current or next level,
-    if any. *)
-val round_proposer :
-  state -> level:[`Current | `Next] -> Round.t -> delegate_slot option
-
-type timeout_kind =
-  | End_of_round of {ending_round : Round.t}
-  | Time_to_prepare_next_level_block of {at_round : Round.t}
-
-val timeout_kind_encoding : timeout_kind Data_encoding.t
-
-type event =
-  | New_valid_proposal of proposal
-  | New_head_proposal of proposal
-  | Prequorum_reached of
-      Operation_worker.candidate * Kind.preattestation operation list
-  | Quorum_reached of
-      Operation_worker.candidate * Kind.attestation operation list
-  | New_forge_event of forge_event
-  | Timeout of timeout_kind
-
-val event_encoding : event Data_encoding.t
-
-val forge_event_encoding : forge_event Data_encoding.t
-
-type state_data = {
-  level_data : int32;
-  locked_round_data : locked_round option;
-  attestable_payload_data : attestable_payload option;
-}
+val pp : Format.formatter -> t -> unit
 
-val state_data_encoding : state_data Data_encoding.t
+val update_current_phase : t -> phase -> t
 
 val record_state : t -> unit tzresult Lwt.t
 
 val may_record_new_state :
   previous_state:t -> new_state:t -> unit tzresult Lwt.t
 
-val load_attestable_data :
-  Protocol_client_context.full ->
-  [`State] Baking_files.location ->
-  state_data option tzresult Lwt.t
+(** Returns, among our *own* delegates, the delegate (and its attesting slot)
+    that has a proposer slot at the given round and the current or next level,
+    if any. *)
+val round_proposer :
+  state -> level:[`Current | `Next] -> Round.t -> delegate_slot option
 
 val may_load_attestable_data : t -> t tzresult Lwt.t
 
+(** Memoization wrapper for [Round.timestamp_of_round]. *)
+val timestamp_of_round :
+  state ->
+  predecessor_timestamp:Time.Protocol.t ->
+  predecessor_round:Round.t ->
+  round:Round.t ->
+  Time.Protocol.t tzresult
+
 (** @param block default to [`Head 0]*)
 val compute_delegate_slots :
   Protocol_client_context.full ->
@@ -357,54 +386,48 @@ val compute_delegate_slots :
   consensus_key list ->
   delegate_slots tzresult Lwt.t
 
-val create_cache : unit -> cache
-
-(** Memoization wrapper for [Round.timestamp_of_round]. *)
-val timestamp_of_round :
-  state ->
-  predecessor_timestamp:Time.Protocol.t ->
-  predecessor_round:Round.t ->
-  round:Round.t ->
-  Time.Protocol.t tzresult
-
 (** From the current [state], the function returns an optional
     association pair, which consists of the next round timestamp and its
     round. *)
 val compute_next_round_time : state -> (Time.Protocol.t * Round.t) option
 
-val pp_validation_mode : Format.formatter -> validation_mode -> unit
-
-val pp_global_state : Format.formatter -> global_state -> unit
+(** {2 Timeout type and functions} *)
 
-val pp_option :
-  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
-
-val pp_block_info : Format.formatter -> block_info -> unit
-
-val pp_proposal : Format.formatter -> proposal -> unit
-
-val pp_locked_round : Format.formatter -> locked_round -> unit
-
-val pp_attestable_payload : Format.formatter -> attestable_payload -> unit
+type timeout_kind =
+  | End_of_round of {ending_round : Round.t}
+  | Time_to_prepare_next_level_block of {at_round : Round.t}
 
-val pp_elected_block : Format.formatter -> elected_block -> unit
+val timeout_kind_encoding : timeout_kind Data_encoding.t
 
-val pp_delegate_slot : Format.formatter -> delegate_slot -> unit
+val pp_timeout_kind : Format.formatter -> timeout_kind -> unit
 
-val pp_delegate_slots : Format.formatter -> delegate_slots -> unit
+(** {2 State_data type and functions} *)
 
-val pp_prepared_block : Format.formatter -> prepared_block -> unit
+type state_data = {
+  level_data : int32;
+  locked_round_data : locked_round option;
+  attestable_payload_data : attestable_payload option;
+}
 
-val pp_level_state : Format.formatter -> level_state -> unit
+val state_data_encoding : state_data Data_encoding.t
 
-val pp_phase : Format.formatter -> phase -> unit
+val load_attestable_data :
+  Protocol_client_context.full ->
+  [`State] Baking_files.location ->
+  state_data option tzresult Lwt.t
 
-val pp_round_state : Format.formatter -> round_state -> unit
+(** {2 Event type and functions} *)
 
-val pp : Format.formatter -> t -> unit
+type event =
+  | New_valid_proposal of proposal
+  | New_head_proposal of proposal
+  | Prequorum_reached of
+      Operation_worker.candidate * Kind.preattestation operation list
+  | Quorum_reached of
+      Operation_worker.candidate * Kind.attestation operation list
+  | New_forge_event of forge_event
+  | Timeout of timeout_kind
 
-val pp_timeout_kind : Format.formatter -> timeout_kind -> unit
+val event_encoding : event Data_encoding.t
 
 val pp_event : Format.formatter -> event -> unit
-
-val pp_forge_event : Format.formatter -> forge_event -> unit
diff --git a/src/proto_alpha/lib_delegate/forge_worker.ml b/src/proto_alpha/lib_delegate/forge_worker.ml
index 1fbdcedfb477..09f0374e3157 100644
--- a/src/proto_alpha/lib_delegate/forge_worker.ml
+++ b/src/proto_alpha/lib_delegate/forge_worker.ml
@@ -177,7 +177,7 @@ let handle_forge_consensus_votes worker baking_state
           unsigned_consensus_votes)
   in
   List.iter
-    (fun unsigned_preattestation ->
+    (fun (unsigned_preattestation : unsigned_consensus_vote) ->
       let queue = get_or_create_queue worker unsigned_preattestation.delegate in
       Delegate_signing_queue.push_task
         ~on_error:(fun _err -> Lwt.return_unit)
diff --git a/src/proto_alpha/lib_delegate/state_transitions.ml b/src/proto_alpha/lib_delegate/state_transitions.ml
index 9cc23c9604de..1b08f8c85752 100644
--- a/src/proto_alpha/lib_delegate/state_transitions.ml
+++ b/src/proto_alpha/lib_delegate/state_transitions.ml
@@ -77,7 +77,8 @@ let is_acceptable_proposal_for_current_level state
    finalized) instead of the predecessor. This is done to avoid having consensus
    operation branched on block that are not part of the canonical chain
    anymore. *)
-let get_branch_from_proposal proposal = proposal.predecessor.shell.predecessor
+let get_branch_from_proposal (proposal : proposal) =
+  proposal.predecessor.shell.predecessor
 
 let make_consensus_vote_batch state proposal kind =
   let level =
-- 
GitLab


From 23ad281e6c0ebf91ba7016484e47ef859cbdbffe Mon Sep 17 00:00:00 2001
From: Albin Coquereau <albin.coquereau@nomadic-labs.com>
Date: Mon, 2 Sep 2024 16:49:37 +0200
Subject: [PATCH 4/4] alpha/baker: add documentation for baking_state file

---
 src/proto_alpha/lib_delegate/baking_state.mli | 175 ++++++++++++++----
 1 file changed, 136 insertions(+), 39 deletions(-)

diff --git a/src/proto_alpha/lib_delegate/baking_state.mli b/src/proto_alpha/lib_delegate/baking_state.mli
index 0861aa8d3bb1..6eb41e0402c3 100644
--- a/src/proto_alpha/lib_delegate/baking_state.mli
+++ b/src/proto_alpha/lib_delegate/baking_state.mli
@@ -64,7 +64,7 @@ module Delegate_slots : sig
   type t
 
   (** Returns the list of our own delegates that have at least a slot. There are
-     no duplicates, the associated slot is the first one. *)
+      no duplicates, the associated slot is the first one. *)
   val own_delegates : t -> delegate_slot list
 
   (** Returns, among our *own* delegates, the delegate (together with its
@@ -81,6 +81,17 @@ type delegate_slots = Delegate_slots.t
 
 val pp_delegate_slots : Format.formatter -> delegate_slots -> unit
 
+(** [compute_delegate_slots cctxt ?block ~level ~chain delegates] computes the
+    delegate slots of the given [delegates] for the [level]
+    @param block default to [`Head 0]*)
+val compute_delegate_slots :
+  Protocol_client_context.full ->
+  ?block:Block_services.block ->
+  level:int32 ->
+  chain:Shell_services.chain ->
+  consensus_key list ->
+  delegate_slots tzresult Lwt.t
+
 (** {2 Consensus operations types functions} *)
 
 type consensus_vote_kind = Attestation | Preattestation
@@ -89,6 +100,9 @@ val consensus_vote_kind_encoding : consensus_vote_kind Data_encoding.t
 
 val pp_consensus_vote_kind : Format.formatter -> consensus_vote_kind -> unit
 
+(** An unsigned consensus vote consists of the consensus vote kind, either an
+    attestation or a preattestation, the delegate keys and its protocol and dal
+    content. *)
 type unsigned_consensus_vote = {
   vote_kind : consensus_vote_kind;
   vote_consensus_content : consensus_content;
@@ -96,17 +110,18 @@ type unsigned_consensus_vote = {
   dal_content : dal_content option;
 }
 
-type signed_consensus_vote = {
-  unsigned_consensus_vote : unsigned_consensus_vote;
-  signed_operation : packed_operation;
-}
-
+(** A batch content contains information common to all consensus operation in a
+    batch of consensus votes. *)
 type batch_content = {
   level : Raw_level.t;
   round : Round.t;
   block_payload_hash : Block_payload_hash.t;
 }
 
+(** An unsigned consensus batch consists of a batch kind: either preattestations
+    or attestations, a batch content and a batch branch. These values should be
+    common to each operations in the batch. This type also contains the list of
+    unsigned consensus votes. *)
 type unsigned_consensus_vote_batch = private {
   batch_kind : consensus_vote_kind;
   batch_content : batch_content;
@@ -114,6 +129,13 @@ type unsigned_consensus_vote_batch = private {
   unsigned_consensus_votes : unsigned_consensus_vote list;
 }
 
+(** [make_unsigned_consensus_vote_batch kind batch_content ~batch_branch
+    delegates_and_slots] maps the [delegates_and_slots] list to create a list of
+    {!type-unsigned_consensus_vote} that is then included in an
+    {!type-unsigned_consensus_vote_batch} with [kind], [batch_content] and
+    [batch_branch]. Note: [dal_content] of each operations is set to [None],
+    {!dal_content_map_p} needs to be called to update the [dal_content] field.
+*)
 val make_unsigned_consensus_vote_batch :
   consensus_vote_kind ->
   batch_content ->
@@ -121,11 +143,22 @@ val make_unsigned_consensus_vote_batch :
   (consensus_key_and_delegate * Slot.t) list ->
   unsigned_consensus_vote_batch
 
+(** [dal_content_map_p f unsigned_consensus_vote_batch] map each
+    [unsigned_consensus_vote] in the batch with [f]. *)
 val dal_content_map_p :
   (unsigned_consensus_vote -> dal_content option tzresult Lwt.t) ->
   unsigned_consensus_vote_batch ->
   unsigned_consensus_vote_batch Lwt.t
 
+(** A signed consensus vote consists of an unsigned consensus vote and its
+    packed version signed. *)
+type signed_consensus_vote = {
+  unsigned_consensus_vote : unsigned_consensus_vote;
+  signed_operation : packed_operation;
+}
+
+(** Similar to {!unsigned_consensus_vote_batch} type but the list of the operation
+    are signed consensus votes. *)
 type signed_consensus_vote_batch = private {
   batch_kind : consensus_vote_kind;
   batch_content : batch_content;
@@ -133,6 +166,17 @@ type signed_consensus_vote_batch = private {
   signed_consensus_votes : signed_consensus_vote list;
 }
 
+(** [make_signed_consensus_vote_batch batch_kind batch_content ~batch_branch
+    signed_consensus_votes] creates a [signed_consensus_vote_batch]. This
+    function raises an error if the batch is ill-formed:
+
+    - batch consensus vote has a different kind than [batch_kind]
+    - batch consensus vote has a different level than the one in [batch_content]
+    - batch consensus vote has a different round than the one in [batch_content]
+    - batch consensus vote has a different block hash payload than the one in
+    [batch_content]
+    - kind is [Preattestation] and a batch consensus vote contains a
+    dal_content. *)
 val make_signed_consensus_vote_batch :
   consensus_vote_kind ->
   batch_content ->
@@ -140,11 +184,17 @@ val make_signed_consensus_vote_batch :
   signed_consensus_vote list ->
   signed_consensus_vote_batch tzresult
 
+(** [make_singleton_consensus_vote_batch signed_consensus_vote] similar to
+    {!make_signed_consensus_vote_batch} but creates a batch with only one
+    operation. *)
 val make_singleton_consensus_vote_batch :
   signed_consensus_vote -> signed_consensus_vote_batch
 
 (** {2 Block info types and functions}  *)
 
+(** A prequorum consists of a level, a round, a block_payload_hash and the list
+    of preattestations that has a total voting power higher than the protocol
+    threshold. *)
 type prequorum = {
   level : int32;
   round : Round.t;
@@ -169,6 +219,8 @@ val pp_block_info : Format.formatter -> block_info -> unit
 
 (** {2 Proposal type and functions}  *)
 
+(** A proposal consists of information about the current block proposal and its
+    predecessor. *)
 type proposal = {block : block_info; predecessor : block_info}
 
 val proposal_encoding : proposal Data_encoding.t
@@ -177,6 +229,10 @@ val pp_proposal : Format.formatter -> proposal -> unit
 
 (** {2 Elected block type and functions} *)
 
+(** An elected block is a [proposal] where the quorum has been reached. The type
+    consists of the proposal and the quorum proof ie. an attestation list where
+    the total voting power of the operation is higher than the protocol
+    threshold. *)
 type elected_block = {
   proposal : proposal;
   attestation_qc : Kind.attestation operation list;
@@ -184,17 +240,17 @@ type elected_block = {
 
 val pp_elected_block : Format.formatter -> elected_block -> unit
 
-(** Identify the first block of the protocol, ie. the block that
-    activates the current protocol.
+(** Identify the first block of the protocol, ie. the block that activates the
+    current protocol.
 
-    This block should be baked by the baker of the previous protocol
-    (that's why this same block is also referred to as the last block
-    of the previous protocol). It is always considered final and
-    therefore is not attested.*)
+    This block should be baked by the baker of the previous protocol (that's why
+    this same block is also referred to as the last block of the previous
+    protocol). It is always considered final and therefore is not attested. *)
 val is_first_block_in_protocol : proposal -> bool
 
 (** {2 Locked_round type and functions} *)
 
+(** A locked round is the last block attested by the baker. *)
 type locked_round = {payload_hash : Block_payload_hash.t; round : Round.t}
 
 val locked_round_encoding : locked_round Data_encoding.t
@@ -203,6 +259,8 @@ val pp_locked_round : Format.formatter -> locked_round -> unit
 
 (** {2 Attestable_payload type and functions} *)
 
+(** An attestable payload is a proposal on which the prequorum has been
+    reached. *)
 type attestable_payload = {proposal : proposal; prequorum : prequorum}
 
 val attestable_payload_encoding : attestable_payload Data_encoding.t
@@ -211,16 +269,29 @@ val pp_attestable_payload : Format.formatter -> attestable_payload -> unit
 
 (** {2 Level_state type and functions} *)
 
+(** A level state consists of all usefull information regarding the current
+    level such as the latest proposal, its status, the delegate slots, etc. *)
 type level_state = {
   current_level : int32;
   latest_proposal : proposal;
+      (** latest validated block by the node that the baker work on. *)
   is_latest_proposal_applied : bool;
+      (** true when the proposal, validated by the block has also been
+          applied. *)
   locked_round : locked_round option;
+      (** Has value when the baker have attested the current proposal *)
   attestable_payload : attestable_payload option;
+      (** Has value when a pqc has been reached on a previous or current
+          round. *)
   elected_block : elected_block option;
+      (** A quorum has been reached on an applied proposal. *)
   delegate_slots : delegate_slots;
+      (** Delegate slots for the baker delegates at the current level *)
   next_level_delegate_slots : delegate_slots;
+      (** Delegate slots for the baker delegates at the next level *)
   next_level_proposed_round : Round.t option;
+      (** Some if a proposal has been injected for the next level on the given
+          round *)
 }
 
 val pp_level_state : Format.formatter -> level_state -> unit
@@ -237,32 +308,46 @@ val phase_encoding : phase Data_encoding.t
 
 val pp_phase : Format.formatter -> phase -> unit
 
+(** A round state consists of information related to the current round phase *)
 type round_state = {
   current_round : Round.t;
   current_phase : phase;
   delayed_quorum : Kind.attestation operation list option;
+      (** Has value when the Quorum has been reached but the current proposal
+          has not yet been applied *)
   early_attestations : signed_consensus_vote list;
+      (** Attestations ready for injection before the prequorum has been
+          reached *)
   awaiting_unlocking_pqc : bool;
+      (** Used to avoid preattesting reproposal if its round is lower than the
+          one we are locked on *)
 }
 
 val pp_round_state : Format.formatter -> round_state -> unit
 
 (** {2 Forge types and functions} *)
 
+(** A block kind is either a reproposal of a proposal that has reached a
+    prequorum, or a fresh block. *)
 type block_kind =
   | Fresh of Operation_pool.pool
+      (** A Fresh proposal contains the list its operations. *)
   | Reproposal of {
       consensus_operations : packed_operation list;
       payload_hash : Block_payload_hash.t;
       payload_round : Round.t;
       payload : Operation_pool.payload;
     }
+      (** A Reproposal contains the consensus_operations as a proof that the
+          prequorum was reached for this proposal. It also contains information
+          about the payload of the previous proposal. *)
 
 type block_to_bake = {
   predecessor : block_info;
   round : Round.t;
   delegate : consensus_key_and_delegate;
-  kind : block_kind;
+      (** Delegate that have the right to bake the block. *)
+  kind : block_kind;  (** Either a reproposal or a fresh proposal *)
   force_apply : bool;
       (** if true, while baking the block, try and apply the block and its
           operations instead of only validating them. this can be permanently
@@ -270,8 +355,8 @@ type block_to_bake = {
           [baking_commands.ml]). *)
 }
 
-(** [forge_request] type used to push a concurrent forging task in the
-    forge worker. *)
+(** [forge_request] type used to push a concurrent forging task in the forge
+    worker. *)
 type forge_request =
   | Forge_and_sign_block of block_to_bake
   | Forge_and_sign_preattestations of {
@@ -281,6 +366,8 @@ type forge_request =
       unsigned_attestations : unsigned_consensus_vote_batch;
     }
 
+(** [prepared_block] type returned by the forge worker and that contains all
+    information useful for block injection. *)
 type prepared_block = {
   signed_block_header : block_header;
   round : Round.t;
@@ -291,8 +378,8 @@ type prepared_block = {
 
 val pp_prepared_block : Format.formatter -> prepared_block -> unit
 
-(** [forge_event] type used to return the result of a task completion
-    in the forge worker. *)
+(** [forge_event] type used to return the result of a task completion in the
+    forge worker. *)
 type forge_event =
   | Block_ready of prepared_block
   | Preattestation_ready of signed_consensus_vote
@@ -302,8 +389,8 @@ val forge_event_encoding : forge_event Data_encoding.t
 
 val pp_forge_event : Format.formatter -> forge_event -> unit
 
-(** [forge_worker_hooks] type that allows interactions with the forge
-    worker. Hooks are needed in order to break a circular dependency. *)
+(** [forge_worker_hooks] type that allows interactions with the forge worker.
+    Hooks are needed in order to break a circular dependency. *)
 type forge_worker_hooks = {
   push_request : forge_request -> unit;
   get_forge_event_stream : unit -> forge_event Lwt_stream.t;
@@ -319,6 +406,7 @@ type validation_mode = Node | Local of Abstract_context_index.t
 
 val pp_validation_mode : Format.formatter -> validation_mode -> unit
 
+(** Caches of timestamps *)
 type cache = {
   known_timestamps : Timestamp.time Baking_cache.Timestamp_of_round_cache.t;
   round_timestamps :
@@ -328,6 +416,8 @@ type cache = {
 
 val create_cache : unit -> cache
 
+(** A global state contains all information related to the chain and baker
+    configuration. *)
 type global_state = {
   cctxt : Protocol_client_context.full;
   chain_id : Chain_id.t;
@@ -354,22 +444,17 @@ type t = state
 
 val pp : Format.formatter -> t -> unit
 
+(** [update_current_phase t new_phase] updates the round state in [t] with the
+    [new_phase]. *)
 val update_current_phase : t -> phase -> t
 
-val record_state : t -> unit tzresult Lwt.t
-
-val may_record_new_state :
-  previous_state:t -> new_state:t -> unit tzresult Lwt.t
-
 (** Returns, among our *own* delegates, the delegate (and its attesting slot)
     that has a proposer slot at the given round and the current or next level,
     if any. *)
 val round_proposer :
   state -> level:[`Current | `Next] -> Round.t -> delegate_slot option
 
-val may_load_attestable_data : t -> t tzresult Lwt.t
-
-(** Memoization wrapper for [Round.timestamp_of_round]. *)
+(** Memoization wrapper for {!Round.timestamp_of_round}. *)
 val timestamp_of_round :
   state ->
   predecessor_timestamp:Time.Protocol.t ->
@@ -377,22 +462,14 @@ val timestamp_of_round :
   round:Round.t ->
   Time.Protocol.t tzresult
 
-(** @param block default to [`Head 0]*)
-val compute_delegate_slots :
-  Protocol_client_context.full ->
-  ?block:Block_services.block ->
-  level:int32 ->
-  chain:Shell_services.chain ->
-  consensus_key list ->
-  delegate_slots tzresult Lwt.t
-
-(** From the current [state], the function returns an optional
-    association pair, which consists of the next round timestamp and its
-    round. *)
+(** From the current [state], the function returns an optional association pair,
+    which consists of the next round timestamp and its round. *)
 val compute_next_round_time : state -> (Time.Protocol.t * Round.t) option
 
 (** {2 Timeout type and functions} *)
 
+(** timeout kind is either a timeout triggered at the end of a round or a
+    timeout triggered when it is time to prepare the block at the next level. *)
 type timeout_kind =
   | End_of_round of {ending_round : Round.t}
   | Time_to_prepare_next_level_block of {at_round : Round.t}
@@ -403,6 +480,19 @@ val pp_timeout_kind : Format.formatter -> timeout_kind -> unit
 
 (** {2 State_data type and functions} *)
 
+(** [record_state t] writes the current level, the locked round and the
+    attestable payload to the disk. *)
+val record_state : t -> unit tzresult Lwt.t
+
+(** [may_record_new_state ~previous_state ~new_state] Does nothing if the baker
+    configuration is set to {!Baking_configuration.Memory} only. Otherwise,
+    check that information from the [new_state] are consistent with
+    [previous_state] and if the information has been updated, record the
+    [new_state] to the disk. *)
+val may_record_new_state :
+  previous_state:t -> new_state:t -> unit tzresult Lwt.t
+
+(** type used for data recorded on disk. *)
 type state_data = {
   level_data : int32;
   locked_round_data : locked_round option;
@@ -411,13 +501,20 @@ type state_data = {
 
 val state_data_encoding : state_data Data_encoding.t
 
+(** [load_attestable_data cctxt location] tries to load the [state_data] from
+    the [cctxt] at [location], returns [None] if the file does not exists. *)
 val load_attestable_data :
   Protocol_client_context.full ->
   [`State] Baking_files.location ->
   state_data option tzresult Lwt.t
 
+(** [may_load_attestable_data t] tries to load locked round and attestable
+    payload from [t] if it is recorded, if not, return the state. *)
+val may_load_attestable_data : t -> t tzresult Lwt.t
+
 (** {2 Event type and functions} *)
 
+(** Event type used in the [baking_scheduling] to trigger state transition. *)
 type event =
   | New_valid_proposal of proposal
   | New_head_proposal of proposal
-- 
GitLab