From c745feff47bb975dd17dfa1553e2a7bc05267dea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Fri, 24 Mar 2023 16:11:34 +0100 Subject: [PATCH 1/5] Proto/Michelson: remove legacy support for annotated options This legacy behaviour has been removed from all affected scripts as part of the Jakarta migration. See for example https://gitlab.com/tezos/tezos/-/merge_requests/3730/diffs#diff-content-f22c010bcd0816d4aae6a8181604b828678e76b4. --- src/proto_alpha/lib_protocol/script_ir_translator.ml | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 0a7e1b068af4..b982b726f446 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -738,12 +738,7 @@ let rec parse_ty : >>? fun (Ex_ty tr, ctxt) -> lambda_t loc ta tr >|? fun ty -> return ctxt ty | Prim (loc, T_option, [ut], annot) -> - (if legacy then - (* legacy semantics with (broken) field annotations *) - remove_field_annot ut >>? fun ut -> - check_composed_type_annot loc annot >>? fun () -> ok ut - else check_type_annot loc annot >>? fun () -> ok ut) - >>? fun ut -> + check_type_annot loc annot >>? fun () -> parse_ty ctxt ~stack_depth:(stack_depth + 1) -- GitLab From 53399968202cd797069cffe28a42d3d3d52e6a5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Fri, 24 Mar 2023 16:18:25 +0100 Subject: [PATCH 2/5] Proto/Michelson: remove legacy support for annotation on parameter The parameter toplevel primitive can, in legacy mode, be annotated by a field annotation which names the root entrypoint. This deprecated feature is not used on mainnet so this commit removes it. --- .../lib_protocol/script_ir_translator.ml | 24 ++----------------- 1 file changed, 2 insertions(+), 22 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index b982b726f446..59e0fc004634 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1764,7 +1764,7 @@ let parse_view_name ctxt : Script.node -> (Script_string.t * context) tzresult = let parse_toplevel : context -> legacy:bool -> Script.expr -> (toplevel * context) tzresult = - fun ctxt ~legacy toplevel -> + fun ctxt ~legacy:_ toplevel -> record_trace (Ill_typed_contract (toplevel, [])) @@ match root toplevel with @@ -1829,30 +1829,10 @@ let parse_toplevel : Some (s, sloc, sannot), Some (c, cloc, cannot), views ) -> - let p_pannot = - (* root name can be attached to either the parameter - primitive or the toplevel constructor (legacy only). - - In the latter case we move it to the parameter type. - *) - Script_ir_annot.has_field_annot p >>? function - | true -> ok (p, pannot) - | false -> ( - match pannot with - | [single] when legacy -> ( - is_field_annot ploc single >|? fun is_field_annot -> - match (is_field_annot, p) with - | true, Prim (loc, prim, args, annots) -> - (Prim (loc, prim, args, single :: annots), []) - | _ -> (p, [])) - | _ -> ok (p, pannot)) - in - (* only one field annot is allowed to set the root entrypoint name *) - p_pannot >>? fun (arg_type, pannot) -> Script_ir_annot.error_unexpected_annot ploc pannot >>? fun () -> Script_ir_annot.error_unexpected_annot cloc cannot >>? fun () -> Script_ir_annot.error_unexpected_annot sloc sannot >|? fun () -> - ({code_field = c; arg_type; views; storage_type = s}, ctxt)) + ({code_field = c; arg_type = p; views; storage_type = s}, ctxt)) (* Normalize lambdas during parsing *) -- GitLab From a47fa01d2a260fb3740c2a63c05cad2cd18302bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Fri, 24 Mar 2023 16:30:28 +0100 Subject: [PATCH 3/5] Proto/Michelson: remove now useless legacy arg on parse_toplevel --- devtools/get_contracts/get_contracts_alpha.ml | 3 +-- src/proto_alpha/lib_plugin/RPC.ml | 7 +++---- .../lib_protocol/contract_services.ml | 4 ++-- .../lib_protocol/script_ir_translator.ml | 18 ++++++++---------- .../lib_protocol/script_ir_translator.mli | 2 +- 5 files changed, 15 insertions(+), 19 deletions(-) diff --git a/devtools/get_contracts/get_contracts_alpha.ml b/devtools/get_contracts/get_contracts_alpha.ml index 48028c8d8174..8035715ad0c1 100644 --- a/devtools/get_contracts/get_contracts_alpha.ml +++ b/devtools/get_contracts/get_contracts_alpha.ml @@ -167,8 +167,7 @@ module Proto = struct let open Lwt_result_syntax in let ctxt : Alpha_context.context = Obj.magic raw_ctxt in let+ toplevel, updated_ctxt = - Lwt.map wrap_tzresult - @@ Script_ir_translator.parse_toplevel ctxt ~legacy:true expr + Lwt.map wrap_tzresult @@ Script_ir_translator.parse_toplevel ctxt expr in let consumed = (Alpha_context.Gas.consumed ~since:ctxt ~until:updated_ctxt :> int) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 265e937c9664..128df48c1f4d 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -1067,7 +1067,7 @@ module Scripts = struct let ctxt = Gas.set_unlimited ctxt in let legacy = false in let open Script_ir_translator in - parse_toplevel ctxt ~legacy expr >>=? fun ({arg_type; _}, ctxt) -> + parse_toplevel ctxt expr >>=? fun ({arg_type; _}, ctxt) -> Lwt.return ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type >>? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _) -> @@ -1083,9 +1083,8 @@ module Scripts = struct in let script_view_type ctxt contract expr view = let ctxt = Gas.set_unlimited ctxt in - let legacy = false in let open Script_ir_translator in - parse_toplevel ctxt ~legacy expr >>=? fun ({views; _}, _) -> + parse_toplevel ctxt expr >>=? fun ({views; _}, _) -> Lwt.return ( Script_string.of_string view >>? fun view_name -> match Script_map.get view_name views with @@ -1607,7 +1606,7 @@ module Scripts = struct let ctxt = Gas.set_unlimited ctxt in let legacy = false in let open Script_ir_translator in - parse_toplevel ~legacy ctxt expr >>=? fun ({arg_type; _}, ctxt) -> + parse_toplevel ctxt expr >>=? fun ({arg_type; _}, ctxt) -> Lwt.return ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type >|? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _) diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml index 0708612f1b4c..59277e4d603b 100644 --- a/src/proto_alpha/lib_protocol/contract_services.ml +++ b/src/proto_alpha/lib_protocol/contract_services.ml @@ -442,7 +442,7 @@ let register () = ctxt expr >>?= fun (expr, _) -> - parse_toplevel ctxt ~legacy expr >>=? fun ({arg_type; _}, ctxt) -> + parse_toplevel ctxt expr >>=? fun ({arg_type; _}, ctxt) -> Lwt.return ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type >>? fun ( Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, @@ -482,7 +482,7 @@ let register () = ctxt expr >>?= fun (expr, _) -> - parse_toplevel ctxt ~legacy expr >>=? fun ({arg_type; _}, ctxt) -> + parse_toplevel ctxt expr >>=? fun ({arg_type; _}, ctxt) -> Lwt.return ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type >>? fun ( Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 59e0fc004634..d3e4c0a5e79d 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1762,9 +1762,8 @@ let parse_view_name ctxt : Script.node -> (Script_string.t * context) tzresult = Script_string.of_string v >|? fun s -> (s, ctxt) ) | expr -> error @@ Invalid_kind (location expr, [String_kind], kind expr) -let parse_toplevel : - context -> legacy:bool -> Script.expr -> (toplevel * context) tzresult = - fun ctxt ~legacy:_ toplevel -> +let parse_toplevel : context -> Script.expr -> (toplevel * context) tzresult = + fun ctxt toplevel -> record_trace (Ill_typed_contract (toplevel, [])) @@ match root toplevel with @@ -4000,7 +3999,7 @@ and parse_instr : contracts but then we throw away the typed version, except for the storage type which is kept for efficiency in the ticket scanner. *) let canonical_code = Micheline.strip_locations code in - parse_toplevel ctxt ~legacy canonical_code + parse_toplevel ctxt canonical_code >>?= fun ({arg_type; storage_type; code_field; views}, ctxt) -> record_trace (Ill_formed_type (Some "parameter", canonical_code, location arg_type)) @@ -4641,8 +4640,7 @@ and parse_contract : code >>? fun (code, ctxt) -> (* can only fail because of gas *) - parse_toplevel ctxt ~legacy:true code - >>? fun ({arg_type; _}, ctxt) -> + parse_toplevel ctxt code >>? fun ({arg_type; _}, ctxt) -> parse_parameter_ty_and_entrypoints ctxt ~stack_depth:(stack_depth + 1) @@ -4768,7 +4766,7 @@ let parse_code : >>?= fun (code, ctxt) -> let legacy = elab_conf.legacy in Global_constants_storage.expand ctxt code >>=? fun (ctxt, code) -> - parse_toplevel ctxt ~legacy code + parse_toplevel ctxt code >>?= fun ({arg_type; storage_type; code_field; views}, ctxt) -> let arg_type_loc = location arg_type in record_trace @@ -4878,7 +4876,7 @@ let typecheck_code : fun ~unparse_code_rec ~legacy ~show_types ctxt code -> (* Constants need to be expanded or [parse_toplevel] may fail. *) Global_constants_storage.expand ctxt code >>=? fun (ctxt, code) -> - parse_toplevel ctxt ~legacy code >>?= fun (toplevel, ctxt) -> + parse_toplevel ctxt code >>?= fun (toplevel, ctxt) -> let {arg_type; storage_type; code_field; views} = toplevel in let type_map = ref [] in let arg_type_loc = location arg_type in @@ -5513,9 +5511,9 @@ let unparse_code ctxt mode code = let parse_contract_data context loc arg_ty contract ~entrypoint = parse_contract_data ~stack_depth:0 context loc arg_ty contract ~entrypoint -let parse_toplevel ctxt ~legacy toplevel = +let parse_toplevel ctxt toplevel = Global_constants_storage.expand ctxt toplevel >>=? fun (ctxt, toplevel) -> - Lwt.return @@ parse_toplevel ctxt ~legacy toplevel + Lwt.return @@ parse_toplevel ctxt toplevel let parse_comparable_ty = parse_comparable_ty ~stack_depth:0 diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli index b945d3347db3..7cb107ef2c8a 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.mli +++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli @@ -297,7 +297,7 @@ val parse_ty : (ex_ty * context) tzresult val parse_toplevel : - context -> legacy:bool -> Script.expr -> (toplevel * context) tzresult Lwt.t + context -> Script.expr -> (toplevel * context) tzresult Lwt.t (** High-level function to typecheck a Michelson script. This function is not used for validating operations but only for the [typecheck_code] RPC. -- GitLab From 74a1dbaa07eb0772a70e01c4a5dd4aac1e5adcf3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Thu, 20 Apr 2023 10:44:57 +0200 Subject: [PATCH 4/5] Tests/Michelson: annotated "parameter" forbidden even with --legacy --- tezt/tests/script_annotations.ml | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/tezt/tests/script_annotations.ml b/tezt/tests/script_annotations.ml index e5045f0c1ade..983ddbb03b0c 100644 --- a/tezt/tests/script_annotations.ml +++ b/tezt/tests/script_annotations.ml @@ -95,17 +95,19 @@ let register = in (* LEGACY: alphabetic field annotation in parameter root *) let* () = - Client.typecheck_script - ~legacy:true - ~script:"parameter %r unit; storage unit; code { FAILWITH }" - client + Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") + @@ Client.spawn_typecheck_script + ~legacy:true + ~script:"parameter %r unit; storage unit; code { FAILWITH }" + client in (* LEGACY: numeric field annotation in parameter root *) let* () = - Client.typecheck_script - ~legacy:true - ~script:"parameter %1 unit; storage unit; code { FAILWITH }" - client + Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") + @@ Client.spawn_typecheck_script + ~legacy:true + ~script:"parameter %1 unit; storage unit; code { FAILWITH }" + client in (* alphabetic field annotation in parameter root *) let* () = -- GitLab From e0880d8bda2c8928070a20f099f647312d8d5c84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Thu, 20 Apr 2023 15:14:30 +0200 Subject: [PATCH 5/5] Tests/Michelson: Fix annotation tests --- tezt/tests/script_annotations.ml | 124 +++++++++++++++++-------------- 1 file changed, 69 insertions(+), 55 deletions(-) diff --git a/tezt/tests/script_annotations.ml b/tezt/tests/script_annotations.ml index 983ddbb03b0c..0da34ff38889 100644 --- a/tezt/tests/script_annotations.ml +++ b/tezt/tests/script_annotations.ml @@ -31,6 +31,17 @@ Subject: Runs Michelson annotation tests using [octez-client typecheck data ...]. *) +let typecheck_wrapper ?res (f : Client.t -> Process.t) client = + match res with + | None -> Process.check @@ f client + | Some msg -> Process.check_error ~exit_code:1 ~msg @@ f client + +let typecheck_data ?res ?legacy ~data ~typ client = + typecheck_wrapper ?res (Client.spawn_typecheck_data ?legacy ~data ~typ) client + +let typecheck_script ?res ?legacy ~script client = + typecheck_wrapper ?res (Client.spawn_typecheck_script ?legacy ~script) client + let register = Protocol.register_test ~__FILE__ @@ -40,114 +51,117 @@ let register = let* client = Client.init_mockup ~protocol () in (* annotation length limit positive case *) let* () = - Client.typecheck_data - ~data:"3" - ~typ:(sf "(int :%s)" @@ String.make 254 'a') - client + typecheck_data ~data:"3" ~typ:(sf "(int :%s)" @@ String.make 254 'a') client in (* annotation length limit negative case *) let* () = - Process.check_error - ~exit_code:1 - ~msg:(rex "annotation exceeded maximum length \\(255 chars\\)") - @@ Client.spawn_typecheck_data - ~data:"3" - ~typ:(sf "(int :%s)" @@ String.make 255 'a') - client + typecheck_data + ~res:(rex "annotation exceeded maximum length \\(255 chars\\)") + ~data:"3" + ~typ:(sf "(int :%s)" @@ String.make 255 'a') + client in (* alphabetic field annotation in type positive case *) let* () = - Client.typecheck_data ~data:"Pair 0 0" ~typ:"pair (nat %x) (int %y)" client + typecheck_data ~data:"Pair 0 0" ~typ:"pair (nat %x) (int %y)" client in (* numeric field annotation in type positive case *) let* () = - Client.typecheck_data ~data:"Pair 0 0" ~typ:"pair (nat %1) (int %2)" client + typecheck_data ~data:"Pair 0 0" ~typ:"pair (nat %1) (int %2)" client in (* field annotation with invalid characters in type *) let* () = - Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") - @@ Client.spawn_typecheck_data - ~data:"Pair 0 0" - ~typ:"pair (nat %.) (int %.)" - client + typecheck_data + ~res:(rex "unexpected annotation") + ~data:"Pair 0 0" + ~typ:"pair (nat %.) (int %.)" + client in (* alphabetic field annotation in lambda data *) let* () = - Client.typecheck_data + typecheck_data ~data:"{ CAR %x }" ~typ:"lambda (pair (nat %x) (int %y)) nat" client in (* numeric field annotation in lambda data *) let* () = - Client.typecheck_data + typecheck_data ~data:"{ CAR %1 }" ~typ:"lambda (pair (nat %1) (int %2)) nat" client in (* field annotation with invalid characters in lambda data *) let* () = - Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") - @@ Client.spawn_typecheck_data - ~data:"{ CAR %. }" - ~typ:"lambda (pair (nat %.) (int %.)) nat" - client + typecheck_data + ~res:(rex "unexpected annotation") + ~data:"{ CAR %. }" + ~typ:"lambda (pair (nat %.) (int %.)) nat" + client in - (* LEGACY: alphabetic field annotation in parameter root *) + (* LEGACY: until Nairobi alphabetic field annotation in parameter + root was allowed in legacy mode *) let* () = - Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") - @@ Client.spawn_typecheck_script - ~legacy:true - ~script:"parameter %r unit; storage unit; code { FAILWITH }" - client + typecheck_script + ?res: + (if Protocol.(number protocol > number Nairobi) then + Some (rex "unexpected annotation") + else None) + ~legacy:true + ~script:"parameter %r unit; storage unit; code { FAILWITH }" + client in - (* LEGACY: numeric field annotation in parameter root *) + (* LEGACY: until Nairobi numeric field annotation in parameter root + was allowed in legacy mode *) let* () = - Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") - @@ Client.spawn_typecheck_script - ~legacy:true - ~script:"parameter %1 unit; storage unit; code { FAILWITH }" - client + typecheck_script + ?res: + (if Protocol.(number protocol > number Nairobi) then + Some (rex "unexpected annotation") + else None) + ~legacy:true + ~script:"parameter %1 unit; storage unit; code { FAILWITH }" + client in (* alphabetic field annotation in parameter root *) let* () = - Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") - @@ Client.spawn_typecheck_script - ~script:"parameter %r unit; storage unit; code { FAILWITH }" - client + typecheck_script + ~res:(rex "unexpected annotation") + ~script:"parameter %r unit; storage unit; code { FAILWITH }" + client in (* numeric field annotation in parameter root *) let* () = - Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") - @@ Client.spawn_typecheck_script - ~script:"parameter %1 unit; storage unit; code { FAILWITH }" - client + typecheck_script + ~res:(rex "unexpected annotation") + ~script:"parameter %1 unit; storage unit; code { FAILWITH }" + client in (* field annotation with invalid characters in parameter root *) let* () = - Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") - @@ Client.spawn_typecheck_script - ~script:"parameter %. unit; storage unit; code { FAILWITH }" - client + typecheck_script + ~res:(rex "unexpected annotation") + ~script:"parameter %. unit; storage unit; code { FAILWITH }" + client in (* alphabetic field annotation in parameter root *) let* () = - Client.typecheck_script + typecheck_script ~script:"parameter (unit %r); storage unit; code { FAILWITH }" client in (* numeric field annotation in parameter root *) let* () = - Client.typecheck_script + typecheck_script ~script:"parameter (unit %1); storage unit; code { FAILWITH }" client in (* field annotation with invalid characters in parameter root *) let* () = - Process.check_error ~exit_code:1 ~msg:(rex "unexpected annotation") - @@ Client.spawn_typecheck_script - ~script:"parameter (unit %.); storage unit; code { FAILWITH }" - client + typecheck_script + ~res:(rex "unexpected annotation") + ~script:"parameter (unit %.); storage unit; code { FAILWITH }" + client in unit -- GitLab