Client, RPCs: do not sign transfer simulations

This commit is contained in:
Benjamin Canou 2018-06-17 02:02:42 +02:00
parent 79ab86b076
commit 94f9230d20
3 changed files with 92 additions and 4 deletions

View File

@ -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

View File

@ -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

View File

@ -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