From ffd83196c3a52889020bf5d73e1924467968d0b0 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 29 Jun 2022 17:17:22 +0200 Subject: [PATCH 01/14] Proto: rename Script_typed_ir.manager_operation to internal_operation_contents. --- src/proto_alpha/lib_protocol/apply.ml | 2 +- .../lib_protocol/apply_internal_results.mli | 2 +- .../lib_protocol/script_typed_ir.ml | 24 +++++++++---------- .../lib_protocol/script_typed_ir.mli | 22 ++++++++--------- 4 files changed, 25 insertions(+), 25 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 46d386aa2ed9..6c09706eba22 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1083,7 +1083,7 @@ let apply_internal_manager_operation_content : payer:public_key_hash -> source:Contract.t -> chain_id:Chain_id.t -> - kind Script_typed_ir.manager_operation -> + kind Script_typed_ir.internal_operation_contents -> (context * kind successful_internal_manager_operation_result * Script_typed_ir.packed_internal_operation list) diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index a827d2a18035..23044a1731ee 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -103,7 +103,7 @@ type successful_origination_result = { paid_storage_size_diff : Z.t; } -(** Result of applying a {!Script_typed_ir.internal_operation}. *) +(** Result of applying a {!Script_typed_ir.internal_operation_contents}. *) type _ successful_internal_manager_operation_result = | ITransaction_result : successful_transaction_result diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index c4c3c4ab5c6a..b13a1c360f67 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1338,7 +1338,7 @@ and ('input, 'output) view_signature = } -> ('input, 'output) view_signature -and 'kind manager_operation = +and 'kind internal_operation_contents = | Transaction_to_implicit : { destination : Signature.Public_key_hash.t; amount : Tez.tez; @@ -1348,7 +1348,7 @@ and 'kind manager_operation = parameters : 'a; unparsed_parameters : Script.expr; } - -> Kind.transaction manager_operation + -> Kind.transaction internal_operation_contents | Transaction_to_smart_contract : { destination : Contract_hash.t; amount : Tez.tez; @@ -1358,14 +1358,14 @@ and 'kind manager_operation = parameters : 'a; unparsed_parameters : Script.expr; } - -> Kind.transaction manager_operation + -> Kind.transaction internal_operation_contents | Transaction_to_tx_rollup : { destination : Tx_rollup.t; parameters_ty : ('a, _) ty; parameters : 'a; unparsed_parameters : Script.expr; } - -> Kind.transaction manager_operation + -> Kind.transaction internal_operation_contents | Transaction_to_sc_rollup : { destination : Sc_rollup.t; entrypoint : Entrypoint.t; @@ -1373,13 +1373,13 @@ and 'kind manager_operation = parameters : 'a; unparsed_parameters : Script.expr; } - -> Kind.transaction manager_operation + -> Kind.transaction internal_operation_contents | Event : { ty : Script.expr; tag : Entrypoint.t; unparsed_data : Script.expr; } - -> Kind.event manager_operation + -> Kind.event internal_operation_contents | Origination : { delegate : Signature.Public_key_hash.t option; code : Script.expr; @@ -1389,14 +1389,14 @@ and 'kind manager_operation = storage_type : ('storage, _) ty; storage : 'storage; } - -> Kind.origination manager_operation + -> Kind.origination internal_operation_contents | Delegation : Signature.Public_key_hash.t option - -> Kind.delegation manager_operation + -> Kind.delegation internal_operation_contents and 'kind internal_operation = { source : Contract.t; - operation : 'kind manager_operation; + operation : 'kind internal_operation_contents; nonce : int; } @@ -1428,11 +1428,11 @@ type ('arg, 'storage) script = -> ('arg, 'storage) script type packed_manager_operation = - | Manager : 'kind manager_operation -> packed_manager_operation + | Manager : 'kind internal_operation_contents -> packed_manager_operation [@@ocaml.unboxed] -let manager_kind : type kind. kind manager_operation -> kind Kind.manager = - function +let manager_kind : + type kind. kind internal_operation_contents -> kind Kind.manager = function | Transaction_to_implicit _ -> Kind.Transaction_manager_kind | Transaction_to_smart_contract _ -> Kind.Transaction_manager_kind | Transaction_to_tx_rollup _ -> Kind.Transaction_manager_kind diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 229a60e7d7b4..50855173009b 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1469,7 +1469,7 @@ and ('input, 'output) view_signature = } -> ('input, 'output) view_signature -and 'kind manager_operation = +and 'kind internal_operation_contents = | Transaction_to_implicit : { (* The [unparsed_parameters] field may seem useless since we have access to a typed version of the field (with [parameters_ty] and @@ -1484,7 +1484,7 @@ and 'kind manager_operation = parameters : 'a; unparsed_parameters : Script.expr; } - -> Kind.transaction manager_operation + -> Kind.transaction internal_operation_contents | Transaction_to_smart_contract : { (* The [unparsed_parameters] field may seem useless since we have access to a typed version of the field (with [parameters_ty] and @@ -1499,14 +1499,14 @@ and 'kind manager_operation = parameters : 'a; unparsed_parameters : Script.expr; } - -> Kind.transaction manager_operation + -> Kind.transaction internal_operation_contents | Transaction_to_tx_rollup : { destination : Tx_rollup.t; parameters_ty : ('a, _) ty; parameters : 'a; unparsed_parameters : Script.expr; } - -> Kind.transaction manager_operation + -> Kind.transaction internal_operation_contents | Transaction_to_sc_rollup : { destination : Sc_rollup.t; entrypoint : Entrypoint.t; @@ -1514,13 +1514,13 @@ and 'kind manager_operation = parameters : 'a; unparsed_parameters : Script.expr; } - -> Kind.transaction manager_operation + -> Kind.transaction internal_operation_contents | Event : { ty : Script.expr; tag : Entrypoint.t; unparsed_data : Script.expr; } - -> Kind.event manager_operation + -> Kind.event internal_operation_contents | Origination : { delegate : Signature.Public_key_hash.t option; code : Script.expr; @@ -1530,14 +1530,14 @@ and 'kind manager_operation = storage_type : ('storage, _) ty; storage : 'storage; } - -> Kind.origination manager_operation + -> Kind.origination internal_operation_contents | Delegation : Signature.Public_key_hash.t option - -> Kind.delegation manager_operation + -> Kind.delegation internal_operation_contents and 'kind internal_operation = { source : Contract.t; - operation : 'kind manager_operation; + operation : 'kind internal_operation_contents; nonce : int; } @@ -1564,10 +1564,10 @@ type ('arg, 'storage) script = -> ('arg, 'storage) script type packed_manager_operation = - | Manager : 'kind manager_operation -> packed_manager_operation + | Manager : 'kind internal_operation_contents -> packed_manager_operation [@@ocaml.unboxed] -val manager_kind : 'kind manager_operation -> 'kind Kind.manager +val manager_kind : 'kind internal_operation_contents -> 'kind Kind.manager val kinstr_location : (_, _, _, _) kinstr -> Script.location -- GitLab From 5b86346458df8a1ffe5682f7f78075cdea66cca4 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 29 Jun 2022 17:22:23 +0200 Subject: [PATCH 02/14] Proto: removed the unused Script_typed_ir.packed_manager_operation. --- src/proto_alpha/lib_protocol/script_typed_ir.ml | 4 ---- src/proto_alpha/lib_protocol/script_typed_ir.mli | 4 ---- 2 files changed, 8 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index b13a1c360f67..33471f475c73 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1427,10 +1427,6 @@ type ('arg, 'storage) script = } -> ('arg, 'storage) script -type packed_manager_operation = - | Manager : 'kind internal_operation_contents -> packed_manager_operation -[@@ocaml.unboxed] - let manager_kind : type kind. kind internal_operation_contents -> kind Kind.manager = function | Transaction_to_implicit _ -> Kind.Transaction_manager_kind diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 50855173009b..dad1dfb731bf 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1563,10 +1563,6 @@ type ('arg, 'storage) script = } -> ('arg, 'storage) script -type packed_manager_operation = - | Manager : 'kind internal_operation_contents -> packed_manager_operation -[@@ocaml.unboxed] - val manager_kind : 'kind internal_operation_contents -> 'kind Kind.manager val kinstr_location : (_, _, _, _) kinstr -> Script.location -- GitLab From d1b71c03e5ca45554458aacca9f1eb900681f609 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 29 Jun 2022 23:05:24 +0200 Subject: [PATCH 03/14] Proto: rename Apply_internal_results.internal_manager_operation to internal_operation_contents. --- src/proto_alpha/bin_sc_rollup_node/inbox.ml | 2 +- .../bin_sc_rollup_node/layer1_services.ml | 2 +- .../bin_sc_rollup_node/layer1_services.mli | 2 +- src/proto_alpha/lib_protocol/apply.ml | 12 ++++------ .../lib_protocol/apply_internal_results.ml | 22 +++++++++---------- .../lib_protocol/apply_internal_results.mli | 17 +++++++++----- .../lib_protocol/script_typed_ir.mli | 4 ++-- src/proto_alpha/lib_tx_rollup/daemon.ml | 2 +- 8 files changed, 32 insertions(+), 31 deletions(-) diff --git a/src/proto_alpha/bin_sc_rollup_node/inbox.ml b/src/proto_alpha/bin_sc_rollup_node/inbox.ml index 4b151a218bb8..1c60d8415635 100644 --- a/src/proto_alpha/bin_sc_rollup_node/inbox.ml +++ b/src/proto_alpha/bin_sc_rollup_node/inbox.ml @@ -85,7 +85,7 @@ let get_messages l1_ctxt head rollup = | _ -> accu in let apply_internal (type kind) accu ~source:_ - (_operation : kind Apply_internal_results.internal_manager_operation) + (_operation : kind Apply_internal_results.internal_operation_contents) (_result : kind Apply_internal_results.successful_internal_manager_operation_result) = diff --git a/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml b/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml index 1a6f2dea2e5e..686e2c82da72 100644 --- a/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml +++ b/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml @@ -40,7 +40,7 @@ type 'accu operation_processor = { 'kind. 'accu -> source:public_key_hash -> - 'kind Apply_internal_results.internal_manager_operation -> + 'kind Apply_internal_results.internal_operation_contents -> 'kind Apply_internal_results.successful_internal_manager_operation_result -> 'accu; } diff --git a/src/proto_alpha/bin_sc_rollup_node/layer1_services.mli b/src/proto_alpha/bin_sc_rollup_node/layer1_services.mli index ea95ba3ad449..a0d1a9c29b96 100644 --- a/src/proto_alpha/bin_sc_rollup_node/layer1_services.mli +++ b/src/proto_alpha/bin_sc_rollup_node/layer1_services.mli @@ -39,7 +39,7 @@ type 'accu operation_processor = { 'kind. 'accu -> source:public_key_hash -> - 'kind Apply_internal_results.internal_manager_operation -> + 'kind Apply_internal_results.internal_operation_contents -> 'kind Apply_internal_results.successful_internal_manager_operation_result -> 'accu; } diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 6c09706eba22..8dee64f4bb6e 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1077,7 +1077,7 @@ let apply_origination ~ctxt ~storage_type ~storage ~unparsed_code *) -let apply_internal_manager_operation_content : +let apply_internal_operation_contents : type kind. context -> payer:public_key_hash -> @@ -1905,7 +1905,7 @@ let apply_external_manager_operation_content : type success_or_failure = Success of context | Failure -let apply_internal_manager_operations ctxt ~payer ~chain_id ops = +let apply_internal_operations ctxt ~payer ~chain_id ops = let[@coq_struct "ctxt"] rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) @@ -1918,7 +1918,7 @@ let apply_internal_manager_operations ctxt ~payer ~chain_id ops = fail (Internal_operation_replay (Internal_contents op_res)) else let ctxt = record_internal_nonce ctxt nonce in - apply_internal_manager_operation_content + apply_internal_operation_contents ctxt ~source ~payer @@ -2183,11 +2183,7 @@ let apply_manager_contents (type kind) ctxt chain_id apply_external_manager_operation_content ctxt ~source ~chain_id operation >>= function | Ok (ctxt, operation_results, internal_operations) -> ( - apply_internal_manager_operations - ctxt - ~payer:source - ~chain_id - internal_operations + apply_internal_operations ctxt ~payer:source ~chain_id internal_operations >>= function | Success ctxt, internal_operations_results -> ( burn_manager_storage_fees diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 09d5f14bc5e5..3c97dae43b43 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -27,38 +27,38 @@ open Alpha_context open Data_encoding open Apply_operation_result -type 'kind internal_manager_operation = +type 'kind internal_operation_contents = | Transaction : { amount : Tez.tez; parameters : Script.lazy_expr; entrypoint : Entrypoint.t; destination : Destination.t; } - -> Kind.transaction internal_manager_operation + -> Kind.transaction internal_operation_contents | Origination : { delegate : Signature.Public_key_hash.t option; script : Script.t; credit : Tez.tez; } - -> Kind.origination internal_manager_operation + -> Kind.origination internal_operation_contents | Delegation : Signature.Public_key_hash.t option - -> Kind.delegation internal_manager_operation + -> Kind.delegation internal_operation_contents | Event : { ty : Script.expr; tag : Entrypoint.t; payload : Script.expr; } - -> Kind.event internal_manager_operation + -> Kind.event internal_operation_contents type packed_internal_manager_operation = | Manager : - 'kind internal_manager_operation + 'kind internal_operation_contents -> packed_internal_manager_operation type 'kind internal_contents = { source : Contract.t; - operation : 'kind internal_manager_operation; + operation : 'kind internal_operation_contents; nonce : int; } @@ -68,7 +68,7 @@ type packed_internal_contents = let contents_of_internal_operation (type kind) ({source; operation; nonce} : kind Script_typed_ir.internal_operation) : kind internal_contents = - let operation : kind internal_manager_operation = + let operation : kind internal_operation_contents = match operation with | Transaction_to_implicit {destination; amount; entrypoint; unparsed_parameters; _} -> @@ -211,9 +211,9 @@ module Internal_result = struct iselect : 'kind iselect; select : packed_internal_manager_operation -> - 'kind internal_manager_operation option; - proj : 'kind internal_manager_operation -> 'a; - inj : 'a -> 'kind internal_manager_operation; + 'kind internal_operation_contents option; + proj : 'kind internal_operation_contents -> 'a; + inj : 'a -> 'kind internal_operation_contents; } -> 'kind case [@@coq_force_gadt] diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index 23044a1731ee..9b38a0104cd7 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -30,33 +30,38 @@ open Alpha_context -type 'kind internal_manager_operation = +(** [internal_operation_contents] are the internal operations as output in + receipts. + The type simply weakens {!Script_typed_ir.internal_operation_contents} so + that it is easier to define an encoding for it (i.e. we remove the typed + parameter). *) +type 'kind internal_operation_contents = | Transaction : { amount : Tez.tez; parameters : Script.lazy_expr; entrypoint : Entrypoint.t; destination : Destination.t; } - -> Kind.transaction internal_manager_operation + -> Kind.transaction internal_operation_contents | Origination : { delegate : Signature.Public_key_hash.t option; script : Script.t; credit : Tez.tez; } - -> Kind.origination internal_manager_operation + -> Kind.origination internal_operation_contents | Delegation : Signature.Public_key_hash.t option - -> Kind.delegation internal_manager_operation + -> Kind.delegation internal_operation_contents | Event : { ty : Script.expr; tag : Entrypoint.t; payload : Script.expr; } - -> Kind.event internal_manager_operation + -> Kind.event internal_operation_contents type 'kind internal_contents = { source : Contract.t; - operation : 'kind internal_manager_operation; + operation : 'kind internal_operation_contents; nonce : int; } diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index dad1dfb731bf..09e06ddbf84c 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1475,7 +1475,7 @@ and 'kind internal_operation_contents = access to a typed version of the field (with [parameters_ty] and [parameters]), but we keep it so that we do not have to unparse the typed version in order to produce the receipt - ([Apply_results.internal_manager_operation]). *) + ([Apply_internal_results.internal_operation_contents]). *) destination : Signature.Public_key_hash.t; amount : Tez.tez; entrypoint : Entrypoint.t; @@ -1490,7 +1490,7 @@ and 'kind internal_operation_contents = access to a typed version of the field (with [parameters_ty] and [parameters]), but we keep it so that we do not have to unparse the typed version in order to produce the receipt - ([Apply_results.internal_manager_operation]). *) + ([Apply_internal_results.internal_operation_contents]). *) destination : Contract_hash.t; amount : Tez.tez; entrypoint : Entrypoint.t; diff --git a/src/proto_alpha/lib_tx_rollup/daemon.ml b/src/proto_alpha/lib_tx_rollup/daemon.ml index 0e9419d71ccf..8e7658ec70c0 100644 --- a/src/proto_alpha/lib_tx_rollup/daemon.ml +++ b/src/proto_alpha/lib_tx_rollup/daemon.ml @@ -76,7 +76,7 @@ let parse_tx_rollup_deposit_parameters : let open Protocol in (* /!\ This pattern matching needs to remain in sync with the deposit parameters. See the transaction to Tx_rollup case in - Protocol.Apply.Apply.apply_internal_manager_operations *) + Protocol.Apply.Apply.apply_internal_operation_contents *) match root parameters with | Seq ( _, -- GitLab From ad42170d5ac06b622e167c9a3818563fe4271eb9 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 29 Jun 2022 23:08:55 +0200 Subject: [PATCH 04/14] Proto: rename Apply_internal_results.packed_internal_manager_operation to packed_internal_operation_contents. --- .../lib_protocol/apply_internal_results.ml | 26 ++++++++++++------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 3c97dae43b43..27895cd7dbec 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -51,10 +51,10 @@ type 'kind internal_operation_contents = } -> Kind.event internal_operation_contents -type packed_internal_manager_operation = - | Manager : +type packed_internal_operation_contents = + | Internal_operation_contents : 'kind internal_operation_contents - -> packed_internal_manager_operation + -> packed_internal_operation_contents type 'kind internal_contents = { source : Contract.t; @@ -210,7 +210,7 @@ module Internal_result = struct encoding : 'a Data_encoding.t; iselect : 'kind iselect; select : - packed_internal_manager_operation -> + packed_internal_operation_contents -> 'kind internal_operation_contents option; proj : 'kind internal_operation_contents -> 'a; inj : 'a -> 'kind internal_operation_contents; @@ -345,7 +345,9 @@ module Internal_result = struct Some (op, res) | _ -> None); select = - (function Manager (Transaction _ as op) -> Some op | _ -> None); + (function + | Internal_operation_contents (Transaction _ as op) -> Some op + | _ -> None); proj = (function | Transaction {amount; destination; parameters; entrypoint} -> @@ -386,7 +388,9 @@ module Internal_result = struct Some (op, res) | _ -> None); select = - (function Manager (Origination _ as op) -> Some op | _ -> None); + (function + | Internal_operation_contents (Origination _ as op) -> Some op + | _ -> None); proj = (function | Origination {credit; delegate; script} -> (credit, delegate, script)); @@ -410,7 +414,9 @@ module Internal_result = struct Some (op, res) | _ -> None); select = - (function Manager (Delegation _ as op) -> Some op | _ -> None); + (function + | Internal_operation_contents (Delegation _ as op) -> Some op + | _ -> None); proj = (function Delegation key -> key); inj = (fun key -> Delegation key); } @@ -464,7 +470,7 @@ module Internal_result = struct name encoding (fun o -> match select o with None -> None | Some o -> Some (proj o)) - (fun x -> Manager (inj x)) + (fun x -> Internal_operation_contents (inj x)) in union ~tag_size:`Uint8 @@ -480,8 +486,8 @@ let internal_contents_encoding : packed_internal_contents Data_encoding.t = def "apply_internal_results.alpha.operation_result" @@ conv (fun (Internal_contents {source; operation; nonce}) -> - ((source, nonce), Manager operation)) - (fun ((source, nonce), Manager operation) -> + ((source, nonce), Internal_operation_contents operation)) + (fun ((source, nonce), Internal_operation_contents operation) -> Internal_contents {source; operation; nonce}) (merge_objs (obj2 (req "source" Contract.encoding) (req "nonce" uint16)) -- GitLab From 3908c734b2984153768ea585f0dc628aebda2c60 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 29 Jun 2022 23:20:35 +0200 Subject: [PATCH 05/14] Proto/Client/Plugin: rename Apply_internal_results.internal_contents to internal_operation. --- .../lib_client/operation_result.ml | 4 ++-- .../lib_client/protocol_client_context.ml | 2 +- src/proto_alpha/lib_plugin/RPC.ml | 4 ++-- src/proto_alpha/lib_protocol/apply.ml | 10 ++++----- .../lib_protocol/apply_internal_results.ml | 22 +++++++++---------- .../lib_protocol/apply_internal_results.mli | 12 +++++----- .../lib_protocol/script_ir_translator.ml | 2 +- 7 files changed, 27 insertions(+), 29 deletions(-) diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index b4427a0d05d6..4966c118839e 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -43,7 +43,7 @@ let pp_micheline_from_lazy_expr ppf expr = in pp_micheline_expr ppf expr -let pp_internal_operation ppf (Internal_contents {operation; source; _}) = +let pp_internal_operation ppf (Internal_operation {operation; source; _}) = (* For now, try to use the same format as in [pp_manager_operation_content]. *) Format.fprintf ppf "@[Internal " ; (match operation with @@ -840,7 +840,7 @@ let pp_internal_operation_and_result ppf ppf "@[%a@,%a@]" pp_internal_operation - (Internal_contents op) + (Internal_operation op) (pp_operation_result ~operation_name:internal_operation_name pp_internal_operation_result) diff --git a/src/proto_alpha/lib_client/protocol_client_context.ml b/src/proto_alpha/lib_client/protocol_client_context.ml index be5745a532e8..1f0810f27f47 100644 --- a/src/proto_alpha/lib_client/protocol_client_context.ml +++ b/src/proto_alpha/lib_client/protocol_client_context.ml @@ -201,7 +201,7 @@ let () = @@ def "operation" ["internal"] - Protocol.Apply_internal_results.internal_contents_encoding ; + Protocol.Apply_internal_results.internal_operation_encoding ; register @@ def "operation" diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index a988aeea4c3e..e323d8372726 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -183,7 +183,7 @@ module Scripts = struct (req "storage" Script.expr_encoding) (req "operations" - (list Apply_internal_results.internal_contents_encoding)) + (list Apply_internal_results.internal_operation_encoding)) (opt "lazy_storage_diff" Lazy_storage.encoding)) let trace_code_input_encoding = run_code_input_encoding @@ -205,7 +205,7 @@ module Scripts = struct (req "storage" Script.expr_encoding) (req "operations" - (list Apply_internal_results.internal_contents_encoding)) + (list Apply_internal_results.internal_operation_encoding)) (req "trace" trace_encoding) (opt "lazy_storage_diff" Lazy_storage.encoding)) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 8dee64f4bb6e..6c11e9487c4b 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -568,12 +568,12 @@ let () = ~id:"internal_operation_replay" ~title:"Internal operation replay" ~description:"An internal operation was emitted twice by a script" - ~pp:(fun ppf (Apply_internal_results.Internal_contents {nonce; _}) -> + ~pp:(fun ppf (Apply_internal_results.Internal_operation {nonce; _}) -> Format.fprintf ppf "Internal operation %d was emitted twice by a script" nonce) - Apply_internal_results.internal_contents_encoding + Apply_internal_results.internal_operation_encoding (function Internal_operation_replay op -> Some op | _ -> None) (fun op -> Internal_operation_replay op) ; register_error_kind @@ -1912,10 +1912,8 @@ let apply_internal_operations ctxt ~payer ~chain_id ops = | Script_typed_ir.Internal_operation ({source; operation; nonce} as op) :: rest -> ( (if internal_nonce_already_recorded ctxt nonce then - let op_res = - Apply_internal_results.contents_of_internal_operation op - in - fail (Internal_operation_replay (Internal_contents op_res)) + let op_res = Apply_internal_results.internal_operation op in + fail (Internal_operation_replay (Internal_operation op_res)) else let ctxt = record_internal_nonce ctxt nonce in apply_internal_operation_contents diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 27895cd7dbec..d5f023385efc 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -56,18 +56,18 @@ type packed_internal_operation_contents = 'kind internal_operation_contents -> packed_internal_operation_contents -type 'kind internal_contents = { +type 'kind internal_operation = { source : Contract.t; operation : 'kind internal_operation_contents; nonce : int; } type packed_internal_contents = - | Internal_contents : 'kind internal_contents -> packed_internal_contents + | Internal_operation : 'kind internal_operation -> packed_internal_contents -let contents_of_internal_operation (type kind) +let internal_operation (type kind) ({source; operation; nonce} : kind Script_typed_ir.internal_operation) : - kind internal_contents = + kind internal_operation = let operation : kind internal_operation_contents = match operation with | Transaction_to_implicit @@ -121,7 +121,7 @@ let contents_of_internal_operation (type kind) let contents_of_packed_internal_operation (Script_typed_ir.Internal_operation op) = - Internal_contents (contents_of_internal_operation op) + Internal_operation (internal_operation op) let contents_of_packed_internal_operations = List.map contents_of_packed_internal_operation @@ -187,18 +187,18 @@ type 'kind internal_manager_operation_result = type packed_internal_manager_operation_result = | Internal_manager_operation_result : - 'kind internal_contents * 'kind internal_manager_operation_result + 'kind internal_operation * 'kind internal_manager_operation_result -> packed_internal_manager_operation_result let pack_internal_manager_operation_result (type kind) (internal_op : kind Script_typed_ir.internal_operation) (manager_op : kind internal_manager_operation_result) = - let internal_op = contents_of_internal_operation internal_op in + let internal_op = internal_operation internal_op in Internal_manager_operation_result (internal_op, manager_op) type 'kind iselect = packed_internal_manager_operation_result -> - ('kind internal_contents * 'kind internal_manager_operation_result) option + ('kind internal_operation * 'kind internal_manager_operation_result) option module Internal_result = struct open Data_encoding @@ -482,13 +482,13 @@ module Internal_result = struct ] end -let internal_contents_encoding : packed_internal_contents Data_encoding.t = +let internal_operation_encoding : packed_internal_contents Data_encoding.t = def "apply_internal_results.alpha.operation_result" @@ conv - (fun (Internal_contents {source; operation; nonce}) -> + (fun (Internal_operation {source; operation; nonce}) -> ((source, nonce), Internal_operation_contents operation)) (fun ((source, nonce), Internal_operation_contents operation) -> - Internal_contents {source; operation; nonce}) + Internal_operation {source; operation; nonce}) (merge_objs (obj2 (req "source" Contract.encoding) (req "nonce" uint16)) Internal_result.encoding) diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index 9b38a0104cd7..93c38032b04e 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -59,14 +59,14 @@ type 'kind internal_operation_contents = } -> Kind.event internal_operation_contents -type 'kind internal_contents = { +type 'kind internal_operation = { source : Contract.t; operation : 'kind internal_operation_contents; nonce : int; } type packed_internal_contents = - | Internal_contents : 'kind internal_contents -> packed_internal_contents + | Internal_operation : 'kind internal_operation -> packed_internal_contents val contents_of_packed_internal_operation : Script_typed_ir.packed_internal_operation -> packed_internal_contents @@ -133,18 +133,18 @@ type 'kind internal_manager_operation_result = type packed_internal_manager_operation_result = | Internal_manager_operation_result : - 'kind internal_contents * 'kind internal_manager_operation_result + 'kind internal_operation * 'kind internal_manager_operation_result -> packed_internal_manager_operation_result -val contents_of_internal_operation : - 'kind Script_typed_ir.internal_operation -> 'kind internal_contents +val internal_operation : + 'kind Script_typed_ir.internal_operation -> 'kind internal_operation val pack_internal_manager_operation_result : 'kind Script_typed_ir.internal_operation -> 'kind internal_manager_operation_result -> packed_internal_manager_operation_result -val internal_contents_encoding : packed_internal_contents Data_encoding.t +val internal_operation_encoding : packed_internal_contents Data_encoding.t val internal_manager_operation_result_encoding : packed_internal_manager_operation_result Data_encoding.t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 7dcabe585ff4..51a7b8aeb528 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -419,7 +419,7 @@ let unparse_operation ~loc ctxt {piop; lazy_storage_diff = _} = let iop = Apply_internal_results.contents_of_packed_internal_operation piop in let bytes = Data_encoding.Binary.to_bytes_exn - Apply_internal_results.internal_contents_encoding + Apply_internal_results.internal_operation_encoding iop in Gas.consume ctxt (Unparse_costs.operation bytes) >|? fun ctxt -> -- GitLab From 899b5b7a34737e33b6d158d7a5f119883ecd4d61 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 29 Jun 2022 23:29:47 +0200 Subject: [PATCH 06/14] Proto/Client/Plugin: rename Apply_internal_results.packed_internal_contents to packed_internal_operation. --- .../lib_client/client_proto_programs.mli | 8 ++++---- src/proto_alpha/lib_client/operation_result.mli | 2 +- src/proto_alpha/lib_plugin/RPC.ml | 6 ++---- src/proto_alpha/lib_protocol/apply.ml | 3 ++- src/proto_alpha/lib_protocol/apply.mli | 2 +- .../lib_protocol/apply_internal_results.ml | 12 +++++------- .../lib_protocol/apply_internal_results.mli | 14 +++++++------- .../lib_protocol/script_ir_translator.ml | 2 +- 8 files changed, 23 insertions(+), 26 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index c18ecad250bb..dbe6e154e2ab 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -95,7 +95,7 @@ val run : block:Shell_services.block -> run_params -> (Script.expr - * Apply_internal_results.packed_internal_contents list + * Apply_internal_results.packed_internal_operation list * Lazy_storage.diffs option) tzresult Lwt.t @@ -107,7 +107,7 @@ val trace : block:Shell_services.block -> run_params -> (Script.expr - * Apply_internal_results.packed_internal_contents list + * Apply_internal_results.packed_internal_operation list * Script_typed_ir.execution_trace * Lazy_storage.diffs option) tzresult @@ -123,7 +123,7 @@ val print_run_result : show_source:bool -> parsed:Michelson_v1_parser.parsed -> (Script_repr.expr - * Apply_internal_results.packed_internal_contents list + * Apply_internal_results.packed_internal_operation list * Lazy_storage.diffs option) tzresult -> unit tzresult Lwt.t @@ -133,7 +133,7 @@ val print_trace_result : show_source:bool -> parsed:Michelson_v1_parser.parsed -> (Script_repr.expr - * Apply_internal_results.packed_internal_contents list + * Apply_internal_results.packed_internal_operation list * Script_typed_ir.execution_trace * Lazy_storage.diffs option) tzresult -> diff --git a/src/proto_alpha/lib_client/operation_result.mli b/src/proto_alpha/lib_client/operation_result.mli index d6ed7d353edd..18c317ff3e2a 100644 --- a/src/proto_alpha/lib_client/operation_result.mli +++ b/src/proto_alpha/lib_client/operation_result.mli @@ -29,7 +29,7 @@ open Alpha_context val tez_sym : string val pp_internal_operation : - Format.formatter -> Apply_internal_results.packed_internal_contents -> unit + Format.formatter -> Apply_internal_results.packed_internal_operation -> unit val pp_operation_result : Format.formatter -> diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index e323d8372726..2f1467dfc1e2 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -1050,8 +1050,7 @@ module Scripts = struct }, _ ) -> ( storage, - Apply_internal_results.contents_of_packed_internal_operations - operations, + Apply_internal_results.packed_internal_operations operations, lazy_storage_diff )) ; Registration.register0 ~chunked:true @@ -1123,8 +1122,7 @@ module Scripts = struct _ctxt ), trace ) -> ( storage, - Apply_internal_results.contents_of_packed_internal_operations - operations, + Apply_internal_results.packed_internal_operations operations, trace, lazy_storage_diff )) ; Registration.register0 diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 6c11e9487c4b..6f6992e31ee7 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -101,7 +101,8 @@ type error += | Cannot_transfer_ticket_to_implicit | Sc_rollup_feature_disabled | Wrong_voting_period of {expected : int32; provided : int32} - | Internal_operation_replay of Apply_internal_results.packed_internal_contents + | Internal_operation_replay of + Apply_internal_results.packed_internal_operation | Invalid_denunciation of denunciation_kind | Inconsistent_denunciation of { kind : denunciation_kind; diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli index 07f0c78fc47f..91822dcac3e6 100644 --- a/src/proto_alpha/lib_protocol/apply.mli +++ b/src/proto_alpha/lib_protocol/apply.mli @@ -38,7 +38,7 @@ open Apply_results open Apply_internal_results type error += - | Internal_operation_replay of packed_internal_contents + | Internal_operation_replay of packed_internal_operation | Tx_rollup_feature_disabled | Tx_rollup_invalid_transaction_ticket_amount | Sc_rollup_feature_disabled diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index d5f023385efc..2729d3f614a6 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -62,8 +62,8 @@ type 'kind internal_operation = { nonce : int; } -type packed_internal_contents = - | Internal_operation : 'kind internal_operation -> packed_internal_contents +type packed_internal_operation = + | Internal_operation : 'kind internal_operation -> packed_internal_operation let internal_operation (type kind) ({source; operation; nonce} : kind Script_typed_ir.internal_operation) : @@ -119,12 +119,10 @@ let internal_operation (type kind) in {source; operation; nonce} -let contents_of_packed_internal_operation - (Script_typed_ir.Internal_operation op) = +let packed_internal_operation (Script_typed_ir.Internal_operation op) = Internal_operation (internal_operation op) -let contents_of_packed_internal_operations = - List.map contents_of_packed_internal_operation +let packed_internal_operations = List.map packed_internal_operation type successful_transaction_result = | Transaction_to_contract_result of { @@ -482,7 +480,7 @@ module Internal_result = struct ] end -let internal_operation_encoding : packed_internal_contents Data_encoding.t = +let internal_operation_encoding : packed_internal_operation Data_encoding.t = def "apply_internal_results.alpha.operation_result" @@ conv (fun (Internal_operation {source; operation; nonce}) -> diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index 93c38032b04e..1441971a5667 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -65,15 +65,15 @@ type 'kind internal_operation = { nonce : int; } -type packed_internal_contents = - | Internal_operation : 'kind internal_operation -> packed_internal_contents +type packed_internal_operation = + | Internal_operation : 'kind internal_operation -> packed_internal_operation -val contents_of_packed_internal_operation : - Script_typed_ir.packed_internal_operation -> packed_internal_contents +val packed_internal_operation : + Script_typed_ir.packed_internal_operation -> packed_internal_operation -val contents_of_packed_internal_operations : +val packed_internal_operations : Script_typed_ir.packed_internal_operation list -> - packed_internal_contents list + packed_internal_operation list (** Result of applying an internal transaction. *) type successful_transaction_result = @@ -144,7 +144,7 @@ val pack_internal_manager_operation_result : 'kind internal_manager_operation_result -> packed_internal_manager_operation_result -val internal_operation_encoding : packed_internal_contents Data_encoding.t +val internal_operation_encoding : packed_internal_operation Data_encoding.t val internal_manager_operation_result_encoding : packed_internal_manager_operation_result Data_encoding.t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 51a7b8aeb528..454349c54190 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -416,7 +416,7 @@ let unparse_key_hash ~loc ctxt mode k = (* Operations are only unparsed during the production of execution traces of the interpreter. *) let unparse_operation ~loc ctxt {piop; lazy_storage_diff = _} = - let iop = Apply_internal_results.contents_of_packed_internal_operation piop 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 -- GitLab From c55e2a80fb68809041d0c71bd800edcddbad78ea Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Thu, 30 Jun 2022 14:18:43 +0200 Subject: [PATCH 07/14] Proto/Client: rename Apply_internal_results.successful_internal_manager_operation_result to successful_internal_operation_result. --- src/proto_alpha/bin_sc_rollup_node/inbox.ml | 3 +- .../bin_sc_rollup_node/layer1_services.ml | 2 +- .../bin_sc_rollup_node/layer1_services.mli | 2 +- .../lib_client/operation_result.ml | 4 +- src/proto_alpha/lib_protocol/apply.ml | 10 ++--- .../lib_protocol/apply_internal_results.ml | 41 ++++++++++--------- .../lib_protocol/apply_internal_results.mli | 12 +++--- 7 files changed, 37 insertions(+), 37 deletions(-) diff --git a/src/proto_alpha/bin_sc_rollup_node/inbox.ml b/src/proto_alpha/bin_sc_rollup_node/inbox.ml index 1c60d8415635..6c587b880992 100644 --- a/src/proto_alpha/bin_sc_rollup_node/inbox.ml +++ b/src/proto_alpha/bin_sc_rollup_node/inbox.ml @@ -87,8 +87,7 @@ let get_messages l1_ctxt head rollup = let apply_internal (type kind) accu ~source:_ (_operation : kind Apply_internal_results.internal_operation_contents) (_result : - kind Apply_internal_results.successful_internal_manager_operation_result) - = + kind Apply_internal_results.successful_internal_operation_result) = accu in let messages = diff --git a/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml b/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml index 686e2c82da72..2b9fca7ff90a 100644 --- a/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml +++ b/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml @@ -41,7 +41,7 @@ type 'accu operation_processor = { 'accu -> source:public_key_hash -> 'kind Apply_internal_results.internal_operation_contents -> - 'kind Apply_internal_results.successful_internal_manager_operation_result -> + 'kind Apply_internal_results.successful_internal_operation_result -> 'accu; } diff --git a/src/proto_alpha/bin_sc_rollup_node/layer1_services.mli b/src/proto_alpha/bin_sc_rollup_node/layer1_services.mli index a0d1a9c29b96..f6e5a10afecf 100644 --- a/src/proto_alpha/bin_sc_rollup_node/layer1_services.mli +++ b/src/proto_alpha/bin_sc_rollup_node/layer1_services.mli @@ -40,7 +40,7 @@ type 'accu operation_processor = { 'accu -> source:public_key_hash -> 'kind Apply_internal_results.internal_operation_contents -> - 'kind Apply_internal_results.successful_internal_manager_operation_result -> + 'kind Apply_internal_results.successful_internal_operation_result -> 'accu; } diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index 4966c118839e..db825065a770 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -822,14 +822,14 @@ let pp_manager_operation_contents_result ppf op_result = let pp_internal_operation_and_result ppf (Internal_manager_operation_result (op, res)) = let internal_operation_name (type kind) : - kind successful_internal_manager_operation_result -> string = function + kind successful_internal_operation_result -> string = function | ITransaction_result _ -> "transaction" | IOrigination_result _ -> "origination" | IDelegation_result _ -> "delegation" | IEvent_result _ -> "event" in let pp_internal_operation_result (type kind) ppf - (result : kind successful_internal_manager_operation_result) = + (result : kind successful_internal_operation_result) = match result with | ITransaction_result tx -> pp_transaction_result ppf tx | IOrigination_result op_res -> pp_origination_result ppf op_res diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 6f6992e31ee7..d8215420642a 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1086,7 +1086,7 @@ let apply_internal_operation_contents : chain_id:Chain_id.t -> kind Script_typed_ir.internal_operation_contents -> (context - * kind successful_internal_manager_operation_result + * kind successful_internal_operation_result * Script_typed_ir.packed_internal_operation list) tzresult Lwt.t = @@ -1119,8 +1119,7 @@ let apply_internal_operation_contents : ~before_operation:ctxt_before_op >|=? fun (ctxt, res, ops) -> ( ctxt, - (ITransaction_result res - : kind successful_internal_manager_operation_result), + (ITransaction_result res : kind successful_internal_operation_result), ops ) | Transaction_to_smart_contract { @@ -2133,11 +2132,10 @@ let burn_manager_storage_fees : let burn_internal_storage_fees : type kind. context -> - kind successful_internal_manager_operation_result -> + kind successful_internal_operation_result -> storage_limit:Z.t -> payer:public_key_hash -> - (context * Z.t * kind successful_internal_manager_operation_result) tzresult - Lwt.t = + (context * Z.t * kind successful_internal_operation_result) tzresult Lwt.t = fun ctxt smopr ~storage_limit ~payer -> let payer = `Contract (Contract.Implicit payer) in match smopr with diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 2729d3f614a6..9326d5cf8348 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -155,32 +155,32 @@ type successful_origination_result = { paid_storage_size_diff : Z.t; } -(** Result of applying an internal {!manager_operation}. *) -type _ successful_internal_manager_operation_result = +(** Result of applying an internal operation. *) +type _ successful_internal_operation_result = | ITransaction_result : successful_transaction_result - -> Kind.transaction successful_internal_manager_operation_result + -> Kind.transaction successful_internal_operation_result | IOrigination_result : successful_origination_result - -> Kind.origination successful_internal_manager_operation_result + -> Kind.origination successful_internal_operation_result | IDelegation_result : { consumed_gas : Gas.Arith.fp; } - -> Kind.delegation successful_internal_manager_operation_result + -> Kind.delegation successful_internal_operation_result | IEvent_result : { consumed_gas : Gas.Arith.fp; } - -> Kind.event successful_internal_manager_operation_result + -> Kind.event successful_internal_operation_result type packed_successful_internal_manager_operation_result = - | Successful_internal_manager_result : - 'kind successful_internal_manager_operation_result + | Successful_internal_operation_result : + 'kind successful_internal_operation_result -> packed_successful_internal_manager_operation_result type 'kind internal_manager_operation_result = ( 'kind, 'kind Kind.manager, - 'kind successful_internal_manager_operation_result ) + 'kind successful_internal_operation_result ) operation_result type packed_internal_manager_operation_result = @@ -437,7 +437,9 @@ module Internal_result = struct (({operation = Event _; _} as op), res) -> Some (op, res) | _ -> None); - select = (function Manager (Event _ as op) -> Some op | _ -> None); + select = + (function + | Internal_operation_contents (Event _ as op) -> Some op | _ -> None); proj = (function | Event {ty; tag; payload} -> @@ -499,9 +501,9 @@ module Internal_manager_result = struct kind : 'kind Kind.manager; select : packed_successful_internal_manager_operation_result -> - 'kind successful_internal_manager_operation_result option; - proj : 'kind successful_internal_manager_operation_result -> 'a; - inj : 'a -> 'kind successful_internal_manager_operation_result; + 'kind successful_internal_operation_result option; + proj : 'kind successful_internal_operation_result -> 'a; + inj : 'a -> 'kind successful_internal_operation_result; t : 'kind internal_manager_operation_result Data_encoding.t; } -> 'kind case @@ -521,7 +523,7 @@ module Internal_manager_result = struct match o with | Skipped _ | Failed _ | Backtracked _ -> None | Applied o -> ( - match select (Successful_internal_manager_result o) with + match select (Successful_internal_operation_result o) with | None -> None | Some o -> Some ((), proj o))) (fun ((), x) -> Applied (inj x)); @@ -551,7 +553,7 @@ module Internal_manager_result = struct match o with | Skipped _ | Failed _ | Applied _ -> None | Backtracked (o, errs) -> ( - match select (Successful_internal_manager_result o) with + match select (Successful_internal_operation_result o) with | None -> None | Some o -> Some (((), errs), proj o))) (fun (((), errs), x) -> Backtracked (inj x, errs)); @@ -564,7 +566,7 @@ module Internal_manager_result = struct ~op_case:Internal_result.transaction_case ~encoding:Internal_result.transaction_contract_variant_cases ~select:(function - | Successful_internal_manager_result (ITransaction_result _ as op) -> + | Successful_internal_operation_result (ITransaction_result _ as op) -> Some op | _ -> None) ~kind:Kind.Transaction_manager_kind @@ -583,7 +585,7 @@ module Internal_manager_result = struct (dft "paid_storage_size_diff" z Z.zero) (opt "lazy_storage_diff" Lazy_storage.encoding)) ~select:(function - | Successful_internal_manager_result (IOrigination_result _ as op) -> + | Successful_internal_operation_result (IOrigination_result _ as op) -> Some op | _ -> None) ~proj:(function @@ -632,7 +634,7 @@ module Internal_manager_result = struct Data_encoding.( obj1 (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero)) ~select:(function - | Successful_internal_manager_result (IDelegation_result _ as op) -> + | Successful_internal_operation_result (IDelegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind @@ -647,7 +649,8 @@ module Internal_manager_result = struct Data_encoding.( obj1 (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero)) ~select:(function - | Successful_internal_manager_result (IEvent_result _ as op) -> Some op + | Successful_internal_operation_result (IEvent_result _ as op) -> + Some op | _ -> None) ~kind:Kind.Event_manager_kind ~proj:(function[@coq_match_with_default] diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index 1441971a5667..13b3a1aa5845 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -109,26 +109,26 @@ type successful_origination_result = { } (** Result of applying a {!Script_typed_ir.internal_operation_contents}. *) -type _ successful_internal_manager_operation_result = +type _ successful_internal_operation_result = | ITransaction_result : successful_transaction_result - -> Kind.transaction successful_internal_manager_operation_result + -> Kind.transaction successful_internal_operation_result | IOrigination_result : successful_origination_result - -> Kind.origination successful_internal_manager_operation_result + -> Kind.origination successful_internal_operation_result | IDelegation_result : { consumed_gas : Gas.Arith.fp; } - -> Kind.delegation successful_internal_manager_operation_result + -> Kind.delegation successful_internal_operation_result | IEvent_result : { consumed_gas : Gas.Arith.fp; } - -> Kind.event successful_internal_manager_operation_result + -> Kind.event successful_internal_operation_result type 'kind internal_manager_operation_result = ( 'kind, 'kind Kind.manager, - 'kind successful_internal_manager_operation_result ) + 'kind successful_internal_operation_result ) Apply_operation_result.operation_result type packed_internal_manager_operation_result = -- GitLab From 27148ea57370072af05aebda8ca027556538408d Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Thu, 30 Jun 2022 14:31:30 +0200 Subject: [PATCH 08/14] Proto: rename Apply_internal_results.packed_successful_internal_manager_operation_result to packed_successful_internal_operation_result. --- src/proto_alpha/lib_protocol/apply_internal_results.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 9326d5cf8348..e69ec166313a 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -172,10 +172,10 @@ type _ successful_internal_operation_result = } -> Kind.event successful_internal_operation_result -type packed_successful_internal_manager_operation_result = +type packed_successful_internal_operation_result = | Successful_internal_operation_result : 'kind successful_internal_operation_result - -> packed_successful_internal_manager_operation_result + -> packed_successful_internal_operation_result type 'kind internal_manager_operation_result = ( 'kind, @@ -500,7 +500,7 @@ module Internal_manager_result = struct encoding : 'a Data_encoding.t; kind : 'kind Kind.manager; select : - packed_successful_internal_manager_operation_result -> + packed_successful_internal_operation_result -> 'kind successful_internal_operation_result option; proj : 'kind successful_internal_operation_result -> 'a; inj : 'a -> 'kind successful_internal_operation_result; -- GitLab From 3f1777f05af9ca0704a8d64a4d43da3a64cc09f4 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Thu, 30 Jun 2022 14:41:42 +0200 Subject: [PATCH 09/14] Proto/Client/Tx_rollup: rename Apply_internal_results.internal_manager_operation_result to internal_operation_result. --- .../bin_sc_rollup_node/layer1_services.ml | 2 +- src/proto_alpha/lib_client/injection.ml | 15 ++++++----- .../lib_client/operation_result.ml | 3 +-- src/proto_alpha/lib_protocol/apply.ml | 15 ++++++----- .../lib_protocol/apply_internal_results.ml | 25 +++++++++---------- .../lib_protocol/apply_internal_results.mli | 8 +++--- .../lib_protocol/test/helpers/incremental.ml | 3 +-- .../michelson/test_contract_event.ml | 4 +-- src/proto_alpha/lib_tx_rollup/daemon.ml | 2 +- 9 files changed, 36 insertions(+), 41 deletions(-) diff --git a/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml b/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml index 2b9fca7ff90a..6dcd12d01413 100644 --- a/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml +++ b/src/proto_alpha/bin_sc_rollup_node/layer1_services.ml @@ -78,7 +78,7 @@ let process_applied_manager_operations operations accu f = and on_applied_internal_operations accu source internal_operation_results = let open Apply_internal_results in List.fold_left - (fun accu (Internal_manager_operation_result ({operation; _}, result)) -> + (fun accu (Internal_operation_result ({operation; _}, result)) -> match result with | Applied result -> f.apply_internal accu ~source operation result | _ -> accu) diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 3aeb28e294b1..7b7f47594548 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -346,7 +346,7 @@ let estimated_gas_single (type kind) | Failed (_, errs) -> Error (Environment.wrap_tztrace errs) in let internal_consumed_gas (type kind) - (result : kind internal_manager_operation_result) = + (result : kind internal_operation_result) = match result with | Applied res | Backtracked (res, _) -> ( match res with @@ -364,7 +364,7 @@ let estimated_gas_single (type kind) in consumed_gas operation_result >>? fun gas -> List.fold_left_e - (fun acc (Internal_manager_operation_result (_, r)) -> + (fun acc (Internal_operation_result (_, r)) -> internal_consumed_gas r >>? fun gas -> Ok (Gas.Arith.add acc gas)) gas internal_operation_results @@ -431,7 +431,7 @@ let estimated_storage_single (type kind) ~tx_rollup_origination_size | Failed (_, errs) -> Error (Environment.wrap_tztrace errs) in let internal_storage_size_diff (type kind) - (result : kind internal_manager_operation_result) = + (result : kind internal_operation_result) = match result with | Applied res | Backtracked (res, _) -> ( match res with @@ -457,7 +457,7 @@ let estimated_storage_single (type kind) ~tx_rollup_origination_size in storage_size_diff operation_result >>? fun storage -> List.fold_left_e - (fun acc (Internal_manager_operation_result (_, r)) -> + (fun acc (Internal_operation_result (_, r)) -> internal_storage_size_diff r >>? fun storage -> Ok (Z.add acc storage)) storage internal_operation_results @@ -526,7 +526,7 @@ let originated_contracts_single (type kind) | Failed (_, errs) -> Error (Environment.wrap_tztrace errs) in let internal_originated_contracts (type kind) - (result : kind internal_manager_operation_result) = + (result : kind internal_operation_result) = match result with | Applied res | Backtracked (res, _) -> ( match res with @@ -546,7 +546,7 @@ let originated_contracts_single (type kind) originated_contracts operation_result >>? fun contracts -> let contracts = List.rev contracts in List.fold_left_e - (fun acc (Internal_manager_operation_result (_, r)) -> + (fun acc (Internal_operation_result (_, r)) -> internal_originated_contracts r >>? fun contracts -> Ok (List.rev_append contracts acc)) contracts @@ -611,8 +611,7 @@ let detect_script_failure : type kind. kind operation_metadata -> _ = in detect_script_failure operation_result >>? fun () -> List.iter_e - (fun (Internal_manager_operation_result (_, r)) -> - detect_script_failure r) + (fun (Internal_operation_result (_, r)) -> detect_script_failure r) internal_operation_results in function diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index db825065a770..cef3f77a8199 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -819,8 +819,7 @@ let pp_manager_operation_contents_result ppf op_result = ppf op_result -let pp_internal_operation_and_result ppf - (Internal_manager_operation_result (op, res)) = +let pp_internal_operation_and_result ppf (Internal_operation_result (op, res)) = let internal_operation_name (type kind) : kind successful_internal_operation_result -> string = function | ITransaction_result _ -> "transaction" diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index d8215420642a..4ab877e39f72 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -2192,7 +2192,7 @@ let apply_manager_contents (type kind) ctxt chain_id | Ok (ctxt, storage_limit, operation_results) -> ( List.fold_left_es (fun (ctxt, storage_limit, res) imopr -> - let (Internal_manager_operation_result (op, mopr)) = imopr in + let (Internal_operation_result (op, mopr)) = imopr in match mopr with | Applied smopr -> burn_internal_storage_fees @@ -2202,7 +2202,7 @@ let apply_manager_contents (type kind) ctxt chain_id ~payer:source >>=? fun (ctxt, storage_limit, smopr) -> let imopr = - Internal_manager_operation_result (op, Applied smopr) + Internal_operation_result (op, Applied smopr) in return (ctxt, storage_limit, imopr :: res) | _ -> return (ctxt, storage_limit, imopr :: res)) @@ -2371,17 +2371,16 @@ let mark_backtracked results = | (Failed _ | Skipped _ | Backtracked _) as result -> result | Applied result -> Backtracked (result, None) in - let mark_internal_manager_operation_result : + let mark_internal_operation_result : type kind. - kind internal_manager_operation_result -> - kind internal_manager_operation_result = function + kind internal_operation_result -> kind internal_operation_result = + function | (Failed _ | Skipped _ | Backtracked _) as result -> result | Applied result -> Backtracked (result, None) in let mark_internal_operation_results - (Internal_manager_operation_result (kind, result)) = - Internal_manager_operation_result - (kind, mark_internal_manager_operation_result result) + (Internal_operation_result (kind, result)) = + Internal_operation_result (kind, mark_internal_operation_result result) in match results with | Manager_operation_result op -> diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index e69ec166313a..90767c8e88fb 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -177,26 +177,26 @@ type packed_successful_internal_operation_result = 'kind successful_internal_operation_result -> packed_successful_internal_operation_result -type 'kind internal_manager_operation_result = +type 'kind internal_operation_result = ( 'kind, 'kind Kind.manager, 'kind successful_internal_operation_result ) operation_result type packed_internal_manager_operation_result = - | Internal_manager_operation_result : - 'kind internal_operation * 'kind internal_manager_operation_result + | Internal_operation_result : + 'kind internal_operation * 'kind internal_operation_result -> packed_internal_manager_operation_result let pack_internal_manager_operation_result (type kind) (internal_op : kind Script_typed_ir.internal_operation) - (manager_op : kind internal_manager_operation_result) = + (manager_op : kind internal_operation_result) = let internal_op = internal_operation internal_op in - Internal_manager_operation_result (internal_op, manager_op) + Internal_operation_result (internal_op, manager_op) type 'kind iselect = packed_internal_manager_operation_result -> - ('kind internal_operation * 'kind internal_manager_operation_result) option + ('kind internal_operation * 'kind internal_operation_result) option module Internal_result = struct open Data_encoding @@ -338,7 +338,7 @@ module Internal_result = struct (req "value" Script.lazy_expr_encoding))); iselect : Kind.transaction iselect = (function - | Internal_manager_operation_result + | Internal_operation_result (({operation = Transaction _; _} as op), res) -> Some (op, res) | _ -> None); @@ -381,7 +381,7 @@ module Internal_result = struct (req "script" Script.encoding); iselect : Kind.origination iselect = (function - | Internal_manager_operation_result + | Internal_operation_result (({operation = Origination _; _} as op), res) -> Some (op, res) | _ -> None); @@ -407,7 +407,7 @@ module Internal_result = struct encoding = obj1 (opt "delegate" Signature.Public_key_hash.encoding); iselect : Kind.delegation iselect = (function - | Internal_manager_operation_result + | Internal_operation_result (({operation = Delegation _; _} as op), res) -> Some (op, res) | _ -> None); @@ -433,8 +433,7 @@ module Internal_result = struct (opt "payload" Script.expr_encoding); iselect : Kind.event iselect = (function - | Internal_manager_operation_result - (({operation = Event _; _} as op), res) -> + | Internal_operation_result (({operation = Event _; _} as op), res) -> Some (op, res) | _ -> None); select = @@ -504,7 +503,7 @@ module Internal_manager_result = struct 'kind successful_internal_operation_result option; proj : 'kind successful_internal_operation_result -> 'a; inj : 'a -> 'kind successful_internal_operation_result; - t : 'kind internal_manager_operation_result Data_encoding.t; + t : 'kind internal_operation_result Data_encoding.t; } -> 'kind case @@ -681,7 +680,7 @@ let internal_manager_operation_result_encoding : | None -> None) (fun (((), source, nonce), (op, res)) -> let op = {source; operation = ires_case.inj op; nonce} in - Internal_manager_operation_result (op, res)) + Internal_operation_result (op, res)) in def "apply_internal_results.alpha.operation_result" @@ union diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index 13b3a1aa5845..99f49197dec5 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -125,15 +125,15 @@ type _ successful_internal_operation_result = } -> Kind.event successful_internal_operation_result -type 'kind internal_manager_operation_result = +type 'kind internal_operation_result = ( 'kind, 'kind Kind.manager, 'kind successful_internal_operation_result ) Apply_operation_result.operation_result type packed_internal_manager_operation_result = - | Internal_manager_operation_result : - 'kind internal_operation * 'kind internal_manager_operation_result + | Internal_operation_result : + 'kind internal_operation * 'kind internal_operation_result -> packed_internal_manager_operation_result val internal_operation : @@ -141,7 +141,7 @@ val internal_operation : val pack_internal_manager_operation_result : 'kind Script_typed_ir.internal_operation -> - 'kind internal_manager_operation_result -> + 'kind internal_operation_result -> packed_internal_manager_operation_result val internal_operation_encoding : packed_internal_operation Data_encoding.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml index 7c03e9c1d9ba..195e94ff58fb 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml @@ -144,8 +144,7 @@ let detect_script_failure : in detect_script_failure operation_result >>? fun () -> List.iter_e - (fun (Internal_manager_operation_result (_, r)) -> - detect_script_failure r) + (fun (Internal_operation_result (_, r)) -> detect_script_failure r) internal_operation_results in function diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml index 217f9eb45306..9bee0ddb6aea 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml @@ -82,14 +82,14 @@ let contract_test () = { internal_operation_results = [ - Internal_manager_operation_result + Internal_operation_result ( { operation = Event {tag = tag1; payload = data1; ty = ty1}; _; }, Applied (IEvent_result _) ); - Internal_manager_operation_result + Internal_operation_result ( { operation = Event {tag = tag2; payload = data2; ty = ty2}; diff --git a/src/proto_alpha/lib_tx_rollup/daemon.ml b/src/proto_alpha/lib_tx_rollup/daemon.ml index 8e7658ec70c0..439c5110feac 100644 --- a/src/proto_alpha/lib_tx_rollup/daemon.ml +++ b/src/proto_alpha/lib_tx_rollup/daemon.ml @@ -124,7 +124,7 @@ let extract_messages_from_block block_info rollup_id = (msg :: messages, tickets) in let get_messages_of_internal_operation ~source messages_tickets - (Internal_manager_operation_result + (Internal_operation_result ( { operation; source = _use_the_source_of_the_external_operation; -- GitLab From a370c8ff33d878da539e1a066febd313a48fc618 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Thu, 30 Jun 2022 14:54:10 +0200 Subject: [PATCH 10/14] Proto/Client/Tx_rollup: rename Apply_internal_results.packed_internal_manager_operation_result to packed_internal_operation_result. --- src/proto_alpha/lib_protocol/apply.ml | 9 ++++----- .../lib_protocol/apply_internal_results.ml | 12 ++++++------ .../lib_protocol/apply_internal_results.mli | 12 ++++++------ src/proto_alpha/lib_protocol/apply_results.ml | 4 ++-- src/proto_alpha/lib_protocol/apply_results.mli | 2 +- src/proto_alpha/lib_tx_rollup/daemon.ml | 4 ++-- 6 files changed, 21 insertions(+), 22 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 4ab877e39f72..1c71e13b5052 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1925,14 +1925,14 @@ let apply_internal_operations ctxt ~payer ~chain_id ops = >>= function | Error errors -> let result = - pack_internal_manager_operation_result + pack_internal_operation_result op (Failed (Script_typed_ir.manager_kind op.operation, errors)) in let skipped = List.rev_map (fun (Script_typed_ir.Internal_operation op) -> - pack_internal_manager_operation_result + pack_internal_operation_result op (Skipped (Script_typed_ir.manager_kind op.operation))) rest @@ -1941,8 +1941,7 @@ let apply_internal_operations ctxt ~payer ~chain_id ops = | Ok (ctxt, result, emitted) -> apply ctxt - (pack_internal_manager_operation_result op (Applied result) - :: applied) + (pack_internal_operation_result op (Applied result) :: applied) (emitted @ rest)) in apply ctxt [] ops @@ -2162,7 +2161,7 @@ let apply_manager_contents (type kind) ctxt chain_id (op : kind Kind.manager contents) : (success_or_failure * kind manager_operation_result - * packed_internal_manager_operation_result list) + * packed_internal_operation_result list) Lwt.t = let[@coq_match_with_default] (Manager_operation { diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 90767c8e88fb..f2151a90814a 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -183,19 +183,19 @@ type 'kind internal_operation_result = 'kind successful_internal_operation_result ) operation_result -type packed_internal_manager_operation_result = +type packed_internal_operation_result = | Internal_operation_result : 'kind internal_operation * 'kind internal_operation_result - -> packed_internal_manager_operation_result + -> packed_internal_operation_result -let pack_internal_manager_operation_result (type kind) +let pack_internal_operation_result (type kind) (internal_op : kind Script_typed_ir.internal_operation) (manager_op : kind internal_operation_result) = let internal_op = internal_operation internal_op in Internal_operation_result (internal_op, manager_op) type 'kind iselect = - packed_internal_manager_operation_result -> + packed_internal_operation_result -> ('kind internal_operation * 'kind internal_operation_result) option module Internal_result = struct @@ -657,8 +657,8 @@ module Internal_manager_result = struct ~inj:(fun consumed_gas -> IEvent_result {consumed_gas}) end -let internal_manager_operation_result_encoding : - packed_internal_manager_operation_result Data_encoding.t = +let internal_operation_result_encoding : + packed_internal_operation_result Data_encoding.t = let make (type kind) (Internal_manager_result.MCase res_case : kind Internal_manager_result.case) diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index 99f49197dec5..65e80c602af9 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -131,20 +131,20 @@ type 'kind internal_operation_result = 'kind successful_internal_operation_result ) Apply_operation_result.operation_result -type packed_internal_manager_operation_result = +type packed_internal_operation_result = | Internal_operation_result : 'kind internal_operation * 'kind internal_operation_result - -> packed_internal_manager_operation_result + -> packed_internal_operation_result val internal_operation : 'kind Script_typed_ir.internal_operation -> 'kind internal_operation -val pack_internal_manager_operation_result : +val pack_internal_operation_result : 'kind Script_typed_ir.internal_operation -> 'kind internal_operation_result -> - packed_internal_manager_operation_result + packed_internal_operation_result val internal_operation_encoding : packed_internal_operation Data_encoding.t -val internal_manager_operation_result_encoding : - packed_internal_manager_operation_result Data_encoding.t +val internal_operation_result_encoding : + packed_internal_operation_result Data_encoding.t diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index 1c3b6bdf02eb..e3edc5bbe3bb 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -1012,7 +1012,7 @@ type 'kind contents_result = | Manager_operation_result : { balance_updates : Receipt.balance_updates; operation_result : 'kind manager_operation_result; - internal_operation_results : packed_internal_manager_operation_result list; + internal_operation_results : packed_internal_operation_result list; } -> 'kind Kind.manager contents_result @@ -1378,7 +1378,7 @@ module Encoding = struct (req "operation_result" res_case.t) (dft "internal_operation_results" - (list internal_manager_operation_result_encoding) + (list internal_operation_result_encoding) []); select = (function diff --git a/src/proto_alpha/lib_protocol/apply_results.mli b/src/proto_alpha/lib_protocol/apply_results.mli index ec7cd4a0289c..f9aed1d830ec 100644 --- a/src/proto_alpha/lib_protocol/apply_results.mli +++ b/src/proto_alpha/lib_protocol/apply_results.mli @@ -97,7 +97,7 @@ and 'kind contents_result = | Manager_operation_result : { balance_updates : Receipt.balance_updates; operation_result : 'kind manager_operation_result; - internal_operation_results : packed_internal_manager_operation_result list; + internal_operation_results : packed_internal_operation_result list; } -> 'kind Kind.manager contents_result diff --git a/src/proto_alpha/lib_tx_rollup/daemon.ml b/src/proto_alpha/lib_tx_rollup/daemon.ml index 439c5110feac..673e1dd72cd6 100644 --- a/src/proto_alpha/lib_tx_rollup/daemon.ml +++ b/src/proto_alpha/lib_tx_rollup/daemon.ml @@ -164,7 +164,7 @@ let extract_messages_from_block block_info rollup_id = source:public_key_hash -> kind manager_operation -> kind manager_operation_result -> - packed_internal_manager_operation_result list -> + packed_internal_operation_result list -> Tx_rollup_message.t list * Ticket.t list -> Tx_rollup_message.t list * Ticket.t list = fun ~source op result internal_operation_results messages_tickets -> @@ -712,7 +712,7 @@ let handle_l1_operation direction (block : Alpha_block_services.block_info) source:public_key_hash -> kind manager_operation -> kind manager_operation_result -> - packed_internal_manager_operation_result list -> + packed_internal_operation_result list -> 'acc -> 'acc tzresult Lwt.t = fun ~source op result _internal_operation_results acc -> -- GitLab From 8eb32ecf3e2a2682ca401af09b2297b467a93da4 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Thu, 30 Jun 2022 15:01:47 +0200 Subject: [PATCH 11/14] Proto: rename Apply_internal_results.Internal_result to Internal_operation. --- .../lib_protocol/apply_internal_results.ml | 30 +++++++++---------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index f2151a90814a..de3a27347654 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -198,7 +198,7 @@ type 'kind iselect = packed_internal_operation_result -> ('kind internal_operation * 'kind internal_operation_result) option -module Internal_result = struct +module Internal_operation = struct open Data_encoding type 'kind case = @@ -490,12 +490,12 @@ let internal_operation_encoding : packed_internal_operation Data_encoding.t = Internal_operation {source; operation; nonce}) (merge_objs (obj2 (req "source" Contract.encoding) (req "nonce" uint16)) - Internal_result.encoding) + Internal_operation.encoding) module Internal_manager_result = struct type 'kind case = | MCase : { - op_case : 'kind Internal_result.case; + op_case : 'kind Internal_operation.case; encoding : 'a Data_encoding.t; kind : 'kind Kind.manager; select : @@ -508,7 +508,7 @@ module Internal_manager_result = struct -> 'kind case let make ~op_case ~encoding ~kind ~select ~proj ~inj = - let (Internal_result.MCase {name; _}) = op_case in + let (Internal_operation.MCase {name; _}) = op_case in let t = def (Format.asprintf "operation.alpha.internal_operation_result.%s" name) @@ union @@ -562,8 +562,8 @@ module Internal_manager_result = struct let[@coq_axiom_with_reason "gadt"] transaction_case = make - ~op_case:Internal_result.transaction_case - ~encoding:Internal_result.transaction_contract_variant_cases + ~op_case:Internal_operation.transaction_case + ~encoding:Internal_operation.transaction_contract_variant_cases ~select:(function | Successful_internal_operation_result (ITransaction_result _ as op) -> Some op @@ -574,7 +574,7 @@ module Internal_manager_result = struct let[@coq_axiom_with_reason "gadt"] origination_case = make - ~op_case:Internal_result.origination_case + ~op_case:Internal_operation.origination_case ~encoding: (obj6 (dft "balance_updates" Receipt.balance_updates_encoding []) @@ -628,7 +628,7 @@ module Internal_manager_result = struct let delegation_case = make - ~op_case:Internal_result.delegation_case + ~op_case:Internal_operation.delegation_case ~encoding: Data_encoding.( obj1 (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero)) @@ -643,7 +643,7 @@ module Internal_manager_result = struct let event_case = make - ~op_case:Internal_result.event_case + ~op_case:Internal_operation.event_case ~encoding: Data_encoding.( obj1 (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero)) @@ -662,8 +662,8 @@ let internal_operation_result_encoding : let make (type kind) (Internal_manager_result.MCase res_case : kind Internal_manager_result.case) - (Internal_result.MCase ires_case : kind Internal_result.case) = - let (Internal_result.MCase op_case) = res_case.op_case in + (Internal_operation.MCase ires_case : kind Internal_operation.case) = + let (Internal_operation.MCase op_case) = res_case.op_case in case (Tag op_case.tag) ~title:op_case.name @@ -687,12 +687,12 @@ let internal_operation_result_encoding : [ make Internal_manager_result.transaction_case - Internal_result.transaction_case; + Internal_operation.transaction_case; make Internal_manager_result.origination_case - Internal_result.origination_case; + Internal_operation.origination_case; make Internal_manager_result.delegation_case - Internal_result.delegation_case; - make Internal_manager_result.event_case Internal_result.event_case; + Internal_operation.delegation_case; + make Internal_manager_result.event_case Internal_operation.event_case; ] -- GitLab From 46838a1bb21418ba4cca99af825e95f5a0d00714 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Thu, 30 Jun 2022 15:04:46 +0200 Subject: [PATCH 12/14] Proto: rename Apply_internal_results.Internal_manager_result to Internal_operation_result. --- .../lib_protocol/apply_internal_results.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index de3a27347654..2b33a546bbf7 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -492,7 +492,7 @@ let internal_operation_encoding : packed_internal_operation Data_encoding.t = (obj2 (req "source" Contract.encoding) (req "nonce" uint16)) Internal_operation.encoding) -module Internal_manager_result = struct +module Internal_operation_result = struct type 'kind case = | MCase : { op_case : 'kind Internal_operation.case; @@ -660,8 +660,8 @@ end let internal_operation_result_encoding : packed_internal_operation_result Data_encoding.t = let make (type kind) - (Internal_manager_result.MCase res_case : - kind Internal_manager_result.case) + (Internal_operation_result.MCase res_case : + kind Internal_operation_result.case) (Internal_operation.MCase ires_case : kind Internal_operation.case) = let (Internal_operation.MCase op_case) = res_case.op_case in case @@ -686,13 +686,13 @@ let internal_operation_result_encoding : @@ union [ make - Internal_manager_result.transaction_case + Internal_operation_result.transaction_case Internal_operation.transaction_case; make - Internal_manager_result.origination_case + Internal_operation_result.origination_case Internal_operation.origination_case; make - Internal_manager_result.delegation_case + Internal_operation_result.delegation_case Internal_operation.delegation_case; make Internal_manager_result.event_case Internal_operation.event_case; ] -- GitLab From 51e85e5c884a8612a2a5086985907190c16a89b5 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Sat, 2 Jul 2022 11:10:45 +0200 Subject: [PATCH 13/14] Proto/Plugin: rename Apply.apply_manager_operation to apply_manager_operations. --- src/proto_alpha/lib_plugin/RPC.ml | 4 ++-- src/proto_alpha/lib_protocol/apply.ml | 6 +++--- src/proto_alpha/lib_protocol/apply.mli | 8 ++++---- src/proto_alpha/lib_protocol/apply_internal_results.ml | 2 +- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 2f1467dfc1e2..de3553f8f643 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -829,7 +829,7 @@ module Scripts = struct >>=? fun op_validated_stamp -> match protocol_data.contents with | Single (Manager_operation _) as op -> - Apply.apply_manager_operation + Apply.apply_manager_operations ctxt ~payload_producer chain_id @@ -838,7 +838,7 @@ module Scripts = struct op >|=? fun (_ctxt, result) -> ret result | Cons (Manager_operation _, _) as op -> - Apply.apply_manager_operation + Apply.apply_manager_operations ctxt ~payload_producer chain_id diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 1c71e13b5052..60c173776c3f 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -2669,7 +2669,7 @@ let apply_manager_contents_list ctxt ~payload_producer chain_id | Success ctxt -> Lazy_storage.cleanup_temporaries ctxt >|= fun ctxt -> (ctxt, results) -let apply_manager_operation ctxt ~payload_producer chain_id ~mempool_mode +let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode op_validated_stamp contents_list = let open Lwt_result_syntax in let ctxt = if mempool_mode then Gas.reset_block_gas ctxt else ctxt in @@ -3012,7 +3012,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) (* Failing_noop _ always fails *) fail Failing_noop_error | Single (Manager_operation _) -> - apply_manager_operation + apply_manager_operations ctxt ~payload_producer chain_id @@ -3020,7 +3020,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) op_validated_stamp contents_list | Cons (Manager_operation _, _) -> - apply_manager_operation + apply_manager_operations ctxt ~payload_producer chain_id diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli index 91822dcac3e6..c57651730ade 100644 --- a/src/proto_alpha/lib_protocol/apply.mli +++ b/src/proto_alpha/lib_protocol/apply.mli @@ -129,7 +129,7 @@ type apply_mode = been extended to every kind of operation, [apply_operation] should never return an error. - See {!apply_manager_operation} for additional information on the + See {!apply_manager_operations} for additional information on the application of manager operations. *) val apply_operation : context -> @@ -185,12 +185,12 @@ val apply_contents_list : - decrease of the available block gas by operation's [gas_limit]. These updates are mandatory. In particular, taking the fees is - critically important. That's why [apply_manager_operation] takes a + critically important. That's why [apply_manager_operations] takes a [Validate_operation.stamp] argument, so that it may only be called after having validated the operation by calling {!Validate_operation}. Indeed, this module is responsible for ensuring that the operation is solvable, i.e. that fees can be - taken, i.e. that the first stage of [apply_manager_operation] + taken, i.e. that the first stage of [apply_manager_operations] cannot fail. If this stage fails nevertheless, the function returns an error. @@ -203,7 +203,7 @@ val apply_contents_list : stage, and a [contents_result_list] that contains the error. This means that the operation has no other effects than those described above during the first phase. *) -val apply_manager_operation : +val apply_manager_operations : context -> payload_producer:public_key_hash -> Chain_id.t -> diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 2b33a546bbf7..9a4bec05c0ec 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -694,5 +694,5 @@ let internal_operation_result_encoding : make Internal_operation_result.delegation_case Internal_operation.delegation_case; - make Internal_manager_result.event_case Internal_operation.event_case; + make Internal_operation_result.event_case Internal_operation.event_case; ] -- GitLab From dcaa4de616f85c3860fd4fe1cd40b50693a1c465 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Sat, 2 Jul 2022 11:11:33 +0200 Subject: [PATCH 14/14] Proto/Plugin: rename Apply.apply_external_manager_operation_content to apply_manager_operation. --- src/proto_alpha/lib_protocol/apply.ml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 60c173776c3f..8b5bc41e532a 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1219,7 +1219,7 @@ let apply_internal_operation_contents : >|=? fun (ctxt, consumed_gas, ops) -> (ctxt, IDelegation_result {consumed_gas}, ops) -let apply_external_manager_operation_content : +let apply_manager_operation : type kind. context -> source:public_key_hash -> @@ -2176,8 +2176,7 @@ let apply_manager_contents (type kind) ctxt chain_id (* We do not expose the internal scaling to the users. Instead, we multiply the specified gas limit by the internal scaling. *) let ctxt = Gas.set_limit ctxt gas_limit in - apply_external_manager_operation_content ctxt ~source ~chain_id operation - >>= function + apply_manager_operation ctxt ~source ~chain_id operation >>= function | Ok (ctxt, operation_results, internal_operations) -> ( apply_internal_operations ctxt ~payer:source ~chain_id internal_operations >>= function -- GitLab