From 648d631477729a0a46a81701cc8c323c5e5a8685 Mon Sep 17 00:00:00 2001 From: Killian Delarue Date: Sat, 17 Feb 2024 14:14:31 +0100 Subject: [PATCH 1/3] Manifest: octez_injector only for active protocol --- manifest/main.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/manifest/main.ml b/manifest/main.ml index 657e53edfe22..6d47bb814e16 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -6693,7 +6693,7 @@ let hash = Protocol.hash ] in let octez_injector = - only_if N.(number >= 017) @@ fun () -> + only_if N.(active && number >= 017) @@ fun () -> private_lib (sf "octez_injector_%s" short_hash) ~path:(path // "lib_injector") -- GitLab From 213170de5430b4ac93f5d52aa8c5b55dbbd5db4b Mon Sep 17 00:00:00 2001 From: Killian Delarue Date: Fri, 16 Feb 2024 11:07:46 +0100 Subject: [PATCH 2/3] Nairobi: Remove mempool plugin --- src/proto_017_PtNairob/lib_plugin/mempool.ml | 893 ------------------ src/proto_017_PtNairob/lib_plugin/mempool.mli | 219 ----- src/proto_017_PtNairob/lib_plugin/plugin.ml | 1 - .../lib_plugin/plugin_registerer.ml | 7 - 4 files changed, 1120 deletions(-) delete mode 100644 src/proto_017_PtNairob/lib_plugin/mempool.ml delete mode 100644 src/proto_017_PtNairob/lib_plugin/mempool.mli diff --git a/src/proto_017_PtNairob/lib_plugin/mempool.ml b/src/proto_017_PtNairob/lib_plugin/mempool.ml deleted file mode 100644 index f7737b7bcbd0..000000000000 --- a/src/proto_017_PtNairob/lib_plugin/mempool.ml +++ /dev/null @@ -1,893 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Nomadic Development. *) -(* Copyright (c) 2021-2022 Nomadic Labs, *) -(* Copyright (c) 2022 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 Protocol -open Alpha_context - -type nanotez = Q.t - -let nanotez_enc : nanotez Data_encoding.t = - let open Data_encoding in - def - "nanotez" - ~title:"A thousandth of a mutez" - ~description:"One thousand nanotez make a mutez (1 tez = 1e9 nanotez)" - (conv - (fun q -> (q.Q.num, q.Q.den)) - (fun (num, den) -> {Q.num; den}) - (tup2 z z)) - -let manager_op_replacement_factor_enc : Q.t Data_encoding.t = - let open Data_encoding in - def - "manager operation replacement factor" - ~title:"A manager operation's replacement factor" - ~description:"The fee and fee/gas ratio of an operation to replace another" - (conv - (fun q -> (q.Q.num, q.Q.den)) - (fun (num, den) -> {Q.num; den}) - (tup2 z z)) - -type config = { - minimal_fees : Tez.t; - minimal_nanotez_per_gas_unit : nanotez; - minimal_nanotez_per_byte : nanotez; - clock_drift : Period.t option; - replace_by_fee_factor : Q.t; - (** Factor by which the fee and fee/gas ratio of an old operation in - the mempool are both multiplied to determine the values that a new - operation must exceed in order to replace the old operation. See - the [better_fees_and_ratio] function further below. *) -} - -let default_minimal_fees = - match Tez.of_mutez 100L with None -> assert false | Some t -> t - -let default_minimal_nanotez_per_gas_unit = Q.of_int 100 - -let default_minimal_nanotez_per_byte = Q.of_int 1000 - -let managers_quota = - Stdlib.List.nth Main.validation_passes Operation_repr.manager_pass - -(* If the drift is not specified, it will be the duration of round zero. - It allows only to spam with one future round. - - /!\ Warning /!\ : current plugin implementation implies that this drift - cumulates with the accepted drift regarding the current head's timestamp. -*) -let default_config = - { - minimal_fees = default_minimal_fees; - minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit; - minimal_nanotez_per_byte = default_minimal_nanotez_per_byte; - clock_drift = None; - replace_by_fee_factor = - Q.make (Z.of_int 105) (Z.of_int 100) - (* Default value of [replace_by_fee_factor] is set to 5% *); - } - -let config_encoding : config Data_encoding.t = - let open Data_encoding in - conv - (fun { - minimal_fees; - minimal_nanotez_per_gas_unit; - minimal_nanotez_per_byte; - clock_drift; - replace_by_fee_factor; - } -> - ( minimal_fees, - minimal_nanotez_per_gas_unit, - minimal_nanotez_per_byte, - clock_drift, - replace_by_fee_factor )) - (fun ( minimal_fees, - minimal_nanotez_per_gas_unit, - minimal_nanotez_per_byte, - clock_drift, - replace_by_fee_factor ) -> - { - minimal_fees; - minimal_nanotez_per_gas_unit; - minimal_nanotez_per_byte; - clock_drift; - replace_by_fee_factor; - }) - (obj5 - (dft "minimal_fees" Tez.encoding default_config.minimal_fees) - (dft - "minimal_nanotez_per_gas_unit" - nanotez_enc - default_config.minimal_nanotez_per_gas_unit) - (dft - "minimal_nanotez_per_byte" - nanotez_enc - default_config.minimal_nanotez_per_byte) - (opt "clock_drift" Period.encoding) - (dft - "replace_by_fee_factor" - manager_op_replacement_factor_enc - default_config.replace_by_fee_factor)) - -(** Static information to store in the filter state. *) -type info = { - head : Block_header.shell_header; - round_durations : Round.round_durations; - hard_gas_limit_per_block : Gas.Arith.integral; - head_round : Round.t; - round_zero_duration : Period.t; - grandparent_level_start : Timestamp.t; -} - -let init_state_prototzresult ~head round_durations hard_gas_limit_per_block = - let open Lwt_result_syntax in - let*? head_round = - Alpha_context.Fitness.round_from_raw head.Tezos_base.Block_header.fitness - in - let round_zero_duration = Round.round_duration round_durations Round.zero in - let*? grandparent_round = - Alpha_context.Fitness.predecessor_round_from_raw head.fitness - in - let*? proposal_level_offset = - Round.level_offset_of_round - round_durations - ~round:Round.(succ grandparent_round) - in - let*? proposal_round_offset = - Round.level_offset_of_round round_durations ~round:head_round - in - let*? proposal_offset = - Period.(add proposal_level_offset proposal_round_offset) - in - let grandparent_level_start = Timestamp.(head.timestamp - proposal_offset) in - return - { - head; - round_durations; - hard_gas_limit_per_block; - head_round; - round_zero_duration; - grandparent_level_start; - } - -let init_state ~head round_durations hard_gas_limit_per_block = - Lwt.map - Environment.wrap_tzresult - (init_state_prototzresult ~head round_durations hard_gas_limit_per_block) - -let init context ~(head : Tezos_base.Block_header.shell_header) = - let open Lwt_result_syntax in - let* ( ctxt, - (_ : Receipt.balance_updates), - (_ : Migration.origination_result list) ) = - prepare - context - ~level:(Int32.succ head.level) - ~predecessor_timestamp:head.timestamp - ~timestamp:head.timestamp - |> Lwt.map Environment.wrap_tzresult - in - let round_durations = Constants.round_durations ctxt in - let hard_gas_limit_per_block = Constants.hard_gas_limit_per_block ctxt in - init_state ~head round_durations hard_gas_limit_per_block - -let flush old_info ~head = - (* To avoid the need to prepare a context as in [init], we retrieve - the [round_durations] from the previous state. Indeed, they are - only determined by the [minimal_block_delay] and - [delay_increment_per_round] constants (see - {!Raw_context.prepare}), and all the constants remain unchanged - during the lifetime of a protocol. As to - [hard_gas_limit_per_block], it is directly a protocol - constant. *) - init_state ~head old_info.round_durations old_info.hard_gas_limit_per_block - -let manager_prio p = `Low p - -let consensus_prio = `High - -let other_prio = `Medium - -let compute_manager_contents_fee_and_gas_limit contents = - let open Operation in - let l = to_list (Contents_list contents) in - List.fold_left - (fun acc -> function - | Contents (Manager_operation {fee; gas_limit; _}) -> ( - match acc with - | Error _ as e -> e - | Ok (total_fee, total_gas) -> ( - match Tez.(total_fee +? fee) with - | Ok total_fee -> Ok (total_fee, Gas.Arith.add total_gas gas_limit) - | Error _ as e -> e)) - | _ -> acc) - (Ok (Tez.zero, Gas.Arith.zero)) - l - -type Environment.Error_monad.error += Fees_too_low - -let () = - Environment.Error_monad.register_error_kind - `Permanent - ~id:"prefilter.fees_too_low" - ~title:"Operation fees are too low" - ~description:"Operation fees are too low" - ~pp:(fun ppf () -> Format.fprintf ppf "Operation fees are too low") - Data_encoding.unit - (function Fees_too_low -> Some () | _ -> None) - (fun () -> Fees_too_low) - -let size_of_operation op = - (WithExceptions.Option.get ~loc:__LOC__ - @@ Data_encoding.Binary.fixed_length - Tezos_base.Operation.shell_header_encoding) - + Data_encoding.Binary.length Operation.protocol_data_encoding op - -(** Returns the weight and resources consumption of an operation. The weight - corresponds to the one implemented by the baker, to decide which operations - to put in a block first (the code is largely duplicated). - See {!Tezos_baking_alpha.Operation_selection.weight_manager} *) -let weight_and_resources_manager_operation ~hard_gas_limit_per_block ?size ~fee - ~gas op = - let max_size = managers_quota.max_size in - let size = match size with None -> size_of_operation op | Some s -> s in - let size_f = Q.of_int size in - let gas_f = Q.of_bigint (Gas.Arith.integral_to_z gas) in - let fee_f = Q.of_int64 (Tez.to_mutez fee) in - let size_ratio = Q.(size_f / Q.of_int max_size) in - let gas_ratio = - Q.(gas_f / Q.of_bigint (Gas.Arith.integral_to_z hard_gas_limit_per_block)) - in - let resources = Q.max size_ratio gas_ratio in - (Q.(fee_f / resources), resources) - -let output_encoding = - let open Data_encoding in - obj3 - (req "outbox_level" Environment.Bounded.Non_negative_int32.encoding) - (req "message_index" n) - (req "message" Variable.string) - -let output_proof_encoding = - let open Data_encoding in - obj3 - (req - "output_proof" - Tezos_context_helpers.Context.Proof_encoding.Merkle_proof_encoding.V2 - .Tree2 - .tree_proof_encoding) - (req "output_proof_state" Sc_rollup.State_hash.encoding) - (req "output_proof_output" output_encoding) - -module Tree = struct - open Environment - include Context.Tree - - type tree = Context.tree - - type t = Context.t - - type key = string list - - type value = bytes -end - -module Wasm_machine = Environment.Wasm_2_0_0.Make (Tree) - -let discard_wasm_output_proof_early output_proof outbox_level message_index - output = - let open Lwt_syntax in - let+ result = - Environment.Context.verify_tree_proof output_proof (fun tree -> - let* output = - Wasm_machine.get_output {outbox_level; message_index} tree - in - return (tree, output)) - in - match result with - | Ok (_, Some expected_output) -> not (expected_output = output) - | _ -> false - -let kinded_hash_to_state_hash = function - | `Value hash | `Node hash -> - Sc_rollup.State_hash.context_hash_to_state_hash hash - -let is_invalid_op : type t. t manager_operation -> bool Lwt.t = - let open Lwt_syntax in - function - | Sc_rollup_execute_outbox_message - {rollup = _; cemented_commitment = _; output_proof} -> ( - match - Data_encoding.Binary.of_string_opt output_proof_encoding output_proof - with - | None -> return_true - | Some - ( output_proof, - output_proof_state, - (outbox_level, message_index, output) ) -> - let* discard_wasm_proof = - discard_wasm_output_proof_early - output_proof - outbox_level - message_index - output - in - let state_is_correct = - Sc_rollup.State_hash.equal - output_proof_state - (kinded_hash_to_state_hash - output_proof.Environment.Context.Proof.before) - in - let is_invalid = (not state_is_correct) || discard_wasm_proof in - return is_invalid) - | _ -> return_false - -let rec contains_invalid_op : type t. t Kind.manager contents_list -> bool Lwt.t - = function - | Single (Manager_operation {operation; _}) -> is_invalid_op operation - | Cons (Manager_operation {operation; _}, rest) -> - let open Lwt_syntax in - let* is_invalid = is_invalid_op operation in - if not is_invalid then contains_invalid_op rest else return_true - -let syntactic_check - ({shell = _; protocol_data = Operation_data {contents; _}} : Main.operation) - = - let open Lwt_syntax in - match contents with - | Single (Failing_noop _) - | Single (Preendorsement _) - | Single (Endorsement _) - | Single (Dal_attestation _) - | Single (Seed_nonce_revelation _) - | Single (Double_preendorsement_evidence _) - | Single (Double_endorsement_evidence _) - | Single (Double_baking_evidence _) - | Single (Activate_account _) - | Single (Proposals _) - | Single (Vdf_revelation _) - | Single (Drain_delegate _) - | Single (Ballot _) -> - Lwt.return `Well_formed - | Single (Manager_operation _) as op -> - let* is_invalid = contains_invalid_op op in - if is_invalid then return `Ill_formed else return `Well_formed - | Cons (Manager_operation _, _) as op -> - let* is_invalid = contains_invalid_op op in - if is_invalid then return `Ill_formed else return `Well_formed - -let pre_filter_manager : - type t. - info -> - config -> - Operation.packed_protocol_data -> - t Kind.manager contents_list -> - [ `Passed_prefilter of Q.t list - | `Branch_refused of tztrace - | `Branch_delayed of tztrace - | `Refused of tztrace - | `Outdated of tztrace ] = - fun info config packed_op op -> - let size = size_of_operation packed_op in - let check_gas_and_fee fee gas_limit = - let fees_in_nanotez = - Q.mul (Q.of_int64 (Tez.to_mutez fee)) (Q.of_int 1000) - in - let minimal_fees_in_nanotez = - Q.mul (Q.of_int64 (Tez.to_mutez config.minimal_fees)) (Q.of_int 1000) - in - let minimal_fees_for_gas_in_nanotez = - Q.mul - config.minimal_nanotez_per_gas_unit - (Q.of_bigint @@ Gas.Arith.integral_to_z gas_limit) - in - let minimal_fees_for_size_in_nanotez = - Q.mul config.minimal_nanotez_per_byte (Q.of_int size) - in - if - Q.compare - fees_in_nanotez - (Q.add - minimal_fees_in_nanotez - (Q.add - minimal_fees_for_gas_in_nanotez - minimal_fees_for_size_in_nanotez)) - >= 0 - then `Fees_ok - else `Refused [Environment.wrap_tzerror Fees_too_low] - in - match compute_manager_contents_fee_and_gas_limit op with - | Error err -> `Refused (Environment.wrap_tztrace err) - | Ok (fee, gas_limit) -> ( - match check_gas_and_fee fee gas_limit with - | `Refused _ as err -> err - | `Fees_ok -> - let weight, _op_resources = - weight_and_resources_manager_operation - ~hard_gas_limit_per_block:info.hard_gas_limit_per_block - ~fee - ~gas:gas_limit - packed_op - in - `Passed_prefilter [weight]) - -type Environment.Error_monad.error += Wrong_operation - -let () = - Environment.Error_monad.register_error_kind - `Temporary - ~id:"prefilter.wrong_operation" - ~title:"Wrong operation" - ~description:"Failing_noop operations are not accepted in the mempool." - ~pp:(fun ppf () -> - Format.fprintf - ppf - "Failing_noop operations are not accepted in the mempool") - Data_encoding.unit - (function Wrong_operation -> Some () | _ -> None) - (fun () -> Wrong_operation) - -type Environment.Error_monad.error += Consensus_operation_in_far_future - -let () = - Environment.Error_monad.register_error_kind - `Branch - ~id:"prefilter.Consensus_operation_in_far_future" - ~title:"Consensus operation in far future" - ~description:"Consensus operation too far in the future are not accepted." - ~pp:(fun ppf () -> - Format.fprintf - ppf - "Consensus operation too far in the future are not accepted.") - Data_encoding.unit - (function Consensus_operation_in_far_future -> Some () | _ -> None) - (fun () -> Consensus_operation_in_far_future) - -(** {2 consensus operation filtering} - - In Tenderbake, we increased a lot the number of consensus - operations, therefore it seems necessary to be able to filter consensus - operations that could be produced by a Byzantine baker mis-using - its right to produce operations in future rounds or levels. - - We consider the situation where the head is at level [h_l], - round [h_r], and with timestamp [h_ts], with the predecessor of the head - being at round [hp_r]. - We receive at a time [now] a consensus operation for level [op_l] and - round [op_r]. - - A consensus operation is considered too far in the future, and therefore filtered, - if the earliest possible starting time of its round is greater than the - current time plus a safety margin of [config.clock_drift]. - - To consider potential level 2 reorgs, we first compute the expected - timestamp of round zero at previous level [hp0_ts], - - All ops at level p_l and round r' such that time(r') is greater than (now + drift) are - deemed too far in the future: - - h_r op_ts now+drift (h_l,r') - hp0_ts h_0 h_l | | | - +----+-----+---------+-------------------+--+-----+--------------+----------- - | | | | | | | - | h_ts h_r end time | now | earliest expected - | | | | time of round r' - |<----op_r rounds duration -------->| | - | - |<--------------- operations kept ---->|<-rejected----------... - | - |<-----------operations considered by the filter -----------... - - For an operation on a proposal at the next level, we consider the minimum - starting time of the operation's round, obtained by assuming that the proposal - at the next level was built on top of a proposal at round 0 for the current - level, itself based on a proposal at round 0 of previous level. - Operations on proposal with higher levels are treated similarly. - - All ops at the next level and round r' such that timestamp(r') > now+drift - are deemed too far in the future. - - r=0 r=1 h_r now now+drift (h_l+1,r') - hp0_ts h_0 h_l h_l | | | - +----+---- |-------+----+---------+----------+----------+---------- - | | | | | - | t0 | h_ts earliest expected - | | | | time of round r' - |<--- | earliest| | - | next level| | - | |<---------------------------------->| - round_offset(r') - - *) - -(** At a given level a consensus operation is acceptable if its earliest - expected timestamp, [op_earliest_ts] is below the current clock with an - accepted drift for the clock given by a configuration. *) -let acceptable ~drift ~op_earliest_ts ~now_timestamp = - Timestamp.( - now_timestamp +? drift >|? fun now_drifted -> op_earliest_ts <= now_drifted) - -(** Check that an operation with the given [op_round], at level [op_level] - is likely to be correct, meaning it could have been produced before - now (+ the safety margin from configuration). - - Given an operation at level greater or equal than/to the current level, we - compute the expected timestamp of the operation's round. If the operation - is at a greater level, we assume that it is based on the proposal at round - zero of the current level. - - All operations whose (level, round) is lower than or equal to the current - head are deemed valid. - Note that in case where their is a high drift in the computer clock, they - might not have been considered valid by comparing their expected timestamp - to the clock. - - This is a stricter than necessary filter as it will reject operations that - could be valid in the current timeframe if the proposal they endorse is - built over a predecessor of the current proposal that would be of lower - round than the current one. - - What can we do that would be smarter: get current head's predecessor round - and timestamp to compute the timestamp t0 of a predecessor that would have - been proposed at round 0. - - Timestamp of round at current level for an alternative head that would be - based on such proposal would be computed based on t0. - For level higher than current head, compute the round's earliest timestamp - if all proposal passed at round 0 starting from t0. - *) -let acceptable_op ~config ~round_durations ~round_zero_duration ~proposal_level - ~proposal_round ~proposal_timestamp - ~(proposal_predecessor_level_start : Timestamp.t) ~op_level ~op_round - ~now_timestamp = - if - Raw_level.(succ op_level < proposal_level) - || (op_level = proposal_level && op_round <= proposal_round) - then - (* Past and current round operations are not in the future *) - (* This case could be handled directly in `pre_filter_far_future_consensus_ops` - for a (slightly) better performance. *) - Ok true - else - (* If, by some tolerance on local clock drift, the timestamp of the - current head is itself in the future, we use this time instead of - now_timestamp *) - let now_timestamp = Timestamp.(max now_timestamp proposal_timestamp) in - (* Computing when the current level started. *) - let drift = Option.value ~default:round_zero_duration config.clock_drift in - (* We compute the earliest timestamp possible [op_earliest_ts] for the - operation's (level,round), as if all proposals were accepted at round 0 - since the previous level. *) - (* Invariant: [op_level + 1 >= proposal_level] *) - let level_offset = Raw_level.(diff (succ op_level) proposal_level) in - Period.mult level_offset round_zero_duration >>? fun time_shift -> - Timestamp.(proposal_predecessor_level_start +? time_shift) - >>? fun earliest_op_level_start -> - (* computing the operations's round start from it's earliest - possible level start *) - Round.timestamp_of_another_round_same_level - round_durations - ~current_round:Round.zero - ~current_timestamp:earliest_op_level_start - ~considered_round:op_round - >>? fun op_earliest_ts -> - (* We finally check that the expected time of the operation is - acceptable *) - acceptable ~drift ~op_earliest_ts ~now_timestamp - -let pre_filter_far_future_consensus_ops info config - ({level = op_level; round = op_round; _} : consensus_content) : bool Lwt.t = - let res = - let open Result_syntax in - let now_timestamp = Time.System.now () |> Time.System.to_protocol in - let* proposal_level = Raw_level.of_int32 info.head.level in - acceptable_op - ~config - ~round_durations:info.round_durations - ~round_zero_duration:info.round_zero_duration - ~proposal_level - ~proposal_round:info.head_round - ~proposal_timestamp:info.head.timestamp - ~proposal_predecessor_level_start:info.grandparent_level_start - ~op_level - ~op_round - ~now_timestamp - in - match res with Ok b -> Lwt.return b | Error _ -> Lwt.return_false - -(** A quasi infinite amount of "valid" (pre)endorsements could be - sent by a committee member, one for each possible round number. - - This filter rejects (pre)endorsements that refer to a round - that could not have been reached within the time span between - the last head's timestamp and the current local clock. - - We add [config.clock_drift] time as a safety margin. - *) -let pre_filter info config - ({shell = _; protocol_data = Operation_data {contents; _} as op} : - Main.operation) = - let prefilter_manager_op manager_op = - Lwt.return - @@ - match pre_filter_manager info config op manager_op with - | `Passed_prefilter prio -> `Passed_prefilter (manager_prio prio) - | (`Branch_refused _ | `Branch_delayed _ | `Refused _ | `Outdated _) as err - -> - err - in - match contents with - | Single (Failing_noop _) -> - Lwt.return (`Refused [Environment.wrap_tzerror Wrong_operation]) - | Single (Preendorsement consensus_content) - | Single (Endorsement consensus_content) -> - pre_filter_far_future_consensus_ops info config consensus_content - >>= fun keep -> - if keep then Lwt.return @@ `Passed_prefilter consensus_prio - else - Lwt.return - (`Branch_refused - [Environment.wrap_tzerror Consensus_operation_in_far_future]) - | Single (Dal_attestation _) - | Single (Seed_nonce_revelation _) - | Single (Double_preendorsement_evidence _) - | Single (Double_endorsement_evidence _) - | Single (Double_baking_evidence _) - | Single (Activate_account _) - | Single (Proposals _) - | Single (Vdf_revelation _) - | Single (Drain_delegate _) - | Single (Ballot _) -> - Lwt.return @@ `Passed_prefilter other_prio - | Single (Manager_operation _) as op -> prefilter_manager_op op - | Cons (Manager_operation _, _) as op -> prefilter_manager_op op - -let is_manager_operation op = - match Operation.acceptable_pass op with - | Some pass -> Compare.Int.equal pass Operation_repr.manager_pass - | None -> false - -(* Should not fail on a valid manager operation. *) -let compute_fee_and_gas_limit {protocol_data = Operation_data data; _} = - compute_manager_contents_fee_and_gas_limit data.contents - -let gas_as_q gas = Gas.Arith.integral_to_z gas |> Q.of_bigint - -let fee_and_ratio_as_q fee gas = - let fee = Tez.to_mutez fee |> Z.of_int64 |> Q.of_bigint in - let gas = gas_as_q gas in - let ratio = Q.div fee gas in - (fee, ratio) - -let bumped_fee_and_ratio_as_q config fee gas = - let bump = Q.mul config.replace_by_fee_factor in - let fee, ratio = fee_and_ratio_as_q fee gas in - (bump fee, bump ratio) - -(** Determine whether the new manager operation is sufficiently better - than the old manager operation to replace it. Sufficiently better - means that the new operation's fee and fee/gas ratio are both - greater than or equal to the old operation's same metrics bumped by - the factor [config.replace_by_fee_factor]. *) -let better_fees_and_ratio config old_gas old_fee new_gas new_fee = - let bumped_old_fee, bumped_old_ratio = - bumped_fee_and_ratio_as_q config old_fee old_gas - in - let new_fee, new_ratio = fee_and_ratio_as_q new_fee new_gas in - Q.compare new_fee bumped_old_fee >= 0 - && Q.compare new_ratio bumped_old_ratio >= 0 - -(** [conflict_handler config] returns a conflict handler for - {!Mempool.add_operation} (see {!Mempool.conflict_handler}). - - - For non-manager operations, we select the greater operation - according to {!Operation.compare}. - - - A manager operation is replaced only when the new operation's - fee and fee/gas ratio both exceed the old operation's by at least a - factor of [config.replace_by_fee_factor] (see {!better_fees_and_ratio}). - - Precondition: both operations must be individually valid (because - of the call to {!Operation.compare}). *) -let conflict_handler config : Mempool.conflict_handler = - fun ~existing_operation ~new_operation -> - let (_ : Operation_hash.t), old_op = existing_operation in - let (_ : Operation_hash.t), new_op = new_operation in - if is_manager_operation old_op && is_manager_operation new_op then - let new_op_is_better = - let open Result_syntax in - let* old_fee, old_gas_limit = compute_fee_and_gas_limit old_op in - let* new_fee, new_gas_limit = compute_fee_and_gas_limit new_op in - return - (better_fees_and_ratio - config - old_gas_limit - old_fee - new_gas_limit - new_fee) - in - match new_op_is_better with - | Ok b when b -> `Replace - | Ok _ | Error _ -> `Keep - else if Operation.compare existing_operation new_operation < 0 then `Replace - else `Keep - -let int64_ceil_of_q q = - let n = Q.to_int64 q in - if Q.(equal q (of_int64 n)) then n else Int64.succ n - -(* Compute the minimal fee (expressed in mutez) that [candidate_op] - would need to have in order for the {!conflict_handler} to let it - replace [op_to_replace], when both operations are manager - operations. - - As specified in {!conflict_handler}, this means that [candidate_op] - with the returned fee needs to have both its fee and its fee/gas - ratio exceed (or match) [op_to_replace]'s same metrics bumped by - the {!config}'s [replace_by_fee_factor]. - - Return [None] when at least one operation is not a manager - operation. - - Also return [None] if both operations are manager operations but - there was an error while computing the needed fee. However, note - that this cannot happen when both manager operations have been - successfully validated by the protocol. *) -let fee_needed_to_replace_by_fee config ~op_to_replace ~candidate_op = - if is_manager_operation candidate_op && is_manager_operation op_to_replace - then - (let open Result_syntax in - let* _fee, candidate_gas = compute_fee_and_gas_limit candidate_op in - let* old_fee, old_gas = compute_fee_and_gas_limit op_to_replace in - if Gas.Arith.(old_gas = zero || candidate_gas = zero) then - (* This should not happen when both operations are valid. *) - Result.return_none - else - let candidate_gas = gas_as_q candidate_gas in - let bumped_old_fee, bumped_old_ratio = - bumped_fee_and_ratio_as_q config old_fee old_gas - in - (* The new operation needs to exceed both the bumped fee and the - bumped ratio to make {!better_fees_and_ratio} return [true]. - (Having fee or ratio equal to its bumped counterpart is ok too, - hence the [ceil] in [int64_ceil_of_q].) *) - let fee_needed_for_fee = int64_ceil_of_q bumped_old_fee in - let fee_needed_for_ratio = - int64_ceil_of_q Q.(bumped_old_ratio * candidate_gas) - in - Result.return_some (max fee_needed_for_fee fee_needed_for_ratio)) - |> Option.of_result |> Option.join - else None - -let find_manager {shell = _; protocol_data = Operation_data {contents; _}} = - match contents with - | Single (Manager_operation {source; _}) -> Some source - | Cons (Manager_operation {source; _}, _) -> Some source - | Single - ( Preendorsement _ | Endorsement _ | Dal_attestation _ | Proposals _ - | Ballot _ | Seed_nonce_revelation _ | Vdf_revelation _ - | Double_baking_evidence _ | Double_preendorsement_evidence _ - | Double_endorsement_evidence _ | Activate_account _ | Drain_delegate _ - | Failing_noop _ ) -> - None - -(* The purpose of this module is to offer a version of - [fee_needed_to_replace_by_fee] where the caller doesn't need to - provide the [op_to_replace]. Instead, it needs to call - [Conflict_map.update] every time a new operation is added to the - mempool. This setup prevents the mempool plugin from exposing the - notion of manager operations and their source. *) -module Conflict_map = struct - (* The state consists in a map of all validated manager operations, - indexed by their source. - - Note that the protocol already enforces that there is at most one - operation per source. - - The state only tracks manager operations because other kinds of - operations don't have fees that we might adjust to change the - outcome of the {!conflict_handler}, so - [fee_needed_to_replace_by_fee] will always return [None] when - they are involved anyway. *) - type t = packed_operation Signature.Public_key_hash.Map.t - - let empty = Signature.Public_key_hash.Map.empty - - (* Remove all the [replacements] from the state, then add - [new_operation]. Non-manager operations are ignored. - - It is important to remove before adding: otherwise, we would - remove the newly added operation when it has the same manager as - one of the replacements. *) - let update conflict_map ~new_operation ~replacements = - let conflict_map = - List.fold_left - (fun conflict_map op -> - match find_manager op with - | Some manager -> - Signature.Public_key_hash.Map.remove manager conflict_map - | None -> (* Non-manager operation: ignore it. *) conflict_map) - conflict_map - replacements - in - match find_manager new_operation with - | Some manager -> - Signature.Public_key_hash.Map.add manager new_operation conflict_map - | None -> (* Non-manager operation: ignore it. *) conflict_map - - let fee_needed_to_replace_by_fee config ~candidate_op ~conflict_map = - match find_manager candidate_op with - | None -> (* Non-manager operation. *) None - | Some manager -> ( - match Signature.Public_key_hash.Map.find manager conflict_map with - | None -> - (* This can only happen when the pre-existing conflicting - operation is a [Drain_delegate], which cannot be replaced by a - manager operation regardless of the latter's fee. *) - None - | Some op_to_replace -> - fee_needed_to_replace_by_fee config ~candidate_op ~op_to_replace) -end - -let fee_needed_to_overtake ~op_to_overtake ~candidate_op = - if is_manager_operation candidate_op && is_manager_operation op_to_overtake - then - (let open Result_syntax in - let* _fee, candidate_gas = compute_fee_and_gas_limit candidate_op in - let* target_fee, target_gas = compute_fee_and_gas_limit op_to_overtake in - if Gas.Arith.(target_gas = zero || candidate_gas = zero) then - (* This should not happen when both operations are valid. *) - Result.return_none - else - (* Compute the target ratio as in {!Operation_repr.weight_manager}. - We purposefully don't use {!fee_and_ratio_as_q} because the code - here needs to stay in sync with {!Operation_repr.weight_manager} - rather than {!better_fees_and_ratio}. *) - let target_fee = Q.of_int64 (Tez.to_mutez target_fee) in - let target_gas = Q.of_bigint (Gas.Arith.integral_to_z target_gas) in - let target_ratio = Q.(target_fee / target_gas) in - (* Compute the minimal fee needed to have a strictly greater ratio. *) - let candidate_gas = Q.of_bigint (Gas.Arith.integral_to_z candidate_gas) in - Result.return_some - (Int64.succ Q.(to_int64 (target_ratio * candidate_gas)))) - |> Option.of_result |> Option.join - else None - -module Internal_for_tests = struct - let default_config_with_clock_drift clock_drift = - {default_config with clock_drift} - - let default_config_with_replace_factor replace_by_fee_factor = - {default_config with replace_by_fee_factor} - - let get_clock_drift {clock_drift; _} = clock_drift - - let acceptable_op = acceptable_op - - let fee_needed_to_replace_by_fee = fee_needed_to_replace_by_fee -end diff --git a/src/proto_017_PtNairob/lib_plugin/mempool.mli b/src/proto_017_PtNairob/lib_plugin/mempool.mli deleted file mode 100644 index 8157d174f705..000000000000 --- a/src/proto_017_PtNairob/lib_plugin/mempool.mli +++ /dev/null @@ -1,219 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Nomadic Development. *) -(* Copyright (c) 2021 Nomadic Labs, *) -(* Copyright (c) 2022 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. *) -(* *) -(*****************************************************************************) - -(** Plugin for the shell mempool. It must include the signature - [FILTER.Mempool] from [lib_shell/shell_plugin.mli]. *) - -(** Settings for the {!pre_filter}: - - minimal fees to accept an operation (absolute, relative to the - gas limit, and relative to the byte size) - - clock drift for the prefiltering of consensus operations - - and for the {!conflict_handler}: - - replacement factor, that is, how much better a new manager - operation needs to be, in terms of both absolute fees and fee/gas - ratios, in order to replace an old conflicting manager operation. *) -type config - -(** Default parameters. *) -val default_config : config - -(** Encoding for {!config}. *) -val config_encoding : config Data_encoding.t - -(** Static information needed by {!pre_filter}. - - It depends on the [head] block upon which a mempool is built. *) -type info - -(** Create an {!info} based on the [head] block and the current - context. *) -val init : - Environment.Context.t -> - head:Block_header.shell_header -> - (info, tztrace) result Lwt.t - -(** Create a new {!info} based on the [head] block. - - Parts of the old {!info} (which may have been built on - a different block) are recycled, so that this function is more - efficient than {!init} and does not need an - {!Environment.Context.t} argument. *) -val flush : info -> head:Block_header.shell_header -> info tzresult Lwt.t - -(** Perform some syntactic checks on the operation. - - To be used mostly as an exceptional mechanism to prevent - ill-formed operations to block block application. - - Should be called before the {!pre_filter}, does not need a context. *) -val syntactic_check : - Protocol.Alpha_context.packed_operation -> [`Well_formed | `Ill_formed] Lwt.t - -(** Perform some preliminary checks on an operation. - - For manager operations, check that its fee, fee/gas ratio, and - fee/size ratio all meet the minimal requirements specified in the - {!config}. - - For consensus operations, check that it is possible for the - operation to have been produced before now (plus additional time - equal to the [clock_drift] from {!config}, as a safety margin). - Indeed, without this check, a baker could flood the network with - consensus operations for any future rounds or levels. The ml file - contains more detailled explanations with diagrams. *) -val pre_filter : - info -> - config -> - Protocol.Alpha_context.packed_operation -> - [ `Passed_prefilter of [`High | `Medium | `Low of Q.t list] - | `Branch_delayed of tztrace - | `Branch_refused of tztrace - | `Refused of tztrace - | `Outdated of tztrace ] - Lwt.t - -(** Return a conflict handler for {!Protocol.Mempool.add_operation} - (see {!Protocol.Mempool.conflict_handler}). - - For non-manager operations, select the greater operation according - to {!Protocol.Alpha_context.Operation.compare}. - - A manager operation is replaced only when the new operation's fee - and fee/gas ratio both exceed (or match) the old operation's metrics - multiplied by the [replace_by_fee] factor specified in the {!config}. - - Precondition: both operations must be individually valid (to be - able to call {!Protocol.Alpha_context.Operation.compare}). *) -val conflict_handler : config -> Protocol.Mempool.conflict_handler - -(** The purpose of this module is to provide the - [fee_needed_to_replace_by_fee] function. For this function to be - correct, the caller must maintain the state of type [t] by calling - [update] on each successfully validated operation and its induced - replacements. *) -module Conflict_map : sig - (** Internal state needed by [fee_needed_to_replace_by_fee]. *) - type t - - (** Initial state. *) - val empty : t - - (** Removes all the [replacements] from the state then adds - [new_operation]. *) - val update : - t -> - new_operation:Protocol.Alpha_context.packed_operation -> - replacements:Protocol.Alpha_context.packed_operation list -> - t - - (** This function should be called when - [Protocol.Mempool.add_operation] has returned [Unchanged]. This - means that the [candidate_op] has been rejected because there was - a conflict with an pre-existing operation and the - {!val-conflict_handler} has returned [`Keep]. When both - operations are manager operations, this function returns the - minimal fee (in mutez) that [candidate_op] would need in order to - win the conflict, i.e. make the {!val-conflict_handler} return - [`Replace] instead. Otherwise, it returns [None]. *) - val fee_needed_to_replace_by_fee : - config -> - candidate_op:Protocol.Alpha_context.packed_operation -> - conflict_map:t -> - int64 option -end - -(** Compute the minimal fee (expressed in mutez) that [candidate_op] would - need to have in order to be strictly greater than [op_to_overtake] - according to {!Protocol.Alpha_context.Operation.compare}, when both - operations are manager operations. - - Return [None] when at least one operation is not a manager operation. - - Also return [None] if both operations are manager operations but - there was an error while computing the needed fee. However, note - that this cannot happen when both manager operations have been - successfully validated by the protocol. *) -val fee_needed_to_overtake : - op_to_overtake:Protocol.Alpha_context.packed_operation -> - candidate_op:Protocol.Alpha_context.packed_operation -> - int64 option - -(** The following type, encoding, and default values are exported for - [bin_sc_rollup_node/configuration.ml]. *) - -(** An amount of fees in nanotez. *) -type nanotez = Q.t - -(** Encoding for {!nanotez}. *) -val nanotez_enc : nanotez Data_encoding.t - -(** Minimal absolute fees in {!default_config}. *) -val default_minimal_fees : Protocol.Alpha_context.Tez.t - -(** Minimal fee over gas_limit ratio in {!default_config}. *) -val default_minimal_nanotez_per_gas_unit : nanotez - -(** Minimal fee over byte size ratio in {!default_config}. *) -val default_minimal_nanotez_per_byte : nanotez - -module Internal_for_tests : sig - open Protocol.Alpha_context - - (** {!default_config} with a custom value for the [clock_drift] field. *) - val default_config_with_clock_drift : Period.t option -> config - - (** {!default_config} with a custom [replace_by_fee_factor]. *) - val default_config_with_replace_factor : nanotez -> config - - (** Return the [clock_drift] field of the given {!config}. *) - val get_clock_drift : config -> Period.t option - - (** The main auxiliary function for {!pre_filter} regarding - consensus operations. *) - val acceptable_op : - config:config -> - round_durations:Round.round_durations -> - round_zero_duration:Period.t -> - proposal_level:Raw_level.t -> - proposal_round:Round.t -> - proposal_timestamp:Timestamp.time -> - proposal_predecessor_level_start:Timestamp.time -> - op_level:Raw_level.t -> - op_round:Round.t -> - now_timestamp:Timestamp.time -> - bool Environment.Error_monad.tzresult - - (** The main component of - {!Conflict_map.fee_needed_to_replace_by_fee}. See comment in the - ml file. *) - val fee_needed_to_replace_by_fee : - config -> - op_to_replace:Protocol.Alpha_context.packed_operation -> - candidate_op:Protocol.Alpha_context.packed_operation -> - int64 option -end diff --git a/src/proto_017_PtNairob/lib_plugin/plugin.ml b/src/proto_017_PtNairob/lib_plugin/plugin.ml index 8fb75ce08aad..63fa99ac034b 100644 --- a/src/proto_017_PtNairob/lib_plugin/plugin.ml +++ b/src/proto_017_PtNairob/lib_plugin/plugin.ml @@ -25,7 +25,6 @@ (* *) (*****************************************************************************) -module Mempool = Mempool module View_helpers = View_helpers module RPC = RPC module Metrics = Metrics_plugin diff --git a/src/proto_017_PtNairob/lib_plugin/plugin_registerer.ml b/src/proto_017_PtNairob/lib_plugin/plugin_registerer.ml index a34184865ed4..89b9f9b6cf33 100644 --- a/src/proto_017_PtNairob/lib_plugin/plugin_registerer.ml +++ b/src/proto_017_PtNairob/lib_plugin/plugin_registerer.ml @@ -23,11 +23,6 @@ (* *) (*****************************************************************************) -module Validation = struct - include Registerer.Registered - module Plugin = Plugin.Mempool -end - module RPC = struct module Proto = Registerer.Registered include Plugin.RPC @@ -39,8 +34,6 @@ module Metrics = struct let hash = Registerer.Registered.hash end -let () = Protocol_plugin.register_validation_plugin (module Validation) - let () = Protocol_plugin.register_rpc (module RPC) let () = Protocol_plugin.register_metrics (module Metrics) -- GitLab From 3951a103c989947774ccf620b1f53808c054b2b3 Mon Sep 17 00:00:00 2001 From: Killian Delarue Date: Sat, 17 Feb 2024 14:09:54 +0100 Subject: [PATCH 3/3] Nairobi: Remove injector plugin --- .gitlab/ci/jobs/packaging/opam_package.yml | 2 - contrib/octez_injector_server/dune | 4 - dune-project | 1 - opam/octez-injector-server.opam | 1 - opam/tezos-injector-017-PtNairob.opam | 24 - src/proto_017_PtNairob/lib_injector/dune | 23 - .../lib_injector/injector_plugin.ml | 441 ------------------ 7 files changed, 496 deletions(-) delete mode 100644 opam/tezos-injector-017-PtNairob.opam delete mode 100644 src/proto_017_PtNairob/lib_injector/dune delete mode 100644 src/proto_017_PtNairob/lib_injector/injector_plugin.ml diff --git a/.gitlab/ci/jobs/packaging/opam_package.yml b/.gitlab/ci/jobs/packaging/opam_package.yml index 7f4d5a1b17d2..230901aefbda 100644 --- a/.gitlab/ci/jobs/packaging/opam_package.yml +++ b/.gitlab/ci/jobs/packaging/opam_package.yml @@ -878,8 +878,6 @@ opam:tezos-dal-node-services: variables: package: tezos-dal-node-services -# Ignoring unreleased package tezos-injector-017-PtNairob. - # Ignoring unreleased package tezos-injector-018-Proxford. # Ignoring unreleased package tezos-injector-alpha. diff --git a/contrib/octez_injector_server/dune b/contrib/octez_injector_server/dune index 360834d27ee7..46e31738a335 100644 --- a/contrib/octez_injector_server/dune +++ b/contrib/octez_injector_server/dune @@ -15,9 +15,6 @@ octez-shell-libs.client-base octez-shell-libs.client-base-unix data-encoding - (select void_for_linking-octez_injector_PtNairob from - (octez_injector_PtNairob -> void_for_linking-octez_injector_PtNairob.empty) - (-> void_for_linking-octez_injector_PtNairob.empty)) (select void_for_linking-octez_injector_Proxford from (octez_injector_Proxford -> void_for_linking-octez_injector_Proxford.empty) (-> void_for_linking-octez_injector_Proxford.empty)) @@ -42,6 +39,5 @@ (rule (action (progn - (write-file void_for_linking-octez_injector_PtNairob.empty "") (write-file void_for_linking-octez_injector_Proxford.empty "") (write-file void_for_linking-octez_injector_alpha.empty "")))) diff --git a/dune-project b/dune-project index 9d879c6f78c8..d73a6eebe79e 100644 --- a/dune-project +++ b/dune-project @@ -91,7 +91,6 @@ (package (name tezos-dac-node-lib-test)(allow_empty)) (package (name tezos-dal-node-lib)) (package (name tezos-dal-node-services)) -(package (name tezos-injector-017-PtNairob)(allow_empty)) (package (name tezos-injector-018-Proxford)(allow_empty)) (package (name tezos-injector-alpha)(allow_empty)) (package (name tezos-lazy-containers-tests)(allow_empty)) diff --git a/opam/octez-injector-server.opam b/opam/octez-injector-server.opam index 66932c8c230a..ca87e0c42fdb 100644 --- a/opam/octez-injector-server.opam +++ b/opam/octez-injector-server.opam @@ -16,7 +16,6 @@ depends: [ "data-encoding" { >= "0.7.1" & < "1.0.0" } ] depopts: [ - "tezos-injector-017-PtNairob" "tezos-injector-018-Proxford" "tezos-injector-alpha" ] diff --git a/opam/tezos-injector-017-PtNairob.opam b/opam/tezos-injector-017-PtNairob.opam deleted file mode 100644 index 6f869b9ece2a..000000000000 --- a/opam/tezos-injector-017-PtNairob.opam +++ /dev/null @@ -1,24 +0,0 @@ -# This file was automatically generated, do not edit. -# Edit file manifest/main.ml instead. -opam-version: "2.0" -maintainer: "contact@tezos.com" -authors: ["Tezos devteam"] -homepage: "https://www.tezos.com/" -bug-reports: "https://gitlab.com/tezos/tezos/issues" -dev-repo: "git+https://gitlab.com/tezos/tezos.git" -license: "MIT" -depends: [ - "dune" { >= "3.11.1" } - "ocaml" { >= "4.14" } - "octez-libs" - "tezos-protocol-017-PtNairob" - "octez-injector" - "octez-protocol-017-PtNairob-libs" - "octez-shell-libs" -] -build: [ - ["rm" "-r" "vendors" "contrib"] - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -synopsis: "Tezos/Protocol: protocol-specific library for the injector binary" diff --git a/src/proto_017_PtNairob/lib_injector/dune b/src/proto_017_PtNairob/lib_injector/dune deleted file mode 100644 index 13a753baf4e8..000000000000 --- a/src/proto_017_PtNairob/lib_injector/dune +++ /dev/null @@ -1,23 +0,0 @@ -; This file was automatically generated, do not edit. -; Edit file manifest/main.ml instead. - -(library - (name octez_injector_PtNairob) - (package tezos-injector-017-PtNairob) - (instrumentation (backend bisect_ppx)) - (libraries - octez-libs.base - tezos-protocol-017-PtNairob.protocol - octez-injector - octez-protocol-017-PtNairob-libs.client - octez-shell-libs.client-base - octez-protocol-017-PtNairob-libs.plugin) - (library_flags (:standard -linkall)) - (flags - (:standard) - -open Tezos_base.TzPervasives - -open Tezos_protocol_017_PtNairob - -open Octez_injector - -open Tezos_client_017_PtNairob - -open Tezos_client_base - -open Tezos_protocol_plugin_017_PtNairob)) diff --git a/src/proto_017_PtNairob/lib_injector/injector_plugin.ml b/src/proto_017_PtNairob/lib_injector/injector_plugin.ml deleted file mode 100644 index ed2d1e11ec3f..000000000000 --- a/src/proto_017_PtNairob/lib_injector/injector_plugin.ml +++ /dev/null @@ -1,441 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Functori, *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context -open Protocol_client_context -open Injector_common -open Injector_sigs -open Injector_server -open Injector_server_operation -module Block_cache = - Aches_lwt.Lache.Make_result - (Aches.Rache.Transfer (Aches.Rache.LRU) (Block_hash)) - -module Proto_client = struct - open Tezos_micheline - - type operation = Injector_server_operation.t - - type state = Injector_server.state - - type unsigned_operation = - Tezos_base.Operation.shell_header * packed_contents_list - - let max_operation_data_length = Constants.max_operation_data_length - - let manager_pass = Operation_repr.manager_pass - - let to_manager_operation : t -> packed_manager_operation = function - | Transaction {amount; destination; parameters} -> - let destination = - Contract.of_b58check destination - |> WithExceptions.Result.to_exn_f ~error:(fun _trace -> - Stdlib.failwith - "Injector_plugin.to_manager_operation: invalid destination") - in - let entrypoint, parameters = - match parameters with - | Some {entrypoint; value} -> - let entrypoint = - Entrypoint.of_string_lax entrypoint - |> WithExceptions.Result.to_exn_f ~error:(fun _trace -> - Stdlib.failwith - "Injector_plugin.to_manager_operation: invalid \ - entrypoint") - in - let expr = - Michelson_v1_parser.parse_expression value - |> Micheline_parser.no_parsing_error - |> WithExceptions.Result.to_exn_f ~error:(fun _trace -> - Stdlib.failwith - "Injector_plugin.to_manager_operation: invalid \ - parameters") - in - (entrypoint, Script.lazy_expr expr.expanded) - | None -> (Entrypoint.default, Script.unit_parameter) - in - Manager - (Transaction - { - amount = Tez.of_mutez_exn amount; - destination; - parameters; - entrypoint; - }) - - let of_manager_operation : type kind. kind manager_operation -> t option = - function - | Transaction {amount; parameters; entrypoint; destination} -> - Option.bind (Data_encoding.force_decode parameters) (fun parameters -> - Some - (Transaction - { - amount = Tez.to_mutez amount; - destination = Contract.to_b58check destination; - parameters = - Some - { - value = - Michelson_v1_printer.micheline_string_of_expression - ~zero_loc:true - parameters; - entrypoint = Entrypoint.to_string entrypoint; - }; - })) - | _ -> None - - let manager_operation_size (Manager operation) = - let contents = - Manager_operation - { - source = Signature.Public_key_hash.zero; - operation; - fee = Tez.zero; - counter = Manager_counter.Internal_for_tests.of_int 0; - gas_limit = Gas.Arith.zero; - storage_limit = Z.zero; - } - in - Data_encoding.Binary.length Operation.contents_encoding (Contents contents) - - let operation_size op = manager_operation_size (to_manager_operation op) - - (* The operation size overhead is an upper bound (in practice) of the overhead - that will be added to a manager operation. To compute it we can use any - manager operation (here a revelation), add an overhead with upper bounds as - values (for the fees, limits, counters, etc.) and compare the encoded - operations with respect to their size. - NOTE: This information is only used to pre-select operations from the - injector queue as a candidate batch. *) - let operation_size_overhead = - let dummy_operation = - Reveal - (Signature.Public_key.of_b58check_exn - "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav") - in - let dummy_contents = - Manager_operation - { - source = Signature.Public_key_hash.zero; - operation = dummy_operation; - fee = Tez.of_mutez_exn 3_000_000L; - counter = Manager_counter.Internal_for_tests.of_int 500_000; - gas_limit = Gas.Arith.integral_of_int_exn 500_000; - storage_limit = Z.of_int 500_000; - } - in - let dummy_size = - Data_encoding.Binary.length - Operation.contents_encoding - (Contents dummy_contents) - in - dummy_size - manager_operation_size (Manager dummy_operation) - - let manager_operation_result_status (type kind) - (op_result : kind Apply_results.manager_operation_result) : - operation_status = - match op_result with - | Applied _ -> Successful - | Backtracked (_, None) -> Unsuccessful Backtracked - | Skipped _ -> Unsuccessful Skipped - | Backtracked (_, Some err) - (* Backtracked because internal operation failed *) - | Failed (_, err) -> - Unsuccessful (Failed (Environment.wrap_tztrace err)) - - let operation_result_status (type kind) - (op_result : kind Apply_results.contents_result) : operation_status = - match op_result with - | Preendorsement_result _ -> Successful - | Endorsement_result _ -> Successful - | Dal_attestation_result _ -> Successful - | Seed_nonce_revelation_result _ -> Successful - | Vdf_revelation_result _ -> Successful - | Double_endorsement_evidence_result _ -> Successful - | Double_preendorsement_evidence_result _ -> Successful - | Double_baking_evidence_result _ -> Successful - | Activate_account_result _ -> Successful - | Proposals_result -> Successful - | Ballot_result -> Successful - | Drain_delegate_result _ -> Successful - | Manager_operation_result {operation_result; _} -> - manager_operation_result_status operation_result - - let operation_contents_status (type kind) - (contents : kind Apply_results.contents_result_list) ~index : - operation_status tzresult = - let rec rec_status : - type kind. int -> kind Apply_results.contents_result_list -> _ = - fun n -> function - | Apply_results.Single_result _ when n <> 0 -> - error_with "No operation with index %d" index - | Single_result result -> Ok (operation_result_status result) - | Cons_result (result, _rest) when n = 0 -> - Ok (operation_result_status result) - | Cons_result (_result, rest) -> rec_status (n - 1) rest - in - rec_status index contents - - let operation_status_of_receipt (operation : Protocol.operation_receipt) - ~index : operation_status tzresult = - match (operation : _) with - | No_operation_metadata -> - error_with "Cannot find operation status because metadata is missing" - | Operation_metadata {contents} -> operation_contents_status contents ~index - - let get_block_operations = - let ops_cache = Block_cache.create 32 in - fun cctxt block_hash -> - Block_cache.bind_or_put - ops_cache - block_hash - (fun block_hash -> - let open Lwt_result_syntax in - let+ operations = - Alpha_block_services.Operations.operations_in_pass - cctxt - ~chain:cctxt#chain - ~block:(`Hash (block_hash, 0)) - ~metadata:`Always - manager_pass - in - List.fold_left - (fun acc (op : Alpha_block_services.operation) -> - Operation_hash.Map.add op.hash op acc) - Operation_hash.Map.empty - operations) - Lwt.return - - let operation_status (node_ctxt : state) block_hash operation_hash ~index = - let open Lwt_result_syntax in - let* operations = get_block_operations node_ctxt.cctxt block_hash in - match Operation_hash.Map.find_opt operation_hash operations with - | None -> return_none - | Some operation -> ( - match operation.receipt with - | Empty -> - failwith "Cannot find operation status because metadata is empty" - | Too_large -> - failwith - "Cannot find operation status because metadata is too large" - | Receipt receipt -> - let*? status = operation_status_of_receipt receipt ~index in - return_some status) - - let dummy_sk_uri = - WithExceptions.Result.get_ok ~loc:__LOC__ - @@ Tezos_signer_backends.Unencrypted.make_sk - @@ Signature.Secret_key.of_b58check_exn - "edsk3UqeiQWXX7NFEY1wUs6J1t2ez5aQ3hEWdqX5Jr5edZiGLW8nZr" - - let simulate_operations cctxt ~force ~source ~src_pk ~successor_level - ~fee_parameter ?safety_guard operations = - let open Lwt_result_syntax in - let fee_parameter : Injection.fee_parameter = - { - minimal_fees = Tez.of_mutez_exn fee_parameter.minimal_fees.mutez; - minimal_nanotez_per_byte = fee_parameter.minimal_nanotez_per_byte; - minimal_nanotez_per_gas_unit = - fee_parameter.minimal_nanotez_per_gas_unit; - force_low_fee = fee_parameter.force_low_fee; - fee_cap = Tez.of_mutez_exn fee_parameter.fee_cap.mutez; - burn_cap = Tez.of_mutez_exn fee_parameter.burn_cap.mutez; - } - in - let open Annotated_manager_operation in - let annotated_operations = - List.map - (fun operation -> - let (Manager operation) = to_manager_operation operation in - Annotated_manager_operation - (Injection.prepare_manager_operation - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown - operation)) - operations - in - let (Manager_list annot_op) = - Annotated_manager_operation.manager_of_list annotated_operations - in - let cctxt = - new Protocol_client_context.wrap_full (cctxt :> Client_context.full) - in - let safety_guard = Option.map Gas.Arith.integral_of_int_exn safety_guard in - let*! simulation_result = - Injection.inject_manager_operation - cctxt - ~simulation:true (* Only simulation here *) - ~force - ~chain:cctxt#chain - ~block:(`Head 0) - ~source - ~src_pk - ~src_sk:dummy_sk_uri - (* Use dummy secret key as it is not used by simulation *) - ~successor_level - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown - ?safety_guard - ~fee_parameter - annot_op - in - match simulation_result with - | Error trace -> - let exceeds_quota = - TzTrace.fold - (fun exceeds -> function - | Environment.Ecoproto_error - (Gas.Block_quota_exceeded | Gas.Operation_quota_exceeded) -> - true - | _ -> exceeds) - false - trace - in - fail (if exceeds_quota then `Exceeds_quotas trace else `TzError trace) - | Ok (_oph, packed_op, _contents, results) -> - let nb_ops = List.length operations in - let results = Apply_results.to_list (Contents_result_list results) in - (* packed_op can have reveal operations added automatically. *) - let start_index = List.length results - nb_ops in - (* remove extra reveal operations *) - let operations_statuses = - List.fold_left_i - (fun index_in_batch acc (Apply_results.Contents_result result) -> - if index_in_batch < start_index then acc - else - {index_in_batch; status = operation_result_status result} :: acc) - [] - results - |> List.rev - in - let unsigned_operation = - let {shell; protocol_data = Operation_data {contents; signature = _}} - = - packed_op - in - (shell, Contents_list contents) - in - return {operations_statuses; unsigned_operation} - - let sign_operation cctxt src_sk - ((shell, Contents_list contents) as unsigned_op) = - let open Lwt_result_syntax in - let unsigned_bytes = - Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding unsigned_op - in - let cctxt = - new Protocol_client_context.wrap_full (cctxt :> Client_context.full) - in - let+ signature = - Client_keys.sign - cctxt - ~watermark:Signature.Generic_operation - src_sk - unsigned_bytes - in - let op : packed_operation = - { - shell; - protocol_data = Operation_data {contents; signature = Some signature}; - } - in - Data_encoding.Binary.to_bytes_exn Operation.encoding op - - let time_until_next_block {minimal_block_delay; delay_increment_per_round; _} - (header : Tezos_base.Block_header.shell_header option) = - let open Result_syntax in - match header with - | None -> minimal_block_delay |> Int64.to_int |> Ptime.Span.of_int_s - | Some header -> - let minimal_block_delay = Period.of_seconds_exn minimal_block_delay in - let delay_increment_per_round = - Period.of_seconds_exn delay_increment_per_round - in - let next_level_timestamp = - let* durations = - Round.Durations.create - ~first_round_duration:minimal_block_delay - ~delay_increment_per_round - in - let* predecessor_round = Fitness.round_from_raw header.fitness in - Round.timestamp_of_round - durations - ~predecessor_timestamp:header.timestamp - ~predecessor_round - ~round:Round.zero - in - let next_level_timestamp = - Result.value - next_level_timestamp - ~default: - (WithExceptions.Result.get_ok - ~loc:__LOC__ - Timestamp.(header.timestamp +? minimal_block_delay)) - in - Ptime.diff - (Time.System.of_protocol_exn next_level_timestamp) - (Time.System.now ()) - - let check_fee_parameters {fee_parameters; _} = - let check_value purpose name compare to_string mempool_default value = - if compare mempool_default value > 0 then - error_with - "Bad configuration fee_parameter.%s for %s. It must be at least %s \ - for operations of the injector to be propagated." - name - (Configuration.string_of_purpose purpose) - (to_string mempool_default) - else Ok () - in - let check purpose - { - minimal_fees; - minimal_nanotez_per_byte; - minimal_nanotez_per_gas_unit; - force_low_fee = _; - fee_cap = _; - burn_cap = _; - } = - let open Result_syntax in - let+ () = - check_value - purpose - "minimal_fees" - Int64.compare - Int64.to_string - (Protocol.Alpha_context.Tez.to_mutez - Plugin.Mempool.default_minimal_fees) - minimal_fees.mutez - and+ () = - check_value - purpose - "minimal_nanotez_per_byte" - Q.compare - Q.to_string - Plugin.Mempool.default_minimal_nanotez_per_byte - minimal_nanotez_per_byte - and+ () = - check_value - purpose - "minimal_nanotez_per_gas_unit" - Q.compare - Q.to_string - Plugin.Mempool.default_minimal_nanotez_per_gas_unit - minimal_nanotez_per_gas_unit - in - () - in - check Transaction fee_parameters - - let checks state = check_fee_parameters state -end - -let () = register_proto_client Protocol.hash (module Proto_client) -- GitLab