Alpha/Daemons: add documentation and refactor parts

src/proto_alpha/lib_delegate/client_baking_forge.ml

@@ -78,7 +78,12 @@ let generate_seed_nonce () =
 
 let forge_block_header
     (cctxt : #Proto_alpha.full)
-    ?(chain = `Main) block delegate_sk shell priority seed_nonce_hash =
+    ?(chain = `Main)
+    block
+    delegate_sk
+    shell
+    priority
+    seed_nonce_hash =
   Client_baking_pow.mine
     cctxt chain block shell
     (fun proof_of_work_nonce ->
@@ -111,10 +116,15 @@ let assert_valid_operations_hash shell_header operations =
        operations_hash shell_header.Tezos_base.Block_header.operations_hash)
     (failure "Client_baking_forge.inject_block: inconsistent header.")
 
-
-let inject_block cctxt
-    ?force ?(chain = `Main)
-    ~shell_header ~priority ?seed_nonce_hash ~src_sk operations =
+let inject_block
+    cctxt
+    ?force
+    ?(chain = `Main)
+    ?seed_nonce_hash
+    ~shell_header
+    ~priority
+    ~src_sk
+    operations =
   assert_valid_operations_hash shell_header operations >>=? fun () ->
   let block = `Hash (shell_header.Tezos_base.Block_header.predecessor, 0) in
   forge_block_header cctxt ~chain block
@@ -163,8 +173,7 @@ let sort_manager_operations
     ~max_size
     ~hard_gas_limit_per_block
     ~fee_threshold
-    (operations : Proto_alpha.operation list)
-  =
+    (operations : Proto_alpha.operation list) =
   let compute_weight op (fee, gas) =
     let size = Data_encoding.Binary.length Operation.encoding op in
     let size_f = Q.of_int size in
@@ -515,7 +524,9 @@ let finalize_block_header
     } in
   return header
 
-let forge_block cctxt ?(chain = `Main) block
+let forge_block
+    cctxt
+    ?(chain = `Main)
     ?force
     ?operations
     ?(best_effort = operations = None)
@@ -524,8 +535,10 @@ let forge_block cctxt ?(chain = `Main) block
     ?timestamp
     ?mempool
     ?context_path
+    ?seed_nonce_hash
     ~priority
-    ?seed_nonce_hash ~src_sk () =
+    ~src_sk
+    block =
   (* making the arguments usable *)
   unopt_operations cctxt chain mempool operations >>=? fun operations_arg ->
   decode_priority cctxt chain block priority >>=? fun (priority, minimal_timestamp) ->
@@ -610,7 +623,7 @@ let shell_prevalidation
     ~block
     seed_nonce_hash
     operations
-    (timestamp, (bi, priority, delegate)) =
+    ((timestamp, (bi, priority, delegate)) as _slot) =
   let protocol_data =
     forge_faked_protocol_data ~priority ~seed_nonce_hash in
   Alpha_block_services.Helpers.Preapply.block
@@ -637,7 +650,7 @@ let fetch_operations
     (cctxt : #Proto_alpha.full)
     ~chain
     state
-    (timestamp, (_head, priority, _delegate))
+    (timestamp, (head, priority, _delegate))
   =
   Alpha_block_services.Mempool.monitor_operations cctxt ~chain
     ~applied:true ~branch_delayed:true
@@ -671,6 +684,8 @@ let fetch_operations
               if prio = 0 then first
               else loop (prio - 1) durations
         in
+        (* The "safe" allocated time for injection stops when the next
+           baker's time begins. *)
         let allocated_time = loop (priority + 1) time_between_blocks in
         (* Wait 1/3 of the allocated time *)
         let timespan = Int64.div (Period.to_seconds allocated_time) 3L in
@@ -708,13 +723,13 @@ let fetch_operations
         loop ()
 
 (** Given a delegate baking slot [build_block] constructs a full block
-    with consistent operations and client-side validation *)
+    with consistent operations that went through the client-side
+    validation *)
 let build_block
     cctxt
     state
     seed_nonce_hash
-    ((timestamp, (bi, priority, delegate)) as slot)
-  =
+    ((timestamp, (bi, priority, delegate)) as slot) =
   let chain = `Hash bi.Client_baking_blocks.chain_id in
   let block = `Hash (bi.hash, 0) in
   Alpha_services.Helpers.current_level cctxt
@@ -849,7 +864,6 @@ let bake (cctxt : #Proto_alpha.full) state =
               Client_baking_nonces.add cctxt block_hash seed_nonce
               |> trace_exn (Failure "Error while recording nonce")
             else return_unit end >>=? fun () ->
-
           return_unit
     end
   | None -> (* Error while building a block *)
@@ -863,8 +877,7 @@ let bake (cctxt : #Proto_alpha.full) state =
 let get_baking_slots cctxt
     ?(max_priority = default_max_priority)
     new_head
-    delegates
-  =
+    delegates =
   let chain = `Hash new_head.Client_baking_blocks.chain_id in
   let block = `Hash (new_head.hash, 0) in
   let level = Raw_level.succ new_head.level in
@@ -898,10 +911,9 @@ let compute_best_slot_on_current_level
     ?max_priority
     (cctxt : #Proto_alpha.full)
     state
-    (new_head : Client_baking_blocks.block_info)
-  =
+    new_head =
   get_delegates cctxt state >>=? fun delegates ->
-  let level = Raw_level.succ new_head.level in
+  let level = Raw_level.succ new_head.Client_baking_blocks.level in
   get_baking_slots cctxt ?max_priority new_head delegates >>= function
   | [] ->
       lwt_log_info Tag.DSL.(fun f ->
@@ -984,10 +996,9 @@ let create
     (cctxt : #Proto_alpha.full)
     ?fee_threshold
     ?max_priority
-    ~(context_path: string)
-    (delegates: public_key_hash list)
-    (block_stream: Client_baking_blocks.block_info tzresult Lwt_stream.t)
-  =
+    ~context_path
+    delegates
+    block_stream =
   let state_maker genesis_hash bi =
     let constants =
       tzlazy (fun () -> Alpha_services.Constants.all cctxt (`Main, `Hash (bi.Client_baking_blocks.hash, 0))) in

src/proto_alpha/lib_delegate/client_baking_forge.mli

@@ -49,9 +49,9 @@ val inject_block:
   #Proto_alpha.full ->
   ?force:bool ->
   ?chain:Chain_services.chain ->
+  ?seed_nonce_hash:Nonce_hash.t ->
   shell_header:Block_header.shell_header ->
   priority:int ->
-  ?seed_nonce_hash:Nonce_hash.t ->
   src_sk:Client_keys.sk_uri ->
   Operation.raw list list ->
   Block_hash.t tzresult Lwt.t
@@ -67,7 +67,6 @@ type error +=
 val forge_block:
   #Proto_alpha.full ->
   ?chain:Chain_services.chain ->
-  Block_services.block ->
   ?force:bool ->
   ?operations: Operation.packed list ->
   ?best_effort:bool ->
@@ -76,14 +75,14 @@ val forge_block:
   ?timestamp:Time.t ->
   ?mempool:string ->
   ?context_path:string ->
-  priority:[`Set of int | `Auto of (public_key_hash * int option)] ->
   ?seed_nonce_hash:Nonce_hash.t ->
+  priority:[`Set of int | `Auto of (public_key_hash * int option)] ->
   src_sk:Client_keys.sk_uri ->
-  unit ->
+  Block_services.block ->
   Block_hash.t tzresult Lwt.t
-(** [forge_block cctxt parent_blk ?fee_threshold ?force ?operations ?best_effort
+(** [forge_block cctxt ?fee_threshold ?force ?operations ?best_effort
     ?sort ?timestamp ?max_priority ?priority ~seed_nonce ~src_sk
-    pk_hash] injects a block in the node. In addition of inject_block,
+    pk_hash parent_blk] injects a block in the node. In addition of inject_block,
     it will:
 
     * Operations: If [?operations] is [None], it will get pending

src/proto_alpha/lib_delegate/client_baking_lib.ml

@@ -26,11 +26,19 @@
 open Proto_alpha
 open Alpha_context
 
-let bake_block (cctxt : #Proto_alpha.full)
-    ?(chain = `Main) block
+let bake_block
+    (cctxt : #Proto_alpha.full)
+    ?(chain = `Main)
     ?fee_threshold
-    ?force ?max_priority ?(minimal_timestamp=false) ?mempool ?context_path
-    ?src_sk ?src_pk delegate =
+    ?force
+    ?max_priority
+    ?(minimal_timestamp=false)
+    ?mempool
+    ?context_path
+    ?src_sk
+    ?src_pk
+    block
+    delegate =
   begin
     match src_sk with
     | None ->
@@ -58,10 +66,12 @@ let bake_block (cctxt : #Proto_alpha.full)
     ?timestamp:(if minimal_timestamp then None else Some (Time.now ()))
     ?fee_threshold
     ?force
-    ?seed_nonce_hash ~src_sk block
+    ?seed_nonce_hash
     ?mempool
     ?context_path
-    ~priority:(`Auto (delegate, max_priority)) () >>=? fun block_hash ->
+    ~priority:(`Auto (delegate, max_priority))
+    ~src_sk
+    block >>=? fun block_hash ->
   let src_pkh = Signature.Public_key.hash src_pk in
   Client_baking_forge.State.record cctxt src_pkh level.level >>=? fun () ->
   begin match seed_nonce with

src/proto_alpha/lib_delegate/client_baking_lib.mli

@@ -30,7 +30,6 @@ open Alpha_context
 val bake_block:
   #Proto_alpha.full ->
   ?chain:Chain_services.chain ->
-  Block_services.block ->
   ?fee_threshold:Tez.t ->
   ?force:bool ->
   ?max_priority: int ->
@@ -39,6 +38,7 @@ val bake_block:
   ?context_path: string ->
   ?src_sk:Client_keys.sk_uri ->
   ?src_pk:Signature.public_key ->
+  Block_services.block ->
   public_key_hash ->
   unit tzresult Lwt.t
 

src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml

@@ -546,7 +546,6 @@ module Baking = struct
       Tezos_signer_backends.Unencrypted.make_sk contract.sk in
     Client_baking_forge.forge_block
       ctxt
-      block
       ~operations
       ~force:true
       ~best_effort:false
@@ -554,7 +553,7 @@ module Baking = struct
       ~priority:(`Auto (contract.pkh, Some 1024))
       ?seed_nonce_hash
       ~src_sk
-      ()
+      block
 
 end