Verified Commit 2d51e996 authored by Alain Mebsout's avatar Alain Mebsout Committed by Marco Stronati

Alpha/RPCs: optional fields for source, payer, gas in run and trace

This patch adds new options to the Michelson interpreter RPCs.
They allow to customize the interpreter behaviour.
It only makes utility RPCs more flexible, and does not change the
semantics of Michelson.
parent 94cfcfd2
......@@ -88,36 +88,47 @@ module ContractAlias = struct
(fun cctxt p -> get_contract cctxt p))
next)
let destination_parameter () =
Clic.parameter
~autocomplete:(fun cctxt ->
autocomplete cctxt >>=? fun list1 ->
Client_keys.Public_key_hash.autocomplete cctxt >>=? fun list2 ->
return (list1 @ list2))
(fun cctxt s ->
begin
match String.split ~limit:1 ':' s with
| [ "alias" ; alias ]->
find cctxt alias
| [ "key" ; text ] ->
Client_keys.Public_key_hash.find cctxt text >>=? fun v ->
return (s, Contract.implicit_contract v)
| _ ->
find cctxt s >>= function
| Ok v -> return v
| Error k_errs ->
ContractEntity.of_source s >>= function
| Ok v -> return (s, v)
| Error c_errs ->
Lwt.return (Error (k_errs @ c_errs))
end)
let destination_param ?(name = "dst") ?(desc = "destination contract") next =
let desc =
desc ^ "\n"
^ "Can be an alias, a key, or a literal (autodetected in order).\n\
Use 'text:literal', 'alias:name', 'key:name' to force." in
Clic.(
param ~name ~desc
(parameter
~autocomplete:(fun cctxt ->
autocomplete cctxt >>=? fun list1 ->
Client_keys.Public_key_hash.autocomplete cctxt >>=? fun list2 ->
return (list1 @ list2))
(fun cctxt s ->
begin
match String.split ~limit:1 ':' s with
| [ "alias" ; alias ]->
find cctxt alias
| [ "key" ; text ] ->
Client_keys.Public_key_hash.find cctxt text >>=? fun v ->
return (s, Contract.implicit_contract v)
| _ ->
find cctxt s >>= function
| Ok v -> return v
| Error k_errs ->
ContractEntity.of_source s >>= function
| Ok v -> return (s, v)
| Error c_errs ->
Lwt.return (Error (k_errs @ c_errs))
end)))
next
String.concat "\n" [
desc ;
"Can be an alias, a key, or a literal (autodetected in order).\n\
Use 'text:literal', 'alias:name', 'key:name' to force."
] in
Clic.param ~name ~desc (destination_parameter ()) next
let destination_arg ?(name = "dst") ?(doc = "destination contract") () =
let doc =
String.concat "\n" [
doc ;
"Can be an alias, a key, or a literal (autodetected in order).\n\
Use 'text:literal', 'alias:name', 'key:name' to force."
] in
Clic.arg ~long:name ~doc ~placeholder:name (destination_parameter ())
let name cctxt contract =
rev_find cctxt contract >>=? function
......
......@@ -44,6 +44,11 @@ module ContractAlias : sig
?desc:string ->
('a, (#Client_context.wallet as 'wallet)) params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet) params
val destination_arg:
?name:string ->
?doc:string ->
unit ->
((Lwt_io.file_name * Contract.t) option, #Client_context.wallet) Clic.arg
val rev_find:
#Client_context.wallet ->
Contract.t -> string option tzresult Lwt.t
......
......@@ -102,10 +102,14 @@ let run
~(program : Michelson_v1_parser.parsed)
~(storage : Michelson_v1_parser.parsed)
~(input : Michelson_v1_parser.parsed)
?source
?payer
?gas
() =
Alpha_services.Helpers.Scripts.run_code cctxt
(chain, block)
program.expanded (storage.expanded, input.expanded, amount)
program.expanded
(storage.expanded, input.expanded, amount, source, payer, gas)
let trace
(cctxt : #Proto_alpha.rpc_context)
......@@ -115,10 +119,14 @@ let trace
~(program : Michelson_v1_parser.parsed)
~(storage : Michelson_v1_parser.parsed)
~(input : Michelson_v1_parser.parsed)
?source
?payer
?gas
() =
Alpha_services.Helpers.Scripts.trace_code cctxt
(chain, block)
program.expanded (storage.expanded, input.expanded, amount)
program.expanded
(storage.expanded, input.expanded, amount, source, payer, gas)
let typecheck_data
cctxt
......
......@@ -38,6 +38,9 @@ val run :
program:Michelson_v1_parser.parsed ->
storage:Michelson_v1_parser.parsed ->
input:Michelson_v1_parser.parsed ->
?source:Contract.t ->
?payer:Contract.t ->
?gas:Z.t ->
unit ->
(Script.expr *
packed_internal_operation list *
......@@ -51,6 +54,9 @@ val trace :
program:Michelson_v1_parser.parsed ->
storage:Michelson_v1_parser.parsed ->
input:Michelson_v1_parser.parsed ->
?source:Contract.t ->
?payer:Contract.t ->
?gas:Z.t ->
unit ->
(Script.expr *
packed_internal_operation list *
......
......@@ -32,6 +32,7 @@ let group =
open Tezos_micheline
open Client_proto_programs
open Client_proto_args
open Client_proto_contracts
let commands () =
let open Clic in
......@@ -57,6 +58,16 @@ let commands () =
~parameter:"amount"
~doc:"amount of the transfer in \xEA\x9C\xA9"
~default:"0.05" in
let source_arg =
Please register or sign in to reply
ContractAlias.destination_arg
~name: "source"
~doc: "name of the source (i.e. SENDER) contract for the transaction"
() in
let payer_arg =
ContractAlias.destination_arg
~name: "payer"
~doc: "name of the payer (i.e. SOURCE) contract for the transaction"
() in
let custom_gas_flag =
arg
~long:"gas"
......@@ -137,25 +148,31 @@ let commands () =
return_unit) ;
command ~group ~desc: "Ask the node to run a script."
(args3 trace_stack_switch amount_arg no_print_source_flag)
(args6 trace_stack_switch amount_arg source_arg payer_arg no_print_source_flag custom_gas_flag)
(prefixes [ "run" ; "script" ]
@@ Program.source_param
@@ prefixes [ "on" ; "storage" ]
@@ Clic.param ~name:"storage" ~desc:"the storage data"
data_parameter
@@ prefixes [ "and" ; "input" ]
@@ Clic.param ~name:"storage" ~desc:"the input data"
@@ Clic.param ~name:"input" ~desc:"the input data"
data_parameter
@@ stop)
(fun (trace_exec, amount, no_print_source) program storage input cctxt ->
Lwt.return @@ Micheline_parser.no_parsing_error program >>=? fun program ->
let show_source = not no_print_source in
(if trace_exec then
trace cctxt cctxt#block ~amount ~program ~storage ~input () >>= fun res ->
print_trace_result cctxt ~show_source ~parsed:program res
else
run cctxt cctxt#block ~amount ~program ~storage ~input () >>= fun res ->
print_run_result cctxt ~show_source ~parsed:program res)) ;
(fun
(trace_exec, amount, source, payer, no_print_source, gas)
program storage input cctxt ->
let source = Option.map ~f:snd source in
let payer = Option.map ~f:snd payer in
Lwt.return @@ Micheline_parser.no_parsing_error program >>=? fun program ->
let show_source = not no_print_source in
(if trace_exec then
trace cctxt cctxt#block
~amount ~program ~storage ~input ?source ?payer ?gas () >>= fun res ->
print_trace_result cctxt ~show_source ~parsed:program res
else
run cctxt cctxt#block
~amount ~program ~storage ~input ?source ?payer ?gas () >>= fun res ->
print_run_result cctxt ~show_source ~parsed:program res)) ;
command ~group ~desc: "Ask the node to typecheck a script."
(args4 show_types_switch emacs_mode_switch no_print_source_flag custom_gas_flag)
(prefixes [ "typecheck" ; "script" ]
......
......@@ -59,11 +59,14 @@ module Scripts = struct
let path = RPC_path.(path / "scripts")
let run_code_input_encoding =
(obj4
(obj7
(req "script" Script.expr_encoding)
(req "storage" Script.expr_encoding)
(req "input" Script.expr_encoding)
(req "amount" Tez.encoding))
(req "amount" Tez.encoding)
(opt "source" Contract.encoding)
(opt "payer" Contract.encoding)
(opt "gas" z))
let trace_encoding =
def "scripted.trace" @@
......@@ -167,30 +170,46 @@ module Scripts = struct
~script: (script, None) >>=? fun ctxt ->
return (ctxt, dummy_contract) in
register0 S.run_code begin fun ctxt ()
(code, storage, parameter, amount) ->
(code, storage, parameter, amount, source, payer, gas) ->
let storage = Script.lazy_expr storage in
let code = Script.lazy_expr code in
originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) ->
let ctxt = Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt) in
let source, payer = match source, payer with
| Some source, Some payer -> source, payer
| Some source, None -> source, source
| None, Some payer -> payer, payer
| None, None -> dummy_contract, dummy_contract in
let gas = match gas with
| Some gas -> gas
| None -> Constants.hard_gas_limit_per_operation ctxt in
let ctxt = Gas.set_limit ctxt gas in
Script_interpreter.execute
ctxt Readable
~source:dummy_contract
~payer:dummy_contract
~source
~payer
~self:(dummy_contract, { storage ; code })
~amount ~parameter
>>=? fun { Script_interpreter.storage ; operations ; big_map_diff ; _ } ->
return (storage, operations, big_map_diff)
end ;
register0 S.trace_code begin fun ctxt ()
(code, storage, parameter, amount) ->
(code, storage, parameter, amount, source, payer, gas) ->
let storage = Script.lazy_expr storage in
let code = Script.lazy_expr code in
originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) ->
let ctxt = Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt) in
let source, payer = match source, payer with
| Some source, Some payer -> source, payer
| Some source, None -> source, source
| None, Some payer -> payer, payer
| None, None -> dummy_contract, dummy_contract in
let gas = match gas with
| Some gas -> gas
| None -> Constants.hard_gas_limit_per_operation ctxt in
let ctxt = Gas.set_limit ctxt gas in
Script_interpreter.trace
ctxt Readable
~source:dummy_contract
~payer:dummy_contract
~source
~payer
~self:(dummy_contract, { storage ; code })
~amount ~parameter
>>=? fun ({ Script_interpreter.storage ; operations ; big_map_diff ; _ }, trace) ->
......@@ -305,13 +324,13 @@ module Scripts = struct
end
let run_code ctxt block code (storage, input, amount) =
let run_code ctxt block code (storage, input, amount, source, payer, gas) =
RPC_context.make_call0 S.run_code ctxt
block () (code, storage, input, amount)
block () (code, storage, input, amount, source, payer, gas)
let trace_code ctxt block code (storage, input, amount) =
let trace_code ctxt block code (storage, input, amount, source, payer, gas) =
RPC_context.make_call0 S.trace_code ctxt
block () (code, storage, input, amount)
block () (code, storage, input, amount, source, payer, gas)
let typecheck_code ctxt block =
RPC_context.make_call0 S.typecheck_code ctxt block ()
......
......@@ -39,7 +39,8 @@ module Scripts : sig
val run_code:
'a #RPC_context.simple ->
'a -> Script.expr -> (Script.expr * Script.expr * Tez.t) ->
'a -> Script.expr ->
(Script.expr * Script.expr * Tez.t * Contract.t option * Contract.t option * Z.t option) ->
(Script.expr *
packed_internal_operation list *
Contract.big_map_diff option) shell_tzresult Lwt.t
......@@ -47,7 +48,7 @@ module Scripts : sig
val trace_code:
'a #RPC_context.simple ->
'a -> Script.expr ->
(Script.expr * Script.expr * Tez.t) ->
(Script.expr * Script.expr * Tez.t * Contract.t option * Contract.t option* Z.t option) ->
(Script.expr *
packed_internal_operation list *
Script_interpreter.execution_trace *
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment