Alpha/Baker: add "--context" to "tezos-client bake for"

This allows to bake by using the local context instead of relying on
the RPC 'preapply'.

src/proto_alpha/lib_delegate/client_baking_forge.ml

@@ -303,7 +303,7 @@ let unopt_operations cctxt chain mempool = function
           let mpool = Data_encoding.Json.destruct Alpha_block_services.S.Mempool.encoding json in
           let ops = ops_of_mempool mpool in
           return ops
-end
+    end
   | Some operations ->
       return operations
 
@@ -522,6 +522,7 @@ let forge_block cctxt ?(chain = `Main) block
     ?(fee_threshold = Tez.zero)
     ?timestamp
     ?mempool
+    ?context_path
     ~priority
     ?seed_nonce_hash ~src_sk () =
 
@@ -550,15 +551,52 @@ let forge_block cctxt ?(chain = `Main) block
   (* Size/Gas check already occured in classify operations *)
   let managers = List.nth operations managers_index in
   let operations = [ endorsements ; votes ; anonymous ; managers ] in
-  Alpha_block_services.Helpers.Preapply.block
-    cctxt ~block ~timestamp ~sort ~protocol_data operations >>=? fun (shell_header, result) ->
+  begin
+    match context_path with
+    | None ->
+        Alpha_block_services.Helpers.Preapply.block
+          cctxt ~block ~timestamp ~sort ~protocol_data operations >>=? fun (shell_header, result) ->
+
+        let operations =
+          List.map (fun l -> List.map snd l.Preapply_result.applied) result in
+
+        (* everything went well (or we don't care about errors): GO! *)
+        if best_effort || all_ops_valid result then
+          return (shell_header, operations)
+
+        (* some errors (and we care about them) *)
+        else
+          let result = List.fold_left merge_preapps Preapply_result.empty result in
+          Lwt.return_error @@
+          List.filter_map (error_of_op result) operations_arg
+
+    | Some context_path ->
+        assert sort ;
+        assert best_effort ;
+        Context.init ~readonly:true context_path >>= fun index ->
+        Client_baking_blocks.info cctxt ~chain block >>=? fun bi ->
+        let state = {
+          context_path ;
+          index ;
+          genesis =
+            Block_hash.of_b58check_exn
+              "BLockGenesisGenesisGenesisGenesisGenesisf79b5d1CoW2" ;
+          constants = tzlazy (fun () -> Alpha_services.Constants.all cctxt (`Main, `Head 0)) ;
+          delegates = [] ;
+          future_slots = [] ;
+          best = bi ;
+          fee_threshold = Tez.zero ;
+        } in
+        filter_and_apply_operations ~timestamp ~protocol_data state bi operations >>=? fun (final_context, validation_result, operations) ->
+        finalize_block_header final_context ~timestamp validation_result operations >>=? fun shell_header ->
+        return (shell_header, List.map (List.map forge) operations)
+
+  end >>=? fun (shell_header, operations) ->
 
   (* Now for some logging *)
   let total_op_count = List.length operations_arg in
-  let valid_op_count =
-    List.fold_left
-      (fun acc r -> acc + List.length r.Preapply_result.applied)
-      0 result in
+  let valid_op_count = List.length operations in
+
   lwt_log_info Tag.DSL.(fun f ->
       f "Found %d valid operations (%d refused) for timestamp %a@.Computed fitness %a"
       -% t event "found_valid_operations"
@@ -567,22 +605,9 @@ let forge_block cctxt ?(chain = `Main) block
       -% a timestamp_tag timestamp
       -% a fitness_tag shell_header.fitness) >>= fun () ->
 
-  (* everything went well (or we don't care about errors): GO! *)
-  if best_effort || all_ops_valid result then
-    let operations =
-      if best_effort then
-        List.map (fun l -> List.map snd l.Preapply_result.applied) result
-      else
-        List.map (List.map forge) operations in
-    inject_block cctxt
-      ?force ~chain ~shell_header ~priority ?seed_nonce_hash ~src_sk
-      operations
-
-  (* some errors (and we care about them) *)
-  else
-    let result = List.fold_left merge_preapps Preapply_result.empty result in
-    Lwt.return_error @@
-    List.filter_map (error_of_op result) (List.concat operations)
+  inject_block cctxt
+    ?force ~chain ~shell_header ~priority ?seed_nonce_hash ~src_sk
+    operations
 
 (** Worker *)
 

src/proto_alpha/lib_delegate/client_baking_forge.mli

@@ -62,6 +62,7 @@ val forge_block:
   ?fee_threshold:Tez.t ->
   ?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 ->
   src_sk:Client_keys.sk_uri ->

src/proto_alpha/lib_delegate/client_baking_lib.ml

@@ -29,7 +29,7 @@ open Alpha_context
 let bake_block (cctxt : #Proto_alpha.full)
     ?(chain = `Main) block
     ?fee_threshold
-    ?force ?max_priority ?(minimal_timestamp=false) ?mempool
+    ?force ?max_priority ?(minimal_timestamp=false) ?mempool ?context_path
     ?src_sk ?src_pk delegate =
   begin
     match src_sk with
@@ -60,6 +60,7 @@ let bake_block (cctxt : #Proto_alpha.full)
     ?force
     ?seed_nonce_hash ~src_sk block
     ?mempool
+    ?context_path
     ~priority:(`Auto (delegate, max_priority)) () >>=? fun block_hash ->
   let src_pkh = Signature.Public_key.hash src_pk in
   Client_baking_forge.State.record cctxt src_pkh level.level >>=? fun () ->

src/proto_alpha/lib_delegate/client_baking_lib.mli

@@ -36,6 +36,7 @@ val bake_block:
   ?max_priority: int ->
   ?minimal_timestamp: bool ->
   ?mempool: string ->
+  ?context_path: string ->
   ?src_sk:Client_keys.sk_uri ->
   ?src_pk:Signature.public_key ->
   public_key_hash ->

src/proto_alpha/lib_delegate/delegate_commands.ml

@@ -44,18 +44,26 @@ let mempool_arg =
     ~doc:"When used the client will read the mempool in the provided file instead of querying the node through an RPC (useful for debugging only)."
     string_parameter
 
+let context_path_arg =
+  Clic.arg
+    ~long:"context"
+    ~placeholder:"path"
+    ~doc:"When use the client will read in the local context at the provided path in order to build the block, instead of relying on the 'preapply' RPC."
+    string_parameter
+
 let delegate_commands () =
   let open Clic in
   [
     command ~group ~desc: "Forge and inject block using the delegate rights."
-      (args5 max_priority_arg fee_threshold_arg force_switch minimal_timestamp_switch mempool_arg)
+      (args6 max_priority_arg fee_threshold_arg force_switch minimal_timestamp_switch mempool_arg context_path_arg)
       (prefixes [ "bake"; "for" ]
        @@ Client_keys.Public_key_hash.source_param
          ~name:"baker" ~desc: "name of the delegate owning the baking right"
        @@ stop)
-      (fun (max_priority, fee_threshold, force, minimal_timestamp, mempool) delegate cctxt ->
+      (fun (max_priority, fee_threshold, force, minimal_timestamp, mempool, context_path) delegate cctxt ->
          bake_block cctxt cctxt#block
-           ?fee_threshold ~force ?max_priority ~minimal_timestamp ?mempool delegate) ;
+           ?fee_threshold ~force ?max_priority ~minimal_timestamp
+           ?mempool ?context_path delegate) ;
     command ~group ~desc: "Forge and inject a seed-nonce revelation operation."
       no_options
       (prefixes [ "reveal"; "nonce"; "for" ]