From 32ce667f6785aa6eb201aef5954a6ade671b21ac Mon Sep 17 00:00:00 2001 From: Felix Puscasu Date: Mon, 23 Oct 2023 13:27:40 +0100 Subject: [PATCH 1/6] Added Increase_counter manager operation Added the manager operation with a manager operation result Added the Storage submodule Dummy_counter_storage Added the Dummy_counter module in Alpha_context Added /chains/<>/blocks/<>/dummy_counter/get RPC get command Added test --- src/proto_alpha/lib_client/injection.ml | 15 +-- .../lib_client/operation_result.ml | 7 ++ .../client_proto_context_commands.ml | 35 +++++++ src/proto_alpha/lib_protocol/TEZOS_PROTOCOL | 4 +- src/proto_alpha/lib_protocol/alpha_context.ml | 4 + .../lib_protocol/alpha_context.mli | 16 +++ .../lib_protocol/alpha_services.ml | 5 +- src/proto_alpha/lib_protocol/apply.ml | 11 +++ src/proto_alpha/lib_protocol/apply_results.ml | 64 ++++++++++++ .../lib_protocol/apply_results.mli | 5 + .../lib_protocol/dummy_counter_services.ml | 44 +++++++++ .../lib_protocol/dummy_counter_services.mli | 26 +++++ .../lib_protocol/dummy_counter_storage.ml | 57 +++++++++++ .../lib_protocol/dummy_counter_storage.mli | 32 ++++++ src/proto_alpha/lib_protocol/dune | 8 ++ .../lib_protocol/operation_repr.ml | 23 +++++ .../lib_protocol/operation_repr.mli | 11 ++- src/proto_alpha/lib_protocol/storage.ml | 8 ++ src/proto_alpha/lib_protocol/storage.mli | 3 + .../lib_protocol/test/helpers/block.ml | 3 +- .../validate/manager_operation_helpers.ml | 6 +- .../test/integration/validate/test_sanity.ml | 9 +- src/proto_alpha/lib_protocol/validate.ml | 1 + .../lib_sc_rollup_node/daemon_helpers.ml | 2 +- tezt/lib_tezos/RPC.ml | 6 ++ tezt/lib_tezos/RPC.mli | 8 ++ tezt/lib_tezos/operation_core.ml | 9 ++ tezt/lib_tezos/operation_core.mli | 2 + tezt/tests/main.ml | 1 + tezt/tests/protocol_dummy_counter.ml | 98 +++++++++++++++++++ 30 files changed, 507 insertions(+), 16 deletions(-) create mode 100644 src/proto_alpha/lib_protocol/dummy_counter_services.ml create mode 100644 src/proto_alpha/lib_protocol/dummy_counter_services.mli create mode 100644 src/proto_alpha/lib_protocol/dummy_counter_storage.ml create mode 100644 src/proto_alpha/lib_protocol/dummy_counter_storage.mli create mode 100644 tezt/tests/protocol_dummy_counter.ml diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index d82472539d74..e832fb5fa60b 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -337,6 +337,7 @@ let estimated_gas_single (type kind) match result with | Applied res | Backtracked (res, _) -> ( match res with + | Increase_counter {consumed_gas; _} | Transaction_result ( Transaction_to_contract_result {consumed_gas; _} | Transaction_to_sc_rollup_result {consumed_gas; _} @@ -423,6 +424,7 @@ let estimated_storage_single (type kind) ~origination_size | Transaction_result (Transaction_to_sc_rollup_result _) | Reveal_result _ | Delegation_result _ | Increase_paid_storage_result _ | Dal_publish_slot_header_result _ | Sc_rollup_add_messages_result _ + | Increase_counter _ (* The following Sc_rollup operations have zero storage cost because we consider them to be paid in the stake deposit. @@ -502,12 +504,13 @@ let originated_contracts_single (type kind) ( Transaction_to_sc_rollup_result _ | Transaction_to_zk_rollup_result _ ) | Register_global_constant_result _ | Reveal_result _ - | Delegation_result _ | Update_consensus_key_result _ - | Increase_paid_storage_result _ | Transfer_ticket_result _ - | Dal_publish_slot_header_result _ | Sc_rollup_originate_result _ - | Sc_rollup_add_messages_result _ | Sc_rollup_cement_result _ - | Sc_rollup_publish_result _ | Sc_rollup_refute_result _ - | Sc_rollup_timeout_result _ | Sc_rollup_execute_outbox_message_result _ + | Increase_counter _ | Delegation_result _ + | Update_consensus_key_result _ | Increase_paid_storage_result _ + | Transfer_ticket_result _ | Dal_publish_slot_header_result _ + | Sc_rollup_originate_result _ | Sc_rollup_add_messages_result _ + | Sc_rollup_cement_result _ | Sc_rollup_publish_result _ + | Sc_rollup_refute_result _ | Sc_rollup_timeout_result _ + | Sc_rollup_execute_outbox_message_result _ | Sc_rollup_recover_bond_result _ | Zk_rollup_origination_result _ | Zk_rollup_publish_result _ | Zk_rollup_update_result _ -> return_nil) diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index a5af9f2e7d63..7588a6da0018 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -201,6 +201,7 @@ let pp_manager_operation_content (type kind) source ppf source Signature.Public_key.pp key + | Increase_counter -> Format.fprintf ppf "Increase global counter by one" | Delegation delegate_opt -> ( Format.fprintf ppf "Delegation:@,Contract: %a@,To: " Contract.pp source ; match delegate_opt with @@ -633,6 +634,10 @@ let pp_operation_result ~operation_name pp_operation_result ppf = function (operation_name op_res) ; pp_operation_result ppf op_res +let pp_increase_counter ppf (Increase_counter {consumed_gas; new_counter}) = + pp_consumed_gas ppf consumed_gas ; + Format.fprintf ppf "@,Increased counter to: %d" @@ Z.to_int new_counter + let pp_manager_operation_contents_result ppf op_result = let pp_register_global_constant_result (Register_global_constant_result @@ -778,6 +783,7 @@ let pp_manager_operation_contents_result ppf op_result = (result : kind successful_manager_operation_result) = match result with | Reveal_result _ -> "revelation" + | Increase_counter _ -> "increase_counter" | Transaction_result _ -> "transaction" | Origination_result _ -> "origination" | Delegation_result _ -> "delegation" @@ -804,6 +810,7 @@ let pp_manager_operation_contents_result ppf op_result = (result : kind successful_manager_operation_result) = match result with | Reveal_result {consumed_gas} -> pp_consumed_gas ppf consumed_gas + | Increase_counter _ as op -> pp_increase_counter ppf op | Delegation_result {consumed_gas; balance_updates} -> pp_consumed_gas ppf consumed_gas ; pp_balance_updates ppf balance_updates diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index 93f8575e610d..6e5ea705e049 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -3637,6 +3637,41 @@ let commands_rw () = ~fee_parameter () in + return_unit); + command + ~group + ~desc:"Inject the Increase_counter manager operation" + (args2 default_fee_arg fee_parameter_args) + (prefixes ["increase"; "counter"] + @@ Public_key_hash.source_param ~name:"src" ~desc:"the delegate key" + @@ stop) + (fun (fee, fee_parameter) src_pkh (cctxt : Protocol_client_context.full) -> + let open Lwt_result_syntax in + let* _ = + let* _, src_pk, src_sk = Client_keys.get_key cctxt src_pkh in + let operation = Increase_counter in + let operation = + Annotated_manager_operation.Single_manager + (Injection.prepare_manager_operation + ~fee:(Limit.of_option fee) + ~gas_limit:Limit.unknown + ~storage_limit:Limit.unknown + operation) + in + Injection.inject_manager_operation + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~source:src_pkh + ~fee:(Limit.of_option fee) + ~gas_limit:Limit.unknown + ~storage_limit:Limit.unknown + ~src_pk + ~src_sk + ~fee_parameter + operation + in + return_unit); ] diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index 35301a9490ac..56f99e6c1cb9 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -207,10 +207,11 @@ "Sc_rollup_refutation_storage", "Zk_rollup_errors", + "Dummy_counter_storage", "Bootstrap_storage", "Init_storage", - "Destination_storage", + "Destination_storage", "Alpha_context", "Script_string", @@ -276,6 +277,7 @@ "Apply", "Services_registration", + "Dummy_counter_services", "Constants_services", "Sapling_services", "Contract_services", diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 7a48a69be63b..160b565b69c4 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -714,3 +714,7 @@ end module Internal_for_tests = struct let to_raw x = x end + +module Dummy_counter = struct + include Dummy_counter_storage +end diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 8b655fdb76fb..8c98df89916f 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -4265,6 +4265,8 @@ module Kind : sig type reveal = Reveal_kind + type increase_counter = Increase_counter_kind + type transaction = Transaction_kind type origination = Origination_kind @@ -4312,6 +4314,7 @@ module Kind : sig type 'a manager = | Reveal_manager_kind : reveal manager + | Increase_counter_manager_kind : increase_counter manager | Transaction_manager_kind : transaction manager | Origination_manager_kind : origination manager | Delegation_manager_kind : delegation manager @@ -4436,6 +4439,7 @@ and _ contents = and _ manager_operation = | Reveal : public_key -> Kind.reveal manager_operation + | Increase_counter : Kind.increase_counter manager_operation | Transaction : { amount : Tez.tez; parameters : Script.lazy_expr; @@ -4688,6 +4692,8 @@ module Operation : sig val reveal_case : Kind.reveal Kind.manager case + val increase_counter_case : Kind.increase_counter Kind.manager case + val transaction_case : Kind.transaction Kind.manager case val origination_case : Kind.origination Kind.manager case @@ -4747,6 +4753,8 @@ module Operation : sig val reveal_case : Kind.reveal case + val increase_counter_case : Kind.increase_counter case + val transaction_case : Kind.transaction case val origination_case : Kind.origination case @@ -5250,3 +5258,11 @@ module Fees : sig val check_storage_limit : context -> storage_limit:Z.t -> unit tzresult end + +module Dummy_counter : sig + val get : context -> Z.t option tzresult Lwt.t + + val get_or_init : context -> (context * Z.t, error trace) result Lwt.t + + val increase_counter : context -> (context, error trace) result Lwt.t +end diff --git a/src/proto_alpha/lib_protocol/alpha_services.ml b/src/proto_alpha/lib_protocol/alpha_services.ml index b7b33e8b7bf8..ec005198ad41 100644 --- a/src/proto_alpha/lib_protocol/alpha_services.ml +++ b/src/proto_alpha/lib_protocol/alpha_services.ml @@ -336,6 +336,8 @@ module Denunciations = struct RPC_context.make_call0 S.denunciations ctxt block () () end +module Dummy_counter = Dummy_counter_services + let register () = Contract.register () ; Constants.register () ; @@ -347,4 +349,5 @@ let register () = Liquidity_baking.register () ; Cache.register () ; Adaptive_issuance.register () ; - Denunciations.register () + Denunciations.register () ; + Dummy_counter.register () diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 710b7bac1d37..50e70f26834f 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1123,6 +1123,16 @@ let apply_manager_operation : ~parameter:(Untyped_arg parameters) in (ctxt, Transaction_result res, ops) + | Increase_counter -> + let* ctxt = Dummy_counter.increase_counter ctxt in + let+ ctxt, counter = Dummy_counter.get_or_init ctxt in + ( ctxt, + Increase_counter + { + consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt; + new_counter = counter; + }, + [] ) | Transfer_ticket {contents; ty; ticketer; amount; destination; entrypoint} -> ( match destination with @@ -1691,6 +1701,7 @@ let burn_manager_storage_fees : size_of_constant = payload.size_of_constant; global_address = payload.global_address; } ) + | Increase_counter _ -> return (ctxt, storage_limit, smopr) | Update_consensus_key_result _ -> return (ctxt, storage_limit, smopr) | Increase_paid_storage_result _ -> return (ctxt, storage_limit, smopr) | Transfer_ticket_result payload -> diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index 4c43948711b7..b9b34eb08da3 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -40,6 +40,11 @@ type _ successful_manager_operation_result = consumed_gas : Gas.Arith.fp; } -> Kind.reveal successful_manager_operation_result + | Increase_counter : { + consumed_gas : Gas.Arith.fp; + new_counter : Z.t; + } + -> Kind.increase_counter successful_manager_operation_result | Transaction_result : successful_transaction_result -> Kind.transaction successful_manager_operation_result @@ -267,6 +272,24 @@ module Manager_result = struct ~proj:(function Reveal_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Reveal_result {consumed_gas}) + let increase_counter_case = + make + ~op_case:Operation.Encoding.Manager_operations.increase_counter_case + ~encoding: + Data_encoding.( + obj2 + (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero) + (req "counter" z)) + ~select:(function + | Successful_manager_result (Increase_counter _ as op) -> Some op + | _ -> None) + ~kind:Kind.Increase_counter_manager_kind + ~proj:(function + | Increase_counter {consumed_gas; new_counter} -> + (consumed_gas, new_counter)) + ~inj:(fun (consumed_gas, new_counter) -> + Increase_counter {consumed_gas; new_counter}) + let transaction_contract_variant_cases = let case = function | Tag tag -> @@ -882,6 +905,7 @@ let successful_manager_operation_result_encoding : @@ union [ make Manager_result.reveal_case; + make Manager_result.increase_counter_case; make Manager_result.transaction_case; make Manager_result.origination_case; make Manager_result.delegation_case; @@ -957,6 +981,9 @@ let equal_manager_kind : match (ka, kb) with | Kind.Reveal_manager_kind, Kind.Reveal_manager_kind -> Some Eq | Kind.Reveal_manager_kind, _ -> None + | Kind.Increase_counter_manager_kind, Kind.Increase_counter_manager_kind -> + Some Eq + | Kind.Increase_counter_manager_kind, _ -> None | Kind.Transaction_manager_kind, Kind.Transaction_manager_kind -> Some Eq | Kind.Transaction_manager_kind, _ -> None | Kind.Origination_manager_kind, Kind.Origination_manager_kind -> Some Eq @@ -1523,6 +1550,17 @@ module Encoding = struct Some (op, res) | _ -> None) + let increase_counter_case = + make_manager_case + Operation.Encoding.increase_counter_case + Manager_result.increase_counter_case + (function + | Contents_and_result + ((Manager_operation {operation = Increase_counter; _} as op), res) + -> + Some (op, res) + | _ -> None) + let transaction_case = make_manager_case Operation.Encoding.transaction_case @@ -1745,6 +1783,7 @@ let common_cases = ballot_case; drain_delegate_case; reveal_case; + increase_counter_case; transaction_case; origination_case; delegation_case; @@ -2050,6 +2089,31 @@ let kind_equal : } ) -> Some Eq | Manager_operation {operation = Transaction _; _}, _ -> None + | ( Manager_operation {operation = Increase_counter; _}, + Manager_operation_result + {operation_result = Applied (Increase_counter _); _} ) -> + Some Eq + | ( Manager_operation {operation = Increase_counter; _}, + Manager_operation_result + {operation_result = Backtracked (Increase_counter _, _); _} ) -> + Some Eq + | ( Manager_operation {operation = Increase_counter; _}, + Manager_operation_result + { + operation_result = + Failed (Alpha_context.Kind.Increase_counter_manager_kind, _); + _; + } ) -> + Some Eq + | ( Manager_operation {operation = Increase_counter; _}, + Manager_operation_result + { + operation_result = + Skipped Alpha_context.Kind.Increase_counter_manager_kind; + _; + } ) -> + Some Eq + | Manager_operation {operation = Increase_counter; _}, _ -> None | ( Manager_operation {operation = Origination _; _}, Manager_operation_result {operation_result = Applied (Origination_result _); _} ) -> diff --git a/src/proto_alpha/lib_protocol/apply_results.mli b/src/proto_alpha/lib_protocol/apply_results.mli index 1f8edf1eb8e9..b721f28fd02e 100644 --- a/src/proto_alpha/lib_protocol/apply_results.mli +++ b/src/proto_alpha/lib_protocol/apply_results.mli @@ -131,6 +131,11 @@ and _ successful_manager_operation_result = consumed_gas : Gas.Arith.fp; } -> Kind.reveal successful_manager_operation_result + | Increase_counter : { + consumed_gas : Gas.Arith.fp; + new_counter : Z.t; + } + -> Kind.increase_counter successful_manager_operation_result | Transaction_result : successful_transaction_result -> Kind.transaction successful_manager_operation_result diff --git a/src/proto_alpha/lib_protocol/dummy_counter_services.ml b/src/proto_alpha/lib_protocol/dummy_counter_services.ml new file mode 100644 index 000000000000..15dc469ab325 --- /dev/null +++ b/src/proto_alpha/lib_protocol/dummy_counter_services.ml @@ -0,0 +1,44 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Trilitech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +module S = struct + let path = RPC_path.(open_root / "dummy_counter") + + let current_value = + RPC_service.get_service + ~description:"Current value of the global dummy counter" + ~query:RPC_query.empty + ~output:Data_encoding.z + RPC_path.(path / "get") +end + +let register () = + let open Lwt_result_syntax in + let open Services_registration in + register0 ~chunked:false S.current_value (fun ctxt () () -> + let* rez = Dummy_counter.get ctxt in + match rez with None -> return Z.zero | Some r -> return r) diff --git a/src/proto_alpha/lib_protocol/dummy_counter_services.mli b/src/proto_alpha/lib_protocol/dummy_counter_services.mli new file mode 100644 index 000000000000..6063600490c9 --- /dev/null +++ b/src/proto_alpha/lib_protocol/dummy_counter_services.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Trilitech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val register : unit -> unit diff --git a/src/proto_alpha/lib_protocol/dummy_counter_storage.ml b/src/proto_alpha/lib_protocol/dummy_counter_storage.ml new file mode 100644 index 000000000000..a3ee365819eb --- /dev/null +++ b/src/proto_alpha/lib_protocol/dummy_counter_storage.ml @@ -0,0 +1,57 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Trilitech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt_result_syntax + +(** Un comment the [initd] and {!val:internal_get} for the implementation using [init] instead of [find]. + For some reason [init] is throwing a [Missing key error] *) +(* let initd = ref false + + let internal_get ctxt = + match !initd with + | false -> + let* ctxt = Storage.Dummy_counter_storage.init ctxt Z.zero in + initd := true; + return (ctxt, Z.zero) + | true -> + let* counter = Storage.Dummy_counter_storage.get ctxt in + return (ctxt, counter) *) + +let get = Storage.Dummy_counter_storage.find + +let get_or_init ctxt = + let* counter = get ctxt in + match counter with + | None -> + let* ctxt = Storage.Dummy_counter_storage.init ctxt Z.zero in + return (ctxt, Z.zero) + | Some counter -> return (ctxt, counter) + +let increase_counter ctxt = + let* ctxt, rez = get_or_init ctxt in + let*! ctxt = + Storage.Dummy_counter_storage.add ctxt @@ Z.add rez @@ Z.of_int 1 + in + return ctxt diff --git a/src/proto_alpha/lib_protocol/dummy_counter_storage.mli b/src/proto_alpha/lib_protocol/dummy_counter_storage.mli new file mode 100644 index 000000000000..ac8f5b2efdd4 --- /dev/null +++ b/src/proto_alpha/lib_protocol/dummy_counter_storage.mli @@ -0,0 +1,32 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Trilitech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val get : Raw_context.t -> Z.t option tzresult Lwt.t + +val get_or_init : + Raw_context.t -> (Raw_context.t * Z.t, error trace) result Lwt.t + +val increase_counter : + Raw_context.t -> (Raw_context.t, error trace) result Lwt.t diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index 6cf514ca8cdc..fe2ee1ab20bf 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -218,6 +218,7 @@ Dal_slot_storage Sc_rollup_refutation_storage Zk_rollup_errors + Dummy_counter_storage Bootstrap_storage Init_storage Destination_storage @@ -278,6 +279,7 @@ Mempool_validation Apply Services_registration + Dummy_counter_services Constants_services Sapling_services Contract_services @@ -513,6 +515,7 @@ dal_slot_storage.ml dal_slot_storage.mli sc_rollup_refutation_storage.ml sc_rollup_refutation_storage.mli zk_rollup_errors.ml + dummy_counter_storage.ml dummy_counter_storage.mli bootstrap_storage.ml bootstrap_storage.mli init_storage.ml init_storage.mli destination_storage.ml destination_storage.mli @@ -573,6 +576,7 @@ mempool_validation.ml mempool_validation.mli apply.ml apply.mli services_registration.ml services_registration.mli + dummy_counter_services.ml dummy_counter_services.mli constants_services.ml constants_services.mli sapling_services.ml contract_services.ml contract_services.mli @@ -809,6 +813,7 @@ dal_slot_storage.ml dal_slot_storage.mli sc_rollup_refutation_storage.ml sc_rollup_refutation_storage.mli zk_rollup_errors.ml + dummy_counter_storage.ml dummy_counter_storage.mli bootstrap_storage.ml bootstrap_storage.mli init_storage.ml init_storage.mli destination_storage.ml destination_storage.mli @@ -869,6 +874,7 @@ mempool_validation.ml mempool_validation.mli apply.ml apply.mli services_registration.ml services_registration.mli + dummy_counter_services.ml dummy_counter_services.mli constants_services.ml constants_services.mli sapling_services.ml contract_services.ml contract_services.mli @@ -1089,6 +1095,7 @@ dal_slot_storage.ml dal_slot_storage.mli sc_rollup_refutation_storage.ml sc_rollup_refutation_storage.mli zk_rollup_errors.ml + dummy_counter_storage.ml dummy_counter_storage.mli bootstrap_storage.ml bootstrap_storage.mli init_storage.ml init_storage.mli destination_storage.ml destination_storage.mli @@ -1149,6 +1156,7 @@ mempool_validation.ml mempool_validation.mli apply.ml apply.mli services_registration.ml services_registration.mli + dummy_counter_services.ml dummy_counter_services.mli constants_services.ml constants_services.mli sapling_services.ml contract_services.ml contract_services.mli diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml index 1a9681d589cb..60e59ee2770d 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/operation_repr.ml @@ -64,6 +64,8 @@ module Kind = struct type reveal = Reveal_kind + type increase_counter = Increase_counter_kind + type transaction = Transaction_kind type origination = Origination_kind @@ -111,6 +113,7 @@ module Kind = struct type 'a manager = | Reveal_manager_kind : reveal manager + | Increase_counter_manager_kind : increase_counter manager | Transaction_manager_kind : transaction manager | Origination_manager_kind : origination manager | Delegation_manager_kind : delegation manager @@ -300,6 +303,7 @@ and _ contents = and _ manager_operation = | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation + | Increase_counter : Kind.increase_counter manager_operation | Transaction : { amount : Tez_repr.tez; parameters : Script_repr.lazy_expr; @@ -403,6 +407,7 @@ and _ manager_operation = let manager_kind : type kind. kind manager_operation -> kind Kind.manager = function | Reveal _ -> Kind.Reveal_manager_kind + | Increase_counter -> Kind.Increase_counter_manager_kind | Transaction _ -> Kind.Transaction_manager_kind | Origination _ -> Kind.Origination_manager_kind | Delegation _ -> Kind.Delegation_manager_kind @@ -592,6 +597,18 @@ module Encoding = struct inj = (fun pkh -> Reveal pkh); } + let increase_counter_case = + MCase + { + tag = 123; + name = "increase_counter"; + encoding = Data_encoding.empty; + select = + (function Manager (Increase_counter as op) -> Some op | _ -> None); + proj = (function Increase_counter -> ()); + inj = (fun _ -> Increase_counter); + } + let transaction_case = MCase { @@ -1430,6 +1447,9 @@ module Encoding = struct inj = (fun (op, contents) -> rebuild op (mcase.inj contents)); } + let increase_counter_case = + make_manager_case 106 Manager_operations.increase_counter_case + let reveal_case = make_manager_case 107 Manager_operations.reveal_case let transaction_case = @@ -1528,6 +1548,7 @@ module Encoding = struct PCase proposals_case; PCase ballot_case; PCase reveal_case; + PCase increase_counter_case; PCase transaction_case; PCase origination_case; PCase delegation_case; @@ -1977,6 +1998,8 @@ let equal_manager_operation_kind : match (op1, op2) with | Reveal _, Reveal _ -> Some Eq | Reveal _, _ -> None + | Increase_counter, Increase_counter -> Some Eq + | Increase_counter, _ -> None | Transaction _, Transaction _ -> Some Eq | Transaction _, _ -> None | Origination _, Origination _ -> Some Eq diff --git a/src/proto_alpha/lib_protocol/operation_repr.mli b/src/proto_alpha/lib_protocol/operation_repr.mli index caccb54f0232..bfeec95c31a7 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.mli +++ b/src/proto_alpha/lib_protocol/operation_repr.mli @@ -39,7 +39,7 @@ - failing noop - manager operation (which in turn has several types): - revelation - - transaction + - transaction - origination - delegation - set deposits limitation @@ -98,6 +98,8 @@ module Kind : sig type reveal = Reveal_kind + type increase_counter = Increase_counter_kind + type transaction = Transaction_kind type origination = Origination_kind @@ -145,6 +147,7 @@ module Kind : sig type 'a manager = | Reveal_manager_kind : reveal manager + | Increase_counter_manager_kind : increase_counter manager | Transaction_manager_kind : transaction manager | Origination_manager_kind : origination manager | Delegation_manager_kind : delegation manager @@ -337,6 +340,8 @@ and _ manager_operation = prerequisite to any signed operation, in order to be able to check the sender’s signature. *) | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation + (* [Increase_counter] increses the special global chain constant *) + | Increase_counter : Kind.increase_counter manager_operation (* [Transaction] of some amount to some destination contract. It can also be used to execute/call smart-contracts. *) | Transaction : { @@ -708,6 +713,8 @@ module Encoding : sig val reveal_case : Kind.reveal Kind.manager case + val increase_counter_case : Kind.increase_counter Kind.manager case + val transaction_case : Kind.transaction Kind.manager case val origination_case : Kind.origination Kind.manager case @@ -765,6 +772,8 @@ module Encoding : sig val reveal_case : Kind.reveal case + val increase_counter_case : Kind.increase_counter case + val transaction_case : Kind.transaction case val origination_case : Kind.origination case diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index 4fb55ad496ec..855a3a882ae9 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -2338,3 +2338,11 @@ module Legacy = struct end) (Tenderbake.Branch) end + +module Dummy_counter_storage : + Single_data_storage with type t = Raw_context.t with type value = Z.t = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["dummy_counter"] + end) + (Encoding.Z) diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index 56a187abbc10..678a2861b1a7 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -1098,3 +1098,6 @@ module Legacy : sig with type value = Block_hash.t * Block_payload_hash.t and type t := Raw_context.t end + +module Dummy_counter_storage : + Single_data_storage with type t = Raw_context.t with type value = Z.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index ef72163eca90..e75b136f33de 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -1069,7 +1069,7 @@ let balance_update_of_operation_result : match siopr with | Protocol.Apply_results.Transaction_result (Transaction_to_sc_rollup_result _) - | Reveal_result _ | Update_consensus_key_result _ + | Reveal_result _ | Update_consensus_key_result _ | Increase_counter _ | Transfer_ticket_result _ | Dal_publish_slot_header_result _ | Sc_rollup_originate_result _ | Sc_rollup_add_messages_result _ | Sc_rollup_cement_result _ | Sc_rollup_publish_result _ @@ -1178,6 +1178,7 @@ let bake_n_with_origination_results ?baking_mode ?policy n b = let open Apply_results in function | Successful_manager_result (Reveal_result _) + | Successful_manager_result (Increase_counter _) | Successful_manager_result (Delegation_result _) | Successful_manager_result (Update_consensus_key_result _) | Successful_manager_result (Transaction_result _) diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml b/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml index ef6d9ec573b0..db4e835a4d7a 100644 --- a/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml @@ -75,6 +75,7 @@ type infos = {ctxt : ctxt; accounts : accounts; flags : feature_flags} new manager_operation kind. *) type manager_operation_kind = | K_Transaction + | K_Increase_counter | K_Origination | K_Register_global_constant | K_Delegation @@ -167,6 +168,7 @@ let operation_req_default kind = (** {2 String_of data} *) let kind_to_string = function | K_Transaction -> "Transaction" + | K_Increase_counter -> "Increase_counter" | K_Delegation -> "Delegation" | K_Undelegation -> "Undelegation" | K_Self_delegation -> "Self-delegation" @@ -976,6 +978,7 @@ let select_op (op_req : operation_req) (infos : infos) = let mk_op = match op_req.kind with | K_Transaction -> mk_transaction + | K_Increase_counter -> mk_transaction | K_Origination -> mk_origination | K_Register_global_constant -> mk_register_global_constant | K_Delegation -> mk_delegation @@ -1374,7 +1377,7 @@ let is_consumer = function | K_Zk_rollup_update -> false | K_Transaction | K_Origination | K_Register_global_constant - | K_Transfer_ticket -> + | K_Increase_counter | K_Transfer_ticket -> true let gas_consumer_in_validate_subjects, not_gas_consumer_in_validate_subjects = @@ -1388,6 +1391,7 @@ let is_disabled flags = function | K_Undelegation | K_Self_delegation | K_Update_consensus_key | K_Increase_paid_storage | K_Reveal | K_Transfer_ticket -> false + | K_Increase_counter -> false | K_Sc_rollup_origination | K_Sc_rollup_publish | K_Sc_rollup_cement | K_Sc_rollup_add_messages | K_Sc_rollup_refute | K_Sc_rollup_timeout | K_Sc_rollup_execute_outbox_message | K_Sc_rollup_recover_bond -> diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/test_sanity.ml b/src/proto_alpha/lib_protocol/test/integration/validate/test_sanity.ml index 439db456ea92..143885cd7490 100644 --- a/src/proto_alpha/lib_protocol/test/integration/validate/test_sanity.ml +++ b/src/proto_alpha/lib_protocol/test/integration/validate/test_sanity.ml @@ -58,6 +58,7 @@ let ensure_kind infos kind = match (operation, kind) with | Transaction _, K_Transaction | Reveal _, K_Reveal + | Increase_counter, K_Increase_counter | Origination _, K_Origination | Delegation _, K_Delegation | Delegation _, K_Undelegation @@ -80,10 +81,10 @@ let ensure_kind infos kind = | Zk_rollup_update _, K_Zk_rollup_update -> return_unit | ( ( Transaction _ | Origination _ | Register_global_constant _ - | Delegation _ | Update_consensus_key _ | Increase_paid_storage _ - | Reveal _ | Transfer_ticket _ | Sc_rollup_originate _ - | Sc_rollup_publish _ | Sc_rollup_cement _ | Sc_rollup_add_messages _ - | Sc_rollup_refute _ | Sc_rollup_timeout _ + | Increase_counter | Delegation _ | Update_consensus_key _ + | Increase_paid_storage _ | Reveal _ | Transfer_ticket _ + | Sc_rollup_originate _ | Sc_rollup_publish _ | Sc_rollup_cement _ + | Sc_rollup_add_messages _ | Sc_rollup_refute _ | Sc_rollup_timeout _ | Sc_rollup_execute_outbox_message _ | Sc_rollup_recover_bond _ | Dal_publish_slot_header _ | Zk_rollup_origination _ | Zk_rollup_publish _ | Zk_rollup_update _ ), diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml index e57dc23b4dd0..8f014c064373 100644 --- a/src/proto_alpha/lib_protocol/validate.ml +++ b/src/proto_alpha/lib_protocol/validate.ml @@ -2113,6 +2113,7 @@ module Manager = struct consume_decoding_gas remaining_gas parameters in return_unit + | Increase_counter -> return_unit | Origination {script; _} -> let* remaining_gas = consume_decoding_gas remaining_gas script.code in let* (_ : Gas.Arith.fp) = diff --git a/src/proto_alpha/lib_sc_rollup_node/daemon_helpers.ml b/src/proto_alpha/lib_sc_rollup_node/daemon_helpers.ml index 3326d63442e3..abf17290b2cb 100644 --- a/src/proto_alpha/lib_sc_rollup_node/daemon_helpers.ml +++ b/src/proto_alpha/lib_sc_rollup_node/daemon_helpers.ml @@ -322,7 +322,7 @@ let process_l1_operation (type kind) ~catching_up node_ctxt Sc_rollup.Address.( rollup = node_ctxt.Node_context.config.sc_rollup_address) | Dal_publish_slot_header _ -> true - | Reveal _ | Transaction _ | Origination _ | Delegation _ + | Reveal _ | Transaction _ | Origination _ | Delegation _ | Increase_counter | Update_consensus_key _ | Register_global_constant _ | Increase_paid_storage _ | Transfer_ticket _ | Sc_rollup_originate _ | Zk_rollup_origination _ | Zk_rollup_publish _ | Zk_rollup_update _ -> diff --git a/tezt/lib_tezos/RPC.ml b/tezt/lib_tezos/RPC.ml index bc1d6c702fca..5dd14d3971a9 100644 --- a/tezt/lib_tezos/RPC.ml +++ b/tezt/lib_tezos/RPC.ml @@ -206,6 +206,12 @@ let get_chain_block_context_liquidity_baking_cpmm_address ?(chain = "main") ] JSON.as_string +let get_chain_context_dummy_counter ?(chain = "main") ?(block = "head") () = + make + GET + ["chains"; chain; "blocks"; block; "dummy_counter"; "get"] + JSON.as_string + let get_network_peer_untrust peer_id = make GET ["network"; "peers"; peer_id; "untrust"] Fun.id diff --git a/tezt/lib_tezos/RPC.mli b/tezt/lib_tezos/RPC.mli index 9070ac5a45e1..560c1ffd193f 100644 --- a/tezt/lib_tezos/RPC.mli +++ b/tezt/lib_tezos/RPC.mli @@ -182,6 +182,14 @@ val get_chain_block_helper_round : val get_chain_block_context_liquidity_baking_cpmm_address : ?chain:string -> ?block:string -> unit -> string t +(** RPC: [GET /chains//blocks//context/dummy_counter/get] + + [chain] defaults to ["main"]. + [block] defaults to ["head"]. +*) +val get_chain_context_dummy_counter : + ?chain:string -> ?block:string -> unit -> string t + (** RPC: [GET /network/peers] *) val get_network_peers : (string * JSON.t) list t diff --git a/tezt/lib_tezos/operation_core.ml b/tezt/lib_tezos/operation_core.ml index 9c672d3a8ce2..3172175f3664 100644 --- a/tezt/lib_tezos/operation_core.ml +++ b/tezt/lib_tezos/operation_core.ml @@ -569,6 +569,7 @@ module Manager = struct type transfer_parameters = {entrypoint : string; arg : JSON.u} type payload = + | Increase_counter | Reveal of Account.key | Transfer of { amount : int; @@ -589,6 +590,8 @@ module Manager = struct refutation : sc_rollup_refutation; } + let increase_counter = Increase_counter + let reveal account = Reveal account let transfer ?(dest = Constant.bootstrap2) ?(amount = 1_000_000) () = @@ -619,6 +622,7 @@ module Manager = struct } let json_payload_binding = function + | Increase_counter -> [("kind", `String "increase_counter")] | Reveal account -> [("kind", `String "reveal"); ("public_key", `String account.public_key)] | Transfer {amount; dest; parameters} -> @@ -710,6 +714,11 @@ module Manager = struct operation. They are close from the default values set by the client. *) match payload with + | Increase_counter -> + let fee = Option.value fee ~default:1_450 in + let gas_limit = Option.value gas_limit ~default:1_490 in + let storage_limit = Option.value storage_limit ~default:0 in + {source; counter; fee; gas_limit; storage_limit; payload} | Transfer _ -> let fee = Option.value fee ~default:1_000 in let gas_limit = Option.value gas_limit ~default:1_040 in diff --git a/tezt/lib_tezos/operation_core.mli b/tezt/lib_tezos/operation_core.mli index cc7eac16324c..da605d6b4031 100644 --- a/tezt/lib_tezos/operation_core.mli +++ b/tezt/lib_tezos/operation_core.mli @@ -450,6 +450,8 @@ module Manager : sig common to all manager operations. See {!type:t}. *) type payload + val increase_counter : payload + (** Build a public key revelation. The [Account.key] argument has no default value because it will diff --git a/tezt/tests/main.ml b/tezt/tests/main.ml index b18b4c29d47d..f32815f66821 100644 --- a/tezt/tests/main.ml +++ b/tezt/tests/main.ml @@ -224,6 +224,7 @@ let register_protocol_specific_because_regression_tests () = Dal.register ~protocols:[Alpha] ; Evm_rollup.register ~protocols:[Alpha] ; Sc_sequencer.register ~protocols:[Alpha] ; + Protocol_dummy_counter.register ~protocols:[Alpha] ; (* This can be safely removed after Nairobi is frozen *) Timelock_disabled.register ~protocols:[Nairobi] diff --git a/tezt/tests/protocol_dummy_counter.ml b/tezt/tests/protocol_dummy_counter.ml new file mode 100644 index 000000000000..ba17a78e8661 --- /dev/null +++ b/tezt/tests/protocol_dummy_counter.ml @@ -0,0 +1,98 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Trilitech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Testing + ------- + Component: Protocol + Invocation: dune exec tezt/tests/main.exe -- --file protocol_dummy_counter.ml + Subject: Test the dummy counter functionalities, baking the manager operation and the rpc to get the value +*) + +let test_dummy_counter = + Protocol.register_test + ~__FILE__ + ~title:"protocol dummy counter" + ~tags:["mockup"; "protocol"; "counter"] + @@ fun protocol -> + let string_check arg expected ~__LOC__ = + Check.(arg = expected) + ~__LOC__ + Check.string + ~error_msg:"expected %R, but got %L" + in + + let alice = Constant.bootstrap1 in + let bob = Constant.bootstrap2 in + + (* Init node and client with alpha protocol *) + let* node, client = + Client.init_with_protocol + ~nodes_args:[Synchronisation_threshold 0] + ~protocol + `Client + () + in + + (* Utility functions *) + let do_bake () = Client.bake_for_and_wait ~node client in + let rpc_get_counter () = + Client.RPC.call client @@ RPC.get_chain_context_dummy_counter () + in + let increase_op signer () = + let manager_op = Operation.Manager.(make ~source:signer increase_counter) in + let* manager_op = Operation.Manager.operation ~signer [manager_op] client in + Operation.inject manager_op client + in + let alice_op = increase_op alice in + let bob_op = increase_op bob in + + (* Check value from rpc endpoint *) + let* res_0 = rpc_get_counter () in + + string_check res_0 "0" ~__LOC__ ; + + (* Only alice increases counter *) + let* _ = alice_op () in + let* res_0 = rpc_get_counter () in + let* _ = do_bake () in + let* res_1 = rpc_get_counter () in + + string_check res_0 "0" ~__LOC__ ; + string_check res_1 "1" ~__LOC__ ; + + (* Alice injects two operations and Bob one *) + let* _ = alice_op () in + let* _ = alice_op () in + let* _ = bob_op () in + let* res_1 = rpc_get_counter () in + let* _ = do_bake () in + let* res_3 = rpc_get_counter () in + + string_check res_1 "1" ~__LOC__ ; + string_check res_3 "3" ~__LOC__ ; + + return () + +let register ~protocols = test_dummy_counter protocols -- GitLab From eb7a54252c7a704cac14c03839ac396ad3801e9e Mon Sep 17 00:00:00 2001 From: Felix Puscasu Date: Wed, 8 Nov 2023 12:28:25 +0000 Subject: [PATCH 2/6] Review comments --- .../lib_protocol/dummy_counter_storage.ml | 16 ++---------- .../lib_protocol/dummy_counter_storage.mli | 9 +++++-- src/proto_alpha/lib_protocol/storage.mli | 4 +++ tezt/lib_tezos/RPC.ml | 2 +- tezt/lib_tezos/RPC.mli | 2 +- tezt/lib_tezos/operation_core.mli | 1 + tezt/tests/protocol_dummy_counter.ml | 26 ++++++------------- 7 files changed, 24 insertions(+), 36 deletions(-) diff --git a/src/proto_alpha/lib_protocol/dummy_counter_storage.ml b/src/proto_alpha/lib_protocol/dummy_counter_storage.ml index a3ee365819eb..ebc6b2461e2e 100644 --- a/src/proto_alpha/lib_protocol/dummy_counter_storage.ml +++ b/src/proto_alpha/lib_protocol/dummy_counter_storage.ml @@ -25,20 +25,8 @@ open Lwt_result_syntax -(** Un comment the [initd] and {!val:internal_get} for the implementation using [init] instead of [find]. - For some reason [init] is throwing a [Missing key error] *) -(* let initd = ref false - - let internal_get ctxt = - match !initd with - | false -> - let* ctxt = Storage.Dummy_counter_storage.init ctxt Z.zero in - initd := true; - return (ctxt, Z.zero) - | true -> - let* counter = Storage.Dummy_counter_storage.get ctxt in - return (ctxt, counter) *) - +(* TODO: investigate why using init without calling + find first crashes with [Missing key error] *) let get = Storage.Dummy_counter_storage.find let get_or_init ctxt = diff --git a/src/proto_alpha/lib_protocol/dummy_counter_storage.mli b/src/proto_alpha/lib_protocol/dummy_counter_storage.mli index ac8f5b2efdd4..00108ad52ea4 100644 --- a/src/proto_alpha/lib_protocol/dummy_counter_storage.mli +++ b/src/proto_alpha/lib_protocol/dummy_counter_storage.mli @@ -23,10 +23,15 @@ (* *) (*****************************************************************************) +(* Get the counter value, return None if it wasn't initialised *) val get : Raw_context.t -> Z.t option tzresult Lwt.t +(* Get the counter value. If it wasn't initialised, + initialise with the default value [0] *) val get_or_init : - Raw_context.t -> (Raw_context.t * Z.t, error trace) result Lwt.t + Raw_context.t -> (Raw_context.t * Z.t) tzresult Lwt.t +(* Increasees the counter by [1] by using [get_or_init], + thus being initialised if needed *) val increase_counter : - Raw_context.t -> (Raw_context.t, error trace) result Lwt.t + Raw_context.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index 678a2861b1a7..98dc77d69693 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -1099,5 +1099,9 @@ module Legacy : sig and type t := Raw_context.t end +(** Dummy counter storage + + Stores the integer value of the counter +*) module Dummy_counter_storage : Single_data_storage with type t = Raw_context.t with type value = Z.t diff --git a/tezt/lib_tezos/RPC.ml b/tezt/lib_tezos/RPC.ml index 5dd14d3971a9..a293630104db 100644 --- a/tezt/lib_tezos/RPC.ml +++ b/tezt/lib_tezos/RPC.ml @@ -210,7 +210,7 @@ let get_chain_context_dummy_counter ?(chain = "main") ?(block = "head") () = make GET ["chains"; chain; "blocks"; block; "dummy_counter"; "get"] - JSON.as_string + JSON.as_int64 let get_network_peer_untrust peer_id = make GET ["network"; "peers"; peer_id; "untrust"] Fun.id diff --git a/tezt/lib_tezos/RPC.mli b/tezt/lib_tezos/RPC.mli index 560c1ffd193f..ff2a3dd0b29b 100644 --- a/tezt/lib_tezos/RPC.mli +++ b/tezt/lib_tezos/RPC.mli @@ -188,7 +188,7 @@ val get_chain_block_context_liquidity_baking_cpmm_address : [block] defaults to ["head"]. *) val get_chain_context_dummy_counter : - ?chain:string -> ?block:string -> unit -> string t + ?chain:string -> ?block:string -> unit -> int64 t (** RPC: [GET /network/peers] *) val get_network_peers : (string * JSON.t) list t diff --git a/tezt/lib_tezos/operation_core.mli b/tezt/lib_tezos/operation_core.mli index da605d6b4031..94b8714fe683 100644 --- a/tezt/lib_tezos/operation_core.mli +++ b/tezt/lib_tezos/operation_core.mli @@ -450,6 +450,7 @@ module Manager : sig common to all manager operations. See {!type:t}. *) type payload + (** Build an [Increase_counter] manager operation *) val increase_counter : payload (** Build a public key revelation. diff --git a/tezt/tests/protocol_dummy_counter.ml b/tezt/tests/protocol_dummy_counter.ml index ba17a78e8661..43d0315afa60 100644 --- a/tezt/tests/protocol_dummy_counter.ml +++ b/tezt/tests/protocol_dummy_counter.ml @@ -36,16 +36,14 @@ let test_dummy_counter = ~title:"protocol dummy counter" ~tags:["mockup"; "protocol"; "counter"] @@ fun protocol -> - let string_check arg expected ~__LOC__ = + let int_check arg expected ~__LOC__ = Check.(arg = expected) ~__LOC__ - Check.string + Check.int64 ~error_msg:"expected %R, but got %L" in - let alice = Constant.bootstrap1 in let bob = Constant.bootstrap2 in - (* Init node and client with alpha protocol *) let* node, client = Client.init_with_protocol @@ -54,7 +52,6 @@ let test_dummy_counter = `Client () in - (* Utility functions *) let do_bake () = Client.bake_for_and_wait ~node client in let rpc_get_counter () = @@ -67,21 +64,16 @@ let test_dummy_counter = in let alice_op = increase_op alice in let bob_op = increase_op bob in - - (* Check value from rpc endpoint *) + (* Check value from rpc endpoint before any commands *) let* res_0 = rpc_get_counter () in - - string_check res_0 "0" ~__LOC__ ; - + int_check res_0 0L ~__LOC__ ; (* Only alice increases counter *) let* _ = alice_op () in let* res_0 = rpc_get_counter () in let* _ = do_bake () in let* res_1 = rpc_get_counter () in - - string_check res_0 "0" ~__LOC__ ; - string_check res_1 "1" ~__LOC__ ; - + int_check res_0 0L ~__LOC__ ; + int_check res_1 1L ~__LOC__ ; (* Alice injects two operations and Bob one *) let* _ = alice_op () in let* _ = alice_op () in @@ -89,10 +81,8 @@ let test_dummy_counter = let* res_1 = rpc_get_counter () in let* _ = do_bake () in let* res_3 = rpc_get_counter () in - - string_check res_1 "1" ~__LOC__ ; - string_check res_3 "3" ~__LOC__ ; - + int_check res_1 1L ~__LOC__ ; + int_check res_3 3L ~__LOC__ ; return () let register ~protocols = test_dummy_counter protocols -- GitLab From bf0b16f56e78e31eb131b9104e402e8a15e79bb5 Mon Sep 17 00:00:00 2001 From: Felix Puscasu Date: Thu, 9 Nov 2023 17:03:03 +0000 Subject: [PATCH 3/6] added new instruction Increase_counter in michelson --- .../lib_benchmarks_proto/interpreter_model.ml | 2 +- .../interpreter_workload.ml | 5 ++++ src/proto_alpha/lib_client/injection.ml | 13 ++++++----- .../lib_client/operation_result.ml | 14 +++++++---- src/proto_alpha/lib_plugin/RPC.ml | 1 + .../lib_plugin/script_interpreter_logging.ml | 8 +++++++ .../lib_protocol/alpha_context.mli | 1 + src/proto_alpha/lib_protocol/apply.ml | 16 +++++++++++-- .../lib_protocol/apply_internal_results.ml | 12 ++++++++++ .../lib_protocol/apply_internal_results.mli | 11 +++++++++ src/proto_alpha/lib_protocol/apply_results.ml | 12 +++++----- .../lib_protocol/apply_results.mli | 2 +- .../lib_protocol/michelson_v1_gas.ml | 4 +++- .../lib_protocol/michelson_v1_gas.mli | 3 +++ .../michelson_v1_gas_costs_generated.ml | 4 ++++ .../lib_protocol/michelson_v1_primitives.ml | 9 ++++++-- .../lib_protocol/michelson_v1_primitives.mli | 1 + .../lib_protocol/script_interpreter.ml | 3 +++ .../lib_protocol/script_interpreter_defs.ml | 23 +++++++++++++++++++ .../lib_protocol/script_typed_ir.ml | 16 +++++++++++++ .../lib_protocol/script_typed_ir.mli | 14 +++++++++++ .../lib_protocol/script_typed_ir_size.ml | 1 + .../lib_protocol/test/helpers/block.ml | 7 +++--- .../lib_protocol/ticket_operations_diff.ml | 1 + 24 files changed, 157 insertions(+), 26 deletions(-) diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_model.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_model.ml index 0100cd5898be..502286243c73 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_model.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_model.ml @@ -745,7 +745,7 @@ let ir_model instr_or_cont = | N_ILambda_lam | N_ILambda_lamrec | N_ILog -> (const1_model, const1_model) |> m2 name | N_IOpen_chest -> (open_chest_model, open_chest_model) |> m2 name - | N_IEmit | N_IOpt_map_none | N_IOpt_map_some -> + | N_IEmit | N_IOpt_map_none | N_IOpt_map_some | N_IIncrease_counter -> (const1_model, const1_model) |> m2 name) | Cont_name cont -> ( match cont with diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml index c7c16d355f91..35b808c75e83 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml @@ -242,6 +242,7 @@ type instruction_name = | N_IOpen_chest (* Event *) | N_IEmit + | N_IIncrease_counter type continuation_name = | N_KNil @@ -445,6 +446,7 @@ let string_of_instruction_name : instruction_name -> string = | N_ILog -> "N_ILog" | N_IOpen_chest -> "N_IOpen_chest" | N_IEmit -> "N_IEmit" + | N_IIncrease_counter -> "N_IIncrease_counter" let string_of_continuation_name : continuation_name -> string = fun c -> @@ -1192,6 +1194,8 @@ module Instructions = struct (** cost model for the EMIT instruction *) let emit = ir_sized_step N_IEmit nullary + + let increase_counter = ir_sized_step N_IIncrease_counter nullary end module Control = struct @@ -1547,6 +1551,7 @@ let extract_ir_sized_step : Instructions.open_chest log_time plaintext_size | IMin_block_time _, _ -> Instructions.min_block_time | IEmit _, _ -> Instructions.emit + | IIncrease_counter _, _ -> Instructions.increase_counter | ILsl_bytes (_, _), (x, (y, _)) -> let y = match Script_int.to_int y with diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index e832fb5fa60b..00d2eca7e1ba 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -337,7 +337,7 @@ let estimated_gas_single (type kind) match result with | Applied res | Backtracked (res, _) -> ( match res with - | Increase_counter {consumed_gas; _} + | Increase_counter_result {consumed_gas; _} | Transaction_result ( Transaction_to_contract_result {consumed_gas; _} | Transaction_to_sc_rollup_result {consumed_gas; _} @@ -379,7 +379,8 @@ let estimated_gas_single (type kind) | Transaction_to_zk_rollup_result {consumed_gas; _} ) | IOrigination_result {consumed_gas; _} | IDelegation_result {consumed_gas; _} - | IEvent_result {consumed_gas} -> + | IEvent_result {consumed_gas} + | IIncrease_counter_result {consumed_gas} -> Ok consumed_gas) | Skipped _ -> Ok Gas.Arith.zero (* there must be another error for this to happen *) @@ -424,7 +425,7 @@ let estimated_storage_single (type kind) ~origination_size | Transaction_result (Transaction_to_sc_rollup_result _) | Reveal_result _ | Delegation_result _ | Increase_paid_storage_result _ | Dal_publish_slot_header_result _ | Sc_rollup_add_messages_result _ - | Increase_counter _ + | Increase_counter_result _ (* The following Sc_rollup operations have zero storage cost because we consider them to be paid in the stake deposit. @@ -458,7 +459,7 @@ let estimated_storage_single (type kind) ~origination_size (Transaction_to_zk_rollup_result {paid_storage_size_diff; _}) -> Ok paid_storage_size_diff | ITransaction_result (Transaction_to_sc_rollup_result _) - | IDelegation_result _ | IEvent_result _ -> + | IDelegation_result _ | IEvent_result _ | IIncrease_counter_result _ -> Ok Z.zero) | Skipped _ -> Ok Z.zero (* there must be another error for this to happen *) @@ -504,7 +505,7 @@ let originated_contracts_single (type kind) ( Transaction_to_sc_rollup_result _ | Transaction_to_zk_rollup_result _ ) | Register_global_constant_result _ | Reveal_result _ - | Increase_counter _ | Delegation_result _ + | Increase_counter_result _ | Delegation_result _ | Update_consensus_key_result _ | Increase_paid_storage_result _ | Transfer_ticket_result _ | Dal_publish_slot_header_result _ | Sc_rollup_originate_result _ | Sc_rollup_add_messages_result _ @@ -532,7 +533,7 @@ let originated_contracts_single (type kind) | ITransaction_result ( Transaction_to_sc_rollup_result _ | Transaction_to_zk_rollup_result _ ) - | IDelegation_result _ | IEvent_result _ -> + | IDelegation_result _ | IEvent_result _ | IIncrease_counter_result _ -> return_nil) | Skipped _ -> return_nil (* there must be another error for this to happen *) diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index 7588a6da0018..43e68587e73f 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -135,7 +135,11 @@ let pp_internal_operation ppf (Internal_operation {operation; sender; _}) = ty ; if not (Entrypoint.is_default tag) then Format.fprintf ppf "@,Tag: %a" Entrypoint.pp tag ; - Format.fprintf ppf "@,Payload: %a" pp_micheline_expr payload) ; + Format.fprintf ppf "@,Payload: %a" pp_micheline_expr payload + | Increase_counter _ -> + Format.fprintf + ppf + "Increase counter operation") ; Format.fprintf ppf "@]" let pp_manager_operation_content (type kind) source ppf @@ -634,7 +638,7 @@ let pp_operation_result ~operation_name pp_operation_result ppf = function (operation_name op_res) ; pp_operation_result ppf op_res -let pp_increase_counter ppf (Increase_counter {consumed_gas; new_counter}) = +let pp_increase_counter ppf (Increase_counter_result {consumed_gas; new_counter}) = pp_consumed_gas ppf consumed_gas ; Format.fprintf ppf "@,Increased counter to: %d" @@ Z.to_int new_counter @@ -783,7 +787,7 @@ let pp_manager_operation_contents_result ppf op_result = (result : kind successful_manager_operation_result) = match result with | Reveal_result _ -> "revelation" - | Increase_counter _ -> "increase_counter" + | Increase_counter_result _ -> "increase_counter" | Transaction_result _ -> "transaction" | Origination_result _ -> "origination" | Delegation_result _ -> "delegation" @@ -810,7 +814,7 @@ let pp_manager_operation_contents_result ppf op_result = (result : kind successful_manager_operation_result) = match result with | Reveal_result {consumed_gas} -> pp_consumed_gas ppf consumed_gas - | Increase_counter _ as op -> pp_increase_counter ppf op + | Increase_counter_result _ as op -> pp_increase_counter ppf op | Delegation_result {consumed_gas; balance_updates} -> pp_consumed_gas ppf consumed_gas ; pp_balance_updates ppf balance_updates @@ -852,6 +856,7 @@ let pp_internal_operation_and_result ppf (Internal_operation_result (op, res)) = | IOrigination_result _ -> "origination" | IDelegation_result _ -> "delegation" | IEvent_result _ -> "event" + | IIncrease_counter_result _ -> "increase_counter" in let pp_internal_operation_result (type kind) ppf (result : kind successful_internal_operation_result) = @@ -862,6 +867,7 @@ let pp_internal_operation_and_result ppf (Internal_operation_result (op, res)) = pp_consumed_gas ppf consumed_gas ; pp_balance_updates ppf balance_updates | IEvent_result {consumed_gas} -> pp_consumed_gas ppf consumed_gas + | IIncrease_counter_result {consumed_gas} -> pp_consumed_gas ppf consumed_gas in Format.fprintf ppf diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 8530b6d638f7..432f566d0bf3 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -1029,6 +1029,7 @@ module Scripts = struct | IJoin_tickets _ -> pp_print_string fmt "JOIN_TICKETS" | IOpen_chest _ -> pp_print_string fmt "OPEN_CHEST" | IEmit _ -> pp_print_string fmt "EMIT" + | IIncrease_counter _ -> pp_print_string fmt "INCREASE_COUNTER" | IHalt _ -> pp_print_string fmt "[halt]" | ILog (_, _, _, _, instr) -> Format.fprintf fmt "log/%a" pp_instr_name instr diff --git a/src/proto_alpha/lib_plugin/script_interpreter_logging.ml b/src/proto_alpha/lib_plugin/script_interpreter_logging.ml index a6fa1d80bce2..aa8d3a7ea742 100644 --- a/src/proto_alpha/lib_plugin/script_interpreter_logging.ml +++ b/src/proto_alpha/lib_plugin/script_interpreter_logging.ml @@ -1743,6 +1743,14 @@ module Stack_utils = struct reconstruct = (fun k -> IEmit {loc; ty; unparsed_ty; tag; k}); } | IEmit _, Bot_t -> . + | IIncrease_counter {loc; k; ty}, s -> + return + @@ Ex_split_kinstr + { + cont_init_stack = s; + continuation = k; + reconstruct = (fun k -> IIncrease_counter {loc; k; ty}); + } | IHalt loc, _s -> return @@ Ex_split_halt loc | ILog (loc, _stack_ty, event, logger, continuation), stack -> return diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 8c98df89916f..195bc60773eb 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -600,6 +600,7 @@ module Script : sig | I_IF_CONS | I_IF_LEFT | I_IF_NONE + | I_INCREASE_COUNTER | I_INT | I_LAMBDA | I_LAMBDA_REC diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 50e70f26834f..748771fdf909 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -952,6 +952,16 @@ let apply_internal_operation_contents : ~before_operation:ctxt_before_op in (ctxt, IDelegation_result {consumed_gas; balance_updates}, ops) + | Increase_counter _ -> + let* ctxt = Dummy_counter.increase_counter ctxt in + let+ ctxt, _counter = Dummy_counter.get_or_init ctxt in + ( ctxt, + IIncrease_counter_result + { + consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt; + }, + [] ) + let apply_manager_operation : type kind. @@ -1127,7 +1137,7 @@ let apply_manager_operation : let* ctxt = Dummy_counter.increase_counter ctxt in let+ ctxt, counter = Dummy_counter.get_or_init ctxt in ( ctxt, - Increase_counter + Increase_counter_result { consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt; new_counter = counter; @@ -1701,7 +1711,7 @@ let burn_manager_storage_fees : size_of_constant = payload.size_of_constant; global_address = payload.global_address; } ) - | Increase_counter _ -> return (ctxt, storage_limit, smopr) + | Increase_counter_result _ -> return (ctxt, storage_limit, smopr) | Update_consensus_key_result _ -> return (ctxt, storage_limit, smopr) | Increase_paid_storage_result _ -> return (ctxt, storage_limit, smopr) | Transfer_ticket_result payload -> @@ -1811,6 +1821,8 @@ let burn_internal_storage_fees : (ctxt, storage_limit, IOrigination_result origination_result) | IDelegation_result _ -> return (ctxt, storage_limit, smopr) | IEvent_result _ -> return (ctxt, storage_limit, smopr) + (* TODOF: Question - shouldn't a fee be burned if the init function actually allocates space? *) + | IIncrease_counter_result _ -> return (ctxt, storage_limit, smopr) let apply_manager_contents (type kind) ctxt chain_id ~consume_gas_for_sig_check (op : kind Kind.manager contents) : diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 3c188af0d33c..fbcd7cf6d938 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -50,6 +50,13 @@ type 'kind internal_operation_contents = payload : Script.expr; } -> Kind.event internal_operation_contents + | Increase_counter : { + (* ty : Script.expr; + tag : Entrypoint.t; + payload : Script.expr; *) + useless: string + } + -> Kind.increase_counter internal_operation_contents type packed_internal_operation_contents = | Internal_operation_contents : @@ -123,6 +130,7 @@ let internal_operation (type kind) in Origination {delegate; script; credit} | Delegation delegate -> Delegation delegate + | Increase_counter {useless} -> Increase_counter {useless} in {sender; operation; nonce} @@ -180,6 +188,10 @@ type _ successful_internal_operation_result = consumed_gas : Gas.Arith.fp; } -> Kind.event successful_internal_operation_result + | IIncrease_counter_result : { + consumed_gas : Gas.Arith.fp; + } + -> Kind.increase_counter successful_internal_operation_result type packed_successful_internal_operation_result = | Successful_internal_operation_result : diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index 8a2f2b5ccb13..f9fbcb016cfd 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -58,6 +58,13 @@ type 'kind internal_operation_contents = payload : Script.expr; } -> Kind.event internal_operation_contents + | Increase_counter : { + (* ty : Script.expr; + tag : Entrypoint.t; + payload : Script.expr; *) + useless: string + } + -> Kind.increase_counter internal_operation_contents type 'kind internal_operation = { sender : Destination.t; @@ -126,6 +133,10 @@ type _ successful_internal_operation_result = consumed_gas : Gas.Arith.fp; } -> Kind.event successful_internal_operation_result + | IIncrease_counter_result : { + consumed_gas : Gas.Arith.fp; + } + -> Kind.increase_counter successful_internal_operation_result type 'kind internal_operation_result = ( 'kind, diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index b9b34eb08da3..d8385a3081d6 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -40,7 +40,7 @@ type _ successful_manager_operation_result = consumed_gas : Gas.Arith.fp; } -> Kind.reveal successful_manager_operation_result - | Increase_counter : { + | Increase_counter_result : { consumed_gas : Gas.Arith.fp; new_counter : Z.t; } @@ -281,14 +281,14 @@ module Manager_result = struct (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero) (req "counter" z)) ~select:(function - | Successful_manager_result (Increase_counter _ as op) -> Some op + | Successful_manager_result (Increase_counter_result _ as op) -> Some op | _ -> None) ~kind:Kind.Increase_counter_manager_kind ~proj:(function - | Increase_counter {consumed_gas; new_counter} -> + | Increase_counter_result {consumed_gas; new_counter} -> (consumed_gas, new_counter)) ~inj:(fun (consumed_gas, new_counter) -> - Increase_counter {consumed_gas; new_counter}) + Increase_counter_result {consumed_gas; new_counter}) let transaction_contract_variant_cases = let case = function @@ -2091,11 +2091,11 @@ let kind_equal : | Manager_operation {operation = Transaction _; _}, _ -> None | ( Manager_operation {operation = Increase_counter; _}, Manager_operation_result - {operation_result = Applied (Increase_counter _); _} ) -> + {operation_result = Applied (Increase_counter_result _); _} ) -> Some Eq | ( Manager_operation {operation = Increase_counter; _}, Manager_operation_result - {operation_result = Backtracked (Increase_counter _, _); _} ) -> + {operation_result = Backtracked (Increase_counter_result _, _); _} ) -> Some Eq | ( Manager_operation {operation = Increase_counter; _}, Manager_operation_result diff --git a/src/proto_alpha/lib_protocol/apply_results.mli b/src/proto_alpha/lib_protocol/apply_results.mli index b721f28fd02e..17949aaff389 100644 --- a/src/proto_alpha/lib_protocol/apply_results.mli +++ b/src/proto_alpha/lib_protocol/apply_results.mli @@ -131,7 +131,7 @@ and _ successful_manager_operation_result = consumed_gas : Gas.Arith.fp; } -> Kind.reveal successful_manager_operation_result - | Increase_counter : { + | Increase_counter_result : { consumed_gas : Gas.Arith.fp; new_counter : Z.t; } diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml index 681337fa61c1..5b89ed3cecda 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml @@ -403,7 +403,7 @@ module Cost_of = struct let push = atomic_step_cost cost_N_IPush - let unit = atomic_step_cost cost_N_IUnit + let unit = atomic_step_cost cost_N_IIncrease_counter let empty_big_map = atomic_step_cost cost_N_IEmpty_big_map @@ -638,6 +638,8 @@ module Cost_of = struct let emit = atomic_step_cost cost_N_IEmit + let increase_counter = atomic_step_cost cost_N_IEmit + (* Continuations *) module Control = struct let nil = atomic_step_cost cost_N_KNil diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli index 8f64123e310c..8dcf32e1ca43 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli @@ -402,6 +402,9 @@ module Cost_of : sig (** cost to generate one event emission internal operation *) val emit : Gas.cost + (** cost to increase the global counter *) + val increase_counter : Gas.cost + module Control : sig val nil : Gas.cost diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas_costs_generated.ml b/src/proto_alpha/lib_protocol/michelson_v1_gas_costs_generated.ml index a64681951e44..434598afbf9e 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas_costs_generated.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas_costs_generated.ml @@ -3278,6 +3278,10 @@ let cost_N_IUncomb_synthesized size = ((S.sub size (S.safe_int 2) * S.safe_int 4) + S.safe_int 30) ((size * S.safe_int 12) + S.safe_int 10) +(* model interpreter/N_IUnit *) +(* max 10 10. *) +let cost_N_IIncrease_counter = S.safe_int 10 + (* model interpreter/N_IUnit *) (* max 10 10. *) let cost_N_IUnit = S.safe_int 10 diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml index 8c198be16e91..009826d77b4a 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml @@ -91,6 +91,7 @@ type prim = | I_IF_CONS | I_IF_LEFT | I_IF_NONE + | I_INCREASE_COUNTER | I_INT | I_LAMBDA | I_LAMBDA_REC @@ -214,7 +215,7 @@ let namespace = function | I_CREATE_CONTRACT | I_DIG | I_DIP | I_DROP | I_DUG | I_DUP | I_VIEW | I_EDIV | I_EMPTY_BIG_MAP | I_EMPTY_MAP | I_EMPTY_SET | I_EQ | I_EXEC | I_FAILWITH | I_GE | I_GET | I_GET_AND_UPDATE | I_GT | I_HASH_KEY | I_IF | I_IF_CONS - | I_IF_LEFT | I_IF_NONE | I_IMPLICIT_ACCOUNT | I_INT | I_ISNAT | I_ITER + | I_IF_LEFT | I_IF_NONE | I_IMPLICIT_ACCOUNT | I_INCREASE_COUNTER | I_INT | I_ISNAT | I_ITER | I_JOIN_TICKETS | I_KECCAK | I_LAMBDA | I_LAMBDA_REC | I_LE | I_LEFT | I_LEVEL | I_LOOP | I_LOOP_LEFT | I_LSL | I_LSR | I_LT | I_MAP | I_MEM | I_MUL | I_NEG | I_NEQ | I_NEVER | I_NIL | I_NONE | I_NOT | I_NOW @@ -303,6 +304,7 @@ let string_of_prim = function | I_IF_CONS -> "IF_CONS" | I_IF_LEFT -> "IF_LEFT" | I_IF_NONE -> "IF_NONE" + | I_INCREASE_COUNTER -> "INCREASE_COUNTER" | I_INT -> "INT" | I_LAMBDA -> "LAMBDA" | I_LAMBDA_REC -> "LAMBDA_REC" @@ -465,6 +467,7 @@ let prim_of_string = | "IF_CONS" -> return I_IF_CONS | "IF_LEFT" -> return I_IF_LEFT | "IF_NONE" -> return I_IF_NONE + | "INCREASE_COUNTER" -> return I_INCREASE_COUNTER | "INT" -> return I_INT | "KECCAK" -> return I_KECCAK | "LAMBDA" -> return I_LAMBDA @@ -792,7 +795,9 @@ let prim_encoding = ("LAMBDA_REC", I_LAMBDA_REC); ("TICKET", I_TICKET); ("BYTES", I_BYTES); - ("NAT", I_NAT) + ("NAT", I_NAT); + (* Alpha_018 *) + ("INCREASE_COUNTER", I_INCREASE_COUNTER) (* New instructions must be added here, for backward compatibility of the encoding. *) (* Keep the comment above at the end of the list *); ] diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli index 761631190aba..66c785e8994b 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli @@ -103,6 +103,7 @@ type prim = | I_IF_CONS | I_IF_LEFT | I_IF_NONE + | I_INCREASE_COUNTER | I_INT | I_LAMBDA | I_LAMBDA_REC diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index fee974aeb0c0..1d8495430caa 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -660,6 +660,8 @@ module Raw = struct | None -> tzfail Gas.Operation_quota_exceeded | Some gas -> ( match i with + | IIncrease_counter {k; _} -> + (step [@ocaml.tailcall]) g gas k ks accu stack | ILog (_, sty, event, logger, k) -> (logger.ilog [@ocaml.tailcall]) logger @@ -1700,6 +1702,7 @@ module Raw = struct ~event_data in (step [@ocaml.tailcall]) (ctxt, sc) gas k ks accu stack) + end open Raw diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index cfdad3f2c2a8..5fe36ccb98a1 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -402,6 +402,7 @@ let cost_of_instr : type a s r f. (a, s, r, f) kinstr -> a -> s -> Gas.cost = and chest, (time, _) = stack in Interp_costs.open_chest ~chest ~time:(Script_int.to_zint time) | IEmit _ -> Interp_costs.emit + | IIncrease_counter _ -> Interp_costs.increase_counter | ILog _ -> Gas.free [@@ocaml.inline always] @@ -612,6 +613,28 @@ let emit_event (type t tc) (ctxt, sc) gas ~(event_type : (t, tc) ty) let gas, ctxt = local_gas_counter_and_outdated_context ctxt in return (res, ctxt, gas) +let increase_counter_event (type t tc) (ctxt, sc) gas ~(event_type : (t, tc) ty) + ~_unparsed_ty ~_tag ~(event_data : t) = + let open Lwt_result_syntax in + let ctxt = update_context gas ctxt in + (* No need to take care of lazy storage as only packable types are allowed *) + let lazy_storage_diff = None in + let* _unparsed_data, ctxt = + unparse_data ctxt Optimized event_type event_data + in + let*? ctxt, nonce = fresh_internal_nonce ctxt in + let operation = Increase_counter {useless= " "} in + let iop = + { + sender = Destination.Contract (Contract.Originated sc.self); + operation; + nonce; + } + in + let res = {piop = Internal_operation iop; lazy_storage_diff} in + let gas, ctxt = local_gas_counter_and_outdated_context ctxt in + return (res, ctxt, gas) + let make_transaction_to_zk_rollup (type t) ctxt ~destination ~amount ~(parameters_ty : ((t ticket, bytes) pair, _) ty) ~parameters = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 087626013f27..99578c61d937 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1120,6 +1120,12 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = k : (operation, 'S, 'r, 'F) kinstr; } -> ('a, 'S, 'r, 'F) kinstr + | IIncrease_counter : { + loc: Script.location; + k : ('a, 'S, 'r, 'F) kinstr; + ty : ('a, _) ty; + } -> + ('a, 'S, 'r, 'F) kinstr (* Internal control instructions ----------------------------- @@ -1490,6 +1496,13 @@ and 'kind internal_operation_contents = | Delegation : Signature.Public_key_hash.t option -> Kind.delegation internal_operation_contents + | Increase_counter : { + (* ty : Script.expr; + tag : Entrypoint.t; + unparsed_data : Script.expr; *) + useless: string + } + -> Kind.increase_counter internal_operation_contents and 'kind internal_operation = { sender : Destination.t; @@ -1536,6 +1549,7 @@ let manager_kind : | Event _ -> Kind.Event_manager_kind | Origination _ -> Kind.Origination_manager_kind | Delegation _ -> Kind.Delegation_manager_kind + | Increase_counter _ -> Kind.Increase_counter_manager_kind let kinstr_location : type a s b f. (a, s, b, f) kinstr -> Script.location = fun i -> @@ -1707,6 +1721,7 @@ let kinstr_location : type a s b f. (a, s, b, f) kinstr -> Script.location = | IJoin_tickets (loc, _, _) -> loc | IOpen_chest (loc, _) -> loc | IEmit {loc; _} -> loc + | IIncrease_counter {loc; _} -> loc | IHalt loc -> loc | ILog (loc, _, _, _, _) -> loc @@ -2286,6 +2301,7 @@ let kinstr_traverse i init f = | IJoin_tickets (_, _, k) -> (next [@ocaml.tailcall]) k | IOpen_chest (_, k) -> (next [@ocaml.tailcall]) k | IEmit {k; _} -> (next [@ocaml.tailcall]) k + | IIncrease_counter {k; _} -> (next [@ocaml.tailcall]) k | IHalt _ -> (return [@ocaml.tailcall]) () | ILog (_, _, _, _, k) -> (next [@ocaml.tailcall]) k in diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index b5889288a17b..3bc46a144525 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1147,6 +1147,12 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = k : (operation, 'S, 'r, 'F) kinstr; } -> ('a, 'S, 'r, 'F) kinstr + | IIncrease_counter : { + loc: Script.location; + k : ('a, 'S, 'r, 'F) kinstr; + ty : ('a, _) ty; + } -> + ('a, 'S, 'r, 'F) kinstr (* Internal control instructions @@ -1655,6 +1661,14 @@ and 'kind internal_operation_contents = | Delegation : Signature.Public_key_hash.t option -> Kind.delegation internal_operation_contents + | Increase_counter : { + (* ty : Script.expr; + tag : Entrypoint.t; + unparsed_data : Script.expr; *) + useless: string + } + -> Kind.increase_counter internal_operation_contents + and 'kind internal_operation = { sender : Destination.t; diff --git a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml index e3ade406d01d..ab881a5053f2 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml @@ -684,6 +684,7 @@ and kinstr_size : ret_succ_adding (accu ++ ty_size ty ++ expr_size unparsed_ty) (base1 loc k +! Entrypoint.in_memory_size tag +! (word_size *? 3)) + | IIncrease_counter {loc; k; _} -> ret_succ_adding accu (base1 loc k) | IHalt loc -> ret_succ_adding accu (base0 loc) | ILog _ -> (* This instruction is ignored because it is only used for testing. diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index e75b136f33de..0e73dd8eb706 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -1056,7 +1056,8 @@ let balance_update_of_internal_operation_result = function | IDelegation_result {balance_updates; _} -> balance_updates | ITransaction_result (Transaction_to_sc_rollup_result _) - | IEvent_result _ -> + | IEvent_result _ + | IIncrease_counter_result _ -> [])) let balance_update_of_operation_result : @@ -1069,7 +1070,7 @@ let balance_update_of_operation_result : match siopr with | Protocol.Apply_results.Transaction_result (Transaction_to_sc_rollup_result _) - | Reveal_result _ | Update_consensus_key_result _ | Increase_counter _ + | Reveal_result _ | Update_consensus_key_result _ | Increase_counter_result _ | Transfer_ticket_result _ | Dal_publish_slot_header_result _ | Sc_rollup_originate_result _ | Sc_rollup_add_messages_result _ | Sc_rollup_cement_result _ | Sc_rollup_publish_result _ @@ -1178,7 +1179,7 @@ let bake_n_with_origination_results ?baking_mode ?policy n b = let open Apply_results in function | Successful_manager_result (Reveal_result _) - | Successful_manager_result (Increase_counter _) + | Successful_manager_result (Increase_counter_result _) | Successful_manager_result (Delegation_result _) | Successful_manager_result (Update_consensus_key_result _) | Successful_manager_result (Transaction_result _) diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml index 6f5a1febd785..84814e9b6432 100644 --- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml +++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml @@ -249,6 +249,7 @@ let tickets_of_operation ctxt storage; } -> tickets_of_origination ctxt ~preorigination ~storage_type ~storage + | Increase_counter _ | Delegation _ | Event _ -> return (None, ctxt) let add_transfer_to_token_map ctxt token_map {destination; tickets} = -- GitLab From 0270abf0dcd3ca59172d127c9cc2bdf11f129d67 Mon Sep 17 00:00:00 2001 From: Felix Puscasu Date: Fri, 10 Nov 2023 16:21:42 +0000 Subject: [PATCH 4/6] Added parse_instr case --- src/proto_alpha/lib_client/injection.ml | 2 +- src/proto_alpha/lib_client/operation_result.ml | 4 +++- src/proto_alpha/lib_protocol/apply.ml | 3 ++- src/proto_alpha/lib_protocol/apply_internal_results.ml | 1 + src/proto_alpha/lib_protocol/apply_internal_results.mli | 1 + src/proto_alpha/lib_protocol/script_ir_translator.ml | 8 +++++++- 6 files changed, 15 insertions(+), 4 deletions(-) diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 00d2eca7e1ba..1b3bc0896782 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -380,7 +380,7 @@ let estimated_gas_single (type kind) | IOrigination_result {consumed_gas; _} | IDelegation_result {consumed_gas; _} | IEvent_result {consumed_gas} - | IIncrease_counter_result {consumed_gas} -> + | IIncrease_counter_result {consumed_gas; _} -> Ok consumed_gas) | Skipped _ -> Ok Gas.Arith.zero (* there must be another error for this to happen *) diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index 43e68587e73f..37b7606dafb4 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -867,7 +867,9 @@ let pp_internal_operation_and_result ppf (Internal_operation_result (op, res)) = pp_consumed_gas ppf consumed_gas ; pp_balance_updates ppf balance_updates | IEvent_result {consumed_gas} -> pp_consumed_gas ppf consumed_gas - | IIncrease_counter_result {consumed_gas} -> pp_consumed_gas ppf consumed_gas + | IIncrease_counter_result {consumed_gas; new_counter} -> + pp_consumed_gas ppf consumed_gas ; + Format.fprintf ppf "@,IIncreased counter to: %d" @@ Z.to_int new_counter in Format.fprintf ppf diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 748771fdf909..420cfd9ba5b5 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -954,11 +954,12 @@ let apply_internal_operation_contents : (ctxt, IDelegation_result {consumed_gas; balance_updates}, ops) | Increase_counter _ -> let* ctxt = Dummy_counter.increase_counter ctxt in - let+ ctxt, _counter = Dummy_counter.get_or_init ctxt in + let+ ctxt, counter = Dummy_counter.get_or_init ctxt in ( ctxt, IIncrease_counter_result { consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt; + new_counter = counter; }, [] ) diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index fbcd7cf6d938..af7206d81faf 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -190,6 +190,7 @@ type _ successful_internal_operation_result = -> Kind.event successful_internal_operation_result | IIncrease_counter_result : { consumed_gas : Gas.Arith.fp; + new_counter : Z.t } -> Kind.increase_counter successful_internal_operation_result diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.mli b/src/proto_alpha/lib_protocol/apply_internal_results.mli index f9fbcb016cfd..53c261adb55f 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.mli +++ b/src/proto_alpha/lib_protocol/apply_internal_results.mli @@ -135,6 +135,7 @@ type _ successful_internal_operation_result = -> Kind.event successful_internal_operation_result | IIncrease_counter_result : { consumed_gas : Gas.Arith.fp; + new_counter : Z.t; } -> Kind.increase_counter successful_internal_operation_result diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 79d53aacb5f2..f2daf3aea27f 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -4566,6 +4566,12 @@ and parse_instr : {apply = (fun k -> IEmit {loc; tag; ty = data; unparsed_ty; k})} in typed ctxt loc instr (Item_t (Operation_t, rest)) + | Prim (loc, I_INCREASE_COUNTER, [], annot), (Item_t (data, rest)) -> + let*? () = check_var_annot loc annot in + let instr = + {apply = (fun k -> IIncrease_counter {loc; ty = data; k})} + in + typed ctxt loc instr (Item_t (data, rest)) (* Primitive parsing errors *) | ( Prim ( loc, @@ -4581,7 +4587,7 @@ and parse_instr : | I_INT | I_SELF | I_CHAIN_ID | I_NEVER | I_VOTING_POWER | I_TOTAL_VOTING_POWER | I_KECCAK | I_SHA3 | I_PAIRING_CHECK | I_TICKET | I_READ_TICKET | I_SPLIT_TICKET | I_JOIN_TICKETS - | I_OPEN_CHEST ) as name), + | I_OPEN_CHEST | I_INCREASE_COUNTER ) as name), (_ :: _ as l), _ ), _ ) -> -- GitLab From 8d21befd82b74102d057a3e3ab9ddaaadea91398 Mon Sep 17 00:00:00 2001 From: Felix Puscasu Date: Mon, 13 Nov 2023 17:46:03 +0000 Subject: [PATCH 5/6] wip --- src/lib_protocol_environment/environment_V11.ml | 6 +++++- src/proto_alpha/lib_client/operation_result.ml | 4 +++- src/proto_alpha/lib_plugin/RPC.ml | 2 ++ .../lib_plugin/script_interpreter_logging.ml | 2 +- src/proto_alpha/lib_protocol/apply.ml | 7 +++++++ src/proto_alpha/lib_protocol/script_interpreter.ml | 5 ++++- .../lib_protocol/script_interpreter_defs.ml | 8 ++------ src/proto_alpha/lib_protocol/script_ir_translator.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.mli | 10 +++++----- 10 files changed, 31 insertions(+), 17 deletions(-) diff --git a/src/lib_protocol_environment/environment_V11.ml b/src/lib_protocol_environment/environment_V11.ml index 9123d2de9b19..6d6a97830848 100644 --- a/src/lib_protocol_environment/environment_V11.ml +++ b/src/lib_protocol_environment/environment_V11.ml @@ -198,7 +198,11 @@ struct | Error | Fatal - let logging_function = ref None + let logging_function = + let + mylogf _level s = Printf.printf "%s" s + in + ref @@ Some mylogf let name_colon_space = Param.name ^ ": " diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index 37b7606dafb4..1980ad11c9a5 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -856,7 +856,9 @@ let pp_internal_operation_and_result ppf (Internal_operation_result (op, res)) = | IOrigination_result _ -> "origination" | IDelegation_result _ -> "delegation" | IEvent_result _ -> "event" - | IIncrease_counter_result _ -> "increase_counter" + | IIncrease_counter_result _ -> + Format.fprintf ppf "here"; + "increase_counter" in let pp_internal_operation_result (type kind) ppf (result : kind successful_internal_operation_result) = diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 432f566d0bf3..de872c001a35 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -1102,6 +1102,7 @@ module Scripts = struct let* _ctxt, op_metadata = Apply.apply_operation application_state oph packed_operation in + Logging.log Logging.Info "hey" ; return (params#version, (packed_operation.protocol_data, op_metadata)) (* @@ -1121,6 +1122,7 @@ module Scripts = struct *) let simulate_operation_service rpc_ctxt params (blocks_before_activation, op, chain_id, time_in_blocks) = + Logging.log Logging.Info "test1"; let open Lwt_result_syntax in let {Services_registration.context; _} = rpc_ctxt in let* context = diff --git a/src/proto_alpha/lib_plugin/script_interpreter_logging.ml b/src/proto_alpha/lib_plugin/script_interpreter_logging.ml index aa8d3a7ea742..1d2674cf513e 100644 --- a/src/proto_alpha/lib_plugin/script_interpreter_logging.ml +++ b/src/proto_alpha/lib_plugin/script_interpreter_logging.ml @@ -1747,7 +1747,7 @@ module Stack_utils = struct return @@ Ex_split_kinstr { - cont_init_stack = s; + cont_init_stack = Item_t (Operation_t, s); continuation = k; reconstruct = (fun k -> IIncrease_counter {loc; k; ty}); } diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 420cfd9ba5b5..de7c6d21204c 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1839,6 +1839,7 @@ let apply_manager_contents (type kind) ctxt chain_id ~consume_gas_for_sig_check the specified gas limit by the internal scaling. *) let ctxt = Gas.set_limit ctxt gas_limit in let*! result = + Logging.log Logging.Info "Normal mgr op"; apply_manager_operation ctxt ~source @@ -1849,6 +1850,7 @@ let apply_manager_contents (type kind) ctxt chain_id ~consume_gas_for_sig_check match result with | Ok (ctxt, operation_results, internal_operations) -> ( let*! result = + Logging.log Logging.Info "Internal mgr op"; apply_internal_operations ctxt ~payer:source @@ -2009,6 +2011,7 @@ let rec apply_manager_contents_list_rec : kind Kind.manager fees_updated_contents_list -> (success_or_failure * kind Kind.manager contents_result_list) Lwt.t = let open Lwt_syntax in + Logging.log Logging.Info "In app mgr cont list "; fun ctxt ~payload_producer chain_id @@ -2443,6 +2446,7 @@ let apply_contents_list (type kind) ctxt chain_id (mode : mode) rejected by {!Validate.validate_operation}. *) tzfail Validate_errors.Failing_noop_error | Single (Manager_operation {source; _}) -> + Logging.log Logging.Info "Single case"; apply_manager_operations ctxt ~payload_producer @@ -2452,6 +2456,7 @@ let apply_contents_list (type kind) ctxt chain_id (mode : mode) ~operation contents_list | Cons (Manager_operation {source; _}, _) -> + Logging.log Logging.Info "Cons case"; apply_manager_operations ctxt ~payload_producer @@ -2472,6 +2477,7 @@ let apply_operation application_state operation_hash operation = in let ctxt = Origination_nonce.init application_state.ctxt operation_hash in let ctxt = record_operation ctxt operation_hash operation in + Logging.log Logging.Debug "ok before apply"; let* ctxt, result = apply_contents_list ctxt @@ -2481,6 +2487,7 @@ let apply_operation application_state operation_hash operation = ~operation operation.protocol_data.contents in + Logging.log Logging.Info "after results" ; let ctxt = Gas.set_unlimited ctxt in let ctxt = Origination_nonce.unset ctxt in let op_count = succ application_state.op_count in diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 1d8495430caa..bc978b6dd2a3 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -661,7 +661,10 @@ module Raw = struct | Some gas -> ( match i with | IIncrease_counter {k; _} -> - (step [@ocaml.tailcall]) g gas k ks accu stack + let* res, ctxt, gas = increase_counter_event + (ctxt, sc) + gas in + (step [@ocaml.tailcall]) (ctxt, sc) gas k ks res (accu, stack) | ILog (_, sty, event, logger, k) -> (logger.ilog [@ocaml.tailcall]) logger diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 5fe36ccb98a1..a2de1e452b71 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -613,15 +613,11 @@ let emit_event (type t tc) (ctxt, sc) gas ~(event_type : (t, tc) ty) let gas, ctxt = local_gas_counter_and_outdated_context ctxt in return (res, ctxt, gas) -let increase_counter_event (type t tc) (ctxt, sc) gas ~(event_type : (t, tc) ty) - ~_unparsed_ty ~_tag ~(event_data : t) = - let open Lwt_result_syntax in +let increase_counter_event (ctxt, sc) gas = + let open Lwt_result_syntax in let ctxt = update_context gas ctxt in (* No need to take care of lazy storage as only packable types are allowed *) let lazy_storage_diff = None in - let* _unparsed_data, ctxt = - unparse_data ctxt Optimized event_type event_data - in let*? ctxt, nonce = fresh_internal_nonce ctxt in let operation = Increase_counter {useless= " "} in let iop = diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index f2daf3aea27f..5f9f77442278 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -4571,7 +4571,7 @@ and parse_instr : let instr = {apply = (fun k -> IIncrease_counter {loc; ty = data; k})} in - typed ctxt loc instr (Item_t (data, rest)) + typed ctxt loc instr (Item_t (Operation_t, Item_t (data, rest))) (* Primitive parsing errors *) | ( Prim ( loc, diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 99578c61d937..acb5fdd4640e 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1122,7 +1122,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = -> ('a, 'S, 'r, 'F) kinstr | IIncrease_counter : { loc: Script.location; - k : ('a, 'S, 'r, 'F) kinstr; + k : (operation, 'a * 'S, 'r, 'F) kinstr; ty : ('a, _) ty; } -> ('a, 'S, 'r, 'F) kinstr diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 3bc46a144525..def7b7f4e696 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1148,11 +1148,11 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = } -> ('a, 'S, 'r, 'F) kinstr | IIncrease_counter : { - loc: Script.location; - k : ('a, 'S, 'r, 'F) kinstr; - ty : ('a, _) ty; - } -> - ('a, 'S, 'r, 'F) kinstr + loc: Script.location; + k : (operation, 'a * 'S, 'r, 'F) kinstr; + ty : ('a, _) ty; + } + -> ('a, 'S, 'r, 'F) kinstr (* Internal control instructions -- GitLab From bbb179d812a61d0c24a6b4021d657beee7a15af2 Mon Sep 17 00:00:00 2001 From: Felix Puscasu Date: Tue, 14 Nov 2023 09:30:27 +0000 Subject: [PATCH 6/6] contract --- mycontract.tz | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 mycontract.tz diff --git a/mycontract.tz b/mycontract.tz new file mode 100644 index 000000000000..fc4dc882e088 --- /dev/null +++ b/mycontract.tz @@ -0,0 +1,3 @@ +parameter string; +storage unit; +code {DROP; UNIT; NIL operation; INCREASE_COUNTER; CONS; PAIR;}; -- GitLab