From b7f3513b00dd152a4721a00c8fea68166e852bad Mon Sep 17 00:00:00 2001 From: Jason Ridgway-Taylor Date: Wed, 29 Nov 2023 16:43:45 +0800 Subject: [PATCH 1/3] Proto: Split allow_forged Split allow_forged into allow_forged_tickets and allow_forged_lazy_storage_id --- devtools/get_contracts/get_contracts_alpha.ml | 3 +- .../lib_benchmarks_proto/cache_benchmarks.ml | 3 +- .../script_typed_ir_size_benchmarks.ml | 3 +- .../translator_benchmarks.ml | 6 +- .../translator_workload.ml | 3 +- src/proto_alpha/lib_plugin/RPC.ml | 33 ++++-- src/proto_alpha/lib_protocol/apply.ml | 15 +-- .../lib_protocol/contract_services.ml | 18 ++- src/proto_alpha/lib_protocol/main.ml | 8 +- .../sc_rollup_management_protocol.ml | 3 +- .../lib_protocol/script_big_map.ml | 3 +- src/proto_alpha/lib_protocol/script_cache.ml | 3 +- .../lib_protocol/script_interpreter.ml | 9 +- .../lib_protocol/script_interpreter_defs.ml | 3 +- .../lib_protocol/script_ir_translator.ml | 106 +++++++++++++----- .../lib_protocol/script_ir_translator.mli | 12 +- .../lib_protocol/script_ir_unparser.ml | 10 +- .../lib_protocol/script_ir_unparser.mli | 3 +- .../lib_protocol/test/helpers/block.ml | 8 +- .../integration/michelson/test_annotations.ml | 3 +- .../michelson/test_lambda_normalization.ml | 8 +- .../integration/michelson/test_sapling.ml | 6 +- .../michelson/test_ticket_accounting.ml | 3 +- .../michelson/test_ticket_manager.ml | 3 +- .../michelson/test_ticket_operations_diff.ml | 3 +- .../michelson/test_ticket_scanner.ml | 3 +- .../michelson/test_typechecking.ml | 25 ++++- .../integration/operations/test_sc_rollup.ml | 3 +- .../test/pbt/test_script_roundtrip.ml | 6 +- .../lib_protocol/ticket_scanner.ml | 6 +- 30 files changed, 223 insertions(+), 98 deletions(-) diff --git a/devtools/get_contracts/get_contracts_alpha.ml b/devtools/get_contracts/get_contracts_alpha.ml index dc76eedf8b96..be67f1b35761 100644 --- a/devtools/get_contracts/get_contracts_alpha.ml +++ b/devtools/get_contracts/get_contracts_alpha.ml @@ -133,7 +133,8 @@ module Proto = struct @@ Script_ir_translator.parse_data ~elab_conf:(Script_ir_translator_config.make ~legacy:true ()) ctxt - ~allow_forged + ~allow_forged_tickets:allow_forged + ~allow_forged_lazy_storage_id:allow_forged ty expr in diff --git a/src/proto_alpha/lib_benchmarks_proto/cache_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/cache_benchmarks.ml index 57c9cd4a52cc..9706b5507681 100644 --- a/src/proto_alpha/lib_benchmarks_proto/cache_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/cache_benchmarks.ml @@ -69,7 +69,8 @@ let dummy_script : Cache.cached_contract = Script_ir_translator.parse_script throwaway_context ~elab_conf:(Script_ir_translator_config.make ~legacy:true ()) - ~allow_forged_in_storage:false + ~allow_forged_tickets_in_storage:false + ~allow_forged_lazy_storage_id_in_storage:false script |> assert_ok_lwt in diff --git a/src/proto_alpha/lib_benchmarks_proto/script_typed_ir_size_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/script_typed_ir_size_benchmarks.ml index 5b84dd845646..4c47caea5fdf 100644 --- a/src/proto_alpha/lib_benchmarks_proto/script_typed_ir_size_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/script_typed_ir_size_benchmarks.ml @@ -94,7 +94,8 @@ module Value_size_benchmark : Tezos_benchmark.Benchmark.S = struct (Script_ir_translator.parse_data ctxt ~elab_conf:strict - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false ty (Micheline.root node)) with diff --git a/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml index d19901e69ac3..1151346729b5 100644 --- a/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml @@ -233,7 +233,8 @@ module Typechecking_data : Benchmark.S = struct (Script_ir_translator.parse_data ctxt ~elab_conf:strict - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false ty (Micheline.root node)) with @@ -312,7 +313,8 @@ module Unparsing_data : Benchmark.S = struct Script_ir_translator.parse_data ctxt ~elab_conf:strict - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false ty (Micheline.root node) in diff --git a/src/proto_alpha/lib_benchmarks_proto/translator_workload.ml b/src/proto_alpha/lib_benchmarks_proto/translator_workload.ml index 09212c347c96..177ff05f08ba 100644 --- a/src/proto_alpha/lib_benchmarks_proto/translator_workload.ml +++ b/src/proto_alpha/lib_benchmarks_proto/translator_workload.ml @@ -118,7 +118,8 @@ let data_typechecker_workload ctxt t_kind micheline_node ex_ty = Script_ir_translator.parse_data ctxt ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false ty micheline_node |> Lwt.map Environment.wrap_tzresult diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index dfedda356909..3c46a35f2f66 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -780,14 +780,16 @@ module Scripts = struct (fun () -> let exp_ty = Script_ir_unparser.serialize_ty_for_error exp_ty in Script_tc_errors.Ill_typed_data (None, data, exp_ty)) - (let allow_forged = + (let allow_forged_tickets = true in + let allow_forged_lazy_storage_id = true (* Safe since we ignore the value afterwards. *) in Script_ir_translator.parse_data ctxt ~elab_conf:(elab_conf ~legacy ()) - ~allow_forged + ~allow_forged_tickets + ~allow_forged_lazy_storage_id exp_ty (Micheline.root data)) in @@ -909,7 +911,8 @@ module Scripts = struct Script_ir_translator.parse_data ctxt ~elab_conf - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true ty data_node in @@ -1289,7 +1292,8 @@ module Scripts = struct parse_data ctxt ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true map_ty items in @@ -1778,7 +1782,8 @@ module Scripts = struct let* storage, _ = Script_ir_translator.parse_data ~elab_conf - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true ctxt storage_type (Micheline.root storage) @@ -1828,7 +1833,8 @@ module Scripts = struct parse_data ctxt ~elab_conf:(elab_conf ~legacy:true ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true typ (Micheline.root expr) in @@ -1855,7 +1861,8 @@ module Scripts = struct parse_data ctxt ~elab_conf:(elab_conf ~legacy ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true typ (Micheline.root expr) in @@ -2348,7 +2355,8 @@ module Contract = struct parse_script ctxt ~elab_conf:(elab_conf ~legacy:true ()) - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let+ storage, _ctxt = @@ -2370,7 +2378,8 @@ module Contract = struct Script_ir_translator.parse_and_unparse_script_unaccounted ctxt ~legacy:true - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true unparsing_mode ~normalize_types script @@ -2417,7 +2426,8 @@ module Contract = struct Script_ir_translator.parse_script ctxt ~elab_conf:(elab_conf ~legacy:true ()) - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let*? has_tickets, ctxt = @@ -2538,7 +2548,8 @@ module Big_map = struct parse_data ctxt ~elab_conf:(elab_conf ~legacy:true ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true value_type (Micheline.root value) in diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 7bd50d67271c..cdf518ad0cb2 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1091,7 +1091,8 @@ let apply_manager_operation : Script_ir_translator.parse_data ~elab_conf ctxt - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false Script_typed_ir.pair_int_int_unit_t (Micheline.root parameters) in @@ -1152,13 +1153,8 @@ let apply_manager_operation : Script_ir_translator.parse_data ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:false ()) - (* FIXME: https://gitlab.com/tezos/tezos/-/issues/2964 - - Setting [allow_forged] to [true] would also enable placing - lazy storage ids in the parameter, which is something we should avoid. - To prevent this, we should split [allow_forged] into something like - [allow_tickets] and [allow_lazy_storage_id]. *) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true parameters_ty (Micheline.root parameters) in @@ -1321,7 +1317,8 @@ let apply_manager_operation : Script_ir_translator.parse_script ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:false ()) - ~allow_forged_in_storage:false + ~allow_forged_tickets_in_storage:false + ~allow_forged_lazy_storage_id_in_storage:false script in let (Script {storage_type; views; storage; _}) = parsed_script in diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml index 3ba4acddcf35..308535694aab 100644 --- a/src/proto_alpha/lib_protocol/contract_services.ml +++ b/src/proto_alpha/lib_protocol/contract_services.ml @@ -321,7 +321,8 @@ module S = struct Script_ir_translator.parse_script ctxt ~elab_conf:legacy - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let*? Ex_script (Script script), ctxt = tzresult in @@ -430,7 +431,8 @@ let register () = parse_data ctxt ~elab_conf:legacy - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true value_type (Micheline.root value) in @@ -458,7 +460,8 @@ let register () = parse_data ctxt ~elab_conf:legacy - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true value_type (Micheline.root value) in @@ -533,7 +536,8 @@ let register () = parse_script ctxt ~elab_conf:legacy - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let+ storage, _ctxt = @@ -664,7 +668,8 @@ let register () = parse_script ctxt ~elab_conf:legacy - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let*? ids, _ctxt = @@ -702,7 +707,8 @@ let register () = Script_ir_translator.parse_and_unparse_script_unaccounted ctxt ~legacy:true - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true Readable ~normalize_types script diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index e3595b2c2acd..d03225f04943 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -367,15 +367,17 @@ let init chain_id ctxt block_header = let predecessor = block_header.predecessor in let typecheck_smart_contract (ctxt : Alpha_context.context) (script : Alpha_context.Script.t) = - let allow_forged_in_storage = - false + let allow_forged_tickets_in_storage, allow_forged_lazy_storage_id_in_storage + = + (false, false) (* There should be no forged value in bootstrap contracts. *) in let* Ex_script (Script parsed_script), ctxt = Script_ir_translator.parse_script ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:true ()) - ~allow_forged_in_storage + ~allow_forged_tickets_in_storage + ~allow_forged_lazy_storage_id_in_storage script in let* storage, lazy_storage_diff, ctxt = diff --git a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml index 3bd0d7b13667..423764a1a62f 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml @@ -77,7 +77,8 @@ let make_transaction ctxt ~parameters_ty ~unparsed_parameters ~destination Script_ir_translator.parse_data ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:false ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true parameters_ty (Micheline.root unparsed_parameters) in diff --git a/src/proto_alpha/lib_protocol/script_big_map.ml b/src/proto_alpha/lib_protocol/script_big_map.ml index b0fe7ca2ec4b..d1bd1482a9a7 100644 --- a/src/proto_alpha/lib_protocol/script_big_map.ml +++ b/src/proto_alpha/lib_protocol/script_big_map.ml @@ -63,7 +63,8 @@ let get_by_hash ctxt key (Big_map {id; diff; value_type; _}) = parse_data ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:true ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true value_type (Micheline.root value) in diff --git a/src/proto_alpha/lib_protocol/script_cache.ml b/src/proto_alpha/lib_protocol/script_cache.ml index 6d6b3d6cabbc..70a79eb8f447 100644 --- a/src/proto_alpha/lib_protocol/script_cache.ml +++ b/src/proto_alpha/lib_protocol/script_cache.ml @@ -49,7 +49,8 @@ let load_and_elaborate ctxt addr = ctxt script ~elab_conf:Script_ir_translator_config.(make ~legacy:true ()) - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true in (* We consume gas after the fact in order to not have to instrument [script_size] (for efficiency). diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 02f00a6bf3f5..7ffcfcabc21e 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -574,7 +574,8 @@ module Raw = struct let* Ex_script (Script {storage; storage_type; views; _}), ctxt = parse_script ~elab_conf:legacy - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true ctxt script in @@ -1770,7 +1771,8 @@ let lift_execution_arg (type a ac) ctxt ~internal (entrypoint_ty : (a, ac) ty) parse_data ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:false ()) - ~allow_forged:internal + ~allow_forged_tickets:internal + ~allow_forged_lazy_storage_id:internal entrypoint_ty arg | Typed_arg (loc, parsed_arg_ty, parsed_arg) -> @@ -1825,7 +1827,8 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal ctxt unparsed_script ~elab_conf - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true | Some ex_script -> return (ex_script, ctxt) in let*? r, ctxt = diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index cfdad3f2c2a8..f63fcd930472 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -783,7 +783,8 @@ let unpack ctxt ~ty ~bytes = parse_data ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:false ()) - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false ty (Micheline.root expr) in diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 5c1903f5189e..d6befe9ab5fd 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -2066,14 +2066,16 @@ let normalized_lam_rec ~unparse_code_rec ~stack_depth ctxt kdescr code_field = (* Some values, such as operations, tickets, or big map ids, are used only internally and are not allowed to be forged by users. - In [parse_data], [allow_forged] should be [false] for: + In [parse_data], both [allow_forged_tickets] and [allow_forged_lazy_storage_id] should be [false] for: - PUSH - UNPACK - - user-provided script parameters - storage on origination And [true] for: - internal calls parameters - - storage after origination + - storage after origination. + For + - user-provided script parameters + [allow_forged_lazy_storage_id] should be [false] but [allow_forged_tickets] should be [true] as users are allowed to transfer tickets. Checking ticket ownership is handled by the ticket table. *) let rec parse_data : @@ -2082,11 +2084,19 @@ let rec parse_data : elab_conf:elab_conf -> stack_depth:int -> context -> - allow_forged:bool -> + allow_forged_tickets:bool -> + allow_forged_lazy_storage_id:bool -> (a, ac) ty -> Script.node -> (a * context) tzresult Lwt.t = - fun ~unparse_code_rec ~elab_conf ~stack_depth ctxt ~allow_forged ty script_data -> + fun ~unparse_code_rec + ~elab_conf + ~stack_depth + ctxt + ~allow_forged_tickets + ~allow_forged_lazy_storage_id + ty + script_data -> let open Lwt_result_syntax in let*? ctxt = Gas.consume ctxt Typecheck_costs.parse_data_cycle in let non_terminal_recursion ctxt ty script_data = @@ -2098,7 +2108,8 @@ let rec parse_data : ~elab_conf ~stack_depth:(stack_depth + 1) ctxt - ~allow_forged + ~allow_forged_tickets + ~allow_forged_lazy_storage_id ty script_data in @@ -2353,7 +2364,7 @@ let rec parse_data : let+ amount, ctxt = non_terminal_recursion ctxt nat_t amount in ((destination, contents, amount), ctxt) in - if allow_forged then + if allow_forged_tickets then let* (destination, contents, amount), ctxt = match expr with | Prim @@ -2462,7 +2473,7 @@ let rec parse_data : match id_opt with | None -> return (None, ctxt) | Some (id, loc) -> - if allow_forged then + if allow_forged_lazy_storage_id then let id = Big_map.Id.parse_z id in let* ctxt, tys_opt = Big_map.exists ctxt id in match tys_opt with @@ -2504,7 +2515,7 @@ let rec parse_data : Lwt.return @@ traced_no_lwt @@ parse_bls12_381_fr ctxt expr (* /!\ When adding new lazy storage kinds, you may want to guard the parsing - of identifiers with [allow_forged]. + of identifiers with [allow_forged_lazy_storage_id]. *) (* Sapling *) | Sapling_transaction_t memo_size, expr -> @@ -2514,7 +2525,7 @@ let rec parse_data : Lwt.return @@ traced_no_lwt @@ parse_sapling_transaction_deprecated ctxt ~memo_size expr | Sapling_state_t memo_size, Int (loc, id) -> - if allow_forged then + if allow_forged_lazy_storage_id then let id = Sapling.Id.parse_z id in let* state, ctxt = Sapling.state_from_id ctxt id in let*? () = @@ -2975,7 +2986,8 @@ and parse_instr : ~elab_conf ~stack_depth:(stack_depth + 1) ctxt - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false t d in @@ -5159,12 +5171,19 @@ let parse_storage : unparse_code_rec:Script_ir_unparser.unparse_code_rec -> elab_conf:elab_conf -> context -> - allow_forged:bool -> + allow_forged_tickets:bool -> + allow_forged_lazy_storage_id:bool -> ('storage, _) ty -> storage:lazy_expr -> ('storage * context) tzresult Lwt.t = let open Lwt_result_syntax in - fun ~unparse_code_rec ~elab_conf ctxt ~allow_forged storage_type ~storage -> + fun ~unparse_code_rec + ~elab_conf + ctxt + ~allow_forged_tickets + ~allow_forged_lazy_storage_id + storage_type + ~storage -> let*? storage, ctxt = Script.force_decode_in_context ~consume_deserialization_gas:When_needed @@ -5180,7 +5199,8 @@ let parse_storage : ~elab_conf ~stack_depth:0 ctxt - ~allow_forged + ~allow_forged_tickets + ~allow_forged_lazy_storage_id storage_type (root storage)) @@ -5188,11 +5208,17 @@ let parse_script : unparse_code_rec:Script_ir_unparser.unparse_code_rec -> elab_conf:elab_conf -> context -> - allow_forged_in_storage:bool -> + allow_forged_tickets_in_storage:bool -> + allow_forged_lazy_storage_id_in_storage:bool -> Script.t -> (ex_script * context) tzresult Lwt.t = let open Lwt_result_syntax in - fun ~unparse_code_rec ~elab_conf ctxt ~allow_forged_in_storage {code; storage} -> + fun ~unparse_code_rec + ~elab_conf + ctxt + ~allow_forged_tickets_in_storage + ~allow_forged_lazy_storage_id_in_storage + {code; storage} -> let* ( Ex_code (Code {code; arg_type; storage_type; views; entrypoints; code_size}), @@ -5204,7 +5230,8 @@ let parse_script : ~unparse_code_rec ~elab_conf ctxt - ~allow_forged:allow_forged_in_storage + ~allow_forged_tickets:allow_forged_tickets_in_storage + ~allow_forged_lazy_storage_id:allow_forged_lazy_storage_id_in_storage storage_type ~storage in @@ -5366,7 +5393,8 @@ let unparse_code_rec : unparse_code_rec = let* code, ctxt = unparse_code ctxt ~stack_depth mode node in return (Micheline.root code, ctxt) -let parse_and_unparse_script_unaccounted ctxt ~legacy ~allow_forged_in_storage +let parse_and_unparse_script_unaccounted ctxt ~legacy + ~allow_forged_tickets_in_storage ~allow_forged_lazy_storage_id_in_storage mode ~normalize_types {code; storage} = let open Lwt_result_syntax in let*? code, ctxt = @@ -5398,7 +5426,8 @@ let parse_and_unparse_script_unaccounted ctxt ~legacy ~allow_forged_in_storage ~unparse_code_rec ~elab_conf:(Script_ir_translator_config.make ~legacy ()) ctxt - ~allow_forged:allow_forged_in_storage + ~allow_forged_tickets:allow_forged_tickets_in_storage + ~allow_forged_lazy_storage_id:allow_forged_lazy_storage_id_in_storage storage_type ~storage in @@ -5902,8 +5931,17 @@ let extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v let list_of_big_map_ids ids = Lazy_storage.IdSet.fold Big_map (fun id acc -> id :: acc) ids [] -let parse_data ~elab_conf ctxt ~allow_forged ty t = - parse_data ~unparse_code_rec ~elab_conf ~allow_forged ~stack_depth:0 ctxt ty t +let parse_data ~elab_conf ctxt ~allow_forged_tickets + ~allow_forged_lazy_storage_id ty t = + parse_data + ~unparse_code_rec + ~elab_conf + ~allow_forged_tickets + ~allow_forged_lazy_storage_id + ~stack_depth:0 + ctxt + ty + t let parse_view ~elab_conf ctxt ty view = parse_view ~unparse_code_rec ~elab_conf ctxt ty view @@ -5914,16 +5952,32 @@ let parse_views ~elab_conf ctxt ty views = let parse_code ~elab_conf ctxt ~code = parse_code ~unparse_code_rec ~elab_conf ctxt ~code -let parse_storage ~elab_conf ctxt ~allow_forged ty ~storage = - parse_storage ~unparse_code_rec ~elab_conf ctxt ~allow_forged ty ~storage +let parse_storage ~elab_conf ctxt ~allow_forged_tickets + ~allow_forged_lazy_storage_id ty ~storage = + parse_storage + ~unparse_code_rec + ~elab_conf + ctxt + ~allow_forged_tickets + ~allow_forged_lazy_storage_id + ty + ~storage -let parse_script ~elab_conf ctxt ~allow_forged_in_storage script = - parse_script ~unparse_code_rec ~elab_conf ctxt ~allow_forged_in_storage script +let parse_script ~elab_conf ctxt ~allow_forged_tickets_in_storage + ~allow_forged_lazy_storage_id_in_storage script = + parse_script + ~unparse_code_rec + ~elab_conf + ctxt + ~allow_forged_tickets_in_storage + ~allow_forged_lazy_storage_id_in_storage + script let parse_comparable_data ?type_logger ctxt ty t = parse_data ~elab_conf:Script_ir_translator_config.(make ~legacy:false ?type_logger ()) - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false ctxt ty t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli index 7cb107ef2c8a..ebe241b20354 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.mli +++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli @@ -180,7 +180,8 @@ val parse_comparable_data : val parse_data : elab_conf:Script_ir_translator_config.elab_config -> context -> - allow_forged:bool -> + allow_forged_tickets:bool -> + allow_forged_lazy_storage_id:bool -> ('a, _) Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t @@ -320,7 +321,8 @@ val parse_code : val parse_storage : elab_conf:Script_ir_translator_config.elab_config -> context -> - allow_forged:bool -> + allow_forged_tickets:bool -> + allow_forged_lazy_storage_id:bool -> ('storage, _) Script_typed_ir.ty -> storage:Script.lazy_expr -> ('storage * context) tzresult Lwt.t @@ -329,7 +331,8 @@ val parse_storage : val parse_script : elab_conf:Script_ir_translator_config.elab_config -> context -> - allow_forged_in_storage:bool -> + allow_forged_tickets_in_storage:bool -> + allow_forged_lazy_storage_id_in_storage:bool -> Script.t -> (ex_script * context) tzresult Lwt.t @@ -337,7 +340,8 @@ val parse_script : val parse_and_unparse_script_unaccounted : context -> legacy:bool -> - allow_forged_in_storage:bool -> + allow_forged_tickets_in_storage:bool -> + allow_forged_lazy_storage_id_in_storage:bool -> Script_ir_unparser.unparsing_mode -> normalize_types:bool -> Script.t -> diff --git a/src/proto_alpha/lib_protocol/script_ir_unparser.ml b/src/proto_alpha/lib_protocol/script_ir_unparser.ml index 8ab7dc86632b..2a911dd3b1f0 100644 --- a/src/proto_alpha/lib_protocol/script_ir_unparser.ml +++ b/src/proto_alpha/lib_protocol/script_ir_unparser.ml @@ -489,7 +489,8 @@ module type MICHELSON_PARSER = sig elab_conf:Script_ir_translator_config.elab_config -> stack_depth:int -> context -> - allow_forged:bool -> + allow_forged_tickets:bool -> + allow_forged_lazy_storage_id:bool -> ('a, 'ac) ty -> Script.node -> ('a * t) tzresult Lwt.t @@ -767,8 +768,8 @@ module Data_unparser (P : MICHELSON_PARSER) = struct ~legacy:elab_conf.legacy ty in - let allow_forged = - false + let allow_forged_tickets, allow_forged_lazy_storage_id = + (false, false) (* Forgeable in PUSH data are already forbidden at parsing, the only case for which this matters is storing a lambda resulting from APPLYing a non-forgeable but this cannot happen either as long @@ -780,7 +781,8 @@ module Data_unparser (P : MICHELSON_PARSER) = struct ~elab_conf ctxt ~stack_depth:(stack_depth + 1) - ~allow_forged + ~allow_forged_tickets + ~allow_forged_lazy_storage_id t data in diff --git a/src/proto_alpha/lib_protocol/script_ir_unparser.mli b/src/proto_alpha/lib_protocol/script_ir_unparser.mli index 82747ff5c6d9..193607ba1f73 100644 --- a/src/proto_alpha/lib_protocol/script_ir_unparser.mli +++ b/src/proto_alpha/lib_protocol/script_ir_unparser.mli @@ -192,7 +192,8 @@ module type MICHELSON_PARSER = sig elab_conf:Script_ir_translator_config.elab_config -> stack_depth:int -> context -> - allow_forged:bool -> + allow_forged_tickets:bool -> + allow_forged_lazy_storage_id:bool -> ('a, 'ac) ty -> Script.node -> ('a * t) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index b5bd8cc1e05e..36b85fd6921e 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -441,15 +441,17 @@ let initial_alpha_context ?(commitments = []) constants let predecessor = block_header.predecessor in let typecheck_smart_contract (ctxt : Alpha_context.context) (script : Alpha_context.Script.t) = - let allow_forged_in_storage = - false + let allow_forged_tickets_in_storage, allow_forged_lazy_storage_id_in_storage + = + (false, false) (* There should be no forged value in bootstrap contracts. *) in let* Ex_script (Script parsed_script), ctxt = Script_ir_translator.parse_script ctxt ~elab_conf:(Script_ir_translator_config.make ~legacy:true ()) - ~allow_forged_in_storage + ~allow_forged_tickets_in_storage + ~allow_forged_lazy_storage_id_in_storage script in let* storage, lazy_storage_diff, ctxt = diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_annotations.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_annotations.ml index fa18ed71408e..d2f3a7f0a7c7 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_annotations.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_annotations.ml @@ -87,7 +87,8 @@ let get_address_from_storage inc factory_addr = Script_ir_translator.parse_data ctxt ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) - ~allow_forged:false + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false option_address_t (Micheline.root factory_storage) in diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_lambda_normalization.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_lambda_normalization.ml index 7c4f246a9686..056acdccbecd 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_lambda_normalization.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_lambda_normalization.ml @@ -46,7 +46,13 @@ let parse_and_project (ty : ((_, _) lambda, _) ty) (node : Script.node) = let* ctxt = new_ctxt () in let elab_conf = Script_ir_translator_config.make ~legacy:false () in let*@ lam, _ctxt = - Script_ir_translator.parse_data ~elab_conf ctxt ~allow_forged:false ty node + Script_ir_translator.parse_data + ~elab_conf + ctxt + ~allow_forged_tickets:false + ~allow_forged_lazy_storage_id:false + ty + node in match lam with | Lam (_kdescr, node) -> return node diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml index ef6f77f67af3..6b8dc40341e4 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml @@ -1053,7 +1053,8 @@ module Interpreter_tests = struct Script_ir_translator.parse_script ctx_without_gas_2 ~elab_conf:(Script_ir_translator_config.make ~legacy:true ()) - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let*?@ id, _ctx_2 = @@ -1197,7 +1198,8 @@ module Interpreter_tests = struct Script_ir_translator.parse_storage ctx_without_gas ~elab_conf:(Script_ir_translator_config.make ~legacy:true ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true tytype ~storage:storage_lazy_expr in diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml index 1d7f992bb7c7..bf398d0443f7 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml @@ -354,7 +354,8 @@ let origination_operation ctxt ~sender ~script:(code, storage) ~orig_contract = Script_ir_translator.parse_script ctxt ~elab_conf:(Script_ir_translator_config.make ~legacy:true ()) - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let operation = diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_manager.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_manager.ml index d885ab3dc8fd..1d4bbf4c0be7 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_manager.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_manager.ml @@ -95,7 +95,8 @@ let ticket_balance_of_storage ctxt (contract : Alpha_context.Contract.t) = Script_ir_translator.parse_script ctxt ~elab_conf:(Script_ir_translator_config.make ~legacy:true ()) - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let*@ tokens, ctxt = diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml index 2d740798281b..6fc319f718d4 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml @@ -280,7 +280,8 @@ let origination_operation block ~sender ~baker ~script ~storage ~forges_tickets Script_ir_translator.parse_script ctxt ~elab_conf:(Script_ir_translator_config.make ~legacy:true ()) - ~allow_forged_in_storage:true + ~allow_forged_tickets_in_storage:true + ~allow_forged_lazy_storage_id_in_storage:true script in let operation = diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml index 69a327105753..048197a48099 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml @@ -137,7 +137,8 @@ let tickets_of_value ctxt ~include_lazy ~type_exp ~value_exp = Script_ir_translator.parse_data ctxt ~elab_conf:(Script_ir_translator_config.make ~legacy:false ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true ty node in diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml index 2078efd76d88..af3afbbb4762 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml @@ -77,7 +77,8 @@ let test_unparse_view () = Script_ir_translator.parse_and_unparse_script_unaccounted ctx ~legacy:true - ~allow_forged_in_storage:false + ~allow_forged_tickets_in_storage:false + ~allow_forged_lazy_storage_id_in_storage:false Readable ~normalize_types:true script @@ -395,9 +396,16 @@ let test_unparse_comb_comparable_type () = let test_parse_data ?(equal = Stdlib.( = )) loc ctxt ty node expected = let open Lwt_result_wrap_syntax in let elab_conf = Script_ir_translator_config.make ~legacy:false () in - let allow_forged = true in + let allow_forged_tickets = true in + let allow_forged_lazy_storage_id = true in let*@ actual, ctxt = - Script_ir_translator.parse_data ctxt ~elab_conf ~allow_forged ty node + Script_ir_translator.parse_data + ctxt + ~elab_conf + ~allow_forged_tickets + ~allow_forged_lazy_storage_id + ty + node in if equal actual expected then return ctxt else Alcotest.failf "Unexpected error: %s" loc @@ -405,9 +413,16 @@ let test_parse_data ?(equal = Stdlib.( = )) loc ctxt ty node expected = let test_parse_data_fails loc ctxt ty node = let open Lwt_result_wrap_syntax in let elab_conf = Script_ir_translator_config.make ~legacy:false () in - let allow_forged = false in + let allow_forged_tickets = false in + let allow_forged_lazy_storage_id = false in let*! result = - Script_ir_translator.parse_data ctxt ~elab_conf ~allow_forged ty node + Script_ir_translator.parse_data + ctxt + ~elab_conf + ~allow_forged_tickets + ~allow_forged_lazy_storage_id + ty + node in match result with | Ok _ -> Alcotest.failf "Unexpected typechecking success: %s" loc diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml index 360051b5afb2..0bb433a83acc 100644 --- a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml +++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml @@ -362,7 +362,8 @@ let verify_params ctxt ~parameters_ty ~parameters ~unparsed_parameters = Script_ir_translator.parse_data ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:true ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true parameters_ty (Environment.Micheline.root unparsed_parameters) in diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_script_roundtrip.ml b/src/proto_alpha/lib_protocol/test/pbt/test_script_roundtrip.ml index b893be6aee87..bee8d5beec3c 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_script_roundtrip.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_script_roundtrip.ml @@ -168,13 +168,15 @@ let roundtrip (ty : ('a, 'ac) ty) (x : 'a) lazy_storage_diff ctxt = let* ctxt, script = Contract.get_script ctxt dummy_address in let script = assert_some script in let elab_conf = Script_ir_translator_config.make ~legacy:true () in - let allow_forged_in_storage = true in + let allow_forged_tickets_in_storage = true in + let allow_forged_lazy_storage_id_in_storage = true in let* Ex_script (Script {storage_type; storage; _}), ctxt = Script_ir_translator.parse_script ctxt script ~elab_conf - ~allow_forged_in_storage + ~allow_forged_tickets_in_storage + ~allow_forged_lazy_storage_id_in_storage in let*? eq, _ctxt = Gas_monad.run ctxt diff --git a/src/proto_alpha/lib_protocol/ticket_scanner.ml b/src/proto_alpha/lib_protocol/ticket_scanner.ml index 63fbcf553bf2..b153202dd92d 100644 --- a/src/proto_alpha/lib_protocol/ticket_scanner.ml +++ b/src/proto_alpha/lib_protocol/ticket_scanner.ml @@ -498,7 +498,8 @@ module Ticket_collection = struct ~elab_conf: Script_ir_translator_config.(make ~legacy:true ()) ctxt - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true value_type (Micheline.root exp) in @@ -547,7 +548,8 @@ let tickets_of_node ctxt ~include_lazy has_tickets expr = Script_ir_translator.parse_data ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:true ()) - ~allow_forged:true + ~allow_forged_tickets:true + ~allow_forged_lazy_storage_id:true ty expr in -- GitLab From 0c9f281f8a6880ad9d7684dbffedc51d6ca7e0f6 Mon Sep 17 00:00:00 2001 From: lin Date: Fri, 19 Jan 2024 17:16:52 +0700 Subject: [PATCH 2/3] Proto: Disallow lazy storage id in transaction apply --- src/proto_alpha/lib_protocol/apply.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index cdf518ad0cb2..31603b2b10f0 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1154,7 +1154,7 @@ let apply_manager_operation : ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:false ()) ~allow_forged_tickets:true - ~allow_forged_lazy_storage_id:true + ~allow_forged_lazy_storage_id:false parameters_ty (Micheline.root parameters) in -- GitLab From 548923bcd2fc7def59144c60d1c3d898d343d918 Mon Sep 17 00:00:00 2001 From: lin Date: Fri, 19 Jan 2024 17:24:31 +0700 Subject: [PATCH 3/3] Proto: Disallow lazy storage ids in sc_rollup_management_protocol --- src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml index 423764a1a62f..8cec2b1c633d 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml @@ -78,7 +78,7 @@ let make_transaction ctxt ~parameters_ty ~unparsed_parameters ~destination ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:false ()) ~allow_forged_tickets:true - ~allow_forged_lazy_storage_id:true + ~allow_forged_lazy_storage_id:false parameters_ty (Micheline.root unparsed_parameters) in -- GitLab