diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index bd6b9215a..ee4cc7004 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -68,6 +68,26 @@ let preapply (type t) end | _ -> failwith "Unexpected result" +let simulate (type t) + (cctxt: #Proto_alpha.full) ~chain ~block + ?branch (contents : t contents_list) = + get_branch cctxt ~chain ~block branch >>=? fun branch -> + let op : _ Operation.t = + { shell = { branch } ; + protocol_data = { contents ; signature = None } } in + let oph = Operation.hash op in + Alpha_services.Helpers.Scripts.run_operation + cctxt (chain, block) (Operation.pack op) >>=? function + | (Operation_data op', Operation_metadata result) -> begin + match Operation.equal + op { shell = { branch } ; protocol_data = op' }, + Apply_operation_result.kind_equal_list contents result.contents with + | Some Operation.Eq, Some Apply_operation_result.Eq -> + return ((oph, op, result) : t preapply_result) + | _ -> failwith "Unexpected result" + end + | _ -> failwith "Unexpected result" + let estimated_gas_single (type kind) (Manager_operation_result { operation_result ; @@ -197,7 +217,7 @@ let detect_script_failure : let may_patch_limits (type kind) (cctxt : #Proto_alpha.full) ~chain ~block ?branch - ?src_sk (contents: kind contents_list) : kind contents_list tzresult Lwt.t = + (contents: kind contents_list) : kind contents_list tzresult Lwt.t = Alpha_services.Constants.all cctxt (chain, block) >>=? fun { parametric = { hard_gas_limit_per_operation = gas_limit ; @@ -287,8 +307,7 @@ let may_patch_limits end in match may_need_patching contents with | Some contents -> - preapply cctxt ~chain ~block - ?branch ?src_sk contents >>=? fun (_, _, result) -> + simulate cctxt ~chain ~block ?branch contents >>=? fun (_, _, result) -> let res = pack_contents_list contents result.contents in patch_list res | None -> return contents @@ -297,7 +316,7 @@ let inject_operation (type kind) cctxt ~chain ~block ?confirmations ?branch ?src_sk (contents: kind contents_list) = may_patch_limits - cctxt ~chain ~block ?branch ?src_sk contents >>=? fun contents -> + cctxt ~chain ~block ?branch contents >>=? fun contents -> preapply cctxt ~chain ~block ?branch ?src_sk contents >>=? fun (_oph, op, result) -> begin match detect_script_failure result with diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index e3571dba7..d29ccc8e1 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -123,6 +123,15 @@ module Scripts = struct ~query: RPC_query.empty RPC_path.(path / "hash_data") + let run_operation = + RPC_service.post_service + ~description: + "Run an operation without signature checks" + ~query: RPC_query.empty + ~input: Operation.encoding + ~output: Apply_operation_result.operation_data_and_metadata_encoding + RPC_path.(path / "run_operation") + end let register () = @@ -180,6 +189,59 @@ module Scripts = struct parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) -> Script_ir_translator.hash_data ctxt typ data >>=? fun (hash, ctxt) -> return (hash, Gas.level ctxt) + end ; + register0 S.run_operation begin fun ctxt () + { shell ; protocol_data = Operation_data protocol_data } -> + (* this code is a duplicate of Apply without signature check *) + let partial_precheck_manager_contents + (type kind) ctxt (op : kind Kind.manager contents) + : context tzresult Lwt.t = + let Manager_operation { source ; fee ; counter ; operation } = op in + Contract.must_be_allocated ctxt source >>=? fun () -> + Contract.check_counter_increment ctxt source counter >>=? fun () -> + begin + match operation with + | Reveal pk -> + Contract.reveal_manager_key ctxt source pk + | _ -> return ctxt + end >>=? fun ctxt -> + Contract.get_manager_key ctxt source >>=? fun _public_key -> + (* signature check unplugged from here *) + Contract.increment_counter ctxt source >>=? fun ctxt -> + Contract.spend ctxt source fee >>=? fun ctxt -> + return ctxt in + let rec partial_precheck_manager_contents_list + : type kind. + Alpha_context.t -> kind Kind.manager contents_list -> + context tzresult Lwt.t = + fun ctxt contents_list -> + match contents_list with + | Single (Manager_operation _ as op) -> + partial_precheck_manager_contents ctxt op + | Cons (Manager_operation _ as op, rest) -> + partial_precheck_manager_contents ctxt op >>=? fun ctxt -> + partial_precheck_manager_contents_list ctxt rest in + let return contents = + return (Operation_data protocol_data, + Apply_operation_result.Operation_metadata { contents }) in + let operation : _ operation = { shell ; protocol_data } in + let hash = Operation.hash { shell ; protocol_data } in + let ctxt = Contract.init_origination_nonce ctxt hash in + match protocol_data.contents with + | Single (Manager_operation _) as op -> + partial_precheck_manager_contents_list ctxt op >>=? fun ctxt -> + Apply.apply_manager_contents_list ctxt Readable op >>= fun (_ctxt, result) -> + return result + | Cons (Manager_operation _, _) as op -> + partial_precheck_manager_contents_list ctxt op >>=? fun ctxt -> + Apply.apply_manager_contents_list ctxt Readable op >>= fun (_ctxt, result) -> + return result + | _ -> + Apply.apply_contents_list + ctxt Readable shell.branch operation + operation.protocol_data.contents >>=? fun (_ctxt, result) -> + return result + end let run_code ctxt block code (storage, input, amount, contract) = @@ -199,6 +261,9 @@ module Scripts = struct let hash_data ctxt block = RPC_context.make_call0 S.hash_data ctxt block () + let run_operation ctxt block = + RPC_context.make_call0 S.run_operation ctxt block () + end module Forge = struct diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.mli b/src/proto_alpha/lib_protocol/src/helpers_services.mli index 4cb24117c..4c863bdfc 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.mli +++ b/src/proto_alpha/lib_protocol/src/helpers_services.mli @@ -52,6 +52,10 @@ module Scripts : sig 'a #RPC_context.simple -> 'a -> Script.expr * Script.expr * Z.t option -> (string * Gas.t) shell_tzresult Lwt.t + val run_operation: + 'a #RPC_context.simple -> + 'a -> packed_operation -> + (packed_protocol_data * Apply_operation_result.packed_operation_metadata) shell_tzresult Lwt.t end