From 2d4e03cafaae6f1718a64fc46c254bd8ff4247cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 5 Dec 2023 22:31:27 +0100 Subject: [PATCH 1/5] Proto/Michelson: add operation constructor primitives This commit adds a new Data constructor primitive for each case of `operation`. These primitives are not used in this commit but only reserved for later use to define a readable unparsing of values of type `operation`. --- .../lib_protocol/alpha_context.mli | 4 ++++ .../lib_protocol/michelson_v1_primitives.ml | 22 +++++++++++++++++-- .../lib_protocol/michelson_v1_primitives.mli | 4 ++++ 3 files changed, 28 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index fe7b23dde6fc..56cfd3d69cac 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -571,6 +571,10 @@ module Script : sig | D_Unit | D_Ticket | D_Lambda_rec + | D_Transfer_tokens + | D_Set_delegate + | D_Create_contract + | D_Emit | I_PACK | I_UNPACK | I_BLAKE2B diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml index 1b370589413e..d7d5275d8172 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml @@ -52,6 +52,10 @@ type prim = | D_Unit | D_Ticket | D_Lambda_rec + | D_Transfer_tokens + | D_Set_delegate + | D_Create_contract + | D_Emit | I_PACK | I_UNPACK | I_BLAKE2B @@ -208,7 +212,8 @@ type namespace = let namespace = function | K_code | K_view | K_parameter | K_storage -> Keyword_namespace | D_Elt | D_False | D_Left | D_None | D_Pair | D_Right | D_Some | D_True - | D_Unit | D_Lambda_rec | D_Ticket -> + | D_Unit | D_Lambda_rec | D_Ticket | D_Transfer_tokens | D_Set_delegate + | D_Create_contract | D_Emit -> Constant_namespace | I_ABS | I_ADD | I_ADDRESS | I_AMOUNT | I_AND | I_APPLY | I_BALANCE | I_BLAKE2B | I_CAR | I_CAST | I_CDR | I_CHAIN_ID | I_CHECK_SIGNATURE @@ -266,6 +271,10 @@ let string_of_prim = function | D_Unit -> "Unit" | D_Ticket -> "Ticket" | D_Lambda_rec -> "Lambda_rec" + | D_Transfer_tokens -> "Transfer_tokens" + | D_Set_delegate -> "Set_delegate" + | D_Create_contract -> "Create_contract" + | D_Emit -> "Emit" | I_PACK -> "PACK" | I_UNPACK -> "UNPACK" | I_BLAKE2B -> "BLAKE2B" @@ -428,6 +437,10 @@ let prim_of_string = | "Unit" -> return D_Unit | "Ticket" -> return D_Ticket | "Lambda_rec" -> return D_Lambda_rec + | "Transfer_tokens" -> return D_Transfer_tokens + | "Set_delegate" -> return D_Set_delegate + | "Create_contract" -> return D_Create_contract + | "Emit" -> return D_Emit | "PACK" -> return I_PACK | "UNPACK" -> return I_UNPACK | "BLAKE2B" -> return I_BLAKE2B @@ -799,8 +812,13 @@ let prim_encoding = ("NAT", I_NAT); (* Alpha_019 addition *) ("Ticket", D_Ticket); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("Transfer_tokens", D_Transfer_tokens); + ("Set_delegate", D_Set_delegate); + ("Create_contract", D_Create_contract); + ("Emit", D_Emit) (* New instructions must be added here, for backward compatibility of the encoding. *) - (* Keep the comment above at the end of the list *) + (* Keep the comment above at the end of the list *); ] let () = diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli index 133edfc06799..461a4c97cdc8 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli @@ -64,6 +64,10 @@ type prim = | D_Unit | D_Ticket | D_Lambda_rec + | D_Transfer_tokens + | D_Set_delegate + | D_Create_contract + | D_Emit | I_PACK | I_UNPACK | I_BLAKE2B -- GitLab From f930c4e1267dc3f29e36a0e6dabf96d7338350b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 7 Jul 2020 00:20:15 +0200 Subject: [PATCH 2/5] Proto/Michelson: Replace an assert false by a proper error A previous commit made this branch reachable by parse_stack when the stack to parse contains an operation. --- .../lib_client/michelson_v1_error_reporter.ml | 6 ++++++ .../lib_protocol/script_ir_translator.ml | 6 +++--- src/proto_alpha/lib_protocol/script_tc_errors.ml | 2 ++ .../lib_protocol/script_tc_errors_registration.ml | 13 +++++++++++++ 4 files changed, 24 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml index b13825d560ab..4f8b6a5117b8 100644 --- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml +++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml @@ -589,6 +589,12 @@ let report_errors ~details ~show_source duplicate value was found:@ @[%a@]" print_expr expr + | Operations_cannot_be_parsed (loc, _) -> + Format.fprintf + ppf + "%aOperations have no concrete syntax so they cannot be parsed." + print_loc + loc | Unordered_set_values (_, expr) -> Format.fprintf ppf diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index fc0d0b08a7c3..aea067220010 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -2259,10 +2259,10 @@ let rec parse_data : | Key_hash_t, expr -> Lwt.return @@ traced_no_lwt @@ parse_key_hash ctxt expr | Signature_t, expr -> Lwt.return @@ traced_no_lwt @@ parse_signature ctxt expr - | Operation_t, _ -> + | Operation_t, expr -> (* operations cannot appear in parameters or storage, - the protocol should never parse the bytes of an operation *) - assert false + the protocol should never parse the bytes of an operation *) + tzfail (Operations_cannot_be_parsed (location expr, strip_locations expr)) | Chain_id_t, expr -> Lwt.return @@ traced_no_lwt @@ parse_chain_id ctxt expr | Address_t, expr -> Lwt.return @@ traced_no_lwt @@ parse_address ctxt expr | Contract_t (arg_ty, _), expr -> diff --git a/src/proto_alpha/lib_protocol/script_tc_errors.ml b/src/proto_alpha/lib_protocol/script_tc_errors.ml index d3e8855e3807..f67dc2ff50e6 100644 --- a/src/proto_alpha/lib_protocol/script_tc_errors.ml +++ b/src/proto_alpha/lib_protocol/script_tc_errors.ml @@ -187,6 +187,8 @@ type error += Duplicate_map_keys of Script.location * Script.expr type error += Duplicate_set_values of Script.location * Script.expr +type error += Operations_cannot_be_parsed of Script.location * Script.expr + (* Toplevel errors *) type error += | Ill_typed_data : string option * Script.expr * Script.expr -> error diff --git a/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml b/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml index a24e2c6545bf..4c283bcea52b 100644 --- a/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml +++ b/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml @@ -341,6 +341,19 @@ let () = (function | Duplicate_set_values (loc, expr) -> Some (loc, expr) | _ -> None) (fun (loc, expr) -> Duplicate_set_values (loc, expr)) ; + (* Cannot parse operation *) + register_error_kind + `Permanent + ~id:"michelson_v1.cannot_parse_operation" + ~title:"Operations cannot be parsed" + ~description: + "There is no concrete syntax for operations so they cannot be parsed" + (obj2 + (req "location" Script.location_encoding) + (req "value" Script.expr_encoding)) + (function + | Operations_cannot_be_parsed (loc, expr) -> Some (loc, expr) | _ -> None) + (fun (loc, expr) -> Operations_cannot_be_parsed (loc, expr)) ; (* -- Instruction typing errors ------------- *) (* Fail not in tail position *) register_error_kind -- GitLab From d2fad180ccad267127cfe7051e79eb21b2369f6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 7 Jul 2020 00:19:44 +0200 Subject: [PATCH 3/5] Proto/Michelson: Hackish readable uparsing of operations --- .../lib_protocol/script_ir_unparser.ml | 185 ++++++++++++++++-- .../lib_protocol/script_ir_unparser.mli | 5 +- 2 files changed, 177 insertions(+), 13 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_unparser.ml b/src/proto_alpha/lib_protocol/script_ir_unparser.ml index e7cad561e77d..81ce0095961e 100644 --- a/src/proto_alpha/lib_protocol/script_ir_unparser.ml +++ b/src/proto_alpha/lib_protocol/script_ir_unparser.ml @@ -278,18 +278,181 @@ let unparse_key_hash ~loc ctxt mode k = let+ ctxt = Gas.consume ctxt Unparse_costs.key_hash_readable in (String (loc, Signature.Public_key_hash.to_b58check k), ctxt) -(* Operations are only unparsed during the production of execution traces of - the interpreter. *) -let unparse_operation ~loc ctxt {piop; lazy_storage_diff = _} = +let unparse_option_result ~loc unparse_v ctxt = + let open Result_syntax in + function + | Some v -> + let+ v, ctxt = unparse_v ctxt v in + (Prim (loc, D_Some, [v], []), ctxt) + | None -> return (Prim (loc, D_None, [], []), ctxt) + +(* Operations are only unparsed in RPCs, in particular during the + production of execution traces of the interpreter. *) +let unparse_operation ~loc ctxt mode {piop; lazy_storage_diff = _} = let open Result_syntax in let iop = Apply_internal_results.packed_internal_operation piop in - let bytes = - Data_encoding.Binary.to_bytes_exn - Apply_internal_results.internal_operation_encoding - iop - in - let+ ctxt = Gas.consume ctxt (Unparse_costs.operation bytes) in - (Bytes (loc, bytes), ctxt) + match mode with + | Optimized | Optimized_legacy -> + let bytes = + Data_encoding.Binary.to_bytes_exn + Apply_internal_results.internal_operation_encoding + iop + in + let+ ctxt = Gas.consume ctxt (Unparse_costs.operation bytes) in + (Bytes (loc, bytes), ctxt) + | Readable -> + let transfer_tokens ~params ~amount ~dest ctxt = + ("Transfer_tokens", [params; amount; dest], ctxt) + in + let (Internal_operation op) = piop in + let+ name, args, ctxt = + match op.operation with + | Transaction_to_implicit {destination; amount} -> + let* amount, ctxt = unparse_mutez ~loc ctxt amount in + let+ destination, ctxt = + unparse_address + ~loc + ctxt + Readable + { + destination = Contract (Implicit destination); + entrypoint = Entrypoint.default; + } + in + transfer_tokens + ~params:(Prim (loc, D_Unit, [], [])) + ~amount + ~dest:destination + ctxt + | Transaction_to_implicit_with_ticket + {destination; ticket_ty = _; ticket = _; unparsed_ticket; amount} -> + let* unparsed_ticket, ctxt = + Script.force_decode_in_context + ~consume_deserialization_gas:Always + ctxt + unparsed_ticket + in + let* amount, ctxt = unparse_mutez ~loc ctxt amount in + let+ destination, ctxt = + unparse_address + ~loc + ctxt + Readable + { + destination = Contract (Implicit destination); + entrypoint = Entrypoint.default; + } + in + transfer_tokens + ~params:(root unparsed_ticket) + ~amount + ~dest:destination + ctxt + | Transaction_to_sc_rollup + { + destination; + entrypoint; + parameters_ty = _; + parameters = _; + unparsed_parameters; + } -> + let+ destination, ctxt = + unparse_address + ~loc + ctxt + Readable + {destination = Sc_rollup destination; entrypoint} + in + transfer_tokens + ~params:(root unparsed_parameters) + ~amount:(Int (loc, Z.zero)) + ~dest:destination + ctxt + | Transaction_to_zk_rollup + { + destination; + parameters_ty = _; + parameters = _; + unparsed_parameters; + } -> + let+ destination, ctxt = + unparse_address + ~loc + ctxt + Readable + { + destination = Zk_rollup destination; + entrypoint = Entrypoint.default; + } + in + transfer_tokens + ~params:(root unparsed_parameters) + ~amount:(Int (loc, Z.zero)) + ~dest:destination + ctxt + | Transaction_to_smart_contract + { + amount; + location = _; + parameters_ty = _; + parameters = _; + unparsed_parameters; + entrypoint; + destination; + } -> + let* amount, ctxt = unparse_mutez ~loc ctxt amount in + let+ destination, ctxt = + unparse_address + ~loc + ctxt + Readable + {destination = Contract (Originated destination); entrypoint} + in + transfer_tokens + ~params:(root unparsed_parameters) + ~amount + ~dest:destination + ctxt + | Event {ty; tag; unparsed_data} -> + let tag = String (loc, Entrypoint.to_string tag) in + return ("Event", [root ty; tag; root unparsed_data], ctxt) + | Origination + { + delegate; + code; + unparsed_storage; + credit; + preorigination = _; + storage_type = _; + storage = _; + } -> + let* delegate, ctxt = + unparse_option_result + ~loc + (fun ctxt -> unparse_key_hash ~loc ctxt Readable) + ctxt + delegate + in + let+ credit, ctxt = unparse_mutez ~loc ctxt credit in + ( "Create_contract", + [root code; delegate; credit; root unparsed_storage], + ctxt ) + | Delegation delegate -> + let+ delegate, ctxt = + unparse_option_result + ~loc + (fun ctxt -> unparse_key_hash ~loc ctxt Readable) + ctxt + delegate + in + ("Set_delegate", [delegate], ctxt) + in + ( Prim + ( loc, + D_Pair, + (String (loc, name) :: args) @ [Int (loc, Z.of_int op.nonce)], + [] ), + ctxt ) let unparse_chain_id ~loc ctxt mode chain_id = let open Result_syntax in @@ -535,7 +698,7 @@ module Data_unparser (P : MICHELSON_PARSER) = struct | Key_t, k -> Lwt.return @@ unparse_key ~loc ctxt mode k | Key_hash_t, k -> Lwt.return @@ unparse_key_hash ~loc ctxt mode k | Operation_t, operation -> - Lwt.return @@ unparse_operation ~loc ctxt operation + Lwt.return @@ unparse_operation ~loc ctxt mode operation | Chain_id_t, chain_id -> Lwt.return @@ unparse_chain_id ~loc ctxt mode chain_id | Bls12_381_g1_t, x -> Lwt.return @@ unparse_bls12_381_g1 ~loc ctxt x diff --git a/src/proto_alpha/lib_protocol/script_ir_unparser.mli b/src/proto_alpha/lib_protocol/script_ir_unparser.mli index 193607ba1f73..ae8589617057 100644 --- a/src/proto_alpha/lib_protocol/script_ir_unparser.mli +++ b/src/proto_alpha/lib_protocol/script_ir_unparser.mli @@ -106,10 +106,11 @@ val unparse_bls12_381_fr : [op] and consumes gas from [ctxt]. Useful only for producing execution traces in the interpreter. *) val unparse_operation : - loc:'loc -> + loc:Script.location -> context -> + unparsing_mode -> Script_typed_ir.operation -> - ('loc Script.michelson_node * context, error trace) result + (Script.node * context, error trace) result (** [unparse_with_data_encoding ~loc ctxt v gas_cost enc] returns the bytes representation of [v] wrapped in [Micheline.Bytes], consuming [gas_cost] -- GitLab From 816a380d28ba737fc5bd9c33be79012a00c75520 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Sun, 19 Feb 2023 23:49:22 +0100 Subject: [PATCH 4/5] Proto/Michelson: WIP: parse data: parametrize by parsing function for operations --- .../lib_protocol/script_ir_translator.ml | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index aea067220010..e192ad6e8515 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1854,6 +1854,11 @@ let parse_chest ctxt : Script.node -> (Script_timelock.chest * context) tzresult (loc, strip_locations expr, "a valid time-lock chest"))) | expr -> tzfail (Invalid_kind (location expr, [Bytes_kind], kind expr)) +let default_parse_operation _ctxt expr = + (* operations cannot appear in parameters or storage, + the protocol should never parse the bytes of an operation. *) + error (Operations_cannot_be_parsed (location expr, strip_locations expr)) + (* -- parse data of complex types -- *) let parse_pair (type r) parse_l parse_r ctxt ~legacy @@ -2086,6 +2091,8 @@ let rec parse_data : context -> allow_forged_tickets:bool -> allow_forged_lazy_storage_id:bool -> + parse_operation: + (context -> Script.node -> (Script_typed_ir.operation * context) tzresult) -> (a, ac) ty -> Script.node -> (a * context) tzresult Lwt.t = @@ -2095,6 +2102,7 @@ let rec parse_data : ctxt ~allow_forged_tickets ~allow_forged_lazy_storage_id + ~parse_operation ty script_data -> let open Lwt_result_syntax in @@ -2110,6 +2118,7 @@ let rec parse_data : ctxt ~allow_forged_tickets ~allow_forged_lazy_storage_id + ~parse_operation ty script_data in @@ -2260,9 +2269,7 @@ let rec parse_data : | Signature_t, expr -> Lwt.return @@ traced_no_lwt @@ parse_signature ctxt expr | Operation_t, expr -> - (* operations cannot appear in parameters or storage, - the protocol should never parse the bytes of an operation *) - tzfail (Operations_cannot_be_parsed (location expr, strip_locations expr)) + Lwt.return @@ traced_no_lwt @@ parse_operation ctxt expr | Chain_id_t, expr -> Lwt.return @@ traced_no_lwt @@ parse_chain_id ctxt expr | Address_t, expr -> Lwt.return @@ traced_no_lwt @@ parse_address ctxt expr | Contract_t (arg_ty, _), expr -> @@ -2985,6 +2992,7 @@ and parse_instr : ctxt ~allow_forged_tickets:false ~allow_forged_lazy_storage_id:false + ~parse_operation:default_parse_operation t d in @@ -5198,6 +5206,7 @@ let parse_storage : ctxt ~allow_forged_tickets ~allow_forged_lazy_storage_id + ~parse_operation:default_parse_operation storage_type (root storage)) @@ -5381,7 +5390,7 @@ include Data_unparser (struct let parse_packable_ty = parse_packable_ty - let parse_data = parse_data + let parse_data = parse_data ~parse_operation:default_parse_operation end) let unparse_code_rec : unparse_code_rec = @@ -5936,6 +5945,7 @@ let parse_data ~elab_conf ctxt ~allow_forged_tickets ~allow_forged_tickets ~allow_forged_lazy_storage_id ~stack_depth:0 + ~parse_operation:default_parse_operation ctxt ty t -- GitLab From 6db557081cf9c6011aec239791bd63f1b56785b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 7 Jul 2020 00:22:36 +0200 Subject: [PATCH 5/5] Silently ignore unparsable stacks containing operations in the normalize RPC This is hackish and very imperfect as it does not support mixing operations and optimized data in the output stack of TZT unit tests. --- src/proto_alpha/lib_plugin/RPC.ml | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index ef9977529a7d..28c6976458a8 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -1887,10 +1887,18 @@ module Scripts = struct let* Normalize_stack.Ex_stack (st_ty, x, st), ctxt = Normalize_stack.parse_stack ctxt ~legacy nodes in - let+ normalized, _ctxt = + let*! res = Normalize_stack.unparse_stack ctxt unparsing_mode st_ty x st in - normalized) ; + match res with + | Ok (normalized, _ctxt) -> return normalized + | Error err as output -> ( + match Environment.wrap_tztrace err with + | Ecoproto_error (Script_tc_errors.Operations_cannot_be_parsed _) + :: _ -> + (* TODO: match the last error instead of the first *) + return stack + | _ -> Lwt.return output)) ; Registration.register0 ~chunked:true S.normalize_script -- GitLab