Alpha/Baker: outsource mining

The (small) proof-of-work operation is handled separately.

src/proto_alpha/lib_delegate/client_baking_forge.ml

@@ -45,9 +45,6 @@ let create_state genesis index delegates constants best =
     future_slots = [] ;
   }
 
-let generate_proof_of_work_nonce () =
-  Rand.generate Constants.proof_of_work_nonce_size
-
 let generate_seed_nonce () =
   match Nonce.of_bytes @@
     Rand.generate Constants.nonce_length with
@@ -57,32 +54,23 @@ let generate_seed_nonce () =
 let forge_block_header
     (cctxt : #Proto_alpha.full)
     ?(chain = `Main) block delegate_sk shell priority seed_nonce_hash =
-  Alpha_services.Constants.all cctxt
-    (chain, block) >>=? fun { parametric = {
-      proof_of_work_threshold = stamp_threshold ;
-    } } ->
-  let rec loop () =
-    let proof_of_work_nonce = generate_proof_of_work_nonce () in
-    let contents =
-      { Block_header.priority ; seed_nonce_hash ; proof_of_work_nonce } in
-    if Baking.check_header_proof_of_work_stamp shell contents stamp_threshold then
-      let unsigned_header =
-        Data_encoding.Binary.to_bytes_exn
-          Alpha_context.Block_header.unsigned_encoding
-          (shell, contents) in
-      Client_keys.append cctxt delegate_sk ~watermark:Block_header unsigned_header
-    else
-      loop () in
-  loop ()
-
-let empty_proof_of_work_nonce =
-  MBytes.of_string
-    (String.make Constants_repr.proof_of_work_nonce_size  '\000')
+  Client_baking_pow.mine
+    cctxt chain block shell
+    (fun proof_of_work_nonce ->
+       { Block_header.priority ;
+         seed_nonce_hash ;
+         proof_of_work_nonce ;
+       }) >>=? fun contents ->
+  let unsigned_header =
+    Data_encoding.Binary.to_bytes_exn
+      Alpha_context.Block_header.unsigned_encoding
+      (shell, contents) in
+  Client_keys.append cctxt delegate_sk ~watermark:Block_header unsigned_header
 
 let forge_faked_protocol_data ~priority ~seed_nonce_hash =
   Alpha_context.Block_header.{
     contents = { priority ; seed_nonce_hash ;
-                 proof_of_work_nonce = empty_proof_of_work_nonce } ;
+                 proof_of_work_nonce = Client_baking_pow.empty_proof_of_work_nonce } ;
     signature = Signature.zero
   }
 
@@ -610,9 +598,9 @@ let bake_slot
   | Ok operations ->
       Tezos_stdlib_unix.Lwt_utils_unix.retry
         ~log:(fun errs ->
-          lwt_log_error
-            "Error while prevalidating operations\n%a\nRetrying..."
-            pp_print_error errs
+            lwt_log_error
+              "Error while prevalidating operations\n%a\nRetrying..."
+              pp_print_error errs
           )
         (fun () ->
            Alpha_block_services.Helpers.Preapply.block

src/proto_alpha/lib_delegate/client_baking_pow.ml

@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha
+
+let generate_proof_of_work_nonce () =
+  Rand.generate Alpha_context.Constants.proof_of_work_nonce_size
+
+let empty_proof_of_work_nonce =
+  MBytes.of_string
+    (String.make Constants_repr.proof_of_work_nonce_size  '\000')
+
+let mine cctxt chain block shell builder =
+  Alpha_services.Constants.all cctxt (chain, block) >>=? fun constants ->
+  let threshold = constants.parametric.proof_of_work_threshold in
+  let rec loop () =
+    let block = builder (generate_proof_of_work_nonce ()) in
+    if Baking.check_header_proof_of_work_stamp shell block threshold then
+      return block
+    else
+      loop ()
+  in
+  loop ()

src/proto_alpha/lib_delegate/client_baking_pow.mli

@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** A null proof-of-work nonce. This should only be used to non-sensical blocks
+    of the correct size and shape. *)
+val empty_proof_of_work_nonce: Cstruct.buffer
+
+(** [mine cctxt chain block header builder] returns a block with a valid
+    proof-of-work nonce. The function [builder], provided by the caller, is used
+    to make the block. All the internal logic of generating nonces and checking
+    for the proof-of-work threshold is handled by [mine]. *)
+val mine:
+  #Proto_alpha.full ->
+  Shell_services.chain ->
+  Block_services.block ->
+  Block_header.shell_header ->
+  (Cstruct.buffer -> Proto_alpha.Alpha_context.Block_header.contents) ->
+  Proto_alpha.Alpha_context.Block_header.contents tzresult Lwt.t
+
+
+