diff --git a/lib_client_base/client_node_rpcs.ml b/lib_client_base/client_node_rpcs.ml index 863095fa9..9160d29e4 100644 --- a/lib_client_base/client_node_rpcs.ml +++ b/lib_client_base/client_node_rpcs.ml @@ -69,12 +69,12 @@ module Blocks = struct type preapply_param = Services.Blocks.preapply_param = { timestamp: Time.t ; proto_header: MBytes.t ; - operations: Operation.t list ; + operations: Operation.t list list ; sort_operations: bool ; } type preapply_result = Services.Blocks.preapply_result = { shell_header: Block_header.shell_header ; - operations: error Preapply_result.t ; + operations: error Preapply_result.t list ; } let net_id cctxt h = call_service1 cctxt Services.Blocks.net_id h () diff --git a/lib_client_base/client_node_rpcs.mli b/lib_client_base/client_node_rpcs.mli index dead54edd..7034ca69f 100644 --- a/lib_client_base/client_node_rpcs.mli +++ b/lib_client_base/client_node_rpcs.mli @@ -113,7 +113,7 @@ module Blocks : sig type preapply_result = { shell_header: Block_header.shell_header ; - operations: error Preapply_result.t ; + operations: error Preapply_result.t list ; } val preapply: @@ -122,7 +122,7 @@ module Blocks : sig ?timestamp:Time.t -> ?sort:bool -> proto_header:MBytes.t -> - Operation.t list -> preapply_result tzresult Lwt.t + Operation.t list list -> preapply_result tzresult Lwt.t end diff --git a/lib_embedded_client_alpha/client_baking_forge.ml b/lib_embedded_client_alpha/client_baking_forge.ml index 600aa2b20..16fa21344 100644 --- a/lib_embedded_client_alpha/client_baking_forge.ml +++ b/lib_embedded_client_alpha/client_baking_forge.ml @@ -158,8 +158,9 @@ let forge_block cctxt block let request = List.length operations in let proto_header = forge_faked_proto_header ~priority ~seed_nonce_hash in Client_node_rpcs.Blocks.preapply - cctxt block ~timestamp ~sort ~proto_header operations >>=? + cctxt block ~timestamp ~sort ~proto_header [operations] >>=? fun { operations = result ; shell_header } -> + let result = List.hd result in let valid = List.length result.applied in lwt_log_info "Found %d valid operations (%d refused) for timestamp %a" valid (request - valid) @@ -446,13 +447,14 @@ let bake (cctxt : Client_commands.full_context) state = let proto_header = forge_faked_proto_header ~priority ~seed_nonce_hash in Client_node_rpcs.Blocks.preapply cctxt block - ~timestamp ~sort:true ~proto_header operations >>= function + ~timestamp ~sort:true ~proto_header [operations] >>= function | Error errs -> lwt_log_error "Error while prevalidating operations:\n%a" pp_print_error errs >>= fun () -> return None | Ok { operations ; shell_header } -> + let operations = List.hd operations in lwt_debug "Computed condidate block after %a (slot %d): %d/%d fitness: %a" Block_hash.pp_short bi.hash priority diff --git a/lib_node_services/node_rpc_services.ml b/lib_node_services/node_rpc_services.ml index 313d59062..fa929e621 100644 --- a/lib_node_services/node_rpc_services.ml +++ b/lib_node_services/node_rpc_services.ml @@ -305,7 +305,7 @@ module Blocks = struct type preapply_param = { timestamp: Time.t ; proto_header: MBytes.t ; - operations: Operation.t list ; + operations: Operation.t list list ; sort_operations: bool ; } @@ -318,12 +318,12 @@ module Blocks = struct (obj4 (req "timestamp" Time.encoding) (req "proto_header" bytes) - (req "operations" (list (dynamic_size Operation.encoding))) + (req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding))))) (dft "sort_operations" bool false))) type preapply_result = { shell_header: Block_header.shell_header ; - operations: error Preapply_result.t ; + operations: error Preapply_result.t list ; } let preapply_result_encoding = @@ -335,7 +335,7 @@ module Blocks = struct (obj2 (req "shell_header" Block_header.shell_header_encoding) (req "operations" - (Preapply_result.encoding Error.encoding)))) + (list (Preapply_result.encoding Error.encoding))))) let preapply = RPC_service.post_service diff --git a/lib_node_services/node_rpc_services.mli b/lib_node_services/node_rpc_services.mli index f3a538fba..1c20fe938 100644 --- a/lib_node_services/node_rpc_services.mli +++ b/lib_node_services/node_rpc_services.mli @@ -120,13 +120,13 @@ module Blocks : sig type preapply_param = { timestamp: Time.t ; proto_header: MBytes.t ; - operations: Operation.t list ; + operations: Operation.t list list ; sort_operations: bool ; } type preapply_result = { shell_header: Block_header.shell_header ; - operations: error Preapply_result.t ; + operations: error Preapply_result.t list ; } val preapply: ([ `POST ], unit, diff --git a/lib_node_shell/node.ml b/lib_node_shell/node.ml index e1f2816af..75d39e794 100644 --- a/lib_node_shell/node.ml +++ b/lib_node_shell/node.ml @@ -475,12 +475,20 @@ module RPC = struct end >>=? fun predecessor -> Prevalidation.start_prevalidation ~proto_header ~predecessor ~timestamp () >>=? fun validation_state -> - let ops = List.map (fun x -> Operation.hash x, x) ops in - Prevalidation.prevalidate - validation_state ~sort ops >>= fun (validation_state, r) -> + let ops = List.map (List.map (fun x -> Operation.hash x, x)) ops in + Lwt_list.fold_left_s + (fun (validation_state, rs) ops -> + Prevalidation.prevalidate + validation_state ~sort ops >>= fun (validation_state, r) -> + Lwt.return (validation_state, rs @ [r])) + (validation_state, []) ops >>= fun (validation_state, rs) -> let operations_hash = Operation_list_list_hash.compute - [Operation_list_hash.compute (List.map fst r.applied)] in + (List.map + (fun r -> + Operation_list_hash.compute + (List.map fst r.Preapply_result.applied)) + rs) in Prevalidation.end_prevalidation validation_state >>=? fun { fitness ; context } -> let pred_shell_header = State.Block.shell_header predecessor in @@ -496,11 +504,11 @@ module RPC = struct proto_level ; predecessor = State.Block.hash predecessor ; timestamp ; - validation_passes = 1 ; + validation_passes = List.length rs ; operations_hash ; fitness ; } in - return (shell_header, r) + return (shell_header, rs) let complete node ?block str = match block with diff --git a/lib_node_shell/node.mli b/lib_node_shell/node.mli index 2d49779c3..1d7268ceb 100644 --- a/lib_node_shell/node.mli +++ b/lib_node_shell/node.mli @@ -94,8 +94,8 @@ module RPC : sig val preapply: t -> block -> timestamp:Time.t -> proto_header:MBytes.t -> - sort_operations:bool -> Operation.t list -> - (Block_header.shell_header * error Preapply_result.t) tzresult Lwt.t + sort_operations:bool -> Operation.t list list -> + (Block_header.shell_header * error Preapply_result.t list) tzresult Lwt.t val context_dir: t -> block -> 'a RPC_directory.t option Lwt.t