diff --git a/src/proto_alpha/lib_benchmarks_proto/apply_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/apply_benchmarks.ml new file mode 100644 index 0000000000000000000000000000000000000000..5908a289e5523aea68d9a8e106ac7446e53cce0e --- /dev/null +++ b/src/proto_alpha/lib_benchmarks_proto/apply_benchmarks.ml @@ -0,0 +1,149 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* *) +(* 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 Tezos_benchmark + +let ns = Namespace.make Registration_helpers.ns "apply" + +let fv s = Free_variable.of_namespace (ns s) + +let initial_balance = 4_000_000_000_000L + +let make_context ~rng_state = + let open Lwt_result_syntax in + let* block, (_, src, dst) = + Context.init3 + ~rng_state + ~bootstrap_balances:[initial_balance; initial_balance; initial_balance] + () + in + Context.get_constants (B block) >>=? fun csts -> + let minimal_block_delay = + Protocol.Alpha_context.Period.to_seconds csts.parametric.minimal_block_delay + in + Incremental.begin_construction + ~timestamp: + (Time.Protocol.add block.header.shell.timestamp minimal_block_delay) + block + >>=? fun vs -> + let ctxt = Incremental.alpha_ctxt vs in + let ctxt = + (* Required for eg Create_contract *) + Protocol.Alpha_context.Origination_nonce.init + ctxt + Tezos_crypto.Hashed.Operation_hash.zero + in + return (ctxt, src, dst) + +module Take_fees_benchmark = struct + let name = ns "Take_fees" + + let info = "Benchmark for take_fees" + + let tags = ["apply"] + + type config = unit + + let config_encoding = Data_encoding.unit + + let default_config = () + + type workload = {batch_length : int} + + let workload_encoding = + let open Data_encoding in + conv + (fun {batch_length} -> batch_length) + (fun batch_length -> {batch_length}) + (obj1 (req "batch_length" int31)) + + let workload_to_vector {batch_length} = + Sparse_vec.String.of_list [("batch_length", float_of_int batch_length)] + + let model = + Model.make + ~conv:(fun {batch_length} -> (batch_length, ())) + ~model: + (Model.affine + ~name + ~intercept:(fv "take_fees_const") + ~coeff:(fv "take_fees_coeff")) + + let models = [("take_fees", model)] + + let benchmark rng_state _conf () = + let open Annotated_manager_operation in + let open Alpha_context in + let open Lwt_result_syntax in + let batch_length = + Base_samplers.sample_in_interval ~range:{min = 1; max = 100} rng_state + in + let workload = {batch_length} in + let closure_result = + Lwt_main.run + (let* ctxt, src, dest = make_context ~rng_state in + let* parameters = Client_proto_context.parse_arg_transfer None in + let transaction = + Transaction + { + amount = Tez.one; + parameters; + entrypoint = Entrypoint_repr.default; + destination = dest; + } + in + let pkh = match src with Implicit pkh -> pkh | _ -> assert false in + let manager_info = + Manager_info + { + source = Some pkh; + fee = Limit.known Tez.one; + gas_limit = Limit.known (Gas.Arith.integral_exn (Z.of_int 2000)); + storage_limit = Limit.known (Z.of_int 10); + counter = Some (Manager_counter.Internal_for_tests.of_int 0); + operation = transaction; + } + in + let tr = Annotated_manager_operation manager_info in + let transaction_list = List.repeat batch_length tr in + let (Manager_list annotated_list) = manager_of_list transaction_list in + let* batch = Lwt.return (manager_list_from_annotated annotated_list) in + let closure () = + Protocol.Apply.Internal_for_benchmark.take_fees ctxt batch + in + return closure) + in + let closure = + match closure_result with + | Ok c -> c + | Error _ -> assert false (* TODO better error *) + in + Generator.Plain {workload; closure} + + let create_benchmarks ~rng_state ~bench_num config = + List.repeat bench_num (benchmark rng_state config) +end + +let () = Registration_helpers.register (module Take_fees_benchmark) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 2ae9942395f0d4621f74827685fb7291f880b477..3c2bf68c3d82c9a62c1243522cf0aee721a6709a 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -3075,3 +3075,7 @@ let finalize_block (application_state : application_state) shell_header_opt = return (result, receipt) let value_of_key ctxt k = Cache.Admin.value_of_key ctxt k + +module Internal_for_benchmark = struct + let take_fees ctxt batch = ignore (take_fees ctxt batch) +end diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli index 5a8c0489b647f8c4c6263b13d0b602ab10b7e7d5..36c3d27662262bef654c03b3acb4df0986ff736f 100644 --- a/src/proto_alpha/lib_protocol/apply.mli +++ b/src/proto_alpha/lib_protocol/apply.mli @@ -164,3 +164,7 @@ val finalize_block : so that it can be put into the cache. *) val value_of_key : context -> Context.Cache.key -> Context.Cache.value tzresult Lwt.t + +module Internal_for_benchmark : sig + val take_fees : context -> 'a Kind.manager contents_list -> unit +end