From 9f9a4af5061090af9b47ba31c0b41cdcfb93e157 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Mon, 3 Jul 2023 22:18:19 +0200 Subject: [PATCH 01/14] Plugin: monadic simplification This commit increases the consistency of the code by replacing the (let* .. return) pattern with let+. --- src/proto_alpha/lib_plugin/RPC.ml | 71 +++++++++++++++---------------- 1 file changed, 34 insertions(+), 37 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 8530b6d638f7..a0f772bcba13 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -647,20 +647,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 +836,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 +859,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 +1165,7 @@ module Scripts = struct dummy_contract_hash ~script:(script, None) in - let* ctxt, _ = + let+ ctxt, _ = Token.transfer ~origin:Simulation ctxt @@ -1173,7 +1173,7 @@ module Scripts = struct (`Contract dummy_contract) balance in - return (ctxt, dummy_contract_hash) + (ctxt, dummy_contract_hash) in let sender_and_payer ~sender_opt ~payer_opt ~default_sender = match (sender_opt, payer_opt) with @@ -1185,25 +1185,25 @@ module Scripts = struct in let configure_contracts ctxt script balance ~sender_opt ~payer_opt ~self_opt = - let* ctxt, self, balance = + 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}) + (ctxt, {balance; self; sender; payer}) in let script_entrypoint_type ctxt expr entrypoint = let ctxt = Gas.set_unlimited ctxt in @@ -2074,7 +2074,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 +2083,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 +2110,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 +2138,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 +2499,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 +2573,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 +2605,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 -- GitLab From daa04db653d372ec284369f7082a97ecae5dd890 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Mon, 3 Jul 2023 22:22:15 +0200 Subject: [PATCH 02/14] Plugin/Michelson: suffix optional arguments with "_opt" --- src/proto_alpha/lib_plugin/RPC.ml | 32 +++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index a0f772bcba13..f01517ba5662 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -1252,7 +1252,7 @@ module Scripts = struct payer_opt, self_opt, entrypoint ), - (unparsing_mode, gas, now, level) ) + (unparsing_mode, gas_opt, now_opt, level_opt) ) -> let unparsing_mode = Option.value ~default:Readable unparsing_mode in let storage = Script.lazy_expr storage in @@ -1267,16 +1267,16 @@ module Scripts = struct ~self_opt in let gas = - match gas with + 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 now = - match now with None -> Script_timestamp.now ctxt | Some t -> t + match now_opt with None -> Script_timestamp.now ctxt | Some t -> t in let level = - match level with + match level_opt with | None -> (Level.current ctxt).level |> Raw_level.to_int32 |> Script_int.of_int32 |> Script_int.abs @@ -1326,7 +1326,7 @@ module Scripts = struct payer_opt, self_opt, entrypoint ), - (unparsing_mode, gas, now, level) ) + (unparsing_mode, gas_opt, now_opt, level_opt) ) -> let unparsing_mode = Option.value ~default:Readable unparsing_mode in let storage = Script.lazy_expr storage in @@ -1341,16 +1341,16 @@ module Scripts = struct ~self_opt in let gas = - match gas with + 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 now = - match now with None -> Script_timestamp.now ctxt | Some t -> t + match now_opt with None -> Script_timestamp.now ctxt | Some t -> t in let level = - match level with + match level_opt with | None -> (Level.current ctxt).level |> Raw_level.to_int32 |> Script_int.of_int32 |> Script_int.abs @@ -1401,8 +1401,8 @@ module Scripts = struct payer_opt, gas, unparsing_mode, - now, - level ) + now_opt, + level_opt ) -> let* ctxt, script_opt = Contract.get_script ctxt contract_hash in let*? script = @@ -1435,10 +1435,10 @@ module Scripts = struct in let ctxt = Gas.set_limit ctxt gas in let now = - match now with None -> Script_timestamp.now ctxt | Some t -> t + match now_opt with None -> Script_timestamp.now ctxt | Some t -> t in let level = - match level with + match level_opt with | None -> (Level.current ctxt).level |> Raw_level.to_int32 |> Script_int.of_int32 |> Script_int.abs @@ -1503,8 +1503,8 @@ module Scripts = struct payer_opt, gas, unparsing_mode, - now ), - level ) + now_opt ), + level_opt ) -> let* ctxt, script_opt = Contract.get_script ctxt contract_hash in let*? script = @@ -1523,7 +1523,7 @@ module Scripts = struct 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 + match now_opt with None -> Script_timestamp.now ctxt | Some t -> t in (* Using [Gas.set_unlimited] won't work, since the interpreter doesn't use this mode (see !4034#note_774734253) and still consumes gas. @@ -1542,7 +1542,7 @@ module Scripts = struct in let level = Option.value - level + level_opt ~default: ((Level.current ctxt).level |> Raw_level.to_int32 |> Script_int.of_int32 |> Script_int.abs) -- GitLab From ad319b81266747edcd746d456ac7debfbff88b0f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 4 Jul 2023 09:02:40 +0200 Subject: [PATCH 03/14] Plugin/Michelson: factorize computation of gas and step constants Many Plugin RPCs compute step constants (and gas limit) with the same logic. We factorize them before adding yet another one. --- src/proto_alpha/lib_plugin/RPC.ml | 180 +++++++++++++----------------- 1 file changed, 75 insertions(+), 105 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index f01517ba5662..88a54328fd76 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -1183,8 +1183,33 @@ 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 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 -> @@ -1200,10 +1225,16 @@ module Scripts = struct in (ctxt, addr, bal) in - let sender, payer = - sender_and_payer ~sender_opt ~payer_opt ~default_sender:self - in - (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 @@ -1257,35 +1288,19 @@ module Scripts = struct let unparsing_mode = Option.value ~default:Readable unparsing_mode 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_opt 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_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 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 = _; @@ -1331,35 +1346,19 @@ module Scripts = struct let unparsing_mode = Option.value ~default:Readable unparsing_mode 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_opt 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_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 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 @@ -1425,8 +1424,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 +1442,6 @@ module Scripts = struct gas in let ctxt = Gas.set_limit ctxt gas 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 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) @@ -1519,11 +1503,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_opt 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 +1530,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_opt - ~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 -- GitLab From 7fe12f44fa4a1a9b4c4a8442707677d9b857ff57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Wed, 10 Jun 2020 16:42:27 +0200 Subject: [PATCH 04/14] Plugin/Michelson: add other_contracts option to normalize_stack To normalize a stack containing values of type `contract _`, the addressed contracts need to be originated in the current context. This commit adds a "other_contracts" optional argument to normalize_stack permitting to originate dummy contracts of the required types at the required addresses before the normalization. --- .../client_proto_programs_commands.ml | 1 + src/proto_alpha/lib_plugin/RPC.ml | 44 +++++++++++++++++-- 2 files changed, 41 insertions(+), 4 deletions(-) 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 21a10f3fa5e3..47c1f9ce25e5 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 @@ -759,6 +759,7 @@ let commands () = ~legacy ~stack ~unparsing_mode + ~other_contracts:None in match r with | Ok expr -> diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 88a54328fd76..799ddba85267 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -227,6 +227,12 @@ module Scripts = struct let path = RPC_path.(path / "scripts") + let other_contracts_encoding = + list + (obj2 + (req "address" Script.expr_encoding) + (req "type" Script.expr_encoding)) + let run_code_input_encoding = merge_objs (obj10 @@ -325,10 +331,11 @@ module Scripts = struct (obj1 (opt "level" Script_int.n_encoding)) let normalize_stack_input_encoding = - obj3 + obj4 (req "input" stack_encoding) (req "unparsing_mode" unparsing_mode_encoding) (opt "legacy" bool) + (opt "other_contracts" other_contracts_encoding) let normalize_stack_output_encoding = obj1 (req "output" stack_encoding) @@ -1175,6 +1182,32 @@ module Scripts = struct in (ctxt, dummy_contract_hash) in + let originate_dummy_contracts ctxt = + List.fold_left_es + (fun ctxt (address, ty) -> + let* address = + Script_ir_translator.parse_data + ctxt + ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) + ~allow_forged:false + Script_typed_ir.address_t + (Micheline.root address) + in + match address with + | {destination = Contract (Originated address); entrypoint = _}, _ctxt + -> + 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) + | _ -> return ctxt) + ctxt + in let sender_and_payer ~sender_opt ~payer_opt ~default_sender = match (sender_opt, payer_opt) with | None, None -> @@ -1681,12 +1714,14 @@ module Scripts = struct Registration.register0 ~chunked:true S.normalize_stack - (fun ctxt () (stack, unparsing_mode, legacy) -> + (fun ctxt () (stack, unparsing_mode, legacy, other_contracts) -> let legacy = Option.value ~default:false legacy in 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* Normalize_stack.Ex_stack (st_ty, x, st), ctxt = Normalize_stack.parse_stack ctxt ~legacy nodes in @@ -1871,13 +1906,14 @@ module Scripts = struct () (data, ty, unparsing_mode, legacy) - let normalize_stack ?legacy ~stack ~unparsing_mode ctxt block = + let normalize_stack ?legacy ~other_contracts ~stack ~unparsing_mode ctxt block + = RPC_context.make_call0 S.normalize_stack ctxt block () - (stack, unparsing_mode, legacy) + (stack, unparsing_mode, legacy, other_contracts) let normalize_script ~script ~unparsing_mode ctxt block = RPC_context.make_call0 -- GitLab From 1a5ec8e3aaffba29a8400f45d982defa41dcb93d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 16 Jun 2020 12:06:31 +0200 Subject: [PATCH 05/14] Plugin/Michelson: add big_maps in the context for normalize_stack This is similar to the previous commit but for big maps instead of contracts. --- .../client_proto_programs_commands.ml | 1 + src/proto_alpha/lib_plugin/RPC.ml | 102 +++++++++++++++++- 2 files changed, 98 insertions(+), 5 deletions(-) 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 47c1f9ce25e5..95860b17b0f1 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 @@ -760,6 +760,7 @@ let commands () = ~stack ~unparsing_mode ~other_contracts:None + ~extra_big_maps:None in match r with | Ok expr -> diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 799ddba85267..e3d880827537 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -233,6 +233,14 @@ module Scripts = struct (req "address" Script.expr_encoding) (req "type" Script.expr_encoding)) + let extra_big_maps_encoding = + list + (obj4 + (req "id" Script.expr_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 @@ -331,11 +339,12 @@ module Scripts = struct (obj1 (opt "level" Script_int.n_encoding)) let normalize_stack_input_encoding = - obj4 + obj5 (req "input" stack_encoding) (req "unparsing_mode" unparsing_mode_encoding) (opt "legacy" bool) (opt "other_contracts" other_contracts_encoding) + (opt "extra_big_maps" extra_big_maps_encoding) let normalize_stack_output_encoding = obj1 (req "output" stack_encoding) @@ -1208,6 +1217,83 @@ module Scripts = struct | _ -> return ctxt) 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) (id, kty, vty, update) -> + let open Script_ir_translator in + let update = Micheline.root update in + let init = + Lazy_storage.(Alloc Big_map.{key_type = kty; value_type = vty}) + in + let id = Micheline.root id in + let* id, ctxt = + parse_data + ctxt + ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) + ~allow_forged:false + Script_typed_ir.nat_t + id + in + let id = Script_int.to_zint id 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 + update + in + let items = + match update 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 + (Big_map.Id.parse_z 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 | None, None -> @@ -1714,7 +1800,11 @@ module Scripts = struct Registration.register0 ~chunked:true S.normalize_stack - (fun ctxt () (stack, unparsing_mode, legacy, other_contracts) -> + (fun + ctxt + () + (stack, unparsing_mode, legacy, other_contracts, extra_big_maps) + -> let legacy = Option.value ~default:false legacy in let ctxt = Gas.set_unlimited ctxt in let nodes = @@ -1722,6 +1812,8 @@ module Scripts = struct 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 @@ -1906,14 +1998,14 @@ module Scripts = struct () (data, ty, unparsing_mode, legacy) - let normalize_stack ?legacy ~other_contracts ~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, other_contracts) + (stack, unparsing_mode, legacy, other_contracts, extra_big_maps) let normalize_script ~script ~unparsing_mode ctxt block = RPC_context.make_call0 -- GitLab From db7308f70af0f832f2d5a1c1c09f2093fd947b65 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Wed, 30 Aug 2023 15:00:28 +0200 Subject: [PATCH 06/14] Client/Michelson: add options to the normalize_stack command --- .../lib_client/client_proto_args.ml | 53 ++++++-- .../lib_client/client_proto_args.mli | 8 ++ .../lib_client/michelson_v1_stack.ml | 117 +++++++++++++++++- .../client_proto_programs_commands.ml | 14 ++- 4 files changed, 177 insertions(+), 15 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index c183c2cf785d..b89fc2d23c41 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 e15fb3955a11..216265919128 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -238,6 +238,14 @@ 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 : + ((Script.expr * Script.expr) list option, full) Tezos_clic.arg + +val extra_big_maps_arg : + ( (Script.expr * Script.expr * Script.expr * Script.expr) 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/michelson_v1_stack.ml b/src/proto_alpha/lib_client/michelson_v1_stack.ml index 5f1675b5964b..fafd7ca6a9f8 100644 --- a/src/proto_alpha/lib_client/michelson_v1_stack.ml +++ b/src/proto_alpha/lib_client/michelson_v1_stack.ml @@ -30,6 +30,12 @@ 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 let micheline_printer_location_encoding : Micheline_printer.location Data_encoding.encoding = @@ -81,7 +87,80 @@ 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)) let parse_expression ~source (node : Micheline_parser.node) : Script.expr tzresult = @@ -102,8 +181,44 @@ 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", [addr; ty], _annot) -> + let* addr = parse_expression ~source addr in + let* ty = parse_expression ~source ty in + return (addr, 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", [i; kty; vty; map], _annot) -> + let* i = parse_expression ~source i in + let* kty = parse_expression ~source kty in + let* vty = parse_expression ~source vty in + let* map = parse_expression ~source map in + return (i, kty, vty, map) + | 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_commands/client_proto_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index 95860b17b0f1..abfa98a32d29 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 @@ -738,7 +738,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 +753,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,8 +765,8 @@ let commands () = ~legacy ~stack ~unparsing_mode - ~other_contracts:None - ~extra_big_maps:None + ~other_contracts + ~extra_big_maps in match r with | Ok expr -> -- GitLab From 64b6addc0ac20f58eaaf0e4e9af67cd25c919e1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Wed, 30 Aug 2023 16:33:10 +0200 Subject: [PATCH 07/14] Add other_contracts and extra_big_maps options to all relevant RPCs --- .../lib_client/client_proto_fa12.ml | 2 + .../lib_client/client_proto_programs.ml | 63 ++++++- .../lib_client/client_proto_programs.mli | 3 + .../lib_client/operation_result.ml | 2 + .../client_proto_programs_commands.ml | 138 ++++++++++++--- src/proto_alpha/lib_plugin/RPC.ml | 159 ++++++++++++------ 6 files changed, 285 insertions(+), 82 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_fa12.ml b/src/proto_alpha/lib_client/client_proto_fa12.ml index 77c8107222fd..6b3393b09547 100644 --- a/src/proto_alpha/lib_client/client_proto_fa12.ml +++ b/src/proto_alpha/lib_client/client_proto_fa12.ml @@ -1012,6 +1012,8 @@ let run_view_action (cctxt : #Protocol_client_context.full) ~chain ~block ~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_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 7b163d1fc81f..b1473598c386 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -148,6 +148,9 @@ type simulation_params = { sender : Contract.t option; payer : Signature.public_key_hash option; gas : Gas.Arith.integral option; + other_contracts : (Script.expr * Script.expr) list option; + extra_big_maps : + (Script.expr * Script.expr * Script.expr * Script.expr) list option; } type run_view_params = { @@ -177,7 +180,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; } = @@ -197,12 +211,25 @@ let run_view (cctxt : #Protocol_client_context.rpc_context) ~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; @@ -224,13 +251,26 @@ let run_script_view (cctxt : #Protocol_client_context.rpc_context) ~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; @@ -258,13 +298,26 @@ let run (cctxt : #Protocol_client_context.rpc_context) ~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; @@ -292,6 +345,8 @@ let trace (cctxt : #Protocol_client_context.rpc_context) ~self ~now ~level + ~other_contracts + ~extra_big_maps let typecheck_data cctxt ~(chain : Chain_services.chain) ~block ?gas ?legacy ~(data : Michelson_v1_parser.parsed) ~(ty : Michelson_v1_parser.parsed) () = diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index 402273d2db1c..42e916cfc377 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -41,6 +41,9 @@ type simulation_params = { sender : Contract.t option; payer : Signature.public_key_hash option; gas : Gas.Arith.integral option; + other_contracts : (Script.expr * Script.expr) list option; + extra_big_maps : + (Script.expr * Script.expr * Script.expr * Script.expr) list option; } (* Parameters specific to simulations of TZIP4 views *) diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index a5af9f2e7d63..d527f9ad17c5 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_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index abfa98a32d29..74dc5e704fa0 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; } @@ -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 -> @@ -1145,13 +1178,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" @@ -1164,20 +1199,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; } @@ -1186,14 +1238,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"] @@ -1201,7 +1255,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 -> @@ -1217,7 +1279,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; @@ -1227,14 +1299,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"] @@ -1247,20 +1321,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_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index e3d880827537..47ca797f9e71 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -256,11 +256,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 @@ -306,19 +308,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 @@ -336,7 +342,10 @@ 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 = obj5 @@ -447,11 +456,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)) + (opt "legacy" bool) + (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") @@ -1402,9 +1413,18 @@ module Scripts = struct payer_opt, self_opt, entrypoint ), - (unparsing_mode, gas_opt, now_opt, level_opt) ) + ( 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, step_constants = @@ -1460,9 +1480,18 @@ module Scripts = struct payer_opt, self_opt, entrypoint ), - (unparsing_mode, gas_opt, now_opt, level_opt) ) + ( 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, step_constants = @@ -1511,17 +1540,22 @@ module Scripts = struct (fun ctxt () - ( contract_hash, - entrypoint, - input, - chain_id, - sender_opt, - payer_opt, - gas, - unparsing_mode, - now_opt, - level_opt ) + ( ( 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 @@ -1607,8 +1641,12 @@ module Scripts = struct gas, unparsing_mode, now_opt ), - level_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 @@ -1778,8 +1816,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 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 legacy = Option.value ~default:false legacy in let ctxt = Gas.set_unlimited ctxt in let*? Ex_ty typ, ctxt = @@ -1890,8 +1936,8 @@ module Scripts = struct [] )) let run_code ?unparsing_mode ?gas ?(entrypoint = Entrypoint.default) ?balance - ~script ~storage ~input ~amount ~chain_id ~sender ~payer ~self ~now ~level - ctxt block = + ~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 @@ -1907,11 +1953,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 = + ?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 @@ -1927,30 +1973,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 = + let run_script_view ?gas ~other_contracts ~extra_big_maps ~contract ~view + ~input ?(unlimited_gas = false) ~chain_id ~now ~level ?sender ?payer + ~unparsing_mode ctxt block = RPC_context.make_call0 S.run_script_view ctxt @@ -1966,7 +2014,7 @@ module Scripts = struct gas, unparsing_mode, now ), - level ) + (level, other_contracts, extra_big_maps) ) let typecheck_code ?gas ?legacy ~script ?show_types ctxt block = RPC_context.make_call0 @@ -1990,13 +2038,14 @@ module Scripts = struct 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 ~other_contracts ~extra_big_maps ~stack ~unparsing_mode ctxt block = -- GitLab From 224ef87ff9e09f4cee3b85a67360207e5c2fe5f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Wed, 30 Aug 2023 17:40:48 +0200 Subject: [PATCH 08/14] Plugin/Michelson: remove default arg on RPC wrapper --- .../lib_client/client_proto_fa12.ml | 8 +-- .../lib_client/client_proto_fa12.mli | 6 +-- .../lib_client/client_proto_multisig.ml | 18 ++++--- .../lib_client/client_proto_programs.ml | 48 +++++++++-------- .../lib_client/client_proto_programs.mli | 12 ++--- .../client_proto_fa12_commands.ml | 17 +++--- .../client_proto_programs_commands.ml | 11 ++-- .../client_sapling_commands.ml | 1 + src/proto_alpha/lib_plugin/RPC.ml | 54 +++++++++---------- 9 files changed, 89 insertions(+), 86 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_fa12.ml b/src/proto_alpha/lib_client/client_proto_fa12.ml index 6b3393b09547..925713f50843 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,9 +1005,9 @@ 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 diff --git a/src/proto_alpha/lib_client/client_proto_fa12.mli b/src/proto_alpha/lib_client/client_proto_fa12.mli index 3c11c7340043..21e75392fc50 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 b9b79003abd7..ee854ff5ee6e 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 b1473598c386..555e9bcaac88 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -201,13 +201,13 @@ 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 @@ -240,14 +240,14 @@ 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 @@ -281,17 +281,18 @@ 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 @@ -328,17 +329,18 @@ 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 @@ -348,34 +350,34 @@ let trace (cctxt : #Protocol_client_context.rpc_context) ~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 42e916cfc377..0c4bef5d3a3a 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -147,8 +147,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 -> @@ -159,8 +159,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 @@ -181,8 +181,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_commands/client_proto_fa12_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_fa12_commands.ml index 9eaec00a4f94..c4b82cdc2654 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 74dc5e704fa0..de0eba0556e6 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 @@ -373,7 +373,7 @@ let commands () = cctxt ~chain:cctxt#chain ~block:cctxt#block - ~gas:original_gas + ~gas:(Some original_gas) ~legacy ~program ~storage @@ -439,7 +439,7 @@ let commands () = cctxt ~chain:cctxt#chain ~block:cctxt#block - ~gas:original_gas + ~gas:(Some original_gas) ~legacy ~show_types program @@ -476,7 +476,7 @@ let commands () = cctxt ~chain:cctxt#chain ~block:cctxt#block - ~gas:original_gas + ~gas:(Some original_gas) ~legacy ~data ~ty @@ -523,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 @@ -1016,6 +1016,7 @@ let commands () = ~block:cctxt#block ~legacy ~show_types:true + ~gas:None program in match r with @@ -1103,6 +1104,8 @@ let commands () = ~block:cctxt#block ~data ~ty + ~gas:None + ~legacy:false () in match r with 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 347de5bbe0b1..70aec92f5ceb 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 47ca797f9e71..4e1bb754acc8 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -351,7 +351,7 @@ module Scripts = struct 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) @@ -401,8 +401,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) @@ -418,7 +418,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") @@ -433,7 +433,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") @@ -460,7 +460,7 @@ module Scripts = struct (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)) @@ -1724,8 +1724,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 @@ -1739,7 +1737,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 @@ -1782,7 +1779,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 @@ -1826,7 +1822,6 @@ module Scripts = struct 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 legacy = Option.value ~default:false legacy in let ctxt = Gas.set_unlimited ctxt in let*? Ex_ty typ, ctxt = Script_ir_translator.parse_any_ty ctxt ~legacy (Micheline.root typ) @@ -1851,7 +1846,6 @@ module Scripts = struct () (stack, unparsing_mode, legacy, other_contracts, extra_big_maps) -> - let legacy = Option.value ~default:false legacy in let ctxt = Gas.set_unlimited ctxt in let nodes = List.map (fun (a, b) -> (Micheline.root a, Micheline.root b)) stack @@ -1935,9 +1929,9 @@ module Scripts = struct map [] )) - let run_code ?unparsing_mode ?gas ?(entrypoint = Entrypoint.default) ?balance - ~other_contracts ~extra_big_maps ~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 @@ -1955,9 +1949,9 @@ module Scripts = struct entrypoint ), (unparsing_mode, gas, now, level, other_contracts, extra_big_maps) ) - let trace_code ?unparsing_mode ?gas ?(entrypoint = Entrypoint.default) - ?balance ~other_contracts ~extra_big_maps ~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 @@ -1975,8 +1969,8 @@ module Scripts = struct entrypoint ), (unparsing_mode, gas, now, level, other_contracts, extra_big_maps) ) - let run_tzip4_view ?gas ~other_contracts ~extra_big_maps ~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 @@ -1995,10 +1989,10 @@ module Scripts = struct (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 ~other_contracts ~extra_big_maps ~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 @@ -2016,7 +2010,7 @@ module Scripts = struct now ), (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 @@ -2024,7 +2018,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 @@ -2032,13 +2026,13 @@ 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 ~other_contracts ~extra_big_maps ~data ~ty + let normalize_data ~legacy ~other_contracts ~extra_big_maps ~data ~ty ~unparsing_mode ctxt block = RPC_context.make_call0 S.normalize_data @@ -2047,7 +2041,7 @@ module Scripts = struct () (data, ty, unparsing_mode, legacy, other_contracts, extra_big_maps) - let normalize_stack ?legacy ~other_contracts ~extra_big_maps ~stack + let normalize_stack ~legacy ~other_contracts ~extra_big_maps ~stack ~unparsing_mode ctxt block = RPC_context.make_call0 S.normalize_stack -- GitLab From 600377f24e97e396d2ab086f64b53fda6b0d3678 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Mon, 4 Sep 2023 15:27:34 +0200 Subject: [PATCH 09/14] Changelog: mention !9946 --- CHANGES.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.rst b/CHANGES.rst index 04d6f19886e4..0ba861131877 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 ----- -- GitLab From c96aa1f7f3b4243c4a71b6f9b00135abd94a075b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Wed, 11 Oct 2023 17:34:41 +0200 Subject: [PATCH 10/14] Client+RPC/Michelson: client-side parsing of contract addresses --- .../lib_client/client_proto_args.mli | 2 +- .../lib_client/client_proto_programs.ml | 2 +- .../lib_client/client_proto_programs.mli | 2 +- .../lib_client/michelson_v1_stack.ml | 31 ++++++++++++++++-- src/proto_alpha/lib_plugin/RPC.ml | 32 ++++++------------- 5 files changed, 42 insertions(+), 27 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_args.mli b/src/proto_alpha/lib_client/client_proto_args.mli index 216265919128..2ac9f421b6e4 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -239,7 +239,7 @@ val edge_of_baking_over_staking_billionth_arg : (int option, full) Tezos_clic.arg val other_contracts_arg : - ((Script.expr * Script.expr) list option, full) Tezos_clic.arg + ((Contract_hash.t * Script.expr) list option, full) Tezos_clic.arg val extra_big_maps_arg : ( (Script.expr * Script.expr * Script.expr * Script.expr) list option, diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 555e9bcaac88..c03ab4bd439c 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -148,7 +148,7 @@ type simulation_params = { sender : Contract.t option; payer : Signature.public_key_hash option; gas : Gas.Arith.integral option; - other_contracts : (Script.expr * Script.expr) list option; + other_contracts : (Contract_hash.t * Script.expr) list option; extra_big_maps : (Script.expr * Script.expr * Script.expr * Script.expr) list option; } diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index 0c4bef5d3a3a..b534ae6822bd 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -41,7 +41,7 @@ type simulation_params = { sender : Contract.t option; payer : Signature.public_key_hash option; gas : Gas.Arith.integral option; - other_contracts : (Script.expr * Script.expr) list option; + other_contracts : (Contract_hash.t * Script.expr) list option; extra_big_maps : (Script.expr * Script.expr * Script.expr * Script.expr) list option; } diff --git a/src/proto_alpha/lib_client/michelson_v1_stack.ml b/src/proto_alpha/lib_client/michelson_v1_stack.ml index fafd7ca6a9f8..54b63e5f232e 100644 --- a/src/proto_alpha/lib_client/michelson_v1_stack.ml +++ b/src/proto_alpha/lib_client/michelson_v1_stack.ml @@ -36,6 +36,7 @@ type error += | 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 = @@ -160,7 +161,23 @@ let () = (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)) + (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 = @@ -184,8 +201,18 @@ let parse_stack_item ~source = let parse_other_contract_item ~source = let open Result_syntax in function - | Micheline.Prim (_loc, "Contract", [addr; ty], _annot) -> + | Micheline.Prim (_loc, "Contract", [addr; ty], _annot) as e -> let* addr = parse_expression ~source addr in + let* addr = + match Micheline.root addr 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 (addr, ty) | e -> tzfail (Wrong_other_contracts_item (Micheline.location e, printable e)) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 4e1bb754acc8..512068c1db9a 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -230,7 +230,7 @@ module Scripts = struct let other_contracts_encoding = list (obj2 - (req "address" Script.expr_encoding) + (req "address" Contract_hash.encoding) (req "type" Script.expr_encoding)) let extra_big_maps_encoding = @@ -1205,27 +1205,15 @@ module Scripts = struct let originate_dummy_contracts ctxt = List.fold_left_es (fun ctxt (address, ty) -> - let* address = - Script_ir_translator.parse_data - ctxt - ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) - ~allow_forged:false - Script_typed_ir.address_t - (Micheline.root address) - in - match address with - | {destination = Contract (Originated address); entrypoint = _}, _ctxt - -> - 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) - | _ -> return ctxt) + 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 = -- GitLab From 2a0830c47d3540c14f5724c97abcb7e9348dc4ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Wed, 11 Oct 2023 17:46:55 +0200 Subject: [PATCH 11/14] Client+RPC/Michelson: client side parsing of big map ids --- .../lib_client/client_proto_args.mli | 2 +- .../lib_client/client_proto_programs.ml | 2 +- .../lib_client/client_proto_programs.mli | 2 +- .../lib_client/michelson_v1_stack.ml | 9 ++++++++- src/proto_alpha/lib_plugin/RPC.ml | 17 ++--------------- 5 files changed, 13 insertions(+), 19 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_args.mli b/src/proto_alpha/lib_client/client_proto_args.mli index 2ac9f421b6e4..1e0e71486b41 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -242,7 +242,7 @@ val other_contracts_arg : ((Contract_hash.t * Script.expr) list option, full) Tezos_clic.arg val extra_big_maps_arg : - ( (Script.expr * Script.expr * Script.expr * Script.expr) list option, + ( (Big_map.Id.t * Script.expr * Script.expr * Script.expr) list option, full ) Tezos_clic.arg diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index c03ab4bd439c..ca574a960582 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -150,7 +150,7 @@ type simulation_params = { gas : Gas.Arith.integral option; other_contracts : (Contract_hash.t * Script.expr) list option; extra_big_maps : - (Script.expr * Script.expr * Script.expr * Script.expr) list option; + (Big_map.Id.t * Script.expr * Script.expr * Script.expr) list option; } type run_view_params = { diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index b534ae6822bd..9f7c88b5799d 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -43,7 +43,7 @@ type simulation_params = { gas : Gas.Arith.integral option; other_contracts : (Contract_hash.t * Script.expr) list option; extra_big_maps : - (Script.expr * Script.expr * Script.expr * Script.expr) list option; + (Big_map.Id.t * Script.expr * Script.expr * Script.expr) list option; } (* Parameters specific to simulations of TZIP4 views *) diff --git a/src/proto_alpha/lib_client/michelson_v1_stack.ml b/src/proto_alpha/lib_client/michelson_v1_stack.ml index 54b63e5f232e..e25996c5ce40 100644 --- a/src/proto_alpha/lib_client/michelson_v1_stack.ml +++ b/src/proto_alpha/lib_client/michelson_v1_stack.ml @@ -220,8 +220,15 @@ let parse_other_contract_item ~source = let parse_extra_big_map_item ~source = let open Result_syntax in function - | Micheline.Prim (_loc, "Big_map", [i; kty; vty; map], _annot) -> + | Micheline.Prim (_loc, "Big_map", [i; kty; vty; map], _annot) as e -> let* i = parse_expression ~source i in + let* i = + match Micheline.root i with + | Micheline.Int (_loc, i) -> return (Big_map.Id.parse_z i) + | _ -> + 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* map = parse_expression ~source map in diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 512068c1db9a..1992b8c5c6e0 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -236,7 +236,7 @@ module Scripts = struct let extra_big_maps_encoding = list (obj4 - (req "id" Script.expr_encoding) + (req "id" Big_map.Id.encoding) (req "key_type" Script.expr_encoding) (req "val_type" Script.expr_encoding) (req "map_literal" Script.expr_encoding)) @@ -1225,16 +1225,6 @@ module Scripts = struct let init = Lazy_storage.(Alloc Big_map.{key_type = kty; value_type = vty}) in - let id = Micheline.root id in - let* id, ctxt = - parse_data - ctxt - ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) - ~allow_forged:false - Script_typed_ir.nat_t - id - in - let id = Script_int.to_zint id in let*? Ex_comparable_ty key_comparable_type, ctxt = parse_comparable_ty ctxt (Micheline.root kty) in @@ -1282,10 +1272,7 @@ module Scripts = struct in ( ctxt, Lazy_storage.( - make - Big_map - (Big_map.Id.parse_z id) - (Update {init; updates = List.rev updates})) + make Big_map id (Update {init; updates = List.rev updates})) :: big_map_diff_tl )) (ctxt, []) big_maps -- GitLab From 32804fc7748097683ff626907528506699c97590 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 19 Oct 2023 09:20:16 +0200 Subject: [PATCH 12/14] tezt/client: support other-contracts and extra-big-maps --- tezt/lib_tezos/client.ml | 50 ++++++++++++++++++++++++++------------- tezt/lib_tezos/client.mli | 16 +++++++++++++ 2 files changed, 50 insertions(+), 16 deletions(-) diff --git a/tezt/lib_tezos/client.ml b/tezt/lib_tezos/client.ml index fc6aceeafd55..735c43895388 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 d1796f35eaaa..f454e872a77c 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 -> -- GitLab From 3bbbd6aed7b5d4f675871cc25ea6d1557bd1a65b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Fri, 20 Oct 2023 13:29:27 +0200 Subject: [PATCH 13/14] Plugin/Michelson: introduce record types for the new encodings --- .../lib_client/client_proto_args.mli | 6 +-- .../lib_client/client_proto_programs.ml | 5 +-- .../lib_client/client_proto_programs.mli | 5 +-- .../lib_client/michelson_v1_stack.ml | 24 +++++----- src/proto_alpha/lib_plugin/RPC.ml | 44 +++++++++++++------ 5 files changed, 49 insertions(+), 35 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_args.mli b/src/proto_alpha/lib_client/client_proto_args.mli index 1e0e71486b41..2d9e700bda64 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -239,12 +239,10 @@ val edge_of_baking_over_staking_billionth_arg : (int option, full) Tezos_clic.arg val other_contracts_arg : - ((Contract_hash.t * Script.expr) list option, full) Tezos_clic.arg + (RPC.Scripts.S.other_contract_description list option, full) Tezos_clic.arg val extra_big_maps_arg : - ( (Big_map.Id.t * Script.expr * Script.expr * Script.expr) list option, - full ) - Tezos_clic.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_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index ca574a960582..e3762a69cafa 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -148,9 +148,8 @@ type simulation_params = { sender : Contract.t option; payer : Signature.public_key_hash option; gas : Gas.Arith.integral option; - other_contracts : (Contract_hash.t * Script.expr) list option; - extra_big_maps : - (Big_map.Id.t * Script.expr * Script.expr * Script.expr) list 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 = { diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index 9f7c88b5799d..638d4e6a2752 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -41,9 +41,8 @@ type simulation_params = { sender : Contract.t option; payer : Signature.public_key_hash option; gas : Gas.Arith.integral option; - other_contracts : (Contract_hash.t * Script.expr) list option; - extra_big_maps : - (Big_map.Id.t * Script.expr * Script.expr * Script.expr) list 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 *) diff --git a/src/proto_alpha/lib_client/michelson_v1_stack.ml b/src/proto_alpha/lib_client/michelson_v1_stack.ml index e25996c5ce40..3800dd11425d 100644 --- a/src/proto_alpha/lib_client/michelson_v1_stack.ml +++ b/src/proto_alpha/lib_client/michelson_v1_stack.ml @@ -201,10 +201,10 @@ let parse_stack_item ~source = let parse_other_contract_item ~source = let open Result_syntax in function - | Micheline.Prim (_loc, "Contract", [addr; ty], _annot) as e -> - let* addr = parse_expression ~source addr in - let* addr = - match Micheline.root addr with + | 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 @@ -214,25 +214,25 @@ let parse_other_contract_item ~source = (Wrong_other_contracts_item (Micheline.location e, printable e)) in let* ty = parse_expression ~source ty in - return (addr, ty) + 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", [i; kty; vty; map], _annot) as e -> - let* i = parse_expression ~source i in - let* i = - match Micheline.root i with - | Micheline.Int (_loc, i) -> return (Big_map.Id.parse_z i) + | 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* map = parse_expression ~source map in - return (i, kty, vty, map) + 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 diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 1992b8c5c6e0..3f30818975bb 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -227,19 +227,37 @@ 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 - (obj2 - (req "address" Contract_hash.encoding) - (req "type" Script.expr_encoding)) + (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 - (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)) + (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 @@ -1204,7 +1222,7 @@ module Scripts = struct in let originate_dummy_contracts ctxt = List.fold_left_es - (fun ctxt (address, ty) -> + (fun ctxt {S.address; ty} -> Contract.raw_originate ctxt ~prepaid_bootstrap_storage:false @@ -1219,9 +1237,9 @@ module Scripts = struct 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) (id, kty, vty, update) -> + (fun (ctxt, big_map_diff_tl) {S.id; kty; vty; items} -> let open Script_ir_translator in - let update = Micheline.root update in + let items = Micheline.root items in let init = Lazy_storage.(Alloc Big_map.{key_type = kty; value_type = vty}) in @@ -1241,10 +1259,10 @@ module Scripts = struct ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) ~allow_forged:true map_ty - update + items in let items = - match update with + match items with | Micheline.Seq (_, items) -> items | _ -> assert false in -- GitLab From 932ede5c9ed0a8af62b3bb66894c7ff3b8d9f673 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Mon, 6 Nov 2023 23:17:17 +0100 Subject: [PATCH 14/14] Tezt/Client/Michelson: test args --extra-big-map & --other-contracts --- tezt/tests/run_script.ml | 48 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) diff --git a/tezt/tests/run_script.ml b/tezt/tests/run_script.ml index 5b44148224ad..afc72201ce25 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 -- GitLab