diff --git a/CHANGES.rst b/CHANGES.rst index 04d6f19886e41e6ab92bbef059b9fa7e788a7c28..0ba861131877ba8808d1e08a33985ea13db8dc5b 100644 --- a/CHANGES.rst +++ b/CHANGES.rst @@ -69,6 +69,9 @@ Client - Fixed indentation of the stacks outputted by the ``normalize stack`` command. (MR :gl:`!9944`) +- Added options to temporarily extend the context with other contracts + and extra big maps in Michelson commands. (MR :gl:`!9946`) + Baker ----- diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index c183c2cf785da56247f970a6007ffa9ee11e8227..b89fc2d23c41f8e505eeece2ce8031dfc3b3dc08 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -243,17 +243,20 @@ let binary_encoded_parameter ~name encoding = in file_or_text_parameter ~from_text () +let parse_micheline_parameter source = + Lwt.return @@ Tezos_micheline.Micheline_parser.no_parsing_error + @@ + let tokens, lexing_errors = + Tezos_micheline.Micheline_parser.tokenize source + in + let ast, parsing_errors = + Tezos_micheline.Micheline_parser.parse_expression tokens + in + ((ast, source), lexing_errors @ parsing_errors) + let micheline_parameter = - Tezos_clic.parameter (fun _ source -> - Lwt.return @@ Tezos_micheline.Micheline_parser.no_parsing_error - @@ - let tokens, lexing_errors = - Tezos_micheline.Micheline_parser.tokenize source - in - let ast, parsing_errors = - Tezos_micheline.Micheline_parser.parse_expression tokens - in - ((ast, source), lexing_errors @ parsing_errors)) + Tezos_clic.parameter (fun (_ : full) source -> + parse_micheline_parameter source) let entrypoint_parameter = Tezos_clic.parameter (fun _ str -> @@ -267,6 +270,36 @@ let init_arg = ~default:"Unit" string_parameter +let other_contracts_parameter = + Tezos_clic.parameter (fun _ source -> + let open Lwt_result_syntax in + let* micheline, source = parse_micheline_parameter source in + let*? l = Michelson_v1_stack.parse_other_contracts ~source micheline in + return l) + +let other_contracts_arg = + Tezos_clic.arg + ~doc: + {|types and addresses of extra contracts, formatted as {Contract "KT1..." ; Contract "KT1..." ; ...}|} + ~long:"other-contracts" + ~placeholder:"contracts" + other_contracts_parameter + +let extra_big_maps_parameter = + Tezos_clic.parameter (fun _ source -> + let open Lwt_result_syntax in + let* micheline, source = parse_micheline_parameter source in + let*? l = Michelson_v1_stack.parse_extra_big_maps ~source micheline in + return l) + +let extra_big_maps_arg = + Tezos_clic.arg + ~doc: + {|identifier and content of extra big maps, formatted as {Big_map {Elt ; Elt ; ...}}|} + ~long:"extra-big-maps" + ~placeholder:"big maps" + extra_big_maps_parameter + let global_constant_param ~name ~desc next = Tezos_clic.param ~name ~desc string_parameter next diff --git a/src/proto_alpha/lib_client/client_proto_args.mli b/src/proto_alpha/lib_client/client_proto_args.mli index e15fb3955a119b48972dd1125ddd138b9f3ad0b7..2d9e700bda64fd96dbfe1db2b08f2797a482345d 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -238,6 +238,12 @@ val limit_of_staking_over_baking_millionth_arg : val edge_of_baking_over_staking_billionth_arg : (int option, full) Tezos_clic.arg +val other_contracts_arg : + (RPC.Scripts.S.other_contract_description list option, full) Tezos_clic.arg + +val extra_big_maps_arg : + (RPC.Scripts.S.extra_big_map_description list option, full) Tezos_clic.arg + module Sc_rollup_params : sig val rollup_kind_parameter : (Sc_rollup.Kind.t, full) Tezos_clic.parameter diff --git a/src/proto_alpha/lib_client/client_proto_fa12.ml b/src/proto_alpha/lib_client/client_proto_fa12.ml index 77c8107222fdb57f087de0dd8bf7b43565e7a3f5..925713f50843b848cbf3968c39f5dec566a048db 100644 --- a/src/proto_alpha/lib_client/client_proto_fa12.ml +++ b/src/proto_alpha/lib_client/client_proto_fa12.ml @@ -992,7 +992,7 @@ let is_viewable_action action = | _ -> tzfail (Not_a_viewable_entrypoint (action_to_entrypoint action)) let run_view_action (cctxt : #Protocol_client_context.full) ~chain ~block - ?sender ~contract ~action ?payer ?gas ~unparsing_mode () = + ~sender ~contract ~action ~payer ~gas ~unparsing_mode () = let open Lwt_result_syntax in let* () = is_viewable_action action in let* () = contract_has_fa12_interface cctxt ~chain ~block ~contract () in @@ -1005,13 +1005,15 @@ let run_view_action (cctxt : #Protocol_client_context.full) ~chain ~block ~contract ~input ~chain_id - ?sender - ?payer - ?gas + ~sender + ~payer + ~gas ~entrypoint ~unparsing_mode ~now:None ~level:None + ~other_contracts:None + ~extra_big_maps:None let () = Data_encoding.( diff --git a/src/proto_alpha/lib_client/client_proto_fa12.mli b/src/proto_alpha/lib_client/client_proto_fa12.mli index 3c11c7340043e9563220cc395657d4aa85201e59..21e75392fc50e74d2baeb6f29acb32263ea869fd 100644 --- a/src/proto_alpha/lib_client/client_proto_fa12.mli +++ b/src/proto_alpha/lib_client/client_proto_fa12.mli @@ -152,11 +152,11 @@ val run_view_action : full -> chain:Shell_services.chain -> block:Shell_services.block -> - ?sender:Contract.t -> + sender:Contract.t option -> contract:Contract_hash.t -> action:action -> - ?payer:Signature.public_key_hash -> - ?gas:Gas.Arith.integral -> + payer:Signature.public_key_hash option -> + gas:Gas.Arith.integral option -> unparsing_mode:Script_ir_unparser.unparsing_mode -> unit -> Script.expr tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/client_proto_multisig.ml b/src/proto_alpha/lib_client/client_proto_multisig.ml index b9b79003abd7d963dfee3e1468e63e33a9f99249..ee854ff5ee6e357a89b5eba5b16788cb7c5f0e04 100644 --- a/src/proto_alpha/lib_client/client_proto_multisig.ml +++ b/src/proto_alpha/lib_client/client_proto_multisig.ml @@ -998,7 +998,7 @@ type multisig_prepared_action = { generic : bool; } -let check_parameter_type (cctxt : #Protocol_client_context.full) ?gas ?legacy +let check_parameter_type (cctxt : #Protocol_client_context.full) ~gas ~legacy ~destination ~entrypoint ~parameter_type ~parameter () = let open Lwt_result_syntax in let* _ = @@ -1009,13 +1009,13 @@ let check_parameter_type (cctxt : #Protocol_client_context.full) ?gas ?legacy (cctxt#chain, cctxt#block) ~data:parameter ~ty:parameter_type - ?gas - ?legacy + ~gas + ~legacy in return_unit -let check_action (cctxt : #Protocol_client_context.full) ~action ~balance ?gas - ?legacy () = +let check_action (cctxt : #Protocol_client_context.full) ~action ~balance ~gas + ~legacy () = let open Lwt_result_syntax in match action with | Change_keys (threshold, keys) -> @@ -1029,6 +1029,8 @@ let check_action (cctxt : #Protocol_client_context.full) ~action ~balance ?gas ~entrypoint ~parameter_type ~parameter + ~gas:None + ~legacy:false () in if Tez.(amount > balance) then @@ -1049,8 +1051,8 @@ let check_action (cctxt : #Protocol_client_context.full) ~action ~balance ?gas (cctxt#chain, cctxt#block) ~data:code ~ty:action_t - ?gas - ?legacy + ~gas + ~legacy in return_unit | _ -> return_unit @@ -1073,7 +1075,7 @@ let prepare_multisig_transaction (cctxt : #Protocol_client_context.full) ~chain ~block:cctxt#block contract in - let* () = check_action cctxt ~action ~balance () in + let* () = check_action cctxt ~action ~balance ~gas:None ~legacy:false () in return { bytes; diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 7b163d1fc81f7b77972252f0b3136c5d5afbe0ec..e3762a69cafa8f40b3944849a26c69f971c1a3ed 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -148,6 +148,8 @@ type simulation_params = { sender : Contract.t option; payer : Signature.public_key_hash option; gas : Gas.Arith.integral option; + other_contracts : RPC.Scripts.S.other_contract_description list option; + extra_big_maps : RPC.Scripts.S.extra_big_map_description list option; } type run_view_params = { @@ -177,7 +179,18 @@ let run_view (cctxt : #Protocol_client_context.rpc_context) ~(chain : Chain_services.chain) ~block (params : run_view_params) = let open Lwt_result_syntax in let { - shared_params = {input; unparsing_mode; now; level; sender; payer; gas}; + shared_params = + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; contract; entrypoint; } = @@ -187,22 +200,35 @@ let run_view (cctxt : #Protocol_client_context.rpc_context) Plugin.RPC.Scripts.run_tzip4_view cctxt (chain, block) - ?gas + ~gas ~contract ~entrypoint ~input:input.expanded ~chain_id - ?sender - ?payer + ~sender + ~payer ~unparsing_mode ~now ~level + ~other_contracts + ~extra_big_maps let run_script_view (cctxt : #Protocol_client_context.rpc_context) ~(chain : Chain_services.chain) ~block (params : run_script_view_params) = let open Lwt_result_syntax in let { - shared_params = {input; unparsing_mode; now; level; sender; payer; gas}; + shared_params = + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; contract; view; unlimited_gas; @@ -213,24 +239,37 @@ let run_script_view (cctxt : #Protocol_client_context.rpc_context) Plugin.RPC.Scripts.run_script_view cctxt (chain, block) - ?gas + ~gas ~contract ~view ~input:input.expanded ~unlimited_gas ~chain_id - ?sender - ?payer + ~sender + ~payer ~unparsing_mode ~now ~level + ~other_contracts + ~extra_big_maps let run (cctxt : #Protocol_client_context.rpc_context) ~(chain : Chain_services.chain) ~block (params : run_params) = let open Lwt_result_syntax in let* chain_id = Chain_services.chain_id cctxt ~chain () in let { - shared_params = {input; unparsing_mode; now; level; sender; payer; gas}; + shared_params = + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; program; amount; balance; @@ -241,30 +280,44 @@ let run (cctxt : #Protocol_client_context.rpc_context) params in let amount = Option.value ~default:Tez.fifty_cents amount in + let entrypoint = Option.value ~default:Entrypoint.default entrypoint in Plugin.RPC.Scripts.run_code cctxt (chain, block) - ?gas - ?entrypoint - ~unparsing_mode + ~gas + ~entrypoint + ~unparsing_mode:(Some unparsing_mode) ~script:program.expanded ~storage:storage.expanded ~input:input.expanded ~amount - ?balance + ~balance ~chain_id ~sender ~payer ~self ~now ~level + ~other_contracts + ~extra_big_maps let trace (cctxt : #Protocol_client_context.rpc_context) ~(chain : Chain_services.chain) ~block (params : run_params) = let open Lwt_result_syntax in let* chain_id = Chain_services.chain_id cctxt ~chain () in let { - shared_params = {input; unparsing_mode; now; level; sender; payer; gas}; + shared_params = + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; program; amount; balance; @@ -275,52 +328,55 @@ let trace (cctxt : #Protocol_client_context.rpc_context) params in let amount = Option.value ~default:Tez.fifty_cents amount in + let entrypoint = Option.value ~default:Entrypoint.default entrypoint in Plugin.RPC.Scripts.trace_code cctxt (chain, block) - ?gas - ?entrypoint - ~unparsing_mode + ~gas + ~entrypoint + ~unparsing_mode:(Some unparsing_mode) ~script:program.expanded ~storage:storage.expanded ~input:input.expanded ~amount - ?balance + ~balance ~chain_id ~sender ~payer ~self ~now ~level + ~other_contracts + ~extra_big_maps -let typecheck_data cctxt ~(chain : Chain_services.chain) ~block ?gas ?legacy +let typecheck_data cctxt ~(chain : Chain_services.chain) ~block ~gas ~legacy ~(data : Michelson_v1_parser.parsed) ~(ty : Michelson_v1_parser.parsed) () = Plugin.RPC.Scripts.typecheck_data cctxt (chain, block) - ?gas - ?legacy + ~gas + ~legacy ~data:data.expanded ~ty:ty.expanded -let typecheck_program cctxt ~(chain : Chain_services.chain) ~block ?gas ?legacy +let typecheck_program cctxt ~(chain : Chain_services.chain) ~block ~gas ~legacy ~show_types (program : Michelson_v1_parser.parsed) = Plugin.RPC.Scripts.typecheck_code cctxt (chain, block) - ?gas - ?legacy + ~gas + ~legacy ~script:program.expanded ~show_types -let script_size cctxt ~(chain : Chain_services.chain) ~block ?gas ?legacy +let script_size cctxt ~(chain : Chain_services.chain) ~block ~gas ~legacy ~(program : Michelson_v1_parser.parsed) ~(storage : Michelson_v1_parser.parsed) () = Plugin.RPC.Scripts.script_size cctxt (chain, block) - ?gas - ?legacy + ~gas + ~legacy ~script:program.expanded ~storage:storage.expanded diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index 402273d2db1c8cd507b93871e06de22d54e70139..638d4e6a2752dde453aed6f822115f758e0b21a2 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -41,6 +41,8 @@ type simulation_params = { sender : Contract.t option; payer : Signature.public_key_hash option; gas : Gas.Arith.integral option; + other_contracts : RPC.Scripts.S.other_contract_description list option; + extra_big_maps : RPC.Scripts.S.extra_big_map_description list option; } (* Parameters specific to simulations of TZIP4 views *) @@ -144,8 +146,8 @@ val typecheck_data : #Protocol_client_context.rpc_context -> chain:Shell_services.chain -> block:Shell_services.block -> - ?gas:Gas.Arith.integral -> - ?legacy:bool -> + gas:Gas.Arith.integral option -> + legacy:bool -> data:Michelson_v1_parser.parsed -> ty:Michelson_v1_parser.parsed -> unit -> @@ -156,8 +158,8 @@ val typecheck_program : #Protocol_client_context.rpc_context -> chain:Shell_services.chain -> block:Shell_services.block -> - ?gas:Gas.Arith.integral -> - ?legacy:bool -> + gas:Gas.Arith.integral option -> + legacy:bool -> show_types:bool -> Michelson_v1_parser.parsed -> (Script_tc_errors.type_map * Gas.t) tzresult Lwt.t @@ -178,8 +180,8 @@ val script_size : #Protocol_client_context.rpc_context -> chain:Shell_services.chain -> block:Shell_services.block -> - ?gas:Gas.Arith.integral -> - ?legacy:bool -> + gas:Gas.Arith.integral option -> + legacy:bool -> program:Michelson_v1_parser.parsed -> storage:Michelson_v1_parser.parsed -> unit -> diff --git a/src/proto_alpha/lib_client/michelson_v1_stack.ml b/src/proto_alpha/lib_client/michelson_v1_stack.ml index 5f1675b5964b4466a6bdcc8136bada5970677310..3800dd11425dfe727d642fee4bb4f74675bd6d73 100644 --- a/src/proto_alpha/lib_client/michelson_v1_stack.ml +++ b/src/proto_alpha/lib_client/michelson_v1_stack.ml @@ -30,6 +30,13 @@ open Alpha_context type error += | Wrong_stack_item of Micheline_parser.location * Micheline_printer.node | Wrong_stack of Micheline_parser.location * Micheline_printer.node + | Wrong_other_contracts_item of + Micheline_parser.location * Micheline_printer.node + | Wrong_other_contracts of Micheline_parser.location * Micheline_printer.node + | Wrong_extra_big_maps_item of + Micheline_parser.location * Micheline_printer.node + | Wrong_extra_big_maps of Micheline_parser.location * Micheline_printer.node + | Invalid_address_for_smart_contract of string let micheline_printer_location_encoding : Micheline_printer.location Data_encoding.encoding = @@ -81,7 +88,96 @@ let () = (req "location" Micheline_parser.location_encoding) (req "node" micheline_printer_node_encoding)) (function Wrong_stack (loc, node) -> Some (loc, node) | _ -> None) - (fun (loc, node) -> Wrong_stack (loc, node)) + (fun (loc, node) -> Wrong_stack (loc, node)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"michelson.wrong_other_contracts_item" + ~title:"Wrong description of an other contract" + ~description:"Failed to parse an item in a description of other contracts." + ~pp:(fun ppf (_loc, node) -> + Format.fprintf + ppf + "Unexpected format for an item in a description of other contracts. \ + Expected: Contract
; got %a." + Micheline_printer.print_expr_unwrapped + node) + (obj2 + (req "location" Micheline_parser.location_encoding) + (req "node" micheline_printer_node_encoding)) + (function + | Wrong_other_contracts_item (loc, node) -> Some (loc, node) | _ -> None) + (fun (loc, node) -> Wrong_other_contracts_item (loc, node)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"michelson.wrong_other_contracts" + ~title:"Wrong description of a list of other contracts" + ~description:"Failed to parse a description of other contracts." + ~pp:(fun ppf (_loc, node) -> + Format.fprintf + ppf + "Unexpected format for a description of other contracts. Expected a \ + sequence of Contract
; got %a." + Micheline_printer.print_expr_unwrapped + node) + (obj2 + (req "location" Micheline_parser.location_encoding) + (req "node" micheline_printer_node_encoding)) + (function + | Wrong_other_contracts (loc, node) -> Some (loc, node) | _ -> None) + (fun (loc, node) -> Wrong_other_contracts (loc, node)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"michelson.wrong_extra_big_maps_item" + ~title:"Wrong description of an extra big map" + ~description:"Failed to parse an item in a description of extra big maps." + ~pp:(fun ppf (_loc, node) -> + Format.fprintf + ppf + "Unexpected format for an item in a description of extra big maps. \ + Expected: Big_map ; got %a." + Micheline_printer.print_expr_unwrapped + node) + (obj2 + (req "location" Micheline_parser.location_encoding) + (req "node" micheline_printer_node_encoding)) + (function + | Wrong_extra_big_maps_item (loc, node) -> Some (loc, node) | _ -> None) + (fun (loc, node) -> Wrong_extra_big_maps_item (loc, node)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"michelson.wrong_extra_big_maps" + ~title:"Wrong description of a list of extra big maps" + ~description:"Failed to parse a description of extra big maps." + ~pp:(fun ppf (_loc, node) -> + Format.fprintf + ppf + "Unexpected format for a description of extra big maps. Expected a \ + sequence of Big_map ; got \ + %a." + Micheline_printer.print_expr_unwrapped + node) + (obj2 + (req "location" Micheline_parser.location_encoding) + (req "node" micheline_printer_node_encoding)) + (function + | Wrong_extra_big_maps (loc, node) -> Some (loc, node) | _ -> None) + (fun (loc, node) -> Wrong_extra_big_maps (loc, node)) ; + Protocol_client_context.register_error_kind + `Permanent + ~id:"InvalidAddressForSmartContract" + ~title:"Invalid address for smart contract" + ~description: + "Invalid input, expected a smart contract address in base58 check \ + notation (KT1...)" + Data_encoding.(obj1 (req "invalid_address" string)) + ~pp:(fun ppf literal -> + Format.fprintf + ppf + "Bad argument value for a smart contract address. Expected an address \ + in base58 checked notation starting with 'KT1', but given '%s'" + literal) + (function Invalid_address_for_smart_contract str -> Some str | _ -> None) + (fun str -> Invalid_address_for_smart_contract str) let parse_expression ~source (node : Micheline_parser.node) : Script.expr tzresult = @@ -102,8 +198,61 @@ let parse_stack_item ~source = return (ty, v) | e -> tzfail (Wrong_stack_item (Micheline.location e, printable e)) +let parse_other_contract_item ~source = + let open Result_syntax in + function + | Micheline.Prim (_loc, "Contract", [address; ty], _annot) as e -> + let* address = parse_expression ~source address in + let* address = + match Micheline.root address with + | Micheline.String (_loc, s) -> ( + match Environment.Base58.decode s with + | Some (Contract_hash.Data h) -> return h + | Some _ | None -> tzfail (Invalid_address_for_smart_contract s)) + | _ -> + tzfail + (Wrong_other_contracts_item (Micheline.location e, printable e)) + in + let* ty = parse_expression ~source ty in + return RPC.Scripts.S.{address; ty} + | e -> tzfail (Wrong_other_contracts_item (Micheline.location e, printable e)) + +let parse_extra_big_map_item ~source = + let open Result_syntax in + function + | Micheline.Prim (_loc, "Big_map", [id; kty; vty; items], _annot) as e -> + let* id = parse_expression ~source id in + let* id = + match Micheline.root id with + | Micheline.Int (_loc, id) -> return (Big_map.Id.parse_z id) + | _ -> + tzfail + (Wrong_other_contracts_item (Micheline.location e, printable e)) + in + let* kty = parse_expression ~source kty in + let* vty = parse_expression ~source vty in + let* items = parse_expression ~source items in + return RPC.Scripts.S.{id; kty; vty; items} + | e -> tzfail (Wrong_extra_big_maps_item (Micheline.location e, printable e)) + let parse_stack ~source = function | Micheline.Seq (loc, l) as e -> record_trace (Wrong_stack (loc, printable e)) @@ List.map_e (parse_stack_item ~source) l | e -> Result_syntax.tzfail (Wrong_stack (Micheline.location e, printable e)) + +let parse_other_contracts ~source = function + | Micheline.Seq (loc, l) as e -> + record_trace (Wrong_other_contracts (loc, printable e)) + @@ List.map_e (parse_other_contract_item ~source) l + | e -> + Result_syntax.tzfail + (Wrong_other_contracts (Micheline.location e, printable e)) + +let parse_extra_big_maps ~source = function + | Micheline.Seq (loc, l) as e -> + record_trace (Wrong_extra_big_maps (loc, printable e)) + @@ List.map_e (parse_extra_big_map_item ~source) l + | e -> + Result_syntax.tzfail + (Wrong_extra_big_maps (Micheline.location e, printable e)) diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index a5af9f2e7d639f072af10d0da9927e6de6d3af0d..d527f9ad17c5b43a4b90e24865f3e3550d9aefb4 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -58,6 +58,8 @@ let normalize_internal_operation cctxt unparsing_mode ~data:payload ~ty ~unparsing_mode + ~other_contracts:None + ~extra_big_maps:None in Event {ty; tag; payload} | op -> return op diff --git a/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml index 9eaec00a4f941675304e84e8f558e02423f3b679..c4b82cdc2654c283ad3cfecebdda5c0152495809 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml @@ -176,9 +176,9 @@ let commands_ro () : #Protocol_client_context.full Tezos_clic.command list = ~block:cctxt#block ~contract ~action - ~sender:addr - ?gas - ?payer + ~sender:(Some addr) + ~gas + ~payer ~unparsing_mode () in @@ -215,9 +215,9 @@ let commands_ro () : #Protocol_client_context.full Tezos_clic.command list = ~block:cctxt#block ~contract ~action - ~sender - ?gas - ?payer + ~sender:(Some sender) + ~gas + ~payer ~unparsing_mode () in @@ -242,10 +242,11 @@ let commands_ro () : #Protocol_client_context.full Tezos_clic.command list = cctxt ~chain:cctxt#chain ~block:cctxt#block + ~sender:None ~contract ~action - ?gas - ?payer + ~gas + ~payer ~unparsing_mode () in diff --git a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index 21a10f3fa5e3107b328023679277a722ccf544c7..de0eba0556e61da00ae6476327bc29213c79af3e 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml @@ -248,7 +248,7 @@ let commands () = command ~group ~desc:"Ask the node to run a script." - (args12 + (args14 trace_stack_switch amount_arg balance_arg @@ -260,7 +260,9 @@ let commands () = entrypoint_arg (unparsing_mode_arg ~default:"Readable") now_arg - level_arg) + level_arg + other_contracts_arg + extra_big_maps_arg) (prefixes ["run"; "script"] @@ Program.source_param @@ prefixes ["on"; "storage"] @@ -279,7 +281,9 @@ let commands () = entrypoint, unparsing_mode, now, - level ) + level, + other_contracts, + extra_big_maps ) program storage input @@ -299,7 +303,17 @@ let commands () = program; storage; shared_params = - {input; unparsing_mode; now; level; sender; payer; gas}; + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; entrypoint; self; } @@ -317,7 +331,17 @@ let commands () = program; storage; shared_params = - {input; unparsing_mode; now; level; sender; payer; gas}; + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; entrypoint; self; } @@ -349,7 +373,7 @@ let commands () = cctxt ~chain:cctxt#chain ~block:cctxt#block - ~gas:original_gas + ~gas:(Some original_gas) ~legacy ~program ~storage @@ -415,7 +439,7 @@ let commands () = cctxt ~chain:cctxt#chain ~block:cctxt#block - ~gas:original_gas + ~gas:(Some original_gas) ~legacy ~show_types program @@ -452,7 +476,7 @@ let commands () = cctxt ~chain:cctxt#chain ~block:cctxt#block - ~gas:original_gas + ~gas:(Some original_gas) ~legacy ~data ~ty @@ -499,7 +523,7 @@ let commands () = Plugin.RPC.Scripts.pack_data cctxt (cctxt#chain, cctxt#block) - ~gas:original_gas + ~gas:(Some original_gas) ~data:data.expanded ~ty:typ.expanded in @@ -698,7 +722,11 @@ let commands () = command ~group ~desc:"Ask the node to normalize a data expression." - (args2 (unparsing_mode_arg ~default:"Readable") legacy_switch) + (args4 + (unparsing_mode_arg ~default:"Readable") + legacy_switch + other_contracts_arg + extra_big_maps_arg) (prefixes ["normalize"; "data"] @@ param ~name:"data" @@ -707,7 +735,10 @@ let commands () = @@ prefixes ["of"; "type"] @@ param ~name:"type" ~desc:"type of the data expression" data_parameter @@ stop) - (fun (unparsing_mode, legacy) data typ cctxt -> + (fun (unparsing_mode, legacy, other_contracts, extra_big_maps) + data + typ + cctxt -> let open Lwt_result_syntax in let*! r = Plugin.RPC.Scripts.normalize_data @@ -717,6 +748,8 @@ let commands () = ~data:data.expanded ~ty:typ.expanded ~unparsing_mode + ~other_contracts + ~extra_big_maps in match r with | Ok expr -> @@ -738,7 +771,11 @@ let commands () = command ~group ~desc:"Ask the node to normalize a typed Michelson stack." - (args2 (unparsing_mode_arg ~default:"Readable") legacy_switch) + (args4 + (unparsing_mode_arg ~default:"Readable") + legacy_switch + other_contracts_arg + extra_big_maps_arg) (prefixes ["normalize"; "stack"] @@ param ~name:"stack" @@ -749,7 +786,9 @@ let commands () = of the stack is ." micheline_parameter @@ stop) - (fun (unparsing_mode, legacy) (stack, source) cctxt -> + (fun (unparsing_mode, legacy, other_contracts, extra_big_maps) + (stack, source) + cctxt -> let open Lwt_result_syntax in let*? stack = Michelson_v1_stack.parse_stack ~source stack in let*! r = @@ -759,6 +798,8 @@ let commands () = ~legacy ~stack ~unparsing_mode + ~other_contracts + ~extra_big_maps in match r with | Ok expr -> @@ -975,6 +1016,7 @@ let commands () = ~block:cctxt#block ~legacy ~show_types:true + ~gas:None program in match r with @@ -1062,6 +1104,8 @@ let commands () = ~block:cctxt#block ~data ~ty + ~gas:None + ~legacy:false () in match r with @@ -1137,13 +1181,15 @@ let commands () = command ~group ~desc:"Ask the node to run a TZIP-4 view." - (args6 + (args8 source_arg payer_arg run_gas_limit_arg (unparsing_mode_arg ~default:"Readable") now_arg - level_arg) + level_arg + other_contracts_arg + extra_big_maps_arg) (prefixes ["run"; "tzip4"; "view"] @@ param ~name:"entrypoint" @@ -1156,20 +1202,37 @@ let commands () = @@ prefixes ["with"; "input"] @@ param ~name:"input" ~desc:"the input data" data_parameter @@ stop) - (fun (sender, payer, gas, unparsing_mode, now, level) + (fun ( sender, + payer, + gas, + unparsing_mode, + now, + level, + other_contracts, + extra_big_maps ) entrypoint contract input cctxt -> - let open Lwt_syntax in - let* res = + let open Lwt_result_syntax in + let*! res = Client_proto_programs.run_view cctxt ~chain:cctxt#chain ~block:cctxt#block { shared_params = - {input; unparsing_mode; now; level; sender; payer; gas}; + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; contract; entrypoint; } @@ -1178,14 +1241,16 @@ let commands () = command ~group ~desc:"Ask the node to run a Michelson view with Unit as input." - (args7 + (args9 source_arg payer_arg run_gas_limit_arg unlimited_gas_arg (unparsing_mode_arg ~default:"Readable") now_arg - level_arg) + level_arg + other_contracts_arg + extra_big_maps_arg) (prefixes ["run"; "view"] @@ param ~name:"view" ~desc:"the name of the view" string_parameter @@ prefixes ["on"; "contract"] @@ -1193,7 +1258,15 @@ let commands () = ~name:"contract" ~desc:"the contract containing the view" @@ stop) - (fun (sender, payer, gas, unlimited_gas, unparsing_mode, now, level) + (fun ( sender, + payer, + gas, + unlimited_gas, + unparsing_mode, + now, + level, + other_contracts, + extra_big_maps ) view contract cctxt -> @@ -1209,7 +1282,17 @@ let commands () = ~block:cctxt#block { shared_params = - {input; unparsing_mode; now; level; sender; payer; gas}; + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; contract; view; unlimited_gas; @@ -1219,14 +1302,16 @@ let commands () = command ~group ~desc:"Ask the node to run a Michelson view." - (args7 + (args9 source_arg payer_arg run_gas_limit_arg unlimited_gas_arg (unparsing_mode_arg ~default:"Readable") now_arg - level_arg) + level_arg + other_contracts_arg + extra_big_maps_arg) (prefixes ["run"; "view"] @@ param ~name:"view" ~desc:"the name of the view" string_parameter @@ prefixes ["on"; "contract"] @@ -1239,20 +1324,38 @@ let commands () = ~desc:"the argument provided to the view" data_parameter @@ stop) - (fun (sender, payer, gas, unlimited_gas, unparsing_mode, now, level) + (fun ( sender, + payer, + gas, + unlimited_gas, + unparsing_mode, + now, + level, + other_contracts, + extra_big_maps ) view contract input cctxt -> - let open Lwt_syntax in - let* res = + let open Lwt_result_syntax in + let*! res = Client_proto_programs.run_script_view cctxt ~chain:cctxt#chain ~block:cctxt#block { shared_params = - {input; unparsing_mode; now; level; sender; payer; gas}; + { + input; + unparsing_mode; + now; + level; + sender; + payer; + gas; + other_contracts; + extra_big_maps; + }; contract; view; unlimited_gas; diff --git a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml index 347de5bbe0b1f848dd00b766510f9a397809d8df..70aec92f5ceb83282f60a1d4f08bdaaefd83a1e1 100644 --- a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml @@ -81,6 +81,7 @@ let bound_data_of_public_key_hash cctxt dst = Plugin.RPC.Scripts.pack_data cctxt (cctxt#chain, cctxt#block) + ~gas:None ~data:micheline_bytes ~ty:micheline_pkh_type in diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 8530b6d638f791688f84683b3819cd05719425f1..3f30818975bb96e4e6bbf4e3144af59e58bde986 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -227,6 +227,38 @@ module Scripts = struct let path = RPC_path.(path / "scripts") + type other_contract_description = { + address : Contract_hash.t; + ty : Script.expr; + } + + let other_contracts_encoding = + list + (conv + (fun {address; ty} -> (address, ty)) + (fun (address, ty) -> {address; ty}) + (obj2 + (req "address" Contract_hash.encoding) + (req "type" Script.expr_encoding))) + + type extra_big_map_description = { + id : Big_map.Id.t; + kty : Script.expr; + vty : Script.expr; + items : Script.expr; + } + + let extra_big_maps_encoding = + list + (conv + (fun {id; kty; vty; items} -> (id, kty, vty, items)) + (fun (id, kty, vty, items) -> {id; kty; vty; items}) + (obj4 + (req "id" Big_map.Id.encoding) + (req "key_type" Script.expr_encoding) + (req "val_type" Script.expr_encoding) + (req "map_literal" Script.expr_encoding))) + let run_code_input_encoding = merge_objs (obj10 @@ -242,11 +274,13 @@ module Scripts = struct (opt "payer" Contract.implicit_encoding) (opt "self" Contract.originated_encoding) (dft "entrypoint" Entrypoint.simple_encoding Entrypoint.default)) - (obj4 + (obj6 (opt "unparsing_mode" unparsing_mode_encoding) (opt "gas" Gas.Arith.z_integral_encoding) (opt "now" Script_timestamp.encoding) - (opt "level" Script_int.n_encoding)) + (opt "level" Script_int.n_encoding) + (opt "other_contracts" other_contracts_encoding) + (opt "extra_big_maps" extra_big_maps_encoding)) let run_code_output_encoding = conv @@ -292,19 +326,23 @@ module Scripts = struct let run_tzip4_view_encoding = let open Data_encoding in - obj10 - (req "contract" Contract.originated_encoding) - (req "entrypoint" Entrypoint.simple_encoding) - (req "input" Script.expr_encoding) - (req "chain_id" Chain_id.encoding) - (* TODO: https://gitlab.com/tezos/tezos/-/issues/710 - Rename the "source" field into "sender" *) - (opt "source" Contract.encoding) - (opt "payer" Contract.implicit_encoding) - (opt "gas" Gas.Arith.z_integral_encoding) - (req "unparsing_mode" unparsing_mode_encoding) - (opt "now" Script_timestamp.encoding) - (opt "level" Script_int.n_encoding) + merge_objs + (obj10 + (req "contract" Contract.originated_encoding) + (req "entrypoint" Entrypoint.simple_encoding) + (req "input" Script.expr_encoding) + (req "chain_id" Chain_id.encoding) + (* TODO: https://gitlab.com/tezos/tezos/-/issues/710 + Rename the "source" field into "sender" *) + (opt "source" Contract.encoding) + (opt "payer" Contract.implicit_encoding) + (opt "gas" Gas.Arith.z_integral_encoding) + (req "unparsing_mode" unparsing_mode_encoding) + (opt "now" Script_timestamp.encoding) + (opt "level" Script_int.n_encoding)) + (obj2 + (opt "other_contracts" other_contracts_encoding) + (opt "extra_big_maps" extra_big_maps_encoding)) let run_script_view_encoding = let open Data_encoding in @@ -322,13 +360,18 @@ module Scripts = struct (opt "gas" Gas.Arith.z_integral_encoding) (req "unparsing_mode" unparsing_mode_encoding) (opt "now" Script_timestamp.encoding)) - (obj1 (opt "level" Script_int.n_encoding)) + (obj3 + (opt "level" Script_int.n_encoding) + (opt "other_contracts" other_contracts_encoding) + (opt "extra_big_maps" extra_big_maps_encoding)) let normalize_stack_input_encoding = - obj3 + obj5 (req "input" stack_encoding) (req "unparsing_mode" unparsing_mode_encoding) - (opt "legacy" bool) + (dft "legacy" bool false) + (opt "other_contracts" other_contracts_encoding) + (opt "extra_big_maps" extra_big_maps_encoding) let normalize_stack_output_encoding = obj1 (req "output" stack_encoding) @@ -376,8 +419,8 @@ module Scripts = struct (obj4 (req "program" Script.expr_encoding) (opt "gas" Gas.Arith.z_integral_encoding) - (opt "legacy" bool) - (opt "show_types" bool)) + (dft "legacy" bool false) + (dft "show_types" bool true)) ~output: (obj2 (req "type_map" Script_tc_errors_registration.type_map_enc) @@ -393,7 +436,7 @@ module Scripts = struct (req "program" Script.expr_encoding) (req "storage" Script.expr_encoding) (opt "gas" Gas.Arith.z_integral_encoding) - (opt "legacy" bool)) + (dft "legacy" bool false)) ~output:(obj1 (req "script_size" int31)) RPC_path.(path / "script_size") @@ -408,7 +451,7 @@ module Scripts = struct (req "data" Script.expr_encoding) (req "type" Script.expr_encoding) (opt "gas" Gas.Arith.z_integral_encoding) - (opt "legacy" bool)) + (dft "legacy" bool false)) ~output:(obj1 (req "gas" Gas.encoding)) RPC_path.(path / "typecheck_data") @@ -431,11 +474,13 @@ module Scripts = struct ~description: "Normalizes some data expression using the requested unparsing mode" ~input: - (obj4 + (obj6 (req "data" Script.expr_encoding) (req "type" Script.expr_encoding) (req "unparsing_mode" unparsing_mode_encoding) - (opt "legacy" bool)) + (dft "legacy" bool false) + (opt "other_contracts" other_contracts_encoding) + (opt "extra_big_maps" extra_big_maps_encoding)) ~output:(obj1 (req "normalized" Script.expr_encoding)) ~query:RPC_query.empty RPC_path.(path / "normalize_data") @@ -647,20 +692,20 @@ module Scripts = struct let log_control _ = () let get_log () = - let* _ctxt, res = + let+ _ctxt, res = List.fold_left_es (fun (old_ctxt, l) (Log (ctxt, loc, stack, stack_ty)) -> let consumed_gas = Gas.consumed ~since:old_ctxt ~until:ctxt in - let* stack = + let+ stack = Environment.Error_monad.trace Plugin_errors.Cannot_serialize_log (unparse_stack ctxt (stack, stack_ty)) in - return (ctxt, (loc, consumed_gas, stack) :: l)) + (ctxt, (loc, consumed_gas, stack) :: l)) (ctxt, []) (List.rev !log) in - return_some (List.rev res) + Some (List.rev res) end) let execute ctxt step_constants ~script ~entrypoint ~parameter = @@ -836,8 +881,8 @@ module Scripts = struct ty data_node in - let* Ex_stack (sty, y, st), ctxt = parse_stack ctxt ~legacy l in - return (Ex_stack (Item_t (ty, sty), x, (y, st)), ctxt) + let+ Ex_stack (sty, y, st), ctxt = parse_stack ctxt ~legacy l in + (Ex_stack (Item_t (ty, sty), x, (y, st)), ctxt) let rec unparse_stack : type a s. @@ -859,8 +904,8 @@ module Scripts = struct let* data_node, ctxt = Script_ir_translator.unparse_data ctxt unparsing_mode ty x in - let* l, ctxt = unparse_stack ctxt unparsing_mode sty y st in - return ((Micheline.strip_locations ty_node, data_node) :: l, ctxt) + let+ l, ctxt = unparse_stack ctxt unparsing_mode sty y st in + ((Micheline.strip_locations ty_node, data_node) :: l, ctxt) end let rec pp_instr_name : @@ -1165,7 +1210,7 @@ module Scripts = struct dummy_contract_hash ~script:(script, None) in - let* ctxt, _ = + let+ ctxt, _ = Token.transfer ~origin:Simulation ctxt @@ -1173,7 +1218,85 @@ module Scripts = struct (`Contract dummy_contract) balance in - return (ctxt, dummy_contract_hash) + (ctxt, dummy_contract_hash) + in + let originate_dummy_contracts ctxt = + List.fold_left_es + (fun ctxt {S.address; ty} -> + Contract.raw_originate + ctxt + ~prepaid_bootstrap_storage:false + address + (* We reuse the default script from View_helpers because + the purpose is the same; we only care about having a + script declaring the correct parameter type but we will + never actually run the script. *) + ~script:(View_helpers.make_tzip4_viewer_script ty, None)) + ctxt + in + let initialize_big_maps ctxt big_maps = + let* ctxt, (big_map_diff : Lazy_storage.diffs) = + List.fold_left_es + (fun (ctxt, big_map_diff_tl) {S.id; kty; vty; items} -> + let open Script_ir_translator in + let items = Micheline.root items in + let init = + Lazy_storage.(Alloc Big_map.{key_type = kty; value_type = vty}) + in + let*? Ex_comparable_ty key_comparable_type, ctxt = + parse_comparable_ty ctxt (Micheline.root kty) + in + let*? Ex_ty value_type, ctxt = + parse_big_map_value_ty ctxt ~legacy:false (Micheline.root vty) + in + (* Typecheck the update seq to check that the values are well-typed and the keys are sorted *) + let*? map_ty = + Script_typed_ir.map_t (-1) key_comparable_type value_type + in + let* _, ctxt = + parse_data + ctxt + ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) + ~allow_forged:true + map_ty + items + in + let items = + match items with + | Micheline.Seq (_, items) -> items + | _ -> assert false + in + (* Build a big_map_diff *) + let+ ctxt, updates = + List.fold_left_es + (fun (ctxt, acc) key_value -> + let open Micheline in + let key, value = + match key_value with + | Prim (_, Michelson_v1_primitives.D_Elt, [key; value], _) + -> + (key, value) + | _ -> assert false + in + let* k, ctxt = + parse_comparable_data ctxt key_comparable_type key + in + let+ key_hash, ctxt = hash_data ctxt key_comparable_type k in + let key = Micheline.strip_locations key in + let value = Some (Micheline.strip_locations value) in + (ctxt, Big_map.{key; key_hash; value} :: acc)) + (ctxt, []) + items + in + ( ctxt, + Lazy_storage.( + make Big_map id (Update {init; updates = List.rev updates})) + :: big_map_diff_tl )) + (ctxt, []) + big_maps + in + let+ ctxt, _size_change = Lazy_storage.apply ctxt big_map_diff in + ctxt in let sender_and_payer ~sender_opt ~payer_opt ~default_sender = match (sender_opt, payer_opt) with @@ -1183,27 +1306,58 @@ module Scripts = struct | None, Some c -> (Contract.Implicit c, c) | Some sender, Some payer -> (sender, payer) in - let configure_contracts ctxt script balance ~sender_opt ~payer_opt ~self_opt - = - let* ctxt, self, balance = + let compute_step_constants ctxt ~balance ~amount ~chain_id ~sender_opt + ~payer_opt ~self ~now_opt ~level_opt = + let sender, payer = + sender_and_payer ~sender_opt ~payer_opt ~default_sender:self + in + let now = + match now_opt with None -> Script_timestamp.now ctxt | Some t -> t + in + let level = + match level_opt with + | None -> + (Level.current ctxt).level |> Raw_level.to_int32 + |> Script_int.of_int32 |> Script_int.abs + | Some z -> z + in + let open Script_interpreter in + let sender = Destination.Contract sender in + (ctxt, {sender; payer; self; amount; balance; chain_id; now; level}) + in + let configure_gas_and_step_constants ctxt script ~gas_opt ~balance ~amount + ~chain_id ~sender_opt ~payer_opt ~self_opt ~now_opt ~level_opt = + let gas = + match gas_opt with + | Some gas -> gas + | None -> Constants.hard_gas_limit_per_operation ctxt + in + let ctxt = Gas.set_limit ctxt gas in + let+ ctxt, self, balance = match self_opt with | None -> let balance = Option.value ~default:default_balance balance in - let* ctxt, addr = originate_dummy_contract ctxt script balance in - return (ctxt, addr, balance) + let+ ctxt, addr = originate_dummy_contract ctxt script balance in + (ctxt, addr, balance) | Some addr -> - let* bal = + let+ bal = default_from_context ctxt (fun c -> Contract.get_balance c @@ Contract.Originated addr) balance in - return (ctxt, addr, bal) + (ctxt, addr, bal) in - let sender, payer = - sender_and_payer ~sender_opt ~payer_opt ~default_sender:self - in - return (ctxt, {balance; self; sender; payer}) + compute_step_constants + ctxt + ~balance + ~amount + ~chain_id + ~sender_opt + ~payer_opt + ~self + ~now_opt + ~level_opt in let script_entrypoint_type ctxt expr entrypoint = let ctxt = Gas.set_unlimited ctxt in @@ -1252,40 +1406,33 @@ module Scripts = struct payer_opt, self_opt, entrypoint ), - (unparsing_mode, gas, now, level) ) + ( unparsing_mode, + gas_opt, + now_opt, + level_opt, + other_contracts, + extra_big_maps ) ) -> let unparsing_mode = Option.value ~default:Readable unparsing_mode in + let other_contracts = Option.value ~default:[] other_contracts in + let* ctxt = originate_dummy_contracts ctxt other_contracts in + let extra_big_maps = Option.value ~default:[] extra_big_maps in + let* ctxt = initialize_big_maps ctxt extra_big_maps in let storage = Script.lazy_expr storage in let code = Script.lazy_expr code in - let* ctxt, {self; sender; payer; balance} = - configure_contracts + let* ctxt, step_constants = + configure_gas_and_step_constants ctxt {storage; code} - balance + ~gas_opt + ~balance + ~amount + ~chain_id ~sender_opt ~payer_opt ~self_opt - 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 - let now = - match now with None -> Script_timestamp.now ctxt | Some t -> t - in - let level = - match level with - | None -> - (Level.current ctxt).level |> Raw_level.to_int32 - |> Script_int.of_int32 |> Script_int.abs - | Some z -> z - in - let step_constants = - let open Script_interpreter in - let sender = Destination.Contract sender in - {sender; payer; self; amount; balance; chain_id; now; level} + ~now_opt + ~level_opt in let+ ( { script = _; @@ -1326,40 +1473,33 @@ module Scripts = struct payer_opt, self_opt, entrypoint ), - (unparsing_mode, gas, now, level) ) + ( unparsing_mode, + gas_opt, + now_opt, + level_opt, + other_contracts, + extra_big_maps ) ) -> let unparsing_mode = Option.value ~default:Readable unparsing_mode in + let other_contracts = Option.value ~default:[] other_contracts in + let* ctxt = originate_dummy_contracts ctxt other_contracts in + let extra_big_maps = Option.value ~default:[] extra_big_maps in + let* ctxt = initialize_big_maps ctxt extra_big_maps in let storage = Script.lazy_expr storage in let code = Script.lazy_expr code in - let* ctxt, {self; sender; payer; balance} = - configure_contracts + let* ctxt, step_constants = + configure_gas_and_step_constants ctxt {storage; code} - balance + ~gas_opt + ~balance + ~amount + ~chain_id ~sender_opt ~payer_opt ~self_opt - 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 - let now = - match now with None -> Script_timestamp.now ctxt | Some t -> t - in - let level = - match level with - | None -> - (Level.current ctxt).level |> Raw_level.to_int32 - |> Script_int.of_int32 |> Script_int.abs - | Some z -> z - in - let step_constants = - let open Script_interpreter in - let sender = Destination.Contract sender in - {sender; payer; self; amount; balance; chain_id; now; level} + ~now_opt + ~level_opt in let module Unparsing_mode = struct let unparsing_mode = unparsing_mode @@ -1393,17 +1533,22 @@ module Scripts = struct (fun ctxt () - ( contract_hash, - entrypoint, - input, - chain_id, - sender_opt, - payer_opt, - gas, - unparsing_mode, - now, - level ) + ( ( contract_hash, + entrypoint, + input, + chain_id, + sender_opt, + payer_opt, + gas, + unparsing_mode, + now_opt, + level_opt ), + (other_contracts, extra_big_maps) ) -> + let other_contracts = Option.value ~default:[] other_contracts in + let* ctxt = originate_dummy_contracts ctxt other_contracts in + let extra_big_maps = Option.value ~default:[] extra_big_maps in + let* ctxt = initialize_big_maps ctxt extra_big_maps in let* ctxt, script_opt = Contract.get_script ctxt contract_hash in let*? script = Option.fold @@ -1425,8 +1570,17 @@ module Scripts = struct (View_helpers.make_tzip4_viewer_script ty) Tez.zero in - let sender, payer = - sender_and_payer ~sender_opt ~payer_opt ~default_sender:contract_hash + let ctxt, step_constants = + compute_step_constants + ctxt + ~balance + ~amount:Tez.zero + ~chain_id + ~sender_opt + ~payer_opt + ~self:contract_hash + ~now_opt + ~level_opt in let gas = Option.value @@ -1434,30 +1588,6 @@ module Scripts = struct gas in let ctxt = Gas.set_limit ctxt gas in - let now = - match now with None -> Script_timestamp.now ctxt | Some t -> t - in - let level = - match level with - | None -> - (Level.current ctxt).level |> Raw_level.to_int32 - |> Script_int.of_int32 |> Script_int.abs - | Some z -> z - in - let step_constants = - let open Script_interpreter in - let sender = Destination.Contract sender in - { - sender; - payer; - self = contract_hash; - amount = Tez.zero; - balance; - chain_id; - now; - level; - } - in let parameter = View_helpers.make_view_parameter (Micheline.root input) @@ -1503,9 +1633,13 @@ module Scripts = struct payer_opt, gas, unparsing_mode, - now ), - level ) + now_opt ), + (level_opt, other_contracts, extra_big_maps) ) -> + let other_contracts = Option.value ~default:[] other_contracts in + let* ctxt = originate_dummy_contracts ctxt other_contracts in + let extra_big_maps = Option.value ~default:[] extra_big_maps in + let* ctxt = initialize_big_maps ctxt extra_big_maps in let* ctxt, script_opt = Contract.get_script ctxt contract_hash in let*? script = Option.fold @@ -1519,11 +1653,17 @@ module Scripts = struct script_view_type ctxt contract_hash decoded_script view in let* balance = Contract.get_balance ctxt contract in - let sender, payer = - sender_and_payer ~sender_opt ~payer_opt ~default_sender:contract_hash - in - let now = - match now with None -> Script_timestamp.now ctxt | Some t -> t + let ctxt, step_constants = + compute_step_constants + ctxt + ~balance + ~amount:Tez.zero + ~chain_id + ~sender_opt + ~payer_opt + ~self:contract_hash + ~now_opt + ~level_opt in (* Using [Gas.set_unlimited] won't work, since the interpreter doesn't use this mode (see !4034#note_774734253) and still consumes gas. @@ -1540,26 +1680,6 @@ module Scripts = struct if unlimited_gas then Gas.set_limit ctxt max_gas else Gas.set_limit ctxt gas in - let level = - Option.value - level - ~default: - ((Level.current ctxt).level |> Raw_level.to_int32 - |> Script_int.of_int32 |> Script_int.abs) - in - let step_constants = - let sender = Destination.Contract sender in - { - Script_interpreter.sender; - payer; - self = contract_hash; - amount = Tez.zero; - balance; - chain_id; - now; - level; - } - in let viewer_script = View_helpers.make_michelson_viewer_script contract @@ -1597,8 +1717,6 @@ module Scripts = struct ~chunked:false S.typecheck_code (fun ctxt () (expr, maybe_gas, legacy, show_types) -> - let legacy = Option.value ~default:false legacy in - let show_types = Option.value ~default:true show_types in let ctxt = match maybe_gas with | None -> Gas.set_unlimited ctxt @@ -1612,7 +1730,6 @@ module Scripts = struct ~chunked:false S.script_size (fun ctxt () (expr, storage, maybe_gas, legacy) -> - let legacy = Option.value ~default:false legacy in let ctxt = match maybe_gas with | None -> Gas.set_unlimited ctxt @@ -1655,7 +1772,6 @@ module Scripts = struct ~chunked:false S.typecheck_data (fun ctxt () (data, ty, maybe_gas, legacy) -> - let legacy = Option.value ~default:false legacy in let ctxt = match maybe_gas with | None -> Gas.set_unlimited ctxt @@ -1689,9 +1805,16 @@ module Scripts = struct Registration.register0 ~chunked:true S.normalize_data - (fun ctxt () (expr, typ, unparsing_mode, legacy) -> + (fun + ctxt + () + (expr, typ, unparsing_mode, legacy, other_contracts, extra_big_maps) + -> let open Script_ir_translator in - let legacy = Option.value ~default:false legacy in + let other_contracts = Option.value ~default:[] other_contracts in + let* ctxt = originate_dummy_contracts ctxt other_contracts in + let extra_big_maps = Option.value ~default:[] extra_big_maps in + let* ctxt = initialize_big_maps ctxt extra_big_maps in let ctxt = Gas.set_unlimited ctxt in let*? Ex_ty typ, ctxt = Script_ir_translator.parse_any_ty ctxt ~legacy (Micheline.root typ) @@ -1711,12 +1834,19 @@ module Scripts = struct Registration.register0 ~chunked:true S.normalize_stack - (fun ctxt () (stack, unparsing_mode, legacy) -> - let legacy = Option.value ~default:false legacy in + (fun + ctxt + () + (stack, unparsing_mode, legacy, other_contracts, extra_big_maps) + -> let ctxt = Gas.set_unlimited ctxt in let nodes = List.map (fun (a, b) -> (Micheline.root a, Micheline.root b)) stack in + let other_contracts = Option.value ~default:[] other_contracts in + let* ctxt = originate_dummy_contracts ctxt other_contracts in + let extra_big_maps = Option.value ~default:[] extra_big_maps in + let* ctxt = initialize_big_maps ctxt extra_big_maps in let* Normalize_stack.Ex_stack (st_ty, x, st), ctxt = Normalize_stack.parse_stack ctxt ~legacy nodes in @@ -1792,9 +1922,9 @@ module Scripts = struct map [] )) - let run_code ?unparsing_mode ?gas ?(entrypoint = Entrypoint.default) ?balance - ~script ~storage ~input ~amount ~chain_id ~sender ~payer ~self ~now ~level - ctxt block = + let run_code ~unparsing_mode ~gas ~entrypoint ~balance ~other_contracts + ~extra_big_maps ~script ~storage ~input ~amount ~chain_id ~sender ~payer + ~self ~now ~level ctxt block = RPC_context.make_call0 S.run_code ctxt @@ -1810,11 +1940,11 @@ module Scripts = struct payer, self, entrypoint ), - (unparsing_mode, gas, now, level) ) + (unparsing_mode, gas, now, level, other_contracts, extra_big_maps) ) - let trace_code ?unparsing_mode ?gas ?(entrypoint = Entrypoint.default) - ?balance ~script ~storage ~input ~amount ~chain_id ~sender ~payer ~self - ~now ~level ctxt block = + let trace_code ~unparsing_mode ~gas ~entrypoint ~balance ~other_contracts + ~extra_big_maps ~script ~storage ~input ~amount ~chain_id ~sender ~payer + ~self ~now ~level ctxt block = RPC_context.make_call0 S.trace_code ctxt @@ -1830,30 +1960,32 @@ module Scripts = struct payer, self, entrypoint ), - (unparsing_mode, gas, now, level) ) + (unparsing_mode, gas, now, level, other_contracts, extra_big_maps) ) - let run_tzip4_view ?gas ~contract ~entrypoint ~input ~chain_id ~now ~level - ?sender ?payer ~unparsing_mode ctxt block = + let run_tzip4_view ~gas ~other_contracts ~extra_big_maps ~contract ~entrypoint + ~input ~chain_id ~now ~level ~sender ~payer ~unparsing_mode ctxt block = RPC_context.make_call0 S.run_tzip4_view ctxt block () - ( contract, - entrypoint, - input, - chain_id, - sender, - payer, - gas, - unparsing_mode, - now, - level ) + ( ( contract, + entrypoint, + input, + chain_id, + sender, + payer, + gas, + unparsing_mode, + now, + level ), + (other_contracts, extra_big_maps) ) (** [run_script_view] is an helper function to call the corresponding - RPC. [unlimited_gas] is set to [false] by default. *) - let run_script_view ?gas ~contract ~view ~input ?(unlimited_gas = false) - ~chain_id ~now ~level ?sender ?payer ~unparsing_mode ctxt block = + RPC. *) + let run_script_view ~gas ~other_contracts ~extra_big_maps ~contract ~view + ~input ~unlimited_gas ~chain_id ~now ~level ~sender ~payer ~unparsing_mode + ctxt block = RPC_context.make_call0 S.run_script_view ctxt @@ -1869,9 +2001,9 @@ module Scripts = struct gas, unparsing_mode, now ), - level ) + (level, other_contracts, extra_big_maps) ) - let typecheck_code ?gas ?legacy ~script ?show_types ctxt block = + let typecheck_code ~gas ~legacy ~script ~show_types ctxt block = RPC_context.make_call0 S.typecheck_code ctxt @@ -1879,7 +2011,7 @@ module Scripts = struct () (script, gas, legacy, show_types) - let script_size ?gas ?legacy ~script ~storage ctxt block = + let script_size ~gas ~legacy ~script ~storage ctxt block = RPC_context.make_call0 S.script_size ctxt @@ -1887,27 +2019,29 @@ module Scripts = struct () (script, storage, gas, legacy) - let typecheck_data ?gas ?legacy ~data ~ty ctxt block = + let typecheck_data ~gas ~legacy ~data ~ty ctxt block = RPC_context.make_call0 S.typecheck_data ctxt block () (data, ty, gas, legacy) - let pack_data ?gas ~data ~ty ctxt block = + let pack_data ~gas ~data ~ty ctxt block = RPC_context.make_call0 S.pack_data ctxt block () (data, ty, gas) - let normalize_data ?legacy ~data ~ty ~unparsing_mode ctxt block = + let normalize_data ~legacy ~other_contracts ~extra_big_maps ~data ~ty + ~unparsing_mode ctxt block = RPC_context.make_call0 S.normalize_data ctxt block () - (data, ty, unparsing_mode, legacy) + (data, ty, unparsing_mode, legacy, other_contracts, extra_big_maps) - let normalize_stack ?legacy ~stack ~unparsing_mode ctxt block = + let normalize_stack ~legacy ~other_contracts ~extra_big_maps ~stack + ~unparsing_mode ctxt block = RPC_context.make_call0 S.normalize_stack ctxt block () - (stack, unparsing_mode, legacy) + (stack, unparsing_mode, legacy, other_contracts, extra_big_maps) let normalize_script ~script ~unparsing_mode ctxt block = RPC_context.make_call0 @@ -2074,7 +2208,7 @@ module Contract = struct | None -> return_none | Some script -> let ctxt = Gas.set_unlimited ctxt in - let* script, _ctxt = + let+ script, _ctxt = Script_ir_translator.parse_and_unparse_script_unaccounted ctxt ~legacy:true @@ -2083,21 +2217,21 @@ module Contract = struct ~normalize_types script in - return_some script) ; + Some script) ; Registration.register1 ~chunked:false S.get_used_storage_space (fun ctxt contract () () -> get_contract contract @@ fun _ -> - let* x = Contract.used_storage_space ctxt contract in - return_some x) ; + let+ x = Contract.used_storage_space ctxt contract in + Some x) ; Registration.register1 ~chunked:false S.get_paid_storage_space (fun ctxt contract () () -> get_contract contract @@ fun _ -> - let* x = Contract.paid_storage_space ctxt contract in - return_some x) ; + let+ x = Contract.paid_storage_space ctxt contract in + Some x) ; Registration.register1 ~chunked:false S.ticket_balance @@ -2110,8 +2244,8 @@ module Contract = struct ~contents_type:(Micheline.root contents_type) ~contents:(Micheline.root contents) in - let* amount, _ctxt = Ticket_balance.get_balance ctxt ticket_hash in - return @@ Option.value amount ~default:Z.zero) ; + let+ amount, _ctxt = Ticket_balance.get_balance ctxt ticket_hash in + Option.value amount ~default:Z.zero) ; Registration.opt_register1 ~chunked:false S.all_ticket_balances @@ -2138,18 +2272,18 @@ module Contract = struct has_tickets storage in - let* ticket_balances, _ctxt = + let+ ticket_balances, _ctxt = Ticket_token_map.fold_es ctxt (fun ctxt acc ex_token amount -> - let* unparsed_token, ctxt = + let+ unparsed_token, ctxt = Ticket_token_unparser.unparse ctxt ex_token in - return ((unparsed_token, amount) :: acc, ctxt)) + ((unparsed_token, amount) :: acc, ctxt)) [] ticket_token_map in - return_some ticket_balances) + Some ticket_balances) let get_storage_normalized ctxt block ~contract ~unparsing_mode = RPC_context.make_call1 @@ -2499,8 +2633,8 @@ module Sc_rollup = struct let register_inbox () = let open Lwt_result_syntax in Registration.register0 ~chunked:true S.inbox (fun ctxt () () -> - let* inbox, _ctxt = Sc_rollup.Inbox.get_inbox ctxt in - return inbox) + let+ inbox, _ctxt = Sc_rollup.Inbox.get_inbox ctxt in + inbox) let register_whitelist () = Registration.register1 ~chunked:true S.whitelist (fun ctxt address () () -> @@ -2573,13 +2707,13 @@ module Sc_rollup = struct match commitment_hash with | None -> return_none | Some commitment_hash -> - let* commitment, _ctxt = + let+ commitment, _ctxt = Alpha_context.Sc_rollup.Commitment.get_commitment ctxt address commitment_hash in - return_some (commitment_hash, commitment) + Some (commitment_hash, commitment) let register_commitment () = let open Lwt_result_syntax in @@ -2605,11 +2739,8 @@ module Sc_rollup = struct (fun context rollup staker () () -> let open Sc_rollup.Game.Index in let open Sc_rollup.Refutation_storage in - let* game, _ = get_ongoing_games_for_staker context rollup staker in - let game = - List.map (fun (game, index) -> (game, index.alice, index.bob)) game - in - return game) + let+ game, _ = get_ongoing_games_for_staker context rollup staker in + List.map (fun (game, index) -> (game, index.alice, index.bob)) game) let register_commitments () = Registration.register2 diff --git a/tezt/lib_tezos/client.ml b/tezt/lib_tezos/client.ml index fc6aceeafd558d298ee3c00c6987adcc18362769..735c43895388a67c495be316a0fef9beb41efe5e 100644 --- a/tezt/lib_tezos/client.ml +++ b/tezt/lib_tezos/client.ml @@ -1742,8 +1742,8 @@ let stresstest ?endpoint ?source_aliases ?source_pkhs ?source_accounts ?seed |> Process.check let spawn_run_script ?hooks ?protocol_hash ?no_base_dir_warnings ?balance - ?self_address ?source ?payer ?gas ?(trace_stack = false) ?level ?now ~prg - ~storage ~input client = + ?self_address ?source ?payer ?gas ?(trace_stack = false) ?level ?now + ?other_contracts ?extra_big_maps ~prg ~storage ~input client = spawn_command ?hooks ?protocol_hash ?no_base_dir_warnings client @@ ["run"; "script"; prg; "on"; "storage"; storage; "and"; "input"; input] @ optional_arg "payer" Fun.id payer @@ -1754,10 +1754,12 @@ let spawn_run_script ?hooks ?protocol_hash ?no_base_dir_warnings ?balance @ optional_arg "level" string_of_int level @ optional_switch "trace-stack" trace_stack @ optional_arg "now" Fun.id now + @ optional_arg "other-contracts" Fun.id other_contracts + @ optional_arg "extra-big-maps" Fun.id extra_big_maps let spawn_run_script_at ?hooks ?protocol_hash ?balance ?self_address ?source - ?payer ?prefix ?now ?trace_stack ?level ~storage ~input client script_name - protocol = + ?payer ?prefix ?now ?trace_stack ?level ?other_contracts ?extra_big_maps + ~storage ~input client script_name protocol = let prg = Michelson_script.find ?prefix script_name protocol |> Michelson_script.path in @@ -1771,6 +1773,8 @@ let spawn_run_script_at ?hooks ?protocol_hash ?balance ?self_address ?source ?now ?trace_stack ?level + ?other_contracts + ?extra_big_maps ~prg ~storage ~input @@ -1814,8 +1818,8 @@ let stresstest_fund_accounts_from_source ?endpoint ~source_key_pkh ?batch_size type run_script_result = {storage : string; big_map_diff : string list} let run_script ?hooks ?protocol_hash ?no_base_dir_warnings ?balance - ?self_address ?source ?payer ?gas ?trace_stack ?level ?now ~prg ~storage - ~input client = + ?self_address ?source ?payer ?gas ?trace_stack ?level ?now ?other_contracts + ?extra_big_maps ~prg ~storage ~input client = let* client_output = spawn_run_script ?hooks @@ -1829,6 +1833,8 @@ let run_script ?hooks ?protocol_hash ?no_base_dir_warnings ?balance ?trace_stack ?level ?now + ?other_contracts + ?extra_big_maps ~prg ~storage ~input @@ -1889,7 +1895,8 @@ let run_script ?hooks ?protocol_hash ?no_base_dir_warnings ?balance return {storage; big_map_diff} let run_script_at ?hooks ?protocol_hash ?balance ?self_address ?source ?payer - ?prefix ?now ?trace_stack ?level ~storage ~input client name protocol = + ?prefix ?now ?trace_stack ?level ?other_contracts ?extra_big_maps ~storage + ~input client name protocol = let prg = Michelson_script.find name ?prefix protocol |> Michelson_script.path in @@ -1903,6 +1910,8 @@ let run_script_at ?hooks ?protocol_hash ?balance ?self_address ?source ?payer ?now ?trace_stack ?level + ?other_contracts + ?extra_big_maps ~storage ~input ~prg @@ -2131,8 +2140,9 @@ let typecheck_script ?hooks ?protocol_hash ~scripts ?no_base_dir_warnings client |> Process.check -let spawn_run_tzip4_view ?hooks ?source ?payer ?gas ?unparsing_mode ~entrypoint - ~contract ?input ?(unlimited_gas = false) client = +let spawn_run_tzip4_view ?hooks ?source ?payer ?gas ?unparsing_mode + ?other_contracts ?extra_big_maps ~entrypoint ~contract ?input + ?(unlimited_gas = false) client = let input_params = match input with None -> [] | Some input -> ["with"; "input"; input] in @@ -2145,16 +2155,20 @@ let spawn_run_tzip4_view ?hooks ?source ?payer ?gas ?unparsing_mode ~entrypoint @ optional_arg "source" Fun.id source @ optional_arg "unparsing-mode" normalize_mode_to_string unparsing_mode @ optional_arg "gas" Int.to_string gas - @ optional_switch "unlimited-gas" unlimited_gas) + @ optional_switch "unlimited-gas" unlimited_gas + @ optional_arg "other-contracts" Fun.id other_contracts + @ optional_arg "extra-big-maps" Fun.id extra_big_maps) -let run_tzip4_view ?hooks ?source ?payer ?gas ?unparsing_mode ~entrypoint - ~contract ?input ?unlimited_gas client = +let run_tzip4_view ?hooks ?source ?payer ?gas ?unparsing_mode ?other_contracts + ?extra_big_maps ~entrypoint ~contract ?input ?unlimited_gas client = spawn_run_tzip4_view ?hooks ?source ?payer ?gas ?unparsing_mode + ?other_contracts + ?extra_big_maps ~entrypoint ~contract ?input @@ -2162,8 +2176,8 @@ let run_tzip4_view ?hooks ?source ?payer ?gas ?unparsing_mode ~entrypoint client |> Process.check_and_read_stdout -let spawn_run_view ?hooks ?source ?payer ?gas ?unparsing_mode ~view ~contract - ?input ?(unlimited_gas = false) client = +let spawn_run_view ?hooks ?source ?payer ?gas ?unparsing_mode ?other_contracts + ?extra_big_maps ~view ~contract ?input ?(unlimited_gas = false) client = let input_params = match input with None -> [] | Some input -> ["with"; "input"; input] in @@ -2176,16 +2190,20 @@ let spawn_run_view ?hooks ?source ?payer ?gas ?unparsing_mode ~view ~contract @ optional_arg "source" Fun.id source @ optional_arg "unparsing-mode" normalize_mode_to_string unparsing_mode @ optional_arg "gas" Int.to_string gas + @ optional_arg "other-contracts" Fun.id other_contracts + @ optional_arg "extra-big-maps" Fun.id extra_big_maps @ if unlimited_gas then ["--unlimited-gas"] else []) -let run_view ?hooks ?source ?payer ?gas ?unparsing_mode ~view ~contract ?input - ?unlimited_gas client = +let run_view ?hooks ?source ?payer ?gas ?unparsing_mode ?other_contracts + ?extra_big_maps ~view ~contract ?input ?unlimited_gas client = spawn_run_view ?hooks ?source ?payer ?gas ?unparsing_mode + ?other_contracts + ?extra_big_maps ~view ~contract ?input diff --git a/tezt/lib_tezos/client.mli b/tezt/lib_tezos/client.mli index d1796f35eaaaf9b92930d1e02b5d84f447d6b4f9..f454e872a77ca203de1a970bd7f97243d6a4638d 100644 --- a/tezt/lib_tezos/client.mli +++ b/tezt/lib_tezos/client.mli @@ -1369,6 +1369,8 @@ val run_script : ?trace_stack:bool -> ?level:int -> ?now:string -> + ?other_contracts:string -> + ?extra_big_maps:string -> prg:string -> storage:string -> input:string -> @@ -1388,6 +1390,8 @@ val spawn_run_script : ?trace_stack:bool -> ?level:int -> ?now:string -> + ?other_contracts:string -> + ?extra_big_maps:string -> prg:string -> storage:string -> input:string -> @@ -1414,6 +1418,8 @@ val run_script_at : ?now:string -> ?trace_stack:bool -> ?level:int -> + ?other_contracts:string -> + ?extra_big_maps:string -> storage:string -> input:string -> t -> @@ -1433,6 +1439,8 @@ val spawn_run_script_at : ?now:string -> ?trace_stack:bool -> ?level:int -> + ?other_contracts:string -> + ?extra_big_maps:string -> storage:string -> input:string -> t -> @@ -1648,6 +1656,8 @@ val spawn_run_tzip4_view : ?payer:string -> ?gas:int -> ?unparsing_mode:normalize_mode -> + ?other_contracts:string -> + ?extra_big_maps:string -> entrypoint:string -> contract:string -> ?input:string -> @@ -1667,6 +1677,8 @@ val run_tzip4_view : ?payer:string -> ?gas:int -> ?unparsing_mode:normalize_mode -> + ?other_contracts:string -> + ?extra_big_maps:string -> entrypoint:string -> contract:string -> ?input:string -> @@ -1681,6 +1693,8 @@ val spawn_run_view : ?payer:string -> ?gas:int -> ?unparsing_mode:normalize_mode -> + ?other_contracts:string -> + ?extra_big_maps:string -> view:string -> contract:string -> ?input:string -> @@ -1700,6 +1714,8 @@ val run_view : ?payer:string -> ?gas:int -> ?unparsing_mode:normalize_mode -> + ?other_contracts:string -> + ?extra_big_maps:string -> view:string -> contract:string -> ?input:string -> diff --git a/tezt/tests/run_script.ml b/tezt/tests/run_script.ml index 5b44148224ad70013ca66965c7ece74287d7cb67..afc72201ce259283b3303331bb5a066a3132d08b 100644 --- a/tezt/tests/run_script.ml +++ b/tezt/tests/run_script.ml @@ -70,6 +70,11 @@ let check_sender = prg "address" "SENDER" let check_source = prg "address" "SOURCE" +let check_contract addr = + prg + "address" + (Printf.sprintf "PUSH address %s; CONTRACT nat; ASSERT_SOME; ADDRESS" addr) + let test_balance_and_self_address = Protocol.register_test ~__FILE__ @@ -217,6 +222,47 @@ let test_source_and_sender = in unit +let test_other_contracts = + Protocol.register_test + ~__FILE__ + ~title:"Run script with other_contracts" + ~tags:["client"; "michelson"] + ~supports:(Protocol.From_protocol 019) + @@ fun protocol -> + let* client = Client.init_mockup ~protocol () in + let unused_address = {|"KT1Q36KWPSba7dHsH5E4ZsQHehrChc51e19d"|} in + let* _storage = + Client.run_script + ~prg:(check_contract unused_address) + ~storage:"Unit" + ~input:unused_address + ~other_contracts:(Printf.sprintf "{Contract %s nat}" unused_address) + client + in + unit + +let test_extra_big_maps = + Protocol.register_test + ~__FILE__ + ~title:"Run script with extra_big_maps" + ~tags:["client"; "michelson"] + ~supports:(Protocol.From_protocol 019) + @@ fun protocol -> + let* client = Client.init_mockup ~protocol () in + let* {storage; _} = + Client.run_script + ~prg: + {|parameter unit; storage (pair string (big_map nat string)); code {CDR; CDR; DUP; PUSH nat 42; GET; ASSERT_SOME; PAIR; NIL operation; PAIR}|} + ~storage:{|Pair "" 4|} + ~input:{|Unit|} + ~extra_big_maps:{|{Big_map 4 nat string {Elt 42 "foobar"}}|} + client + in + assert (storage = {|(Pair "foobar" 4)|}) ; + unit + let register ~protocols = test_balance_and_self_address protocols ; - test_source_and_sender protocols + test_source_and_sender protocols ; + test_other_contracts protocols ; + test_extra_big_maps protocols