diff --git a/src/lib_shell/block_directory.ml b/src/lib_shell/block_directory.ml index 087a65141..5a66cf1b3 100644 --- a/src/lib_shell/block_directory.ml +++ b/src/lib_shell/block_directory.ml @@ -252,7 +252,11 @@ let rpc_directory (* helpers *) - register0 S.Helpers.preapply begin fun block q p -> + register0 S.Helpers.Preapply.block begin fun block q p -> + let timestamp = + match q#timestamp with + | None -> Time.now () + | Some time -> time in let protocol_data = Data_encoding.Binary.to_bytes_exn Next_proto.block_header_data_encoding @@ -269,12 +273,32 @@ let rpc_directory p.operations in Prevalidation.preapply ~predecessor:block - ~timestamp:p.timestamp + ~timestamp ~protocol_data ~sort_operations:q#sort_operations operations end ; + register0 S.Helpers.Preapply.operations begin fun block () ops -> + State.Block.context block >>= fun ctxt -> + let predecessor = State.Block.hash block in + let header = State.Block.shell_header block in + Next_proto.begin_construction + ~predecessor_context:ctxt + ~predecessor_timestamp:header.timestamp + ~predecessor_level:header.level + ~predecessor_fitness:header.fitness + ~predecessor + ~timestamp:(Time.now ()) () >>=? fun state -> + fold_left_s + (fun (state, acc) op -> + Next_proto.apply_operation state op >>=? fun (state, result) -> + return (state, result :: acc)) + (state, []) ops >>=? fun (state, acc) -> + Next_proto.finalize_block state >>=? fun _ -> + return (List.rev acc) + end ; + register1 S.Helpers.complete begin fun block prefix () () -> State.Block.context block >>= fun ctxt -> Base58.complete prefix >>= fun l1 -> diff --git a/src/lib_shell_services/block_services.ml b/src/lib_shell_services/block_services.ml index b9ee98a4c..7ec0a8e28 100644 --- a/src/lib_shell_services/block_services.ml +++ b/src/lib_shell_services/block_services.ml @@ -524,52 +524,68 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct let path = RPC_path.(path / "context" / "helpers") - let preapply_result_encoding = - obj2 - (req "shell_header" Block_header.shell_header_encoding) - (req "operations" - (list (Preapply_result.encoding RPC_error.encoding))) + module Preapply = struct - type preapply_param = { - timestamp: Time.t ; - protocol_data: Next_proto.block_header_data ; - operations: Next_proto.operation list list ; - } + let path = RPC_path.(path / "preapply") - let preapply_param_encoding = - (conv - (fun { timestamp ; protocol_data ; operations } -> - (timestamp, protocol_data, operations)) - (fun (timestamp, protocol_data, operations) -> - { timestamp ; protocol_data ; operations }) - (obj3 - (req "timestamp" Time.encoding) - (req "protocol_data" - (conv - (fun h -> ((), h)) (fun ((), h) -> h) - (merge_objs - (obj1 (req "protocol" (constant next_protocol_hash))) - (dynamic_size Next_proto.block_header_data_encoding)))) - (req "operations" - (list (dynamic_size (list next_operation_encoding)))))) + let block_result_encoding = + obj2 + (req "shell_header" Block_header.shell_header_encoding) + (req "operations" + (list (Preapply_result.encoding RPC_error.encoding))) - let preapply_query : < sort_operations: bool > RPC_query.t = - let open RPC_query in - query (fun sort -> object - method sort_operations = sort - end) - |+ flag "sort" (fun t -> t#sort_operations) - |> seal + type block_param = { + protocol_data: Next_proto.block_header_data ; + operations: Next_proto.operation list list ; + } - let preapply = - RPC_service.post_service - ~description: - "Simulate the validation of a block that would contain \ - the given operations and return the resulting fitness." - ~query: preapply_query - ~input: preapply_param_encoding - ~output: preapply_result_encoding - RPC_path.(path / "preapply") + let block_param_encoding = + (conv + (fun { protocol_data ; operations } -> + (protocol_data, operations)) + (fun (protocol_data, operations) -> + { protocol_data ; operations }) + (obj2 + (req "protocol_data" + (conv + (fun h -> ((), h)) (fun ((), h) -> h) + (merge_objs + (obj1 (req "protocol" (constant next_protocol_hash))) + (dynamic_size Next_proto.block_header_data_encoding)))) + (req "operations" + (list (dynamic_size (list next_operation_encoding)))))) + + let block_query = + let open RPC_query in + query (fun sort timestamp -> object + method sort_operations = sort + method timestamp = timestamp + end) + |+ flag "sort" (fun t -> t#sort_operations) + |+ opt_field "timestamp" Time.rpc_arg (fun t -> t#timestamp) + |> seal + + let block = + RPC_service.post_service + ~description: + "Simulate the validation of a block that would contain \ + the given operations and return the resulting fitness \ + and context hash." + ~query: block_query + ~input: block_param_encoding + ~output: block_result_encoding + RPC_path.(path / "block") + + let operations = + RPC_service.post_service + ~description: + "Simulate the validation of an operation." + ~query: RPC_query.empty + ~input: (list next_operation_encoding) + ~output: (list (dynamic_size Next_proto.operation_metadata_encoding)) + RPC_path.(path / "operations") + + end let complete = let prefix_arg = @@ -830,14 +846,25 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct module S = S.Helpers - let preapply ctxt = - let f = make_call0 S.preapply ctxt in - fun - ?(chain = `Main) ?(block = `Head 0) - ?(sort = false) ~timestamp ~protocol_data operations -> - f chain block - (object method sort_operations = sort end) - { timestamp ; protocol_data ; operations } + module Preapply = struct + + module S = S.Preapply + + let block ctxt = + let f = make_call0 S.block ctxt in + fun + ?(chain = `Main) ?(block = `Head 0) + ?(sort = false) ?timestamp ~protocol_data operations -> + f chain block + (object method sort_operations = sort method timestamp = timestamp end) + { protocol_data ; operations } + + let operations ctxt = + let f = make_call0 S.operations ctxt in + fun ?(chain = `Main) ?(block = `Head 0) operations -> + f chain block () operations + + end let complete ctxt = let f = make_call1 S.complete ctxt in diff --git a/src/lib_shell_services/block_services.mli b/src/lib_shell_services/block_services.mli index c3177192e..ff8ec0c8e 100644 --- a/src/lib_shell_services/block_services.mli +++ b/src/lib_shell_services/block_services.mli @@ -222,13 +222,22 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig module Helpers : sig - val preapply: - #simple -> ?chain:chain -> ?block:block -> - ?sort:bool -> - timestamp:Time.t -> - protocol_data:Next_proto.block_header_data -> - Next_proto.operation list list -> - (Block_header.shell_header * error Preapply_result.t list) tzresult Lwt.t + module Preapply : sig + + val block: + #simple -> ?chain:chain -> ?block:block -> + ?sort:bool -> + ?timestamp:Time.t -> + protocol_data:Next_proto.block_header_data -> + Next_proto.operation list list -> + (Block_header.shell_header * error Preapply_result.t list) tzresult Lwt.t + + val operations: + #simple -> ?chain:chain -> ?block:block -> + Next_proto.operation list -> + Next_proto.operation_metadata list tzresult Lwt.t + + end val complete: #simple -> ?chain:chain -> ?block:block -> @@ -413,16 +422,25 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig module Helpers : sig - type preapply_param = { - timestamp: Time.t ; - protocol_data: Next_proto.block_header_data ; - operations: Next_proto.operation list list ; - } + module Preapply : sig - val preapply: - ([ `POST ], prefix, - prefix, < sort_operations : bool >, preapply_param, - Block_header.shell_header * error Preapply_result.t list) RPC_service.t + type block_param = { + protocol_data: Next_proto.block_header_data ; + operations: Next_proto.operation list list ; + } + + val block: + ([ `POST ], prefix, + prefix, < sort_operations : bool; + timestamp : Time.t option >, block_param, + Block_header.shell_header * error Preapply_result.t list) RPC_service.t + + val operations: + ([ `POST ], prefix, + prefix, unit, Next_proto.operation list, + Next_proto.operation_metadata list) RPC_service.t + + end val complete: ([ `GET ], prefix, diff --git a/src/proto_alpha/lib_baking/client_baking_forge.ml b/src/proto_alpha/lib_baking/client_baking_forge.ml index d5072a395..59b84aae7 100644 --- a/src/proto_alpha/lib_baking/client_baking_forge.ml +++ b/src/proto_alpha/lib_baking/client_baking_forge.ml @@ -199,7 +199,7 @@ let forge_block cctxt ?(chain = `Main) block let request = List.length operations in let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in let operations = classify_operations operations in - Block_services.Helpers.preapply + Block_services.Helpers.Preapply.block cctxt ~block ~timestamp ~sort ~protocol_data operations >>=? fun (shell_header, result) -> let valid = @@ -519,7 +519,8 @@ let bake (cctxt : #Proto_alpha.full) state = let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in let operations = classify_operations operations in - Block_services.Helpers.preapply cctxt ~chain ~block + Block_services.Helpers.Preapply.block + cctxt ~chain ~block ~timestamp ~sort:true ~protocol_data operations >>= function | Error errs -> lwt_log_error "Error while prevalidating operations:@\n%a" diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli index 554a5c827..9db8f7f99 100644 --- a/src/proto_alpha/lib_client/client_proto_context.mli +++ b/src/proto_alpha/lib_client/client_proto_context.mli @@ -10,20 +10,20 @@ open Proto_alpha open Alpha_context -val list_contract_labels : +val list_contract_labels: #Proto_alpha.full -> chain:Chain_services.chain -> block:Block_services.block -> (string * string * string) list tzresult Lwt.t -val get_storage : +val get_storage: #Proto_alpha.rpc_context -> chain:Chain_services.chain -> block:Block_services.block -> Contract.t -> Script.expr option tzresult Lwt.t -val get_manager : +val get_manager: #Proto_alpha.full -> chain:Chain_services.chain -> block:Block_services.block -> @@ -38,7 +38,7 @@ val get_balance: Contract.t -> Tez.t tzresult Lwt.t -val set_delegate : +val set_delegate: #Proto_alpha.full -> chain:Chain_services.chain -> block:Block_services.block -> diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index f1f30105e..4b7646ba2 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -51,10 +51,10 @@ let preapply { shell = { branch } ; protocol_data = { contents ; signature } } in let oph = Operation.hash op in - Block_services.hash cctxt ~chain ~block () >>=? fun bh -> - Alpha_services.Helpers.apply_operation cctxt - (chain, block) bh oph bytes signature >>=? fun result -> - return (oph, op, result) + Block_services.Helpers.Preapply.operations cctxt ~chain ~block + [op] >>=? function + | [result] -> return (oph, op, result) + | _ -> failwith "Unexpected result" let estimated_gas = function | Sourced_operation_result (Manager_operations_result { operation_results }) -> diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index 1f0142ebd..3a05995ac 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -100,18 +100,6 @@ module S = struct (opt "big_map_diff" (list (tup2 string (option Script.expr_encoding))))) RPC_path.(custom_root / "run_code") - let apply_operation = - RPC_service.post_service - ~description: "Applies an operation in the current context" - ~query: RPC_query.empty - ~input: (obj4 - (req "pred_block" Block_hash.encoding) - (req "operation_hash" Operation_hash.encoding) - (req "forged_operation" bytes) - (opt "signature" Signature.encoding)) - ~output: Apply_operation_result.encoding - RPC_path.(custom_root / "apply_operation") - let trace_code = RPC_service.post_service ~description: "Run a piece of code in the current context, \ @@ -170,22 +158,6 @@ module S = struct end -module I = struct - - let apply_operation ctxt () (pred_block, hash, forged_operation, signature) = - (* ctxt accept_failing_script baker_contract pred_block block_prio operation *) - match Data_encoding.Binary.of_bytes - Operation.unsigned_encoding - forged_operation with - | None -> fail Cannot_parse_operation - | Some (shell, contents) -> - let operation = { shell ; protocol_data = { contents ; signature } } in - Apply.apply_operation - ctxt Readable pred_block hash operation >>=? fun (_, result) -> - return result - -end - let () = let open Services_registration in register0 S.level begin fun ctxt q () -> @@ -202,7 +174,6 @@ let () = let timestamp = Alpha_context.Timestamp.current ctxt in Baking.minimal_time ctxt q.priority timestamp end ; - register0 S.apply_operation I.apply_operation ; register0 S.run_code begin fun ctxt () (code, storage, parameter, amount, contract) -> Lwt.return (Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt)) >>=? fun ctxt -> @@ -271,10 +242,6 @@ let run_code ctxt block code (storage, input, amount, contract) = RPC_context.make_call0 S.run_code ctxt block () (code, storage, input, amount, contract) -let apply_operation ctxt block pred_block hash forged_operation signature = - RPC_context.make_call0 S.apply_operation ctxt - block () (pred_block, hash, forged_operation, signature) - let trace_code ctxt block code (storage, input, amount, contract) = RPC_context.make_call0 S.trace_code ctxt block () (code, storage, input, amount, contract) diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.mli b/src/proto_alpha/lib_protocol/src/helpers_services.mli index a1405861a..b30fc96b0 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.mli +++ b/src/proto_alpha/lib_protocol/src/helpers_services.mli @@ -28,11 +28,6 @@ val minimal_time: timestamp for the successor of [blk]. [?priority] defaults to [0]. *) -val apply_operation: - 'a #RPC_context.simple -> - 'a -> Block_hash.t -> Operation_hash.t -> MBytes.t -> Signature.t option -> - Apply_operation_result.operation_result shell_tzresult Lwt.t - val run_code: 'a #RPC_context.simple -> 'a -> Script.expr -> diff --git a/src/proto_genesis/lib_client/client_proto_main.ml b/src/proto_genesis/lib_client/client_proto_main.ml index 1fb9dee89..099a8dda9 100644 --- a/src/proto_genesis/lib_client/client_proto_main.ml +++ b/src/proto_genesis/lib_client/client_proto_main.ml @@ -15,7 +15,7 @@ let protocol = let bake cctxt ?(timestamp = Time.now ()) block command sk = let protocol_data = { command ; signature = Signature.zero } in - Block_services.Helpers.preapply + Block_services.Helpers.Preapply.block cctxt ~block ~timestamp ~protocol_data [] >>=? fun (shell_header, _) -> let blk = Data.Command.forge shell_header command in