diff --git a/CHANGES.rst b/CHANGES.rst index 7e8878d1962e9d87b1fa26bf6758c21226a4a40d..f6c2f2b9e5f9cb28e00e9a8fdfd56976b719a4e4 100644 --- a/CHANGES.rst +++ b/CHANGES.rst @@ -71,13 +71,33 @@ Node - **Breaking change**: bumped the node's storage version to ``3.0``. This new version changes the store's representation required by the new protocol's semantics. Upgrading to this new - version is automatic and irreversible. + version is automatic and irreversible. (MR :gl: `!6835`) - **Breaking change**: bumped the snapshot version to ``5``. This version changes internal snapshot file representation to include more information required by the new protocol's semantics. Snapshots of version ``4`` exported with previous versions of Octez can still be imported. Snapshots of version ``5`` are not backward compatible. + (MR :gl: `!6835`) + +- Upon receiving a new non-manager operation that conflicts with a + previously validated operation, the mempool may now replace the old + operation with the new one, depending on both operations' content + and hash. This behavior was already in place for manager operations, + and has simply be extended to non-manager operations. It should help + all mempools converge toward the same set of accepted operations, + regardless of the order in which the operations were + received. (MR :gl: `!6749`) + +- Changed the id and message of the error when the mempool rejects a + new operation because it already contains a preferred conflicting + operation. Changed the id and message of the error associated with + an operation that is removed from the mempool to make room for a + better conflicting operation. (MR :gl: `!6749`) + +- Fixed a minor bug that caused the mempool to accept a manager + operation that conflicts with an already present ``drain_delegate`` + operation. (MR :gl: `!6749`) - Removed the compatibility with storage snapshots of version ``2`` and ``3``. These snapshot versions from Octez 12 cannot be imported @@ -111,7 +131,7 @@ Baker the user directly removes the file ``/_baker_state``. On mainnet, this will have no effect as when the new protocol activates, previous bakers will - be permanently idle. + be permanently idle. (MR :gl: `!6835`) - Fixed an issue where the baker would keep files opened longer than necessary causing unexpected out of space errors making the baker diff --git a/manifest/main.ml b/manifest/main.ml index 7b1274be0846485eba97c7c9014bd1950fa04d2f..418b15aff90cf8ac589c6d2bfe6f5ddb9723c36d 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -4455,7 +4455,8 @@ module Protocol = Protocol opt_map (both plugin test_helpers) @@ fun (plugin, test_helpers) -> only_if (active && N.(number <> 011)) @@ fun () -> tests - ["test_consensus_filter"; "test_filter_state"; "test_plugin"] + (["test_consensus_filter"; "test_filter_state"; "test_plugin"] + @ if N.(number >= 015) then ["test_conflict_handler"] else []) ~path:(path // "lib_plugin/test") ~synopsis:"Tezos/Protocol: protocol plugin tests" ~opam:(sf "tezos-protocol-plugin-%s-tests" name_dash) @@ -5375,7 +5376,7 @@ let _octez_shell_tests = [ "test_shell"; "test_synchronisation_heuristic_fuzzy"; - "test_prevalidation"; + "test_shell_operation"; "test_prevalidation_t"; "test_prevalidator_classification"; "test_prevalidator_classification_operations"; diff --git a/src/lib_protocol_environment/environment_protocol_T_test.ml b/src/lib_protocol_environment/environment_protocol_T_test.ml index 375fa26e267a3b813d1f2e7b21ce9f450b8a389b..da6bc2b21caef0d68e5b25312e48528b4a39f113 100644 --- a/src/lib_protocol_environment/environment_protocol_T_test.ml +++ b/src/lib_protocol_environment/environment_protocol_T_test.ml @@ -33,7 +33,9 @@ module Mock_all_unit : and type operation_data = unit and type operation_receipt = unit and type validation_state = unit - and type application_state = unit = struct + and type application_state = unit + and type Mempool.t = unit + and type Mempool.validation_info = unit = struct type block_header_data = unit type operation = { @@ -148,17 +150,17 @@ module Mock_all_unit : | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = assert false let encoding = Data_encoding.unit let add_operation ?check_signature:_ ?conflict_handler:_ _ _ _ = - Lwt.return_ok ((), Unchanged) + assert false - let remove_operation () _ = () + let remove_operation () _ = assert false - let merge ?conflict_handler:_ () () = Ok () + let merge ?conflict_handler:_ () () = assert false - let operations () = Tezos_crypto.Operation_hash.Map.empty + let operations () = assert false end end diff --git a/src/lib_shell/chain_validator.ml b/src/lib_shell/chain_validator.ml index a4850c9fcd1ad206b2dfce4697897ffcab7aeee9..c178ec4d624bc91361129bcfe842925eb28734fe 100644 --- a/src/lib_shell/chain_validator.ml +++ b/src/lib_shell/chain_validator.ml @@ -384,9 +384,7 @@ let safe_get_prevalidator_filter hash = hash | Some protocol -> let* () = Events.(emit prevalidator_filter_not_found) hash in - let (module Proto) = protocol in - let module Filter = Shell_plugin.No_filter (Proto) in - return_ok (module Filter : Shell_plugin.FILTER)) + return_ok (Shell_plugin.no_filter protocol)) let instantiate_prevalidator parameters set_prevalidator block chain_db = let open Lwt_syntax in @@ -395,8 +393,8 @@ let instantiate_prevalidator parameters set_prevalidator block chain_db = let* new_protocol = Store.Block.protocol_hash parameters.chain_store block in - let* (module Filter) = safe_get_prevalidator_filter new_protocol in - Prevalidator.create parameters.prevalidator_limits (module Filter) chain_db + let* filter = safe_get_prevalidator_filter new_protocol in + Prevalidator.create parameters.prevalidator_limits filter chain_db in match r with | Error errs -> diff --git a/src/lib_shell/legacy_mempool_plugin.ml b/src/lib_shell/legacy_mempool_plugin.ml new file mode 100644 index 0000000000000000000000000000000000000000..cabf30d120a89cf6ac683a0ae88d50bae1ea2cef --- /dev/null +++ b/src/lib_shell/legacy_mempool_plugin.ml @@ -0,0 +1,125 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Nomadic Development. *) +(* Copyright (c) 2018-2022 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. *) +(* *) +(*****************************************************************************) + +module type FILTER = sig + module Proto : Registered_protocol.T + + module Mempool : sig + type config + + val config_encoding : config Data_encoding.t + + val default_config : config + + type state + + val init : + config -> + ?validation_state:Proto.validation_state -> + predecessor:Tezos_base.Block_header.t -> + unit -> + state tzresult Lwt.t + + val on_flush : + config -> + state -> + ?validation_state:Proto.validation_state -> + predecessor:Tezos_base.Block_header.t -> + unit -> + state tzresult Lwt.t + + val remove : filter_state:state -> Tezos_crypto.Operation_hash.t -> state + + val precheck : + config -> + filter_state:state -> + validation_state:Proto.validation_state -> + Tezos_crypto.Operation_hash.t -> + Proto.operation -> + nb_successful_prechecks:int -> + [ `Passed_precheck of + state + * Proto.validation_state + * [ `No_replace + | `Replace of + Tezos_crypto.Operation_hash.t + * Prevalidator_classification.error_classification ] + | `Undecided + | Prevalidator_classification.error_classification ] + Lwt.t + + val pre_filter : + config -> + filter_state:state -> + ?validation_state_before:Proto.validation_state -> + Proto.operation -> + [ `Passed_prefilter of Prevalidator_pending_operations.priority + | Prevalidator_classification.error_classification ] + Lwt.t + + val post_filter : + config -> + filter_state:state -> + validation_state_before:Proto.validation_state -> + validation_state_after:Proto.validation_state -> + Proto.operation * Proto.operation_receipt -> + [`Passed_postfilter of state | `Refused of tztrace] Lwt.t + end +end + +module No_filter (Proto : Registered_protocol.T) : + FILTER with module Proto = Proto = struct + module Proto = Proto + + module Mempool = struct + type config = unit + + let config_encoding = Data_encoding.empty + + let default_config = () + + type state = unit + + let init _ ?validation_state:_ ~predecessor:_ () = + Lwt_result_syntax.return_unit + + let remove ~filter_state _ = filter_state + + let on_flush _ _ ?validation_state:_ ~predecessor:_ () = + Lwt_result_syntax.return_unit + + let precheck _ ~filter_state:_ ~validation_state:_ _ _ + ~nb_successful_prechecks:_ = + Lwt.return `Undecided + + let pre_filter _ ~filter_state:_ ?validation_state_before:_ _ = + Lwt.return @@ `Passed_prefilter (`Low []) + + let post_filter _ ~filter_state ~validation_state_before:_ + ~validation_state_after:_ _ = + Lwt.return (`Passed_postfilter filter_state) + end +end diff --git a/src/lib_shell/legacy_mempool_plugin.mli b/src/lib_shell/legacy_mempool_plugin.mli new file mode 100644 index 0000000000000000000000000000000000000000..8c85ccf598080a0766114f70d6e865af8a12becb --- /dev/null +++ b/src/lib_shell/legacy_mempool_plugin.mli @@ -0,0 +1,146 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Nomadic Development. *) +(* Copyright (c) 2018-2022 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. *) +(* *) +(*****************************************************************************) + +(** Type of a protocol-specific mempool filter plugin. + + This is compatible with the plugins of protocols Kathmandu and + older. For Lima and newer protocols, see {!Shell_plugin.FILTER}. *) +module type FILTER = sig + module Proto : Registered_protocol.T + + module Mempool : sig + type config + + val config_encoding : config Data_encoding.t + + val default_config : config + + (** Internal state of the prevalidator filter *) + type state + + (** [init config ?validation_state ~predecessor] is called once when + a prevalidator starts. *) + val init : + config -> + ?validation_state:Proto.validation_state -> + predecessor:Tezos_base.Block_header.t -> + unit -> + state tzresult Lwt.t + + (** [on_flush config state ?validation_state ~predecessor] is called when + a flush in the prevalidator is triggered. It resets part of the + [state]. *) + val on_flush : + config -> + state -> + ?validation_state:Proto.validation_state -> + predecessor:Tezos_base.Block_header.t -> + unit -> + state tzresult Lwt.t + + (** [remove ~filter_state oph] removes the operation manager linked to + [oph] from the state of the filter *) + val remove : filter_state:state -> Tezos_crypto.Operation_hash.t -> state + + (** [precheck config ~filter_state ~validation_state oph op + ~nb_successful_prechecks] + should be used to decide whether an operation can be gossiped to the + network without executing it. This is a wrapper around + [Proto.precheck_manager] and [Proto.check_signature]. This + function hereby has a similar return type. + + Returns [`Passed_precheck `No_replace] if the operation was successfully + prechecked. In case the operation is successfully prechecked + but replaces an already prechecked operation [old_oph], the + result [`Passed_precheck (`Replace (old_oph, clasification))] is + returned, where [classification] is the new classifiation of the + replaced operation. If the function returns [`Undecided] it means that + [apply_operation] should be called. + + This function takes a filter [state] and a [Proto.validation_state] + as parameters, and returns them updated if the operation has been + successfully [prechecked]. It also takes an under-approximation + [nb_successful_prechecks] of the number of times the given operation + has been successfully prechecked. *) + val precheck : + config -> + filter_state:state -> + validation_state:Proto.validation_state -> + Tezos_crypto.Operation_hash.t -> + Proto.operation -> + nb_successful_prechecks:int -> + [ `Passed_precheck of + state + * Proto.validation_state + * [ `No_replace + | `Replace of + Tezos_crypto.Operation_hash.t + * Prevalidator_classification.error_classification ] + | `Undecided + | Prevalidator_classification.error_classification ] + Lwt.t + + (** [pre_filter config ~filter_state ?validation_state_before operation_data] + is called on arrival of an operation and after a flush of + the prevalidator. This function calls the [pre_filter] in the protocol + plugin and returns [`Passed_prefilter priority] if no error occurs during + checking of the [operation_data], where priority is the priority computed by + the protocol filter plug-in. More tests are done using the + [filter_state]. We classify an operation that passes the prefilter as + [`Passed_prefilter] since we do not know yet if the operation is + applicable or not. If an error occurs during the checks, this function + returns an error corresponding to the kind of the error returned by the + protocol. *) + val pre_filter : + config -> + filter_state:state -> + ?validation_state_before:Proto.validation_state -> + Proto.operation -> + [ `Passed_prefilter of Prevalidator_pending_operations.priority + | Prevalidator_classification.error_classification ] + Lwt.t + + (** [post_filter config ~filter_state ~validation_state_before + ~validation_state_after (operation_data, operation_receipt)] + is called after a call to [Prevalidation.apply_operation] in the + prevalidator, on operations that did not fail. It returns + [`Passed_postfilter] if the operation passes the filter. It returns + [`Refused] otherwise. This function both takes a [filter_state] as + parameter and returns a [filter_state], because it can update it while + executing. *) + val post_filter : + config -> + filter_state:state -> + validation_state_before:Proto.validation_state -> + validation_state_after:Proto.validation_state -> + Proto.operation * Proto.operation_receipt -> + [`Passed_postfilter of state | `Refused of tztrace] Lwt.t + end +end + +(** Dummy filter that does nothing *) +module No_filter (Proto : Registered_protocol.T) : + FILTER with module Proto = Proto diff --git a/src/lib_shell/legacy_prevalidator_internal.ml b/src/lib_shell/legacy_prevalidator_internal.ml index 119dd32bef9e1283ea89636ca0b646ec673f8db6..c439968208a7a4f958d6ad8d09aed40e3a8f0ef6 100644 --- a/src/lib_shell/legacy_prevalidator_internal.ml +++ b/src/lib_shell/legacy_prevalidator_internal.ml @@ -264,7 +264,7 @@ end this functor doesn't assume a specific chain store implementation, which is the crux for having it easily unit-testable. *) module Make_s - (Filter : Shell_plugin.FILTER) + (Filter : Legacy_mempool_plugin.FILTER) (Prevalidation_t : Prevalidation.T with type validation_state = Filter.Proto.validation_state @@ -1056,7 +1056,7 @@ module WorkerGroup = Worker.MakeGroup (Name) (Prevalidator_worker_state.Request) Note that, because this functor [include]s {!Make_s}, it is a strict extension of [Make_s]. *) module Make - (Filter : Shell_plugin.FILTER) + (Filter : Legacy_mempool_plugin.FILTER) (Arg : ARG) (Prevalidation_t : Prevalidation.T with type validation_state = @@ -1649,7 +1649,8 @@ module Make | Lwt.Return (Error _) | Lwt.Fail _ | Lwt.Sleep -> assert false) end -let make limits chain_db chain_id (module Filter : Shell_plugin.FILTER) : t = +let make limits chain_db chain_id (module Filter : Legacy_mempool_plugin.FILTER) + : t = let module Prevalidation_t = Prevalidation.Make (Filter.Proto) in let module Prevalidator = Make @@ -1703,7 +1704,7 @@ module Internal_for_tests = struct } module Make - (Filter : Shell_plugin.FILTER) + (Filter : Legacy_mempool_plugin.FILTER) (Prevalidation_t : Prevalidation.T with type validation_state = Filter.Proto.validation_state diff --git a/src/lib_shell/legacy_prevalidator_internal.mli b/src/lib_shell/legacy_prevalidator_internal.mli index 3da7595c11145143dbde38106b6234b9cbdbe46e..e00d725e958010f1bb844d01e8d563284d66d5b4 100644 --- a/src/lib_shell/legacy_prevalidator_internal.mli +++ b/src/lib_shell/legacy_prevalidator_internal.mli @@ -47,7 +47,7 @@ val make : Shell_limits.prevalidator_limits -> Distributed_db.chain_db -> Tezos_crypto.Chain_id.t -> - (module Shell_plugin.FILTER) -> + (module Legacy_mempool_plugin.FILTER) -> Prevalidator_internal_common.t (**/**) @@ -94,7 +94,7 @@ module Internal_for_tests : sig ('protocol_data, 'prevalidation_t) types_state_shell module Make - (Filter : Shell_plugin.FILTER) + (Filter : Legacy_mempool_plugin.FILTER) (Prevalidation_t : Legacy_prevalidation.T with type validation_state = Filter.Proto.validation_state diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index aeb1fa3d3ce6ab18ef472bcc7ca703355b12b462..281f2cb8af0c3d6138864f4043fe0c51c40d4c41 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -35,28 +35,55 @@ start with the "legacy" prefix and will be removed when Lima is activated on Mainnet. *) -open Validation_errors +open Shell_operation -type 'protocol_operation operation = { - hash : Tezos_crypto.Operation_hash.t; - raw : Operation.t; - protocol : 'protocol_operation; - count_successful_prechecks : int; -} - -type error += Endorsement_branch_not_live +type error += + | Operation_replacement of { + old_hash : Tezos_crypto.Operation_hash.t; + new_hash : Tezos_crypto.Operation_hash.t; + } + | Operation_conflict of {new_hash : Tezos_crypto.Operation_hash.t} let () = register_error_kind - `Permanent - ~id:"prevalidation.endorsement_branch_not_live" - ~title:"Endorsement branch not live" - ~description:"Endorsement's branch is not in the live blocks" - ~pp:(fun ppf () -> - Format.fprintf ppf "Endorsement's branch is not in the live blocks") - Data_encoding.(empty) - (function Endorsement_branch_not_live -> Some () | _ -> None) - (fun () -> Endorsement_branch_not_live) + `Temporary + ~id:"prevalidation.operation_replacement" + ~title:"Operation replacement" + ~description:"The operation has been replaced." + ~pp:(fun ppf (old_hash, new_hash) -> + Format.fprintf + ppf + "The operation %a has been replaced with %a." + Tezos_crypto.Operation_hash.pp + old_hash + Tezos_crypto.Operation_hash.pp + new_hash) + (Data_encoding.obj2 + (Data_encoding.req "old_hash" Tezos_crypto.Operation_hash.encoding) + (Data_encoding.req "new_hash" Tezos_crypto.Operation_hash.encoding)) + (function + | Operation_replacement {old_hash; new_hash} -> Some (old_hash, new_hash) + | _ -> None) + (fun (old_hash, new_hash) -> Operation_replacement {old_hash; new_hash}) ; + register_error_kind + `Temporary + ~id:"prevalidation.operation_conflict" + ~title:"Operation conflict" + ~description: + "The operation cannot be added because the mempool already contains a \ + conflicting operation." + ~pp:(fun ppf new_hash -> + Format.fprintf + ppf + "The operation %a cannot be added because the mempool already contains \ + a conflicting operation that should not be replaced (e.g. an \ + operation from the same manager with better fees)." + Tezos_crypto.Operation_hash.pp + new_hash) + (Data_encoding.obj1 + (Data_encoding.req "new_hash" Tezos_crypto.Operation_hash.encoding)) + (function Operation_conflict {new_hash} -> Some new_hash | _ -> None) + (fun new_hash -> Operation_conflict {new_hash}) module type CHAIN_STORE = sig type chain_store @@ -72,214 +99,255 @@ end module type T = sig type protocol_operation - type operation_receipt - type validation_state - type chain_store + type filter_state - type t + type filter_config - val parse : - Tezos_crypto.Operation_hash.t -> - Operation.t -> - protocol_operation operation tzresult + type chain_store - val increment_successful_precheck : - protocol_operation operation -> protocol_operation operation + type t val create : chain_store -> - predecessor:Store.Block.t -> - live_operations:Tezos_crypto.Operation_hash.Set.t -> + head:Store.Block.t -> timestamp:Time.Protocol.t -> unit -> t tzresult Lwt.t - type result = - | Applied of t * operation_receipt - | Branch_delayed of tztrace - | Branch_refused of tztrace - | Refused of tztrace - | Outdated of tztrace - - val apply_operation : t -> protocol_operation operation -> result Lwt.t + type replacement = + (Tezos_crypto.Operation_hash.t + * Prevalidator_classification.error_classification) + option + + type add_result = + t + * filter_state + * protocol_operation operation + * Prevalidator_classification.classification + * replacement + + val add_operation : + t -> + filter_state -> + filter_config -> + protocol_operation operation -> + add_result Lwt.t val validation_state : t -> validation_state - val set_validation_state : t -> validation_state -> t + module Internal_for_tests : sig + val get_valid_operations : + t -> protocol_operation Tezos_crypto.Operation_hash.Map.t - val pp_result : Format.formatter -> result -> unit + type validation_info - module Internal_for_tests : sig - val to_applied : - t -> (protocol_operation operation * operation_receipt) list + val set_validation_info : t -> validation_info -> t end end -(** Doesn't depend on heavy [Registered_protocol.T] for testability. *) -let safe_binary_of_bytes (encoding : 'a Data_encoding.t) (bytes : bytes) : - 'a tzresult = - let open Result_syntax in - match Data_encoding.Binary.of_bytes_opt encoding bytes with - | None -> tzfail Parse_error - | Some protocol_data -> return protocol_data - -module MakeAbstract - (Chain_store : CHAIN_STORE) - (Proto : Tezos_protocol_environment.PROTOCOL) : +module MakeAbstract (Chain_store : CHAIN_STORE) (Filter : Shell_plugin.FILTER) : T - with type protocol_operation = Proto.operation - and type operation_receipt = Proto.operation_receipt - and type validation_state = Proto.validation_state - and type chain_store = Chain_store.chain_store = struct - type protocol_operation = Proto.operation + with type protocol_operation = Filter.Proto.operation + and type validation_state = Filter.Proto.validation_state + and type filter_state = Filter.Mempool.state + and type filter_config = Filter.Mempool.config + and type chain_store = Chain_store.chain_store + and type Internal_for_tests.validation_info = + Filter.Proto.Mempool.validation_info = struct + module Proto = Filter.Proto - type operation_receipt = Proto.operation_receipt + type protocol_operation = Proto.operation type validation_state = Proto.validation_state + type filter_state = Filter.Mempool.state + + type filter_config = Filter.Mempool.config + type chain_store = Chain_store.chain_store + type operation = protocol_operation Shell_operation.operation + type t = { - validation_state : validation_state; - application_state : Proto.application_state; - applied : (protocol_operation operation * Proto.operation_receipt) list; - live_operations : Tezos_crypto.Operation_hash.Set.t; + validation_info : Proto.Mempool.validation_info; + mempool : Proto.Mempool.t; + validation_state : validation_state; (* initial protocol validation_state *) } - type result = - | Applied of t * Proto.operation_receipt - | Branch_delayed of tztrace - | Branch_refused of tztrace - | Refused of tztrace - | Outdated of tztrace - - let parse_unsafe (proto : bytes) : Proto.operation_data tzresult = - safe_binary_of_bytes Proto.operation_data_encoding proto - - let parse hash (raw : Operation.t) = - let open Result_syntax in - let size = Data_encoding.Binary.length Operation.encoding raw in - if size > Proto.max_operation_data_length then - tzfail (Oversized_operation {size; max = Proto.max_operation_data_length}) - else - let+ protocol_data = parse_unsafe raw.proto in - { - hash; - raw; - protocol = {Proto.shell = raw.Operation.shell; protocol_data}; - (* When an operation is parsed, we assume that it has never been - successfully prechecked. *) - count_successful_prechecks = 0; - } - - let increment_successful_precheck op = - (* We avoid {op with ...} to get feedback from the compiler if the record - type is extended/modified in the future. *) - { - hash = op.hash; - raw = op.raw; - protocol = op.protocol; - count_successful_prechecks = op.count_successful_prechecks + 1; - } - - let create chain_store ~predecessor ~live_operations ~timestamp () = + let create chain_store ~head ~timestamp () = (* The prevalidation module receives input from the system byt handles protocol values. It translates timestamps here. *) let open Lwt_result_syntax in - let* predecessor_context = Chain_store.context chain_store predecessor in - let predecessor_hash = Store.Block.hash predecessor in - let*! predecessor_context = + let* head_context = Chain_store.context chain_store head in + let head_hash = Store.Block.hash head in + let*! head_context = Block_validation.update_testchain_status - predecessor_context - ~predecessor_hash + head_context + ~predecessor_hash:head_hash timestamp in let chain_id = Chain_store.chain_id chain_store in - let mode = Proto.Partial_construction {predecessor_hash; timestamp} in - let predecessor = (Store.Block.header predecessor).shell in + let head = (Store.Block.header head).shell in + let* validation_info, mempool = + Proto.Mempool.init head_context chain_id ~head_hash ~head ~cache:`Lazy + in let* validation_state = Proto.begin_validation - predecessor_context + head_context chain_id - mode - ~predecessor + (Partial_construction {predecessor_hash = head_hash; timestamp}) + ~predecessor:head ~cache:`Lazy in - let* application_state = - Proto.begin_application - predecessor_context - chain_id - mode - ~predecessor - ~cache:`Lazy + return {validation_info; mempool; validation_state} + + type error_classification = Prevalidator_classification.error_classification + + type classification = Prevalidator_classification.classification + + type replacement = + (Tezos_crypto.Operation_hash.t * error_classification) option + + type add_result = t * filter_state * operation * classification * replacement + + let classification_of_trace trace = + match classify_trace trace with + | Branch -> `Branch_refused trace + | Permanent -> `Refused trace + | Temporary -> `Branch_delayed trace + | Outdated -> `Outdated trace + + let proto_add_operation ~conflict_handler state op : + (Proto.Mempool.t * Proto.Mempool.add_result) tzresult Lwt.t = + Proto.Mempool.add_operation + ~check_signature:Compare.Int.(op.count_successful_prechecks <= 0) + ~conflict_handler + state.validation_info + state.mempool + (op.hash, op.protocol) + |> Lwt_result.map_error (function + | Proto.Mempool.Validation_error trace -> trace + | Add_conflict _ -> + (* This cannot happen because we provide a [conflict_handler] to + [Proto.Mempool.add_operation]. See documentation in + [lib_protocol_environment/sigs/v/updater.mli] + with [num >= 7]. *) + assert false) + + let translate_proto_add_result (proto_add_result : Proto.Mempool.add_result) + op : (replacement, error_classification) result = + let open Result in + match proto_add_result with + | Added -> return_none + | Replaced {removed} -> + let trace = + [Operation_replacement {old_hash = removed; new_hash = op.hash}] + in + return_some (removed, `Outdated trace) + | Unchanged -> + error + (classification_of_trace [Operation_conflict {new_hash = op.hash}]) + + (** Call [Filter.Mempool.add_operation_and_enforce_mempool_bound], + which ensures that the number of manager operations in the + mempool is bounded as specified in [filter_config]. + + The [state] argument is the prevalidation state (which has not + been modified yet). The [mempool] and [proto_add_result] are the + results of the protocol's [add_operation]. + + Maintaining this bound may require the removal of an operation + when the mempool was already full. In this case, this operation, + called [full_mempool_replacement], must also be removed from the + protocol's abstract [mempool]. + + Return the updated [state] (containing the updated protocol + [mempool]) and [filter_state], and the final [replacement], which + may have been mandated either by the protocol's [add_operation] + or by [Filter.Mempool.add_operation_and_enforce_mempool_bound] + (but not both: if the protocol already causes a replacement, then + the mempool is no longer full so there cannot be a + [full_mempool_replacement]. *) + let enforce_mempool_bound_and_update_states state filter_state filter_config + (mempool, proto_add_result) op : + (t * filter_state * replacement, error_classification) result Lwt.t = + let open Lwt_result_syntax in + let*? proto_replacement = translate_proto_add_result proto_add_result op in + let* filter_state, full_mempool_replacement = + Filter.Mempool.add_operation_and_enforce_mempool_bound + ?replace:(Option.map fst proto_replacement) + state.validation_state + filter_config + filter_state + (op.hash, op.protocol) in - return {validation_state; application_state; applied = []; live_operations} + let mempool = + match full_mempool_replacement with + | `No_replace -> mempool + | `Replace (replace_oph, _) -> + Proto.Mempool.remove_operation mempool replace_oph + in + let replacement = + match (proto_replacement, full_mempool_replacement) with + | _, `No_replace -> proto_replacement + | None, `Replace repl -> Some repl + | Some _, `Replace _ -> + (* If there is a [proto_replacement], it gets removed from the + mempool before adding [op] so the mempool cannot be full. *) + assert false + in + return ({state with mempool}, filter_state, replacement) - let apply_operation pv op = + let add_operation_result state filter_state filter_config op : + (t * filter_state * operation * classification * replacement) tzresult + Lwt.t = + let open Lwt_result_syntax in + let conflict_handler = Filter.Mempool.conflict_handler filter_config in + let* proto_output = proto_add_operation ~conflict_handler state op in + (* The operation might still be rejected because of a conflict + with a previously validated operation, or if the mempool is + full and the operation does not have enough fees. Nevertheless, + the successful call to [Proto.Mempool.add_operation] guarantees + that the operation is individually valid, in particular its + signature is correct. Therefore we increment its successful + precheck counter, so that any future signature check can be + skipped. *) + let op = increment_successful_precheck op in + let*! res = + enforce_mempool_bound_and_update_states + state + filter_state + filter_config + proto_output + op + in + match res with + | Ok (state, filter_state, replacement) -> + return (state, filter_state, op, `Prechecked, replacement) + | Error err_class -> + return (state, filter_state, op, (err_class :> classification), None) + + let add_operation state filter_state filter_config op : add_result Lwt.t = let open Lwt_syntax in - if Tezos_crypto.Operation_hash.Set.mem op.hash pv.live_operations then - (* As of November 2021, it is dubious that this case can happen. - If it can, it is more likely to be because of a consensus operation; - hence the returned error. *) - Lwt.return (Outdated [Endorsement_branch_not_live]) - else - let+ r = - protect (fun () -> - let open Lwt_result_syntax in - let* validation_state = - Proto.validate_operation pv.validation_state op.hash op.protocol - in - let* application_state, receipt = - Proto.apply_operation pv.application_state op.hash op.protocol - in - return (validation_state, application_state, receipt)) - in - match r with - | Ok (validation_state, application_state, receipt) -> ( - let pv = - { - validation_state; - application_state; - applied = (op, receipt) :: pv.applied; - live_operations = - Tezos_crypto.Operation_hash.Set.add op.hash pv.live_operations; - } - in - match - Data_encoding.Binary.( - of_bytes_exn - Proto.operation_receipt_encoding - (to_bytes_exn Proto.operation_receipt_encoding receipt)) - with - | receipt -> Applied (pv, receipt) - | exception exn -> - Refused - [Validation_errors.Cannot_serialize_operation_metadata; Exn exn] - ) - | Error trace -> ( - match classify_trace trace with - | Branch -> Branch_refused trace - | Permanent -> Refused trace - | Temporary -> Branch_delayed trace - | Outdated -> Outdated trace) + let* res = + protect (fun () -> + add_operation_result state filter_state filter_config op) + in + match res with + | Ok add_result -> return add_result + | Error trace -> + return (state, filter_state, op, classification_of_trace trace, None) let validation_state {validation_state; _} = validation_state - let set_validation_state t validation_state = {t with validation_state} + module Internal_for_tests = struct + let get_valid_operations {mempool; _} = Proto.Mempool.operations mempool - let pp_result ppf = - let open Format in - function - | Applied _ -> pp_print_string ppf "applied" - | Branch_delayed err -> fprintf ppf "branch delayed (%a)" pp_print_trace err - | Branch_refused err -> fprintf ppf "branch refused (%a)" pp_print_trace err - | Refused err -> fprintf ppf "refused (%a)" pp_print_trace err - | Outdated err -> fprintf ppf "outdated (%a)" pp_print_trace err + type validation_info = Proto.Mempool.validation_info - module Internal_for_tests = struct - let to_applied {applied; _} = applied + let set_validation_info state validation_info = {state with validation_info} end end @@ -292,26 +360,16 @@ module Production_chain_store : let chain_id = Store.Chain.chain_id end -module Make (Proto : Tezos_protocol_environment.PROTOCOL) : +module Make (Filter : Shell_plugin.FILTER) : T - with type protocol_operation = Proto.operation - and type operation_receipt = Proto.operation_receipt - and type validation_state = Proto.validation_state - and type chain_store = Production_chain_store.chain_store = - MakeAbstract (Production_chain_store) (Proto) + with type protocol_operation = Filter.Proto.operation + and type validation_state = Filter.Proto.validation_state + and type filter_state = Filter.Mempool.state + and type filter_config = Filter.Mempool.config + and type chain_store = Store.chain_store = + MakeAbstract (Production_chain_store) (Filter) module Internal_for_tests = struct - let to_raw {raw; _} = raw - - let hash_of {hash; _} = hash - - let make_operation op oph data = - (* When we build an operation, we assume that it has never been - successfully prechecked. *) - {hash = oph; raw = op; protocol = data; count_successful_prechecks = 0} - - let safe_binary_of_bytes = safe_binary_of_bytes - module type CHAIN_STORE = CHAIN_STORE module Make = MakeAbstract diff --git a/src/lib_shell/prevalidation.mli b/src/lib_shell/prevalidation.mli index 2e673b9e542816b9797969b4b8a87cc20b8f0dbb..c91eddb951c384a23155c841f3973fe75d60cbc0 100644 --- a/src/lib_shell/prevalidation.mli +++ b/src/lib_shell/prevalidation.mli @@ -39,37 +39,21 @@ consistency. This module is stateless and creates and manipulates the prevalidation_state. *) -type 'protocol_operation operation = private { - hash : Tezos_crypto.Operation_hash.t; (** Hash of an operation. *) - raw : Operation.t; - (** Raw representation of an operation (from the point view of the - shell). *) - protocol : 'protocol_operation; - (** Economic protocol specific data of an operation. It is the - unserialized representation of [raw.protocol_data]. For - convenience, the type associated to this type may be [unit] if we - do not have deserialized the operation yet. *) - count_successful_prechecks : int; - (** This field provides an under-approximation for the number of times - the operation has been successfully prechecked. It is an - under-approximation because if the operation is e.g., parsed more than - once, or is prechecked in other modes, this flag is not globally - updated. *) -} - module type T = sig (** Similar to the same type in the protocol, see {!Tezos_protocol_environment.PROTOCOL.operation} *) type protocol_operation - (** Similar to the same type in the protocol, - see {!Tezos_protocol_environment.PROTOCOL} *) - type operation_receipt - (** Similar to the same type in the protocol, see {!Tezos_protocol_environment.PROTOCOL} *) type validation_state + (** Type {!Shell_plugin.FILTER.Mempool.state}. *) + type filter_state + + (** Type {!Shell_plugin.FILTER.Mempool.config}. *) + type filter_config + (** The type implemented by {!Tezos_store.Store.chain_store} in production, and mocked in tests *) type chain_store @@ -78,98 +62,85 @@ module type T = sig then passed back and possibly updated by {!apply_operation}. *) type t - (** [parse hash op] reads a usual {!Operation.t} and lifts it to the - type {!protocol_operation} used by this module. This function is in the - {!tzresult} monad, because it can return the following errors: - - - {!Validation_errors.Oversized_operation} if the size of the operation - data within [op] is too large (to protect against DoS attacks), and - - {!Validation_errors.Parse_error} if serialized data cannot be parsed. *) - val parse : - Tezos_crypto.Operation_hash.t -> - Operation.t -> - protocol_operation operation tzresult - - (** [increment_successful_precheck op] increments the field - [count_successful_prechecks] of the given operation [op]. It is supposed - to be called after each successful precheck of a given operation [op], - and nowhere else. Overflow is unlikely to occur in practice, as the - counter grows very slowly and the number of prechecks is bounded. *) - val increment_successful_precheck : - protocol_operation operation -> protocol_operation operation - (** Creates a new prevalidation context w.r.t. the protocol associated with - the predecessor block. *) + the head block. *) val create : chain_store -> - predecessor:Store.Block.t -> - live_operations:Tezos_crypto.Operation_hash.Set.t -> + head:Store.Block.t -> timestamp:Time.Protocol.t -> unit -> t tzresult Lwt.t - (** Values returned by {!create}. They are obtained from the result - of the protocol [apply_operation] function and the classification of - errors. *) - type result = - | Applied of t * operation_receipt - | Branch_delayed of tztrace - | Branch_refused of tztrace - | Refused of tztrace - | Outdated of tztrace - - (** [apply_operation t op] calls the protocol [apply_operation] function - and handles possible errors, hereby yielding a classification *) - val apply_operation : t -> protocol_operation operation -> result Lwt.t + (** If an old operation has been replaced by a newly added + operation, then this type contains its hash and its new + classification. If there is no replaced operation, this is [None]. *) + type replacement = + (Tezos_crypto.Operation_hash.t + * Prevalidator_classification.error_classification) + option + + (** Result of {!add_operation}. + + Contain the updated (or unchanged) state {!t} and + {!filter_state}, the operation (in which + [count_successful_prechecks] has been incremented if + appropriate), its classification, and the potential + {!replacement}. + + Invariant: [replacement] can only be [Some _] when the + classification is [`Prechecked]. *) + type add_result = + t + * filter_state + * protocol_operation Shell_operation.operation + * Prevalidator_classification.classification + * replacement + + (** Call the protocol [Mempool.add_operation] function, providing it + with the [conflict_handler] from the plugin. + + Then if the protocol accepts the operation, call the plugin + [add_operation_and_enforce_mempool_bound], which is responsible + for bounding the number of manager operations in the mempool. + + See {!add_result} for a description of the output. *) + val add_operation : + t -> + filter_state -> + filter_config -> + protocol_operation Shell_operation.operation -> + add_result Lwt.t (** [validation_state t] returns the subset of [t] corresponding to the type {!validation_state} of the protocol. *) val validation_state : t -> validation_state - (** Updates the subset of [t] corresponding to the type - {!validation_state} of the protocol. *) - val set_validation_state : t -> validation_state -> t + module Internal_for_tests : sig + (** Return the map of operations currently present in the protocol + representation of the mempool. *) + val get_valid_operations : + t -> protocol_operation Tezos_crypto.Operation_hash.Map.t - val pp_result : Format.formatter -> result -> unit + (** Type {!Tezos_protocol_environment.PROTOCOL.Mempool.validation_info}. *) + type validation_info - module Internal_for_tests : sig - (** Returns operations for which {!apply_operation} returned [Applied _] - so far. *) - val to_applied : - t -> (protocol_operation operation * operation_receipt) list + (** Modify the [validation_info] field of the internal state [t]. *) + val set_validation_info : t -> validation_info -> t end end (** How-to obtain an instance of this module's main module type: {!T} *) -module Make : functor (Proto : Tezos_protocol_environment.PROTOCOL) -> +module Make : functor (Filter : Shell_plugin.FILTER) -> T - with type protocol_operation = Proto.operation - and type operation_receipt = Proto.operation_receipt - and type validation_state = Proto.validation_state + with type protocol_operation = Filter.Proto.operation + and type validation_state = Filter.Proto.validation_state + and type filter_state = Filter.Mempool.state + and type filter_config = Filter.Mempool.config and type chain_store = Store.chain_store (**/**) module Internal_for_tests : sig - (** Returns the {!Operation.t} underlying an {!operation} *) - val to_raw : _ operation -> Operation.t - - (** The hash of an {!operation} *) - val hash_of : _ operation -> Tezos_crypto.Operation_hash.t - - (** A constructor for the [operation] datatype. It by-passes the - checks done by the [parse] function. *) - val make_operation : - Operation.t -> Tezos_crypto.Operation_hash.t -> 'a -> 'a operation - - (** [safe_binary_of_bytes encoding bytes] parses [bytes] using [encoding]. - Any error happening during parsing becomes {!Parse_error}. - - If one day the functor's signature is simplified, tests could use - [parse_unsafe] directly rather than relying on this function to - replace [Proto.operation_data_encoding]. *) - val safe_binary_of_bytes : 'a Data_encoding.t -> bytes -> 'a tzresult - module type CHAIN_STORE = sig (** The [chain_store] type. Implemented by {!Tezos_store.Store.chain_store} in production and mocked in @@ -191,11 +162,14 @@ module Internal_for_tests : sig for mocking purposes. *) module Make : functor (Chain_store : CHAIN_STORE) - (Proto : Tezos_protocol_environment.PROTOCOL) + (Filter : Shell_plugin.FILTER) -> T - with type protocol_operation = Proto.operation - and type operation_receipt = Proto.operation_receipt - and type validation_state = Proto.validation_state + with type protocol_operation = Filter.Proto.operation + and type validation_state = Filter.Proto.validation_state + and type filter_state = Filter.Mempool.state + and type filter_config = Filter.Mempool.config and type chain_store = Chain_store.chain_store + and type Internal_for_tests.validation_info = + Filter.Proto.Mempool.validation_info end diff --git a/src/lib_shell/prevalidator.ml b/src/lib_shell/prevalidator.ml index 356c0011b23b4482ae89539fdca522cf2763e670..fb3e77128312408eb2a685b438bf8761efb6913a 100644 --- a/src/lib_shell/prevalidator.ml +++ b/src/lib_shell/prevalidator.ml @@ -38,23 +38,29 @@ end) let chain_proto_registry : t ChainProto_registry.t ref = ref ChainProto_registry.empty -let create limits (module Filter : Shell_plugin.FILTER) chain_db = +let create limits (filter : Shell_plugin.filter_t) chain_db = let open Lwt_result_syntax in let chain_store = Distributed_db.chain_store chain_db in let chain_id = Store.Chain.chain_id chain_store in + let proto_hash = + match filter with + | Recent (module Filter) -> Filter.Proto.hash + | Legacy (module Filter) -> Filter.Proto.hash + in match - ChainProto_registry.find (chain_id, Filter.Proto.hash) !chain_proto_registry + ChainProto_registry.find (chain_id, proto_hash) !chain_proto_registry with | None -> let prevalidator = - if Filter.Proto.(compare environment_version V7 >= 0) then - Prevalidator_internal.make limits chain_db chain_id (module Filter) - else - Legacy_prevalidator_internal.make - limits - chain_db - chain_id - (module Filter) + match filter with + | Recent (module Filter) -> + Prevalidator_internal.make limits chain_db chain_id (module Filter) + | Legacy (module Filter) -> + Legacy_prevalidator_internal.make + limits + chain_db + chain_id + (module Filter) in let (module Prevalidator : T) = prevalidator in chain_proto_registry := diff --git a/src/lib_shell/prevalidator.mli b/src/lib_shell/prevalidator.mli index 644163bdf93143a499db1b5c00f32805bc8bb4e2..68756c2aabde6cb98d255639e314a3a63741edaa 100644 --- a/src/lib_shell/prevalidator.mli +++ b/src/lib_shell/prevalidator.mli @@ -55,7 +55,7 @@ type t (** Creates/tear-down a new prevalidator context. *) val create : Shell_limits.prevalidator_limits -> - (module Shell_plugin.FILTER) -> + Shell_plugin.filter_t -> Distributed_db.chain_db -> t tzresult Lwt.t diff --git a/src/lib_shell/prevalidator_classification.ml b/src/lib_shell/prevalidator_classification.ml index ecfa3230605ac5a9987cd9771c24b52d54142481..580c26d9a634d4c0339a6305680c575e3ab42a39 100644 --- a/src/lib_shell/prevalidator_classification.ml +++ b/src/lib_shell/prevalidator_classification.ml @@ -33,6 +33,8 @@ start with the "legacy" prefix and will be removed when Lima is activated on Mainnet. *) +open Shell_operation + module Event = struct let section = ["prevalidator_classification"] @@ -67,7 +69,7 @@ module Sized_map = Tezos_base.Sized.MakeSizedMap (Map) *) type 'protocol_data bounded_map = { ring : Tezos_crypto.Operation_hash.t Ringo.Ring.t; - mutable map : ('protocol_data Prevalidation.operation * error list) Map.t; + mutable map : ('protocol_data operation * error list) Map.t; } let map bounded_map = bounded_map.map @@ -95,11 +97,10 @@ type 'protocol_data t = { outdated : 'protocol_data bounded_map; branch_refused : 'protocol_data bounded_map; branch_delayed : 'protocol_data bounded_map; - mutable applied_rev : 'protocol_data Prevalidation.operation list; - mutable prechecked : 'protocol_data Prevalidation.operation Sized_map.t; + mutable applied_rev : 'protocol_data operation list; + mutable prechecked : 'protocol_data operation Sized_map.t; mutable unparsable : Tezos_crypto.Operation_hash.Set.t; - mutable in_mempool : - ('protocol_data Prevalidation.operation * classification) Map.t; + mutable in_mempool : ('protocol_data operation * classification) Map.t; } let create parameters = @@ -153,7 +154,7 @@ let flush (classes : 'protocol_data t) ~handle_branch_refused = let remove_list_from_in_mempool list = classes.in_mempool <- List.fold_left - (fun mempool op -> Map.remove op.Prevalidation.hash mempool) + (fun mempool op -> Map.remove op.hash mempool) classes.in_mempool list in @@ -205,8 +206,7 @@ let remove oph classes = | `Applied -> classes.applied_rev <- List.filter - (fun op -> - Tezos_crypto.Operation_hash.(op.Prevalidation.hash <> oph)) + (fun op -> Tezos_crypto.Operation_hash.(op.hash <> oph)) classes.applied_rev) ; Some (op, classification) @@ -260,14 +260,14 @@ let add_unparsable oph classes = let add classification op classes = match classification with - | `Applied -> handle_applied op.Prevalidation.hash op classes - | `Prechecked -> handle_prechecked op.Prevalidation.hash op classes + | `Applied -> handle_applied op.hash op classes + | `Prechecked -> handle_prechecked op.hash op classes | (`Branch_refused _ | `Branch_delayed _ | `Refused _ | `Outdated _) as classification -> - handle_error op.Prevalidation.hash op classification classes + handle_error op.hash op classification classes let to_map ~applied ~prechecked ~branch_delayed ~branch_refused ~refused - ~outdated classes : 'protocol_data Prevalidation.operation Map.t = + ~outdated classes : 'protocol_data operation Map.t = let ( +> ) accum to_add = let merge_fun _k accum_v_opt to_add_v_opt = match (accum_v_opt, to_add_v_opt) with @@ -290,7 +290,7 @@ let to_map ~applied ~prechecked ~branch_delayed ~branch_refused ~refused (if prechecked then Sized_map.to_map classes.prechecked else Map.empty) @@ (if applied then List.to_seq classes.applied_rev - |> Seq.map (fun op -> (op.Prevalidation.hash, op)) + |> Seq.map (fun op -> (op.hash, op)) |> Map.of_seq else Map.empty) +> (if branch_delayed then classes.branch_delayed.map else Map.empty) @@ -299,7 +299,7 @@ let to_map ~applied ~prechecked ~branch_delayed ~branch_refused ~refused +> if outdated then classes.outdated.map else Map.empty type 'block block_tools = { - hash : 'block -> Tezos_crypto.Block_hash.t; + bhash : 'block -> Tezos_crypto.Block_hash.t; operations : 'block -> Operation.t list list; all_operation_hashes : 'block -> Tezos_crypto.Operation_hash.t list list; } @@ -319,10 +319,10 @@ let handle_live_operations ~classes ~(block_store : 'block block_tools) ~(parse : Tezos_crypto.Operation_hash.t -> Operation.t -> - 'protocol_data Prevalidation.operation option) old_mempool = + 'protocol_data operation option) old_mempool = let open Lwt_syntax in let rec pop_block ancestor (block : 'block) mempool = - let hash = block_store.hash block in + let hash = block_store.bhash block in if Tezos_crypto.Block_hash.equal hash ancestor then Lwt.return mempool else let operations = block_store.operations block in @@ -386,13 +386,12 @@ let handle_live_operations ~classes ~(block_store : 'block block_tools) chain.new_blocks ~from_block:from_branch ~to_block:to_branch in let+ mempool = - pop_block (block_store.hash ancestor) from_branch old_mempool + pop_block (block_store.bhash ancestor) from_branch old_mempool in let new_mempool = List.fold_left push_block mempool path in let new_mempool, outdated = Map.partition - (fun _oph op -> - is_branch_alive op.Prevalidation.raw.Operation.shell.branch) + (fun _oph op -> is_branch_alive op.raw.Operation.shell.branch) new_mempool in Map.iter (fun oph _op -> chain.clear_or_cancel oph) outdated ; @@ -479,7 +478,7 @@ module Internal_for_tests = struct } = let applied_pp ppf applied = applied - |> List.map (fun op -> op.Prevalidation.hash) + |> List.map (fun op -> op.hash) |> Format.fprintf ppf "%a" diff --git a/src/lib_shell/prevalidator_classification.mli b/src/lib_shell/prevalidator_classification.mli index 1176538c8d73d0465c397417b22aa600e5599d10..59e98c2fcb045bf8ce84114712ea47b4e8b7077c 100644 --- a/src/lib_shell/prevalidator_classification.mli +++ b/src/lib_shell/prevalidator_classification.mli @@ -33,6 +33,8 @@ start with the "legacy" prefix and will be removed when Lima is activated on Mainnet. *) +open Shell_operation + (** Classifications which correspond to errors *) type error_classification = [ `Branch_delayed of tztrace @@ -48,8 +50,7 @@ type 'protocol_data bounded_map (** [map bounded_map] gets the underling map of the [bounded_map]. *) val map : 'protocol_data bounded_map -> - ('protocol_data Prevalidation.operation * tztrace) - Tezos_crypto.Operation_hash.Map.t + ('protocol_data operation * tztrace) Tezos_crypto.Operation_hash.Map.t (** [cardinal bounded_map] gets the cardinal of the underling map of the [bounded_map] *) val cardinal : 'protocol_data bounded_map -> int @@ -76,7 +77,7 @@ module Sized_map : applied]. Note: unparsable operations are handled in a different way because - they cannot be handled as a [Prevalidation.operation] since this + they cannot be handled as a [operation] since this datatype requires an operation to be parsable. Hence, unparsable operations are handled differently. In particular, unparsable operations are removed on flush. @@ -92,11 +93,11 @@ type 'protocol_data t = private { outdated : 'protocol_data bounded_map; branch_refused : 'protocol_data bounded_map; branch_delayed : 'protocol_data bounded_map; - mutable applied_rev : 'protocol_data Prevalidation.operation list; - mutable prechecked : 'protocol_data Prevalidation.operation Sized_map.t; + mutable applied_rev : 'protocol_data operation list; + mutable prechecked : 'protocol_data operation Sized_map.t; mutable unparsable : Tezos_crypto.Operation_hash.Set.t; mutable in_mempool : - ('protocol_data Prevalidation.operation * classification) + ('protocol_data operation * classification) Tezos_crypto.Operation_hash.Map.t; } @@ -118,7 +119,7 @@ val is_empty : 'protocol_data t -> bool val is_in_mempool : Tezos_crypto.Operation_hash.t -> 'protocol_data t -> - ('protocol_data Prevalidation.operation * classification) option + ('protocol_data operation * classification) option (** [is_known_unparsable oph] returns [true] if the [oph] is associated to an operation which is known to be unparsable. [false] @@ -142,7 +143,7 @@ val is_known_unparsable : val remove : Tezos_crypto.Operation_hash.t -> 'protocol_data t -> - ('protocol_data Prevalidation.operation * classification) option + ('protocol_data operation * classification) option (** [add ~notify classification op classes] adds the operation [op] classified as [classification] to the classifier [classes]. The @@ -169,11 +170,7 @@ val remove : - [Refused] is discarded 1 or 2 times (if the corresponding bounded_map is full) *) -val add : - classification -> - 'protocol_data Prevalidation.operation -> - 'protocol_data t -> - unit +val add : classification -> 'protocol_data operation -> 'protocol_data t -> unit (** [add_unparsable oph classes] adds [oph] as an unparsable operation. [unparsable] operations are removed automatically by the @@ -183,7 +180,7 @@ val add_unparsable : Tezos_crypto.Operation_hash.t -> 'protocol_data t -> unit (** Functions to query data on a polymorphic block-like type ['block]. *) type 'block block_tools = { - hash : 'block -> Tezos_crypto.Block_hash.t; (** The hash of a block *) + bhash : 'block -> Tezos_crypto.Block_hash.t; (** The hash of a block *) operations : 'block -> Operation.t list list; (** The list of operations of a block ordered by their validation pass *) all_operation_hashes : 'block -> Tezos_crypto.Operation_hash.t list list; @@ -240,13 +237,12 @@ val recycle_operations : parse: (Tezos_crypto.Operation_hash.t -> Operation.t -> - 'protocol_data Prevalidation.operation option) -> - pending: - 'protocol_data Prevalidation.operation Tezos_crypto.Operation_hash.Map.t -> + 'protocol_data operation option) -> + pending:'protocol_data operation Tezos_crypto.Operation_hash.Map.t -> block_store:'block block_tools -> chain:'block chain_tools -> handle_branch_refused:bool -> - 'protocol_data Prevalidation.operation Tezos_crypto.Operation_hash.Map.t Lwt.t + 'protocol_data operation Tezos_crypto.Operation_hash.Map.t Lwt.t (**/**) @@ -280,7 +276,7 @@ module Internal_for_tests : sig refused:bool -> outdated:bool -> 'protocol_data t -> - 'protocol_data Prevalidation.operation Tezos_crypto.Operation_hash.Map.t + 'protocol_data operation Tezos_crypto.Operation_hash.Map.t (** [flush classes ~handle_branch_refused] partially resets [classes]: - fields [applied_rev], [branch_delayed] and [unparsable] are emptied; @@ -330,8 +326,7 @@ module Internal_for_tests : sig parse: (Tezos_crypto.Operation_hash.t -> Operation.t -> - 'protocol_data Prevalidation.operation option) -> - 'protocol_data Prevalidation.operation Tezos_crypto.Operation_hash.Map.t -> - 'protocol_data Prevalidation.operation Tezos_crypto.Operation_hash.Map.t - Lwt.t + 'protocol_data operation option) -> + 'protocol_data operation Tezos_crypto.Operation_hash.Map.t -> + 'protocol_data operation Tezos_crypto.Operation_hash.Map.t Lwt.t end diff --git a/src/lib_shell/prevalidator_internal.ml b/src/lib_shell/prevalidator_internal.ml index fb43a78be04b5f88092b15bad671d68cef0a9d00..e663c6f40143c2ce0a9a6b99b97452258c6d895d 100644 --- a/src/lib_shell/prevalidator_internal.ml +++ b/src/lib_shell/prevalidator_internal.ml @@ -36,6 +36,7 @@ open Prevalidator_internal_common open Prevalidator_worker_state +open Shell_operation module Events = Prevalidator_events module Classification = Prevalidator_classification @@ -75,8 +76,7 @@ module Tools = struct chain_tools : Store.Block.t Classification.chain_tools; (** Lower-level tools provided by {!Prevalidator_classification} *) create : - predecessor:Store.Block.t -> - live_operations:Tezos_crypto.Operation_hash.Set.t -> + head:Store.Block.t -> timestamp:Time.Protocol.t -> unit -> 'prevalidation_t tzresult Lwt.t; @@ -146,7 +146,7 @@ let metrics = Shell_metrics.Mempool.init ["mempool"] (** The concrete production instance of {!block_tools} *) let block_tools : Store.Block.t Classification.block_tools = { - hash = Store.Block.hash; + bhash = Store.Block.hash; operations = Store.Block.operations; all_operation_hashes = Store.Block.all_operation_hashes; } @@ -195,8 +195,7 @@ module type S = sig (** Internal state of the filter in the plugin *) mutable validation_state : prevalidation_t tzresult; mutable operation_stream : - (Classification.classification - * protocol_operation Prevalidation.operation) + (Classification.classification * protocol_operation operation) Lwt_watcher.input; mutable rpc_directory : types_state Tezos_rpc.Directory.t lazy_t; mutable filter_config : filter_config; @@ -266,9 +265,9 @@ module Make_s (Prevalidation_t : Prevalidation.T with type validation_state = Filter.Proto.validation_state - and type protocol_operation = Filter.Proto.operation - and type operation_receipt = - Filter.Proto.operation_receipt) : + and type filter_state = Filter.Mempool.state + and type filter_config = Filter.Mempool.config + and type protocol_operation = Filter.Proto.operation) : S with type filter_state = Filter.Mempool.state and type filter_config = Filter.Mempool.config @@ -282,15 +281,12 @@ module Make_s type prevalidation_t = Prevalidation_t.t - type 'operation_data operation = 'operation_data Prevalidation.operation - type types_state = { shell : (protocol_operation, prevalidation_t) types_state_shell; mutable filter_state : filter_state; mutable validation_state : prevalidation_t tzresult; mutable operation_stream : - (Classification.classification - * protocol_operation Prevalidation.operation) + (Classification.classification * protocol_operation operation) Lwt_watcher.input; mutable rpc_directory : types_state Tezos_rpc.Directory.t lazy_t; mutable filter_config : filter_config; @@ -336,9 +332,8 @@ module Make_s given stream. Operations which cannot be parsed are not notified. *) let handle_classification ~(notifier : - Classification.classification -> - protocol_operation Prevalidation.operation -> - unit) shell (op, kind) = + Classification.classification -> protocol_operation operation -> unit) + shell (op, kind) = Classification.add kind op shell.classification ; notifier kind op @@ -370,15 +365,6 @@ module Make_s `Drop | `Passed_prefilter priority -> (priority :> [Pending_ops.priority | `Drop]) - let post_filter ~filter_config ~filter_state ~validation_state_before - ~validation_state_after op receipt = - Filter.Mempool.post_filter - filter_config - ~filter_state - ~validation_state_before - ~validation_state_after - (op, receipt) - let set_mempool shell mempool = shell.mempool <- mempool ; shell.parameters.tools.set_mempool @@ -410,49 +396,10 @@ module Make_s shell.parameters.tools.chain_tools.clear_or_cancel old_hash ; [] - let precheck ~disable_precheck ~filter_config ~filter_state - ~validation_state:prevalidation_t (op : protocol_operation operation) = - let open Lwt_syntax in - let validation_state = Prevalidation_t.validation_state prevalidation_t in - if disable_precheck then Lwt.return `Undecided - else - let+ v = - Filter.Mempool.precheck - filter_config - ~filter_state - ~validation_state - ~nb_successful_prechecks:op.count_successful_prechecks - op.hash - op.protocol - in - match v with - | `Passed_precheck (filter_state, validation_state, replacement) -> - (* The [precheck] optimization triggers: no need to call the - protocol [apply_operation]. *) - let prevalidation_t = - Prevalidation_t.set_validation_state - prevalidation_t - validation_state - in - let new_op = Prevalidation_t.increment_successful_precheck op in - `Passed_precheck (filter_state, prevalidation_t, new_op, replacement) - | (`Branch_delayed _ | `Branch_refused _ | `Refused _ | `Outdated _) as - errs -> - (* Note that we don't need to distinguish some failure cases - of [Filter.Mempool.precheck], hence grouping them under `Fail. *) - `Fail errs - | `Undecided -> - (* The caller will need to call the protocol's [apply_operation] - function. *) - `Undecided - - (* [classify_operation shell filter_config filter_state validation_state - mempool op oph] allows to determine the class of a given operation. - - Once it's parsed, the operation is prechecked and/or applied in the current - filter/validation state to determine if it could be included in a block on - top of the current head or not. If yes, the operation is accumulated in - the given [mempool]. + (* Determine the classification of a given operation in the current + filter/validation states, i.e. whether it could be included in a + block on top of the current head, and if not, why. If yes, the + operation is accumulated in the given [mempool]. The function returns a tuple [(filter_state, validation_state, mempool, to_handle)], where: @@ -471,73 +418,30 @@ module Make_s * (protocol_operation operation * Classification.classification) trace) Lwt.t = let open Lwt_syntax in - let* v = - let* v = - precheck - ~disable_precheck:shell.parameters.limits.disable_precheck - ~filter_config - ~filter_state - ~validation_state - op - in - match v with - | `Fail errs -> - (* Precheck rejected the operation *) - Lwt.return_error errs - | `Passed_precheck (filter_state, validation_state, new_op, replacement) - -> - (* Precheck succeeded *) - let to_handle = - match replacement with - | `No_replace -> [(new_op, `Prechecked)] - | `Replace (old_oph, replacement_classification) -> - (* Precheck succeeded, but an old operation is replaced *) - let to_replace = - reclassify_replaced_manager_op - old_oph - shell - replacement_classification - in - (new_op, `Prechecked) :: to_replace - in - Lwt.return_ok (filter_state, validation_state, to_handle) - | `Undecided -> ( - (* Precheck was not able to classify *) - let* v = Prevalidation_t.apply_operation validation_state op in - match v with - | Applied (new_validation_state, receipt) -> ( - (* Apply succeeded, call post_filter *) - let* v = - post_filter - ~filter_config - ~filter_state - ~validation_state_before: - (Prevalidation_t.validation_state validation_state) - ~validation_state_after: - (Prevalidation_t.validation_state new_validation_state) - op.protocol - receipt - in - match v with - | `Passed_postfilter new_filter_state -> - (* Post_filter ok, accept operation *) - Lwt.return_ok - (new_filter_state, new_validation_state, [(op, `Applied)]) - | `Refused _ as op_class -> - (* Post_filter refused the operation *) - Lwt.return_error op_class) - (* Apply rejected the operation *) - | Branch_delayed e -> Lwt.return_error (`Branch_delayed e) - | Branch_refused e -> Lwt.return_error (`Branch_refused e) - | Refused e -> Lwt.return_error (`Refused e) - | Outdated e -> Lwt.return_error (`Outdated e)) + let* v_state, f_state, op, classification, replacement = + Prevalidation_t.add_operation + validation_state + filter_state + filter_config + op in - match v with - | Error err_class -> - Lwt.return (filter_state, validation_state, mempool, [(op, err_class)]) - | Ok (f_state, v_state, to_handle) -> - let mempool = Mempool.cons_valid op.hash mempool in - Lwt.return (f_state, v_state, mempool, to_handle) + let to_replace = + match replacement with + | None -> [] + | Some (old_oph, replacement_classification) -> + reclassify_replaced_manager_op + old_oph + shell + replacement_classification + in + let to_handle = (op, classification) :: to_replace in + let mempool = + match classification with + | `Prechecked | `Applied -> Mempool.cons_valid op.hash mempool + | `Branch_refused _ | `Branch_delayed _ | `Refused _ | `Outdated _ -> + mempool + in + return (f_state, v_state, mempool, to_handle) (* Classify pending operations into either: [Refused | Branch_delayed | Branch_refused | Applied | Outdated]. @@ -625,7 +529,7 @@ module Make_s This field does not only contain valid operation *) Mempool.known_valid = List.fold_left - (fun acc op -> op.Prevalidation.hash :: acc) + (fun acc op -> op.hash :: acc) prechecked_hashes pv_shell.classification.applied_rev; pending = Pending_ops.hashes pv_shell.pending; @@ -721,6 +625,8 @@ module Make_s of the mempool. These functions are called by the {!Worker} when an event arrives. *) module Requests = struct + module Parser = MakeParser (Filter.Proto) + let on_arrived (pv : types_state) oph op : (unit, Empty.t) result Lwt.t = let open Lwt_syntax in let* already_handled = @@ -728,7 +634,7 @@ module Make_s in if already_handled then return_ok_unit else - match Prevalidation_t.parse oph op with + match Parser.parse oph op with | Error _ -> let* () = Events.(emit unparsable_operation) oph in Prevalidator_classification.add_unparsable @@ -780,7 +686,7 @@ module Make_s Is this an error? *) return_unit else - match Prevalidation_t.parse oph op with + match Parser.parse oph op with | Error err -> failwith "Invalid operation %a: %a." @@ -904,11 +810,7 @@ module Make_s pv.shell.timestamp <- timestamp_system ; let timestamp = Time.System.to_protocol timestamp_system in let*! validation_state = - pv.shell.parameters.tools.create - ~predecessor:new_predecessor - ~live_operations:new_live_operations - ~timestamp - () + pv.shell.parameters.tools.create ~head:new_predecessor ~timestamp () in pv.validation_state <- validation_state ; let* filter_state = @@ -928,7 +830,7 @@ module Make_s ~from_branch:old_predecessor ~to_branch:new_predecessor ~live_blocks:new_live_blocks - ~parse:(fun oph op -> Result.to_option (Prevalidation_t.parse oph op)) + ~parse:(fun oph op -> Result.to_option (Parser.parse oph op)) ~classes:pv.shell.classification ~pending:(Pending_ops.operations pv.shell.pending) ~block_store:block_tools @@ -1055,9 +957,9 @@ module Make (Prevalidation_t : Prevalidation.T with type validation_state = Filter.Proto.validation_state + and type filter_state = Filter.Mempool.state + and type filter_config = Filter.Mempool.config and type protocol_operation = Filter.Proto.operation - and type operation_receipt = - Filter.Proto.operation_receipt and type chain_store = Store.chain_store) : T = struct module S = Make_s (Filter) (Prevalidation_t) open S @@ -1199,7 +1101,7 @@ module Make if params#applied then let applied_seq = pv.shell.classification.applied_rev |> List.to_seq - |> Seq.map (fun (Prevalidation.{hash; _} as op) -> (hash, op)) + |> Seq.map (fun ({hash; _} as op) -> (hash, op)) in Classification.Sized_map.to_map pv.shell.classification.prechecked @@ -1209,7 +1111,7 @@ module Make if filter_validation_passes params#validation_passes - op.Prevalidation.protocol + op.protocol then Some (oph, op.protocol) else None) |> List.of_seq @@ -1222,7 +1124,7 @@ module Make if filter_validation_passes params#validation_passes - op.Prevalidation.protocol + op.protocol then Some (op.protocol, error) else None) map @@ -1252,7 +1154,7 @@ module Make in let unprocessed = Tezos_crypto.Operation_hash.Map.filter_map - (fun _ Prevalidation.{protocol; _} -> + (fun _ {protocol; _} -> if filter_validation_passes params#validation_passes protocol then Some protocol else None) @@ -1291,8 +1193,7 @@ module Make let applied_seq = if params#applied then pv.shell.classification.applied_rev |> List.to_seq - |> Seq.map (fun Prevalidation.{hash; protocol; _} -> - ((hash, protocol), None)) + |> Seq.map (fun {hash; protocol; _} -> ((hash, protocol), None)) else Seq.empty in (* FIXME https://gitlab.com/tezos/tezos/-/issues/2250 @@ -1304,7 +1205,7 @@ module Make Classification.Sized_map.to_map pv.shell.classification.prechecked |> Tezos_crypto.Operation_hash.Map.to_seq - |> Seq.map (fun (hash, Prevalidation.{protocol; _}) -> + |> Seq.map (fun (hash, {protocol; _}) -> ((hash, protocol), None)) else Seq.empty in @@ -1312,7 +1213,7 @@ module Make let open Tezos_crypto.Operation_hash in map |> Map.to_seq |> Seq.map (fun (hash, (op, error)) -> - ((hash, op.Prevalidation.protocol), Some error)) + ((hash, op.protocol), Some error)) in let refused_seq = if params#refused then @@ -1374,8 +1275,7 @@ module Make | `Outdated errors -> Some errors in - Lwt.return_some - [(Prevalidation.(op.hash, op.protocol), errors)] + Lwt.return_some [((op.hash, op.protocol), errors)] | Some _ -> next () | None -> Lwt.return_none) in @@ -1453,13 +1353,9 @@ module Make Distributed_db.Advertise.current_head chain_db ~mempool bh in let chain_tools = mk_chain_tools chain_db in - let create ~predecessor ~live_operations ~timestamp = + let create ~head ~timestamp = let chain_store = Distributed_db.chain_store chain_db in - Prevalidation_t.create - chain_store - ~predecessor - ~live_operations - ~timestamp + Prevalidation_t.create chain_store ~head ~timestamp in let fetch ?peer ?timeout oph = Distributed_db.Operation.fetch chain_db ?timeout ?peer oph () @@ -1498,8 +1394,7 @@ module Make let on_launch w _ (limits, chain_db) : (state, launch_error) result Lwt.t = let open Lwt_result_syntax in let chain_store = Distributed_db.chain_store chain_db in - let*! predecessor = Store.Chain.current_head chain_store in - let predecessor_header = Store.Block.header predecessor in + let*! head = Store.Chain.current_head chain_store in let*! mempool = Store.Chain.mempool chain_store in let*! live_blocks, live_operations = Store.Chain.live_blocks chain_store @@ -1507,12 +1402,7 @@ module Make let timestamp_system = Tezos_base.Time.System.now () in let timestamp = Time.System.to_protocol timestamp_system in let*! validation_state = - Prevalidation_t.create - chain_store - ~predecessor - ~timestamp - ~live_operations - () + Prevalidation_t.create chain_store ~head ~timestamp () in let fetching = List.fold_left @@ -1534,7 +1424,7 @@ module Make { classification; parameters; - predecessor; + predecessor = head; timestamp = timestamp_system; live_blocks; live_operations; @@ -1576,7 +1466,7 @@ module Make (Option.map Prevalidation_t.validation_state (Option.of_result validation_state)) - ~predecessor:predecessor_header + ~predecessor:(Store.Block.header head) () in let pv = @@ -1649,7 +1539,7 @@ module Make end let make limits chain_db chain_id (module Filter : Shell_plugin.FILTER) : t = - let module Prevalidation_t = Prevalidation.Make (Filter.Proto) in + let module Prevalidation_t = Prevalidation.Make (Filter) in let module Prevalidator = Make (Filter) @@ -1706,9 +1596,9 @@ module Internal_for_tests = struct (Prevalidation_t : Prevalidation.T with type validation_state = Filter.Proto.validation_state - and type protocol_operation = Filter.Proto.operation - and type operation_receipt = - Filter.Proto.operation_receipt) = + and type filter_state = Filter.Mempool.state + and type filter_config = Filter.Mempool.config + and type protocol_operation = Filter.Proto.operation) = struct module Internal = Make_s (Filter) (Prevalidation_t) diff --git a/src/lib_shell/prevalidator_internal.mli b/src/lib_shell/prevalidator_internal.mli index 8338ec39be4c9894eb4f4beaa7b0d93b36b882aa..f115b4776c567a86f464db27f87faf8cb6d66893 100644 --- a/src/lib_shell/prevalidator_internal.mli +++ b/src/lib_shell/prevalidator_internal.mli @@ -57,8 +57,7 @@ module Internal_for_tests : sig advertise_current_head : mempool:Mempool.t -> Store.Block.t -> unit; chain_tools : Store.Block.t Prevalidator_classification.chain_tools; create : - predecessor:Store.Block.t -> - live_operations:Tezos_crypto.Operation_hash.Set.t -> + head:Store.Block.t -> timestamp:Time.Protocol.t -> unit -> 'prevalidation_t tzresult Lwt.t; @@ -97,9 +96,9 @@ module Internal_for_tests : sig (Prevalidation_t : Prevalidation.T with type validation_state = Filter.Proto.validation_state - and type protocol_operation = Filter.Proto.operation - and type operation_receipt = - Filter.Proto.operation_receipt) : sig + and type filter_state = Filter.Mempool.state + and type filter_config = Filter.Mempool.config + and type protocol_operation = Filter.Proto.operation) : sig (** The corresponding internal type of the mempool (see {!Prevalidator.S}), that depends on the protocol *) type types_state diff --git a/src/lib_shell/prevalidator_pending_operations.ml b/src/lib_shell/prevalidator_pending_operations.ml index c47cb1045b3dc9d2dd1312eb11e89616f19a3da8..9f6762fec385b4bdba6682efdebb02268b700796 100644 --- a/src/lib_shell/prevalidator_pending_operations.ml +++ b/src/lib_shell/prevalidator_pending_operations.ml @@ -34,6 +34,8 @@ start with the "legacy" prefix and will be removed when Lima is activated on Mainnet. *) +open Shell_operation + (* Ordering is important, as it is used below in map keys comparison *) type priority = [`High | `Medium | `Low of Q.t list] @@ -74,7 +76,7 @@ module Sized_set = *) type 'a t = { (* The main map *) - pending : 'a Prevalidation.operation Map.t Priority_map.t; + pending : 'a operation Map.t Priority_map.t; (* Used for advertising *) hashes : Sized_set.t; (* We need to remember the priority of each hash, to be used when removing @@ -107,7 +109,7 @@ let get_priority_map prio pending = match Priority_map.find prio pending with None -> Map.empty | Some mp -> mp let add op prio {pending; hashes; priority_of} = - let oph = op.Prevalidation.hash in + let oph = op.hash in let mp = get_priority_map prio pending |> Map.add oph op in { pending = Priority_map.add prio mp pending; diff --git a/src/lib_shell/prevalidator_pending_operations.mli b/src/lib_shell/prevalidator_pending_operations.mli index cf7ffbd4b5c268194a81b93d5abfa7f9d57b74b6..0e2d9f7b3589d2cf93e64397f9078bda7bda23b0 100644 --- a/src/lib_shell/prevalidator_pending_operations.mli +++ b/src/lib_shell/prevalidator_pending_operations.mli @@ -34,6 +34,8 @@ start with the "legacy" prefix and will be removed when Lima is activated on Mainnet. *) +open Shell_operation + (** The priority of a pending operation. A priority is attached to each pending operation. *) @@ -56,8 +58,7 @@ val hashes : 'protocol_data t -> Tezos_crypto.Operation_hash.Set.t (** [operations p] returns the Map of bindings [oph -> op] contained in [p] *) val operations : - 'protocol_data t -> - 'protocol_data Prevalidation.operation Tezos_crypto.Operation_hash.Map.t + 'protocol_data t -> 'protocol_data operation Tezos_crypto.Operation_hash.Map.t (** [is_empty p] returns [true] if [p] has operations, [false] otherwise. *) val is_empty : 'protocol_data t -> bool @@ -80,10 +81,7 @@ val mem : Tezos_crypto.Operation_hash.t -> 'protocol_data t -> bool as the caller of the function to ensure this. *) val add : - 'protocol_data Prevalidation.operation -> - priority -> - 'protocol_data t -> - 'protocol_data t + 'protocol_data operation -> priority -> 'protocol_data t -> 'protocol_data t (** [remove oph op p] removes the binding [oph] from [p]. @@ -112,7 +110,7 @@ val cardinal : 'protocol_data t -> int val fold : (priority -> Tezos_crypto.Operation_hash.t -> - 'protocol_data Prevalidation.operation -> + 'protocol_data operation -> 'a -> 'a) -> 'protocol_data t -> @@ -123,7 +121,7 @@ val fold : val iter : (priority -> Tezos_crypto.Operation_hash.t -> - 'protocol_data Prevalidation.operation -> + 'protocol_data operation -> unit) -> 'protocol_data t -> unit @@ -134,7 +132,7 @@ val iter : val fold_es : (priority -> Tezos_crypto.Operation_hash.t -> - 'protocol_data Prevalidation.operation -> + 'protocol_data operation -> 'a -> ('a, 'b) result Lwt.t) -> 'protocol_data t -> diff --git a/src/lib_shell/shell_operation.ml b/src/lib_shell/shell_operation.ml new file mode 100644 index 0000000000000000000000000000000000000000..39f03f9705725b58b149637ba581c8194e07cd22 --- /dev/null +++ b/src/lib_shell/shell_operation.ml @@ -0,0 +1,99 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2020 Metastate AG *) +(* Copyright (c) 2018-2022 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. *) +(* *) +(*****************************************************************************) + +type 'protocol_operation operation = { + hash : Tezos_crypto.Operation_hash.t; + raw : Operation.t; + protocol : 'protocol_operation; + count_successful_prechecks : int; +} + +let increment_successful_precheck op = + (* We avoid {op with ...} to get feedback from the compiler if the record + type is extended/modified in the future. *) + { + hash = op.hash; + raw = op.raw; + protocol = op.protocol; + count_successful_prechecks = op.count_successful_prechecks + 1; + } + +(** Doesn't depend on heavy [Registered_protocol.T] for testability. *) +let safe_binary_of_bytes (encoding : 'a Data_encoding.t) (bytes : bytes) : + 'a tzresult = + let open Result_syntax in + match Data_encoding.Binary.of_bytes_opt encoding bytes with + | None -> tzfail Validation_errors.Parse_error + | Some protocol_data -> return protocol_data + +module type PARSER = sig + type protocol_operation + + val parse : + Tezos_crypto.Operation_hash.t -> + Operation.t -> + protocol_operation operation tzresult +end + +module MakeParser (Proto : Tezos_protocol_environment.PROTOCOL) : + PARSER with type protocol_operation = Proto.operation = struct + type protocol_operation = Proto.operation + + let parse_unsafe (proto : bytes) : Proto.operation_data tzresult = + safe_binary_of_bytes Proto.operation_data_encoding proto + + let parse hash (raw : Operation.t) = + let open Result_syntax in + let size = Data_encoding.Binary.length Operation.encoding raw in + if size > Proto.max_operation_data_length then + tzfail + (Validation_errors.Oversized_operation + {size; max = Proto.max_operation_data_length}) + else + let+ protocol_data = parse_unsafe raw.proto in + { + hash; + raw; + protocol = {Proto.shell = raw.Operation.shell; protocol_data}; + (* When an operation is parsed, we assume that it has never been + successfully prechecked. *) + count_successful_prechecks = 0; + } +end + +module Internal_for_tests = struct + let to_raw {raw; _} = raw + + let hash_of {hash; _} = hash + + let make_operation op oph data = + (* When we build an operation, we assume that it has never been + successfully prechecked. *) + {hash = oph; raw = op; protocol = data; count_successful_prechecks = 0} + + let safe_binary_of_bytes = safe_binary_of_bytes +end diff --git a/src/lib_shell/shell_operation.mli b/src/lib_shell/shell_operation.mli new file mode 100644 index 0000000000000000000000000000000000000000..d24888df62836ca2b48c0cba45c0da343330f64c --- /dev/null +++ b/src/lib_shell/shell_operation.mli @@ -0,0 +1,104 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2018-2022 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. *) +(* *) +(*****************************************************************************) + +(** This module provides the operation representation used by the + prevalidator and its dependencies. It also contains tools for + parsing an operation into this representation, and updating the + latter. *) + +(** Representation of a parsed operation, used only in the shell. *) +type 'protocol_operation operation = private { + hash : Tezos_crypto.Operation_hash.t; (** Hash of an operation. *) + raw : Operation.t; + (** Raw representation of an operation (from the point view of the + shell). *) + protocol : 'protocol_operation; + (** Economic protocol specific data of an operation. It is the + unserialized representation of [raw.protocol_data]. For + convenience, the type associated to this type may be [unit] if we + do not have deserialized the operation yet. *) + count_successful_prechecks : int; + (** This field provides an under-approximation for the number of times + the operation has been successfully prechecked. It is an + under-approximation because if the operation is e.g., parsed more than + once, or is prechecked in other modes, this flag is not globally + updated. *) +} + +(** [increment_successful_precheck op] increments the field + [count_successful_prechecks] of the given operation [op]. It is supposed + to be called after each successful precheck of a given operation [op], + and nowhere else. Overflow is unlikely to occur in practice, as the + counter grows very slowly and the number of prechecks is bounded. *) +val increment_successful_precheck : + 'protocol_operation operation -> 'protocol_operation operation + +(** The purpose of this module type is to provide the [parse] + function, whose return type depends on the protocol. *) +module type PARSER = sig + (** Similar to the same type in the protocol, + see {!Tezos_protocol_environment.PROTOCOL.operation} *) + type protocol_operation + + (** [parse hash op] reads a usual {!Operation.t} and lifts it to the + type {!protocol_operation} used by this module. This function is in the + {!tzresult} monad, because it can return the following errors: + + - {!Validation_errors.Oversized_operation} if the size of the operation + data within [op] is too large (to protect against DoS attacks), and + - {!Validation_errors.Parse_error} if serialized data cannot be parsed. *) + val parse : + Tezos_crypto.Operation_hash.t -> + Operation.t -> + protocol_operation operation tzresult +end + +(** Create a {!PARSER} tailored to a given protocol. *) +module MakeParser : functor (Proto : Tezos_protocol_environment.PROTOCOL) -> + PARSER with type protocol_operation = Proto.operation + +(**/**) + +module Internal_for_tests : sig + (** Returns the {!Operation.t} underlying an {!operation} *) + val to_raw : _ operation -> Operation.t + + (** The hash of an {!operation} *) + val hash_of : _ operation -> Tezos_crypto.Operation_hash.t + + (** A constructor for the [operation] datatype. It by-passes the + checks done by the [parse] function. *) + val make_operation : + Operation.t -> Tezos_crypto.Operation_hash.t -> 'a -> 'a operation + + (** [safe_binary_of_bytes encoding bytes] parses [bytes] using [encoding]. + Any error happening during parsing becomes {!Parse_error}. + + If one day the functor's signature is simplified, tests could use + [parse_unsafe] directly rather than relying on this function to + replace [Proto.operation_data_encoding]. *) + val safe_binary_of_bytes : 'a Data_encoding.t -> bytes -> 'a tzresult +end diff --git a/src/lib_shell/shell_plugin.ml b/src/lib_shell/shell_plugin.ml index f0c87be4b192e43856b1dde7a3a68f3078643136..373f0b1b65dea3e1edfbc424268e73048705f54f 100644 --- a/src/lib_shell/shell_plugin.ml +++ b/src/lib_shell/shell_plugin.ml @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Nomadic Development. *) +(* Copyright (c) 2018-2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -52,24 +53,6 @@ module type FILTER = sig val remove : filter_state:state -> Tezos_crypto.Operation_hash.t -> state - val precheck : - config -> - filter_state:state -> - validation_state:Proto.validation_state -> - Tezos_crypto.Operation_hash.t -> - Proto.operation -> - nb_successful_prechecks:int -> - [ `Passed_precheck of - state - * Proto.validation_state - * [ `No_replace - | `Replace of - Tezos_crypto.Operation_hash.t - * Prevalidator_classification.error_classification ] - | `Undecided - | Prevalidator_classification.error_classification ] - Lwt.t - val pre_filter : config -> filter_state:state -> @@ -79,13 +62,22 @@ module type FILTER = sig | Prevalidator_classification.error_classification ] Lwt.t - val post_filter : + val add_operation_and_enforce_mempool_bound : + ?replace:Tezos_crypto.Operation_hash.t -> + Proto.validation_state -> config -> - filter_state:state -> - validation_state_before:Proto.validation_state -> - validation_state_after:Proto.validation_state -> - Proto.operation * Proto.operation_receipt -> - [`Passed_postfilter of state | `Refused of tztrace] Lwt.t + state -> + Tezos_crypto.Operation_hash.t * Proto.operation -> + ( state + * [ `No_replace + | `Replace of + Tezos_crypto.Operation_hash.t + * Prevalidator_classification.error_classification ], + Prevalidator_classification.error_classification ) + result + Lwt.t + + val conflict_handler : config -> Proto.Mempool.conflict_handler end end @@ -96,7 +88,8 @@ module type RPC = sig Tezos_protocol_environment.rpc_context Tezos_rpc.Directory.directory end -module No_filter (Proto : Registered_protocol.T) = struct +module No_filter (Proto : Registered_protocol.T) : + FILTER with module Proto = Proto and type Mempool.state = unit = struct module Proto = Proto module Mempool = struct @@ -116,16 +109,16 @@ module No_filter (Proto : Registered_protocol.T) = struct let on_flush _ _ ?validation_state:_ ~predecessor:_ () = Lwt_result_syntax.return_unit - let precheck _ ~filter_state:_ ~validation_state:_ _ _ - ~nb_successful_prechecks:_ = - Lwt.return `Undecided - let pre_filter _ ~filter_state:_ ?validation_state_before:_ _ = Lwt.return @@ `Passed_prefilter (`Low []) - let post_filter _ ~filter_state ~validation_state_before:_ - ~validation_state_after:_ _ = - Lwt.return (`Passed_postfilter filter_state) + let add_operation_and_enforce_mempool_bound ?replace:_ _ _ filter_state _ = + Lwt_result.return (filter_state, `No_replace) + + let conflict_handler _ ~existing_operation ~new_operation = + if Proto.compare_operations existing_operation new_operation < 0 then + `Replace + else `Keep end end @@ -148,23 +141,12 @@ struct let update_metrics ~protocol_metadata:_ _ _ = Lwt.return_unit end -let filter_table : (module FILTER) Tezos_crypto.Protocol_hash.Table.t = - Tezos_crypto.Protocol_hash.Table.create 5 - let rpc_table : (module RPC) Tezos_crypto.Protocol_hash.Table.t = Tezos_crypto.Protocol_hash.Table.create 5 let metrics_table : (module METRICS) Tezos_crypto.Protocol_hash.Table.t = Tezos_crypto.Protocol_hash.Table.create 5 -let register_filter (module Filter : FILTER) = - assert ( - not (Tezos_crypto.Protocol_hash.Table.mem filter_table Filter.Proto.hash)) ; - Tezos_crypto.Protocol_hash.Table.add - filter_table - Filter.Proto.hash - (module Filter) - let register_rpc (module Rpc : RPC) = assert (not (Tezos_crypto.Protocol_hash.Table.mem rpc_table Rpc.Proto.hash)) ; Tezos_crypto.Protocol_hash.Table.add rpc_table Rpc.Proto.hash (module Rpc) @@ -175,8 +157,6 @@ let register_metrics (module Metrics : METRICS) = Metrics.hash (module Metrics) -let find_filter = Tezos_crypto.Protocol_hash.Table.find filter_table - let find_rpc = Tezos_crypto.Protocol_hash.Table.find rpc_table let find_metrics = Tezos_crypto.Protocol_hash.Table.find metrics_table @@ -189,3 +169,29 @@ let safe_find_metrics hash = let hash = hash end) in Lwt.return (module Metrics : METRICS) + +type filter_t = + | Recent of (module FILTER) + | Legacy of (module Legacy_mempool_plugin.FILTER) + +let is_recent_proto (module Proto : Registered_protocol.T) = + Proto.(compare environment_version V7 >= 0) + +let no_filter (module Proto : Registered_protocol.T) = + if is_recent_proto (module Proto) then Recent (module No_filter (Proto)) + else Legacy (module Legacy_mempool_plugin.No_filter (Proto)) + +let filter_table : filter_t Tezos_crypto.Protocol_hash.Table.t = + Tezos_crypto.Protocol_hash.Table.create 5 + +let add_to_filter_table proto_hash (filter : filter_t) = + assert (not (Tezos_crypto.Protocol_hash.Table.mem filter_table proto_hash)) ; + Tezos_crypto.Protocol_hash.Table.add filter_table proto_hash filter + +let register_filter (module Filter : FILTER) = + add_to_filter_table Filter.Proto.hash (Recent (module Filter)) + +let register_legacy_filter (module Filter : Legacy_mempool_plugin.FILTER) = + add_to_filter_table Filter.Proto.hash (Legacy (module Filter)) + +let find_filter = Tezos_crypto.Protocol_hash.Table.find filter_table diff --git a/src/lib_shell/shell_plugin.mli b/src/lib_shell/shell_plugin.mli index 1e01d7cedf019ea1d6a708d89ffc478ae32bc178..081ad0841b9baeebeda0a4ca5d40d9842bee51fb 100644 --- a/src/lib_shell/shell_plugin.mli +++ b/src/lib_shell/shell_plugin.mli @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Nomadic Development. *) +(* Copyright (c) 2018-2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -23,7 +24,10 @@ (* *) (*****************************************************************************) -(** Type of a protocol-specific mempool filter plug-in. *) +(** Type of a protocol-specific mempool filter plugin. + + This is compatible with the plugins of protocols Lima and up. For + Kathmandu and older protocols, see {!Legacy_mempool_plugin.FILTER}. *) module type FILTER = sig module Proto : Registered_protocol.T @@ -61,44 +65,6 @@ module type FILTER = sig [oph] from the state of the filter *) val remove : filter_state:state -> Tezos_crypto.Operation_hash.t -> state - (** [precheck config ~filter_state ~validation_state oph op - ~nb_successful_prechecks] - should be used to decide whether an operation can be gossiped to the - network without executing it. This is a wrapper around - [Proto.precheck_manager] and [Proto.check_signature]. This - function hereby has a similar return type. - - Returns [`Passed_precheck `No_replace] if the operation was successfully - prechecked. In case the operation is successfully prechecked - but replaces an already prechecked operation [old_oph], the - result [`Passed_precheck (`Replace (old_oph, clasification))] is - returned, where [classification] is the new classifiation of the - replaced operation. If the function returns [`Undecided] it means that - [apply_operation] should be called. - - This function takes a filter [state] and a [Proto.validation_state] - as parameters, and returns them updated if the operation has been - successfully [prechecked]. It also takes an under-approximation - [nb_successful_prechecks] of the number of times the given operation - has been successfully prechecked. *) - val precheck : - config -> - filter_state:state -> - validation_state:Proto.validation_state -> - Tezos_crypto.Operation_hash.t -> - Proto.operation -> - nb_successful_prechecks:int -> - [ `Passed_precheck of - state - * Proto.validation_state - * [ `No_replace - | `Replace of - Tezos_crypto.Operation_hash.t - * Prevalidator_classification.error_classification ] - | `Undecided - | Prevalidator_classification.error_classification ] - Lwt.t - (** [pre_filter config ~filter_state ?validation_state_before operation_data] is called on arrival of an operation and after a flush of the prevalidator. This function calls the [pre_filter] in the protocol @@ -119,21 +85,45 @@ module type FILTER = sig | Prevalidator_classification.error_classification ] Lwt.t - (** [post_filter config ~filter_state ~validation_state_before - ~validation_state_after (operation_data, operation_receipt)] - is called after a call to [Prevalidation.apply_operation] in the - prevalidator, on operations that did not fail. It returns - [`Passed_postfilter] if the operation passes the filter. It returns - [`Refused] otherwise. This function both takes a [filter_state] as - parameter and returns a [filter_state], because it can update it while - executing. *) - val post_filter : + (** Add an operation to the filter {!state}. + + The operation should have been previously validated by the protocol. + + This function is responsible for bounding the number of + manager operations in the mempool. If the mempool is full and + the input operation is a manager operation, then it is compared + with the already present operation with minimal weight. Then + either the minimal operation is replaced, or the new operation + is rejected. + + If successful, return the updated state and possibly the + replaced minimal operation, otherwise return the error + classification for the new operation. + + If [replace] is provided, then it is removed from the state + before processing the new operation (in which case the mempool + can no longer be full, so this function will succeed and return + [`No_replace]). *) + val add_operation_and_enforce_mempool_bound : + ?replace:Tezos_crypto.Operation_hash.t -> + Proto.validation_state -> config -> - filter_state:state -> - validation_state_before:Proto.validation_state -> - validation_state_after:Proto.validation_state -> - Proto.operation * Proto.operation_receipt -> - [`Passed_postfilter of state | `Refused of tztrace] Lwt.t + state -> + Tezos_crypto.Operation_hash.t * Proto.operation -> + ( state + * [ `No_replace + | `Replace of + Tezos_crypto.Operation_hash.t + * Prevalidator_classification.error_classification ], + Prevalidator_classification.error_classification ) + result + Lwt.t + + (** Return a conflict handler for [Proto.Mempool.add_operation]. + + See the documentation of type [Mempool.conflict_handler] in + e.g. [lib_protocol_environment/sigs/v8/updater.mli]. *) + val conflict_handler : config -> Proto.Mempool.conflict_handler end end @@ -147,7 +137,7 @@ end (** Dummy filter that does nothing *) module No_filter (Proto : Registered_protocol.T) : - FILTER with module Proto = Proto + FILTER with module Proto = Proto and type Mempool.state = unit (** This is a protocol specific module that is used to collect all the * protocol-specific metrics. This module @@ -168,9 +158,26 @@ module Undefined_metrics_plugin (P : sig val hash : Tezos_crypto.Protocol_hash.t end) : METRICS -(** Registers a mempool filters plug-in for a specific protocol (according to its [Proto.hash]). *) +(** Juggling between recent filter version {!FILTER}, designed for + Lima (environment V7) and newer protocols, and legacy filter + version {!Legacy_mempool_plugin.FILTER}. *) +type filter_t = + | Recent of (module FILTER) + | Legacy of (module Legacy_mempool_plugin.FILTER) + +(** Dummy filter that does nothing. *) +val no_filter : (module Registered_protocol.T) -> filter_t + +(** Register a mempool filter plugin for a specific protocol + (according to its [Proto.hash]). The protocol must be Lima or a + more recent one. *) val register_filter : (module FILTER) -> unit +(** Register a mempool filter plugin for a specific protocol + (according to its [Proto.hash]). The protocol must be Kathmandu + or older. *) +val register_legacy_filter : (module Legacy_mempool_plugin.FILTER) -> unit + (** Registers a RPC plug-in for a specific protocol *) val register_rpc : (module RPC) -> unit @@ -178,7 +185,7 @@ val register_rpc : (module RPC) -> unit val register_metrics : (module METRICS) -> unit (** Looks for a mempool filter plug-in for a specific protocol. *) -val find_filter : Tezos_crypto.Protocol_hash.t -> (module FILTER) option +val find_filter : Tezos_crypto.Protocol_hash.t -> filter_t option (** Looks for an rpc plug-in for a specific protocol. *) val find_rpc : Tezos_crypto.Protocol_hash.t -> (module RPC) option diff --git a/src/lib_shell/test/dune b/src/lib_shell/test/dune index 140ed6254f846542af90c5f73fbfdfae2a27a313..f887b38a42fe88322946aa09f42a31533d7196f6 100644 --- a/src/lib_shell/test/dune +++ b/src/lib_shell/test/dune @@ -5,7 +5,7 @@ (names test_shell test_synchronisation_heuristic_fuzzy - test_prevalidation + test_shell_operation test_prevalidation_t test_prevalidator_classification test_prevalidator_classification_operations @@ -67,7 +67,7 @@ (rule (alias runtest) (package tezos-shell) - (action (run %{dep:./test_prevalidation.exe}))) + (action (run %{dep:./test_shell_operation.exe}))) (rule (alias runtest) diff --git a/src/lib_shell/test/generators.ml b/src/lib_shell/test/generators.ml index 31204b79b23e604aa8632ff85267ff2779693a80..3e0a097294e1f57520b809363973946d4a826187 100644 --- a/src/lib_shell/test/generators.ml +++ b/src/lib_shell/test/generators.ml @@ -34,10 +34,10 @@ activated on Mainnet. *) open Prevalidator_classification +open Shell_operation let add_if_not_present classification op t = - Prevalidator_classification.( - if is_in_mempool op.Prevalidation.hash t = None then add classification op t) + if Option.is_none (is_in_mempool op.hash t) then add classification op t (** A generator for the protocol bytes of an operation. *) let operation_proto_gen = QCheck2.Gen.small_string ?gen:None @@ -66,7 +66,7 @@ let block_hash_gen : Tezos_crypto.Block_hash.t QCheck2.Gen.t = This function should be renamed to [raw_operation_gen] at some point, because it returns {!Operation.t} (the [op] prefix is for functions - returning {!Prevalidation.operation} values). *) + returning {!operation} values). *) let operation_gen ?(proto_gen = operation_proto_gen) ?block_hash_t () : Operation.t QCheck2.Gen.t = let open QCheck2.Gen in @@ -101,7 +101,7 @@ let priority_gen () : Prevalidator_pending_operations.priority QCheck2.Gen.t = `Low weights (** [operation_with_hash_gen ?proto_gen ?block_hash_t ()] is a generator - for parsable operations, i.e. values of type {!Prevalidation.operation}. + for parsable operations, i.e. values of type {!operation}. In production, this type guarantees that the underlying operation has been successfully parsed. This is NOT the case with this generator. @@ -119,14 +119,13 @@ let priority_gen () : Prevalidator_pending_operations.priority QCheck2.Gen.t = i.e. to have both [operation_data = unit] and strings generated for [operation_data] always empty. *) let operation_with_hash_gen ?proto_gen ?block_hash_t () : - unit Prevalidation.operation QCheck2.Gen.t = + unit operation QCheck2.Gen.t = let open QCheck2.Gen in let+ oph, op = raw_operation_with_hash_gen ?proto_gen ?block_hash_t () in - Prevalidation.Internal_for_tests.make_operation op oph () + Internal_for_tests.make_operation op oph () let operation_with_hash_and_priority_gen ?proto_gen ?block_hash_t () : - (unit Prevalidation.operation * Prevalidator_pending_operations.priority) - QCheck2.Gen.t = + (unit operation * Prevalidator_pending_operations.priority) QCheck2.Gen.t = let open QCheck2.Gen in let* op = operation_with_hash_gen ?proto_gen ?block_hash_t () in let* priority = priority_gen () in @@ -148,12 +147,11 @@ let raw_op_map_gen ?proto_gen ?block_hash_t () : this generator guarantees that all returned operations are distinct (because their hashes differ). *) let op_map_gen ?proto_gen ?block_hash_t () : - unit Prevalidation.operation Tezos_crypto.Operation_hash.Map.t QCheck2.Gen.t - = + unit operation Tezos_crypto.Operation_hash.Map.t QCheck2.Gen.t = let open QCheck2.Gen in let+ ops = small_list (operation_with_hash_gen ?proto_gen ?block_hash_t ()) in List.to_seq ops - |> Seq.map (fun op -> (op.Prevalidation.hash, op)) + |> Seq.map (fun op -> (op.hash, op)) |> Tezos_crypto.Operation_hash.Map.of_seq (** A generator like {!raw_op_map_gen} but which guarantees the size @@ -186,16 +184,14 @@ let raw_op_map_gen_n ?proto_gen ?block_hash_t (n : int) : of fixed lengths) because we *need* to return maps, because we need the properties that all operations hashes are different. *) let op_map_gen_n ?proto_gen ?block_hash_t (n : int) : - unit Prevalidation.operation Tezos_crypto.Operation_hash.Map.t QCheck2.Gen.t - = + unit operation Tezos_crypto.Operation_hash.Map.t QCheck2.Gen.t = let open QCheck2.Gen in let map_take_n n m = Tezos_crypto.Operation_hash.Map.bindings m |> List.take_n n |> List.to_seq |> Tezos_crypto.Operation_hash.Map.of_seq in let merge _oph old _new = Some old in - let rec go - (ops : unit Prevalidation.operation Tezos_crypto.Operation_hash.Map.t) = + let rec go (ops : unit operation Tezos_crypto.Operation_hash.Map.t) = if Tezos_crypto.Operation_hash.Map.cardinal ops >= n then (* Done *) return (map_take_n n ops) @@ -247,8 +243,7 @@ let t_gen = t_gen_ ~can_be_full:true (* With probability 1/2, we take an operation hash already present in the classification. This operation is taken uniformly among the different classes. *) -let with_t_operation_gen : unit t -> unit Prevalidation.operation QCheck2.Gen.t - = +let with_t_operation_gen : unit t -> unit operation QCheck2.Gen.t = let module Classification = Prevalidator_classification in let open QCheck2 in fun t -> @@ -292,8 +287,8 @@ let with_t_operation_gen : unit t -> unit Prevalidation.operation QCheck2.Gen.t @ [(freq_fresh t, operation_with_hash_gen ())] |> Gen.frequency -let t_with_operation_gen_ ~can_be_full : - (unit t * unit Prevalidation.operation) QCheck2.Gen.t = +let t_with_operation_gen_ ~can_be_full : (unit t * unit operation) QCheck2.Gen.t + = let open QCheck2.Gen in let* t = t_gen_ ~can_be_full in pair (return t) (with_t_operation_gen t) diff --git a/src/lib_shell/test/generators_tree.ml b/src/lib_shell/test/generators_tree.ml index 11a77b1e37eabf8920d2417f4f9cbe3ff7fdfdeb..2cb2f9e91e339aeb78a9fa1b5391ab514b988645 100644 --- a/src/lib_shell/test/generators_tree.ml +++ b/src/lib_shell/test/generators_tree.ml @@ -36,6 +36,7 @@ (** Generators building on top of {!Generators}, that are capable of producing trees of blocks. *) +open Shell_operation module Classification = Prevalidator_classification (** Various functions about {!list} *) @@ -208,8 +209,8 @@ module Block = struct (** The block-like interface that suffices to test [Prevalidator.Internal_for_tests.handle_live_operations] *) type t = { - hash : Tezos_crypto.Block_hash.t; - operations : unit Prevalidation.operation list list; + bhash : Tezos_crypto.Block_hash.t; + operations : unit operation list list; } (* Because we use hashes to implement equality, we must make sure @@ -217,10 +218,10 @@ module Block = struct implies [b1 <> b2] where [<>] is polymorphic inequality. Said differently, hashes should not be faked. *) let equal : t -> t -> bool = - fun t1 t2 -> Tezos_crypto.Block_hash.equal t1.hash t2.hash + fun t1 t2 -> Tezos_crypto.Block_hash.equal t1.bhash t2.bhash let compare (t1 : t) (t2 : t) = - Tezos_crypto.Block_hash.compare t1.hash t2.hash + Tezos_crypto.Block_hash.compare t1.bhash t2.bhash (** [hash_of_blocks ops] is used to compute the hash of a block whose [operations] field contains [ops]. @@ -233,7 +234,7 @@ module Block = struct let hash_of_block ops = let hash = Tezos_crypto.Operation_list_hash.compute - (List.map (fun op -> op.Prevalidation.hash) @@ List.concat ops) + (List.map (fun op -> op.hash) @@ List.concat ops) in (* We forge a fake [block_header] hash by first hashing the operations and change the [b58] signature into a signature that looks like @@ -247,16 +248,16 @@ module Block = struct | Ok hash -> hash (** Returns the [hash] field of a {!t} *) - let to_hash (blk : t) = blk.hash + let to_hash (blk : t) = blk.bhash let tools : t Classification.block_tools = let operations block = - List.map (List.map (fun op -> op.Prevalidation.raw)) block.operations + List.map (List.map (fun op -> op.raw)) block.operations in let all_operation_hashes block = - List.map (List.map (fun op -> op.Prevalidation.hash)) block.operations + List.map (List.map (fun op -> op.hash)) block.operations in - {hash = to_hash; operations; all_operation_hashes} + {bhash = to_hash; operations; all_operation_hashes} let to_string t = let ops_list_to_string ops = @@ -264,7 +265,7 @@ module Block = struct "|" (List.map Tezos_crypto.Operation_hash.to_short_b58check - (List.map (fun op -> op.Prevalidation.hash) ops)) + (List.map (fun op -> op.hash) ops)) in let ops_string = List.fold_left @@ -272,7 +273,7 @@ module Block = struct "" t.operations in - Format.asprintf "%a:[%s]" Tezos_crypto.Block_hash.pp t.hash ops_string + Format.asprintf "%a:[%s]" Tezos_crypto.Block_hash.pp t.bhash ops_string (* [pp_list] is unused but useful when debugging, renaming it to [_pp_list] to keep it around *) @@ -308,8 +309,8 @@ let block_gen ?proto_gen () : Block.t QCheck2.Gen.t = (* In production these lists are exactly of size 4, being more general *) list_size (int_range 0 8) ops_list_gen in - let hash = Block.hash_of_block ops in - return Block.{hash; operations = ops} + let bhash = Block.hash_of_block ops in + return Block.{bhash; operations = ops} (* A generator of sets of {!Block.t} where all elements are guaranteed to be different. [list_gen] is an optional list generator. If omitted @@ -400,15 +401,14 @@ let tree_gen ?blocks () = (** A generator for passing the last argument of [Prevalidator.handle_live_operations] *) let old_mempool_gen (tree : Block.t Tree.tree) : - unit Prevalidation.operation Tezos_crypto.Operation_hash.Map.t QCheck2.Gen.t - = + unit operation Tezos_crypto.Operation_hash.Map.t QCheck2.Gen.t = let blocks = Tree.values tree in let pairs = List.concat_map Block.tools.operations blocks |> List.concat in let elements = List.map (fun (op : Operation.t) -> let hash = Operation.hash op in - Prevalidation.Internal_for_tests.make_operation op hash ()) + Internal_for_tests.make_operation op hash ()) pairs in if elements = [] then QCheck2.Gen.return Tezos_crypto.Operation_hash.Map.empty @@ -417,7 +417,7 @@ let old_mempool_gen (tree : Block.t Tree.tree) : QCheck2.Gen.map (fun l -> List.to_seq l - |> Seq.map (fun op -> (op.Prevalidation.hash, op)) + |> Seq.map (fun op -> (op.hash, op)) |> Tezos_crypto.Operation_hash.Map.of_seq) list_gen @@ -500,7 +500,7 @@ let classification_chain_tools (tree : Block.t Tree.tree) : let tree_gen ?blocks () : (Block.t Tree.tree * (Block.t * Block.t) option - * unit Prevalidation.operation Tezos_crypto.Operation_hash.Map.t) + * unit operation Tezos_crypto.Operation_hash.Map.t) QCheck2.Gen.t = let open QCheck2.Gen in let* tree = tree_gen ?blocks () in diff --git a/src/lib_shell/test/test_prevalidation_t.ml b/src/lib_shell/test/test_prevalidation_t.ml index cd59889aa279ce9a4957571d87a76bf1e2fba90a..5293ef514af3d1117be16411b4d9e3c43e3b29ca 100644 --- a/src/lib_shell/test/test_prevalidation_t.ml +++ b/src/lib_shell/test/test_prevalidation_t.ml @@ -40,38 +40,12 @@ Subject: Unit tests for {!Prevalidation.T} *) -module Mock_protocol : - Tezos_protocol_environment.PROTOCOL - with type operation_data = unit - and type operation_receipt = unit - and type validation_state = unit - and type application_state = unit = struct - open Tezos_protocol_environment.Internal_for_tests - include Environment_protocol_T_test.Mock_all_unit - - (* We need to override these functions so that they're not [assert - false], because the tests below use [Prevalidation.create] which - calls them. *) - - let begin_validation _ctxt _chain_id _mode ~predecessor:_ ~cache:_ = - Lwt_result_syntax.return_unit - - let begin_application _ctxt _chain_id _mode ~predecessor:_ ~cache:_ = - Lwt_result_syntax.return_unit -end - -module Internal_for_tests = Prevalidation.Internal_for_tests +open Tezos_crypto module Init = struct - let genesis_protocol = - Tezos_crypto.Protocol_hash.of_b58check_exn - "ProtoDemoNoopsDemoNoopsDemoNoopsDemoNoopsDemo6XBoYp" - - let chain_id = Tezos_crypto.Chain_id.zero - - let genesis_time = Time.Protocol.of_seconds 0L + let chain_id = Shell_test_helpers.chain_id - (** [wrap_tzresult_lwt f ()] provides an instance of {!Context.t} to + (** [wrap_tzresult_lwt_disk f ()] provides an instance of {!Context.t} to a test [f]. For this, it creates a temporary directory on disk, populates it with the data required for a {!Context.t} and then calls [f] by passing it an empty [Context.t]. After [f] finishes, the state @@ -87,34 +61,25 @@ module Init = struct Context.commit_genesis idx ~chain_id - ~time:genesis_time - ~protocol:genesis_protocol + ~time:Shell_test_helpers.genesis_time + ~protocol:Shell_test_helpers.genesis_protocol_hash in let*! v = Context.checkout_exn idx genesis in let v = Tezos_shell_context.Shell_context.wrap_disk_context v in f v) - let genesis_block (context_hash : Tezos_crypto.Context_hash.t) : Store.Block.t - = - let block_hash : Tezos_crypto.Block_hash.t = - Tezos_crypto.Block_hash.hash_string ["genesis"] - in - let genesis : Genesis.t = - {time = genesis_time; block = block_hash; protocol = genesis_protocol} - in - let repr : Block_repr.t = - Block_repr.create_genesis_block ~genesis context_hash + let genesis_block ~timestamp ctxt = + let context_hash = Context_ops.hash ~time:timestamp ctxt in + let repr = + Block_repr.create_genesis_block + ~genesis:Shell_test_helpers.genesis + context_hash in Store.Unsafe.block_of_repr repr end -let create_prevalidation - (module Mock_protocol : Tezos_protocol_environment.PROTOCOL - with type operation_data = unit - and type operation_receipt = unit - and type validation_state = unit) ctxt = - let module Chain_store : - Internal_for_tests.CHAIN_STORE with type chain_store = unit = struct +let make_chain_store ctxt = + let module Chain_store = struct type chain_store = unit let context () _block : Tezos_protocol_environment.Context.t tzresult Lwt.t @@ -123,13 +88,46 @@ let create_prevalidation let chain_id () = Init.chain_id end in - let module Prevalidation_t = - Internal_for_tests.Make (Chain_store) (Mock_protocol) - in - (module Prevalidation_t : Prevalidation.T - with type operation_receipt = unit + (module Chain_store : Prevalidation.Internal_for_tests.CHAIN_STORE + with type chain_store = unit) + +(** Module [Environment_protocol_T_test.Mock_all_unit] (where all + functions are [assert false]), with just enough functions actually + implemented so that [Prevalidation.create] can be run successfully. *) +module Mock_protocol : + Tezos_protocol_environment.PROTOCOL + with type operation_data = unit + and type operation_receipt = unit and type validation_state = unit - and type chain_store = Chain_store.chain_store) + and type application_state = unit = struct + open Tezos_protocol_environment.Internal_for_tests + include Environment_protocol_T_test.Mock_all_unit + + let begin_validation _ctxt _chain_id _mode ~predecessor:_ ~cache:_ = + Lwt_result_syntax.return_unit + + module Mempool = struct + include Mempool + + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt_result.return ((), ()) + end +end + +module MakeFilter (Proto : Tezos_protocol_environment.PROTOCOL) : + Shell_plugin.FILTER + with type Proto.operation_data = Proto.operation_data + and type Proto.operation = Proto.operation + and type Mempool.state = unit + and type Proto.Mempool.validation_info = Proto.Mempool.validation_info = +Shell_plugin.No_filter (struct + let hash = Protocol_hash.zero + + include Proto + + let complete_b58prefix _ = assert false +end) + +module MakePrevalidation = Prevalidation.Internal_for_tests.Make let now () = Time.System.to_protocol (Tezos_base.Time.System.now ()) @@ -139,28 +137,22 @@ let chain_store = () (** Test that [create] returns [Ok] in a pristine context. *) let test_create ctxt = let open Lwt_result_syntax in - let live_operations = Tezos_crypto.Operation_hash.Set.empty in + let (module Chain_store) = make_chain_store ctxt in + let module Filter = MakeFilter (Mock_protocol) in + let module P = MakePrevalidation (Chain_store) (Filter) in let timestamp : Time.Protocol.t = now () in - let (module Prevalidation) = - create_prevalidation (module Mock_protocol) ctxt - in - let predecessor : Store.Block.t = - Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt - in - let* _ = - Prevalidation.create chain_store ~predecessor ~live_operations ~timestamp () - in + let head = Init.genesis_block ~timestamp ctxt in + let* _ = P.create chain_store ~head ~timestamp () in return_unit -(** A generator of [Prevalidation.operation] values that make sure +module Parser = Shell_operation.MakeParser (Mock_protocol) + +(** A generator of [operation] values that makes sure to return distinct operations (hashes are not fake and they are all different). Returned maps are exactly of size [n]. *) -let prevalidation_operations_gen (type a) - (module P : Prevalidation.T with type protocol_operation = a) ~(n : int) : - a Prevalidation.operation list QCheck2.Gen.t = - let mk_operation (hash, (raw : Operation.t)) : - P.protocol_operation Prevalidation.operation = - match P.parse hash raw with +let operations_gen ~(n : int) = + let mk_operation (hash, (raw : Operation.t)) = + match Parser.parse hash raw with | Ok x -> x | Error err -> Format.printf "%a" Error_monad.pp_print_trace err ; @@ -168,222 +160,434 @@ let prevalidation_operations_gen (type a) in let open QCheck2.Gen in (* We need to specify the protocol bytes generator to always generate the - empty string, otherwise the call to [P.parse] will fail with the + empty string, otherwise the call to [Parser.parse] will fail with the bytes being too long (hereby looking like an attack). *) - let proto_gen : string QCheck2.Gen.t = QCheck2.Gen.return "" in - let+ (ops : Operation.t Tezos_crypto.Operation_hash.Map.t) = + let proto_gen : string QCheck2.Gen.t = QCheck2.Gen.pure "" in + let+ (ops : Operation.t Operation_hash.Map.t) = Generators.raw_op_map_gen_n ~proto_gen ?block_hash_t:None n in - List.map mk_operation (Tezos_crypto.Operation_hash.Map.bindings ops) + List.map mk_operation (Operation_hash.Map.bindings ops) (** The number of operations used by tests that follow *) let nb_ops = 100 -let mk_ops (type a) - (module P : Prevalidation.T with type protocol_operation = a) : - a Prevalidation.operation list = - let ops = - QCheck2.Gen.generate1 (prevalidation_operations_gen (module P) ~n:nb_ops) - in +let mk_ops () = + let ops = QCheck2.Gen.generate1 (operations_gen ~n:nb_ops) in assert (Compare.List_length_with.(ops = nb_ops)) ; ops -(** Test that [Prevalidation.apply_operations] only returns [Branch_delayed _] - when the protocol's [apply_operation] crashes. *) -let test_apply_operation_crash ctxt = - let open Lwt_result_syntax in - let live_operations = Tezos_crypto.Operation_hash.Set.empty in - let timestamp : Time.Protocol.t = now () in - let (module P) = create_prevalidation (module Mock_protocol) ctxt in - let ops : P.protocol_operation Prevalidation.operation list = - mk_ops (module P) +let pp_classification fmt classification = + let print_error_classification name trace = + Format.fprintf fmt "%s: %a" name pp_print_trace trace in - let predecessor : Store.Block.t = - Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt - in - let* pv = P.create chain_store ~predecessor ~live_operations ~timestamp () in - let apply_op pv op = - let*! application_result = P.apply_operation pv op in - match application_result with - | Applied _ | Branch_refused _ | Refused _ | Outdated _ -> - (* These cases should not happen because - [Mock_protocol.apply_operation] is [assert false]. *) - assert false - | Branch_delayed _ -> - (* This is the only allowed case. *) - Lwt.return pv + match classification with + | `Applied -> Format.fprintf fmt "Applied" + | `Prechecked -> Format.fprintf fmt "Prechecked" + | `Branch_delayed trace -> print_error_classification "Branch_delayed" trace + | `Branch_refused trace -> print_error_classification "Branch_refused" trace + | `Refused trace -> print_error_classification "Refused" trace + | `Outdated trace -> print_error_classification "Outdated" trace + +let check_classification_is_exn loc + (classification : Prevalidator_classification.classification) = + match classification with + | `Branch_delayed [Exn _] -> () + | _ -> + QCheck2.Test.fail_reportf + "%s:@.Expected classification (Branch_delayed: [Exn]), but got %a" + loc + pp_classification + classification + +let pp_expected fmt = function + | `Prechecked -> Format.fprintf fmt "Prechecked" + | `Branch_delayed -> Format.fprintf fmt "Branch_delayed" + | `Branch_refused -> Format.fprintf fmt "Branch_refused" + | `Refused -> Format.fprintf fmt "Refused" + +let check_classification loc ~expected + (classification : Prevalidator_classification.classification) = + match (expected, classification) with + | `Prechecked, `Prechecked + | `Branch_delayed, `Branch_delayed _ + | `Branch_refused, `Branch_refused _ + | `Refused, `Refused _ -> + () + | _ -> + QCheck2.Test.fail_reportf + "%s:@.Expected classification %a, but got %a" + loc + pp_expected + expected + pp_classification + classification + +type error += Branch_delayed_error | Branch_refused_error | Refused_error + +let () = + let register_aux category id from_error to_error = + register_error_kind + category + ~id + ~title:id + ~description:id + Data_encoding.empty + from_error + to_error in - let*! _ = List.fold_left_s apply_op pv ops in - return_unit + register_aux + `Temporary + "test.branch_delayed_error" + (function Branch_delayed_error -> Some () | _ -> None) + (fun () -> Branch_delayed_error) ; + register_aux + `Branch + "test.branch_refused_error" + (function Branch_refused_error -> Some () | _ -> None) + (fun () -> Branch_refused_error) ; + register_aux + `Permanent + "test.refused_error" + (function Refused_error -> Some () | _ -> None) + (fun () -> Refused_error) + +(** Possible outcomes of protocol's [Mempool.add_operation] that we + want to test. *) +type proto_add_outcome = + | Proto_added (** Return [Proto.Mempool.Added]. *) + | Proto_replaced (** Return [Proto.Mempool.Replaced]. *) + | Proto_unchanged (** Return [Proto.Mempool.Unchanged]. *) + | Proto_branch_delayed (** Fail with a [`Temporary] error. *) + | Proto_branch_refused (** Fail with a [`Branch] error. *) + | Proto_refused (** Fail with a [`Permanent] error. *) + | Proto_crash (** Raise an exception. *) + +let proto_add_outcome_gen = + (* We try to give higher weights to more usual outcomes, and in + particular to [Proto_added] so that the number of operations in + the mempool can grow. *) + QCheck2.Gen.frequencyl + [ + (4, Proto_added); + (2, Proto_replaced); + (2, Proto_unchanged); + (1, Proto_branch_delayed); + (1, Proto_branch_refused); + (1, Proto_refused); + (1, Proto_crash); + ] + +(** Mock protocol with a toy mempool that has an adjustable + [add_operation] function: it behaves as instructed by the provided + [proto_add_outcome]. + + Unlike in [Mock_protocol], here [Mempool.t] is an actual state + that keeps track of validated operations and can be retrieved with + [Mempool.operations]. This allows the test below to check that + operations were correctly added or removed. *) +module Toy_proto : + Tezos_protocol_environment.PROTOCOL + with type operation_data = unit + and type operation = Mock_protocol.operation + and type Mempool.validation_info = proto_add_outcome = struct + include Mock_protocol + + module Mempool = struct + include Mempool + + type t = operation Operation_hash.Map.t + + (* We use this type as a hack to tell [add_operation] which + outcome we want. *) + type validation_info = proto_add_outcome + + let init _ctxt _chain_id ~head_hash:_ ~head:_ ~cache:_ = + Lwt_result.return (Proto_crash, Operation_hash.Map.empty) + + let operation_encoding = + Data_encoding.conv + (fun {shell; protocol_data = ()} -> shell) + (fun shell -> {shell; protocol_data = ()}) + Operation.shell_header_encoding + + let encoding = Operation_hash.Map.encoding operation_encoding + + let add_operation ?check_signature:_ ?conflict_handler info state (oph, op) + = + if Option.is_none conflict_handler then + QCheck2.Test.fail_reportf + "Prevalidation should always call [Proto.Mempool.add_operation] with \ + an explicit [conflict_handler]." ; + match (info : proto_add_outcome) with + | Proto_added -> + let state = Operation_hash.Map.add oph op state in + Lwt_result.return (state, Added) + | Proto_replaced -> + let removed = + match Operation_hash.Map.choose state with + | Some (hash, _) -> hash + | None -> + (* This outcome should not be used when the mempool is + empty. See [consistent_outcomes]. *) + assert false + in + let state = Operation_hash.Map.remove removed state in + let state = Operation_hash.Map.add oph op state in + Lwt_result.return (state, Replaced {removed}) + | Proto_unchanged -> Lwt_result.return (state, Unchanged) + | Proto_branch_delayed -> + Lwt_result.fail (Validation_error [Branch_delayed_error]) + | Proto_branch_refused -> + Lwt_result.fail (Validation_error [Branch_refused_error]) + | Proto_refused -> Lwt_result.fail (Validation_error [Refused_error]) + | Proto_crash -> assert false + + let remove_operation state oph = Operation_hash.Map.remove oph state + + let merge ?conflict_handler:_ _ _ = assert false + + let operations = Fun.id + end +end + +(** Possible outcomes of filter's + [Mempool.add_operation_and_enforce_mempool_bound] that we want to test. *) +type filter_add_outcome = + | F_no_replace (** Return [`No_replace]. *) + | F_replace (** Return [`Replace _]. *) + | F_branch_delayed (** Fail with a [`Temporary] error. *) + | F_branch_refused (** Fail with a [`Branch] error. *) + | F_refused (** Fail with a [`Permanent] error. *) + | F_crash (** Raise an exception. *) + +let filter_add_outcome_encoding = + Data_encoding.string_enum + [ + ("No_replace", F_no_replace); + ("Replace", F_replace); + ("Branch_delayed", F_branch_delayed); + ("Branch_refused", F_branch_refused); + ("Refused", F_refused); + ("Crash", F_crash); + ] -(** Logical implication *) -let ( ==> ) a b = (not a) || b - -(** Returns a random generator initialized with a seed from [QCheck2] *) -let mk_rand () = - (* We use QCheck2 as the source of randomness, as we hope one day - this will become a traditional QCheck2 test. *) - QCheck2.Gen.generate ~n:8 QCheck2.Gen.int - |> Array.of_list |> Random.State.make - -(** [mk_live_operations rand ops] returns a subset of [ops], which is - appropriate for being passed as the [live_operations] argument - of [Prevalidation.create] *) -let mk_live_operations (type a) rand (ops : a Prevalidation.operation list) = - List.fold_left - (fun acc (op : _ Prevalidation.operation) -> - if Random.State.bool rand then - Tezos_crypto.Operation_hash.Set.add - (Internal_for_tests.to_raw op |> Operation.hash) - acc - else acc) - Tezos_crypto.Operation_hash.Set.empty - ops - -(** Test that [Prevalidation.apply_operations] returns [Outdated] - for operations in [live_operations] *) -let test_apply_operation_live_operations ctxt = +let filter_add_outcome_gen = + (* We try to give higher weights to more usual outcomes, and in + particular to [Proto_added] so that the number of operations in + the mempool can grow. *) + QCheck2.Gen.frequencyl + [ + (8, F_no_replace); + (4, F_replace); + (1, F_branch_delayed); + (1, F_branch_refused); + (1, F_refused); + (1, F_crash); + ] + +(** Toy mempool filter with an adjustable + [add_operation_and_enforce_mempool_bound] and an actual [state] that + keeps track of added operations. *) +module Toy_filter = struct + include MakeFilter (Toy_proto) + + module Mempool = struct + (* Once again, we hack this type to specify the desired outcome. *) + type config = filter_add_outcome + + let config_encoding = filter_add_outcome_encoding + + let default_config = F_no_replace + + type state = Operation_hash.Set.t + + let init _ ?validation_state:_ ~predecessor:_ () = + Lwt_result.return Operation_hash.Set.empty + + let on_flush _ _ ?validation_state:_ ~predecessor:_ () = assert false + + let remove ~filter_state:_ _ = assert false + + let pre_filter _ ~filter_state:_ ?validation_state_before:_ _ = assert false + + let add_operation_and_enforce_mempool_bound ?replace _ config filter_state + (oph, _op) = + let filter_state = + match replace with + | None -> filter_state + | Some replace_oph -> Operation_hash.Set.remove replace_oph filter_state + in + let filter_state = Operation_hash.Set.add oph filter_state in + match config with + | F_no_replace -> Lwt_result.return (filter_state, `No_replace) + | F_replace -> + let replace_oph = + match Operation_hash.Set.choose filter_state with + | Some hash -> hash + | None -> + (* This outcome should not be used when the mempool is + empty. See [consistent_outcomes]. *) + assert false + in + let filter_state = + Operation_hash.Set.remove replace_oph filter_state + in + let replacement = + (replace_oph, `Branch_delayed [Branch_delayed_error]) + in + Lwt_result.return (filter_state, `Replace replacement) + | F_branch_delayed -> + Lwt_result.fail (`Branch_delayed [Branch_delayed_error]) + | F_branch_refused -> + Lwt_result.fail (`Branch_refused [Branch_refused_error]) + | F_refused -> Lwt_result.fail (`Refused [Refused_error]) + | F_crash -> assert false + + let conflict_handler _ ~existing_operation:_ ~new_operation:_ = assert false + end +end + +(** Adjust the outcomes of [Proto.Mempool.add_operation] and + [Filter.Mempool.add_operation_and_enforce_mempool_bound] we wish to + test, to avoid asking these functions to return a result that + wouldn't make sense. *) +let consistent_outcomes ~mempool_is_empty proto_outcome filter_outcome = + if mempool_is_empty then + (* If the mempool contains no valid operations, then there is no + operation to replace, so outcomes can be neither + [Proto_replaced] nor [F_replace]. *) + let proto_outcome = + match proto_outcome with + | Proto_replaced -> Proto_added + | _ -> proto_outcome + in + let filter_outcome = + match filter_outcome with + | F_replace -> F_no_replace + | _ -> filter_outcome + in + (proto_outcome, filter_outcome) + else + (* If the protocol already causes the removal of an old operation, + then the mempool is not full and the filter won't also remove + an operation. In other words, the outcomes [Proto_replaced] and + [F_replace] are incompatible. *) + match (proto_outcome, filter_outcome) with + | Proto_replaced, F_replace -> (Proto_replaced, F_no_replace) + | _ -> (proto_outcome, filter_outcome) + +(** Test [Prevalidation.add_operation]. + + For various outcomes of the protocol's [Mempool.add_operation] and + the filter's [Mempool.add_operation_and_enforce_mempool_bound], + check the returned classification and the updates of the protocol + and filter internal states. *) +let test_add_operation ctxt = let open Lwt_result_syntax in - let timestamp : Time.Protocol.t = now () in - let rand : Random.State.t = mk_rand () in - let (module Protocol : Tezos_protocol_environment.PROTOCOL - with type operation_data = unit - and type operation_receipt = unit - and type validation_state = unit - and type application_state = unit) = - (module struct - include Mock_protocol - - let apply_operation _ _ _ = - Lwt.return - (if Random.State.bool rand then Ok ((), ()) - else error_with "Operation doesn't apply") - end) - in - let (module P) = create_prevalidation (module Protocol) ctxt in - let ops : P.protocol_operation Prevalidation.operation list = - mk_ops (module P) - in - let live_operations : Tezos_crypto.Operation_hash.Set.t = - mk_live_operations rand ops - in - let predecessor : Store.Block.t = - Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt - in - let* pv = P.create chain_store ~predecessor ~live_operations ~timestamp () in - let op_in_live_operations op = - Tezos_crypto.Operation_hash.Set.mem - (Internal_for_tests.to_raw op |> Operation.hash) - live_operations - in - let apply_op pv (op : _ Prevalidation.operation) = - let*! application_result = P.apply_operation pv op in - let next_pv, result_is_outdated = - match application_result with - | Applied (next_pv, _receipt) -> (next_pv, false) - | Outdated _ -> (pv, true) - | Branch_delayed _ | Branch_refused _ | Refused _ -> (pv, false) + let (module Chain_store) = make_chain_store ctxt in + let module P = MakePrevalidation (Chain_store) (Toy_filter) in + let add_op (state, filter_state_before) (op, (proto_outcome, filter_outcome)) + = + let valid_ops_before = P.Internal_for_tests.get_valid_operations state in + assert ( + not (Operation_hash.Map.mem op.Shell_operation.hash valid_ops_before)) ; + assert (not (Operation_hash.Set.mem op.hash filter_state_before)) ; + let proto_outcome, filter_outcome = + let mempool_is_empty = Operation_hash.Map.is_empty valid_ops_before in + consistent_outcomes ~mempool_is_empty proto_outcome filter_outcome + in + let state = P.Internal_for_tests.set_validation_info state proto_outcome in + let*! ( state, + filter_state, + (_op : Mock_protocol.operation Shell_operation.operation), + classification, + replacement ) = + P.add_operation state filter_state_before filter_outcome op in - (* Here is the main check of this test: *) - assert (op_in_live_operations op ==> result_is_outdated) ; - Lwt.return next_pv + (* Check the classification. *) + (match (proto_outcome, filter_outcome) with + | (Proto_added | Proto_replaced), (F_no_replace | F_replace) -> + check_classification __LOC__ ~expected:`Prechecked classification + | (Proto_unchanged | Proto_branch_delayed), _ + | (Proto_added | Proto_replaced), F_branch_delayed -> + check_classification __LOC__ ~expected:`Branch_delayed classification + | Proto_branch_refused, _ | (Proto_added | Proto_replaced), F_branch_refused + -> + check_classification __LOC__ ~expected:`Branch_refused classification + | Proto_refused, _ | (Proto_added | Proto_replaced), F_refused -> + check_classification __LOC__ ~expected:`Refused classification + | Proto_crash, _ | (Proto_added | Proto_replaced), F_crash -> + check_classification_is_exn __LOC__ classification) ; + (* Check whether the new operation has been added, whether there + is a replacement, and when there is one, whether it has been removed. *) + let valid_ops = P.Internal_for_tests.get_valid_operations state in + (match (proto_outcome, filter_outcome) with + | Proto_added, F_no_replace -> + assert (Operation_hash.Map.mem op.hash valid_ops) ; + assert (Operation_hash.Set.mem op.hash filter_state) ; + assert (Option.is_none replacement) + | Proto_added, F_replace | Proto_replaced, F_no_replace -> ( + assert (Operation_hash.Map.mem op.hash valid_ops) ; + assert (Operation_hash.Set.mem op.hash filter_state) ; + match replacement with + | None -> assert false + | Some (removed, _) -> + assert (Operation_hash.Map.mem removed valid_ops_before) ; + assert (Operation_hash.Set.mem removed filter_state_before) ; + assert (not (Operation_hash.Map.mem removed valid_ops)) ; + assert (not (Operation_hash.Set.mem removed filter_state))) + | Proto_replaced, F_replace -> + (* [consistent_outcomes] makes this case impossible. *) assert false + | _ -> + assert (not (Operation_hash.Map.mem op.hash valid_ops)) ; + assert (not (Operation_hash.Set.mem op.hash filter_state)) ; + assert (Option.is_none replacement)) ; + Lwt.return (state, filter_state) in - let*! _ = List.fold_left_s apply_op pv ops in - return_unit - -(** Test that [Prevalidation.apply_operations] makes field [applied] - grow and that it grows only for operations on which the protocol - [apply_operation] returns [Ok]. *) -let test_apply_operation_applied ctxt = - let open Lwt_result_syntax in let timestamp : Time.Protocol.t = now () in - let rand : Random.State.t = mk_rand () in - let (module Protocol : Tezos_protocol_environment.PROTOCOL - with type operation_data = unit - and type operation_receipt = unit - and type validation_state = unit) = - (module struct - include Mock_protocol - - let apply_operation _ _ _ = - Lwt.return - (if Random.State.bool rand then Ok ((), ()) - else error_with "Operation doesn't apply") - end) + let head = Init.genesis_block ~timestamp ctxt in + let* prevalidation_state = P.create chain_store ~head ~timestamp () in + let* filter_state = + Toy_filter.Mempool.(init default_config ~predecessor:head ()) in - let (module P) = create_prevalidation (module Protocol) ctxt in - let ops : P.protocol_operation Prevalidation.operation list = - mk_ops (module P) + let ops = mk_ops () in + let outcomes = + QCheck2.Gen.( + generate ~n:nb_ops (pair proto_add_outcome_gen filter_add_outcome_gen)) in - let live_operations : Tezos_crypto.Operation_hash.Set.t = - mk_live_operations rand ops + let ops_and_outcomes, leftovers = List.combine_with_leftovers ops outcomes in + assert (Option.is_none leftovers) ; + let*! final_prevalidation_state, final_filter_state = + List.fold_left_s add_op (prevalidation_state, filter_state) ops_and_outcomes in - let predecessor : Store.Block.t = - Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt + let final_valid_ops = + P.Internal_for_tests.get_valid_operations final_prevalidation_state in - let* pv = P.create chain_store ~predecessor ~live_operations ~timestamp () in - let to_applied = P.Internal_for_tests.to_applied in - let apply_op pv (op : _ Prevalidation.operation) = - let applied_before = to_applied pv in - let*! application_result = P.apply_operation pv op in - let next_pv, result_is_applied = - match application_result with - | Applied (next_pv, _receipt) -> (next_pv, true) - | Branch_delayed _ -> - (* As in [test_apply_operation_crash] *) - (pv, false) - | Outdated _ -> - (* This case can happen, because we specified a non-empty [live_operations] set *) - (pv, false) - | Branch_refused _ | Refused _ -> - (* As in [test_apply_operation_crash], these cases cannot happen. *) - assert false - in - let applied_after = to_applied next_pv in - (* Here is the main check of this test: *) - if result_is_applied then - assert (Stdlib.List.tl applied_after = applied_before) - else - (* Physical equality: intended, the [applied] field should - not be changed in this case. *) - assert (applied_after == applied_before) ; - Lwt.return next_pv - in - let*! _ = List.fold_left_s apply_op pv ops in + assert ( + Operation_hash.Map.cardinal final_valid_ops + = Operation_hash.Set.cardinal final_filter_state) ; + Operation_hash.Map.iter + (fun oph _ -> assert (Operation_hash.Set.mem oph final_filter_state)) + final_valid_ops ; return_unit let () = + let register_test name f = + Tztest.tztest name `Quick (Init.wrap_tzresult_lwt_disk f) + in Alcotest_lwt.run "mempool-prevalidation" [ (* Run only those tests with: dune exec src/lib_shell/test/test_prevalidation_t.exe -- test create '0' *) - ( "create", - [ - Tztest.tztest - "[create] returns Ok" - `Quick - (Init.wrap_tzresult_lwt_disk test_create); - ] ); + ("create", [register_test "[create] succeeds" test_create]); (* Run only those tests with: - dune exec src/lib_shell/test/test_prevalidation_t.exe -- test apply_operation '0..2' *) - ( "apply_operation", + dune exec src/lib_shell/test/test_prevalidation_t.exe -- test add_operation '0' *) + ( "add_operation", [ - Tztest.tztest - "[apply_operation] returns [Branch_delayed] when [apply_operation] \ - from the protocol crashes" - `Quick - (Init.wrap_tzresult_lwt_disk test_apply_operation_crash); - Tztest.tztest - "[apply_operation] returns [Outdated] on operations in \ - [live_operations]" - `Quick - (Init.wrap_tzresult_lwt_disk test_apply_operation_live_operations); - Tztest.tztest - "[apply_operation] makes the [applied] field grow for [Applied] \ - operations (and only for them)" - `Quick - (Init.wrap_tzresult_lwt_disk test_apply_operation_applied); + register_test + "Check classification and state updates" + test_add_operation; ] ); ] |> Lwt_main.run diff --git a/src/lib_shell/test/test_prevalidator_classification.ml b/src/lib_shell/test/test_prevalidator_classification.ml index ecb79bf1fba6ba42ec2de42c1e9b82293bacbde8..34187e058e96fb29ebc3a8397bc165b7c5435143 100644 --- a/src/lib_shell/test/test_prevalidator_classification.ml +++ b/src/lib_shell/test/test_prevalidator_classification.ml @@ -41,6 +41,7 @@ *) open Lib_test.Qcheck2_helpers +open Shell_operation module Classification = Prevalidator_classification let is_in_mempool oph t = Classification.is_in_mempool oph t <> None @@ -57,7 +58,7 @@ module Operation_map = struct Tezos_crypto.Operation_hash.pp oph Operation.pp - op.Prevalidation.raw)) + op.raw)) (Tezos_crypto.Operation_hash.Map.bindings map) let pp ppf map = @@ -71,27 +72,23 @@ module Operation_map = struct Tezos_crypto.Operation_hash.pp oph Operation.pp - op.Prevalidation.raw)) + op.raw)) (Tezos_crypto.Operation_hash.Map.bindings map) (* Uses polymorphic equality on tztraces! *) let eq = Tezos_crypto.Operation_hash.Map.equal (fun (o1, t1) (o2, t2) -> - Tezos_crypto.Operation_hash.equal o1.Prevalidation.hash o2.hash - && t1 = t2) + Tezos_crypto.Operation_hash.equal o1.hash o2.hash && t1 = t2) end type classification_event = - | Add_if_not_present of - Classification.classification * unit Prevalidation.operation + | Add_if_not_present of Classification.classification * unit operation | Remove of Tezos_crypto.Operation_hash.t | Flush of bool let drop oph t = let open Classification in - let (_ : (unit Prevalidation.operation * classification) option) = - remove oph t - in + let (_ : (unit operation * classification) option) = remove oph t in () let play_event event t = @@ -123,7 +120,7 @@ module Extra_generators = struct in let remove_gen = let+ op = Generators.with_t_operation_gen t in - Remove op.Prevalidation.hash + Remove op.hash in let flush_gen = let+ b = bool in @@ -192,7 +189,7 @@ let disjoint_union_classified_fields ?fail_msg (t : unit Classification.t) = +> (Classification.Sized_map.to_seq t.prechecked |> Seq.map fst |> Tezos_crypto.Operation_hash.Set.of_seq) +> (Tezos_crypto.Operation_hash.Set.of_list - @@ List.rev_map (fun op -> op.Prevalidation.hash) t.applied_rev) + @@ List.rev_map (fun op -> op.hash) t.applied_rev) (** Checks both invariants of type [Prevalidator_classification.t]: - The field [in_mempool] is the set of all operation hashes present @@ -274,7 +271,7 @@ let event_pp pp = function classification_pp classification Tezos_crypto.Operation_hash.pp - op.Prevalidation.hash + op.hash | Remove oph -> Format.fprintf pp "Remove %a" Tezos_crypto.Operation_hash.pp oph | Flush handle_branch_refused -> @@ -354,7 +351,7 @@ let test_is_in_mempool_remove = Generators.(Gen.pair t_with_operation_gen unrefused_classification_gen) @@ fun ((t, op), unrefused_classification) -> Classification.add unrefused_classification op t ; - let oph = op.Prevalidation.hash in + let oph = op.hash in qcheck_eq_true ~actual:(is_in_mempool oph t) ; drop oph t ; qcheck_eq_false ~actual:(is_in_mempool oph t) ; @@ -367,7 +364,7 @@ let test_is_applied = Generators.(Gen.pair t_gen (operation_with_hash_gen ())) @@ fun (t, op) -> Classification.add `Applied op t ; - let oph = op.Prevalidation.hash in + let oph = op.hash in qcheck_eq_true ~actual:(is_in_mempool oph t) ; match Classification.remove oph t with | None -> false @@ -407,7 +404,7 @@ module Unparsable = struct ~name:"[is_known_unparsable oph (add_unparsable oph t)] holds" Generators.(t_with_operation_gen) @@ fun (t, op) -> - let oph = op.Prevalidation.hash in + let oph = op.hash in Classification.add_unparsable oph t ; qcheck_eq_true ~actual:(Classification.is_known_unparsable oph t) ; true @@ -422,14 +419,14 @@ module Unparsable = struct ~name:"[is_known_unparsable _ (flush t)] does not hold" (Gen.pair Generators.t_with_operation_gen Gen.bool) @@ fun ((t, op), handle_branch_refused) -> - let oph = op.Prevalidation.hash in + let oph = op.hash in Classification.Internal_for_tests.flush ~handle_branch_refused t ; qcheck_eq_false ~actual:(Classification.is_known_unparsable oph t) ; true end module Bounded = struct - type binding = unit Prevalidation.operation + type binding = unit operation type custom = unit Classification.t @@ -451,7 +448,7 @@ module Bounded = struct in let binding_pp ppf bindings = bindings - |> List.map (fun value -> value.Prevalidation.hash) + |> List.map (fun value -> value.hash) |> Format.pp_print_list Tezos_crypto.Operation_hash.pp ppf in Format.asprintf @@ -498,7 +495,7 @@ module Bounded = struct List.iter (fun op -> Classification.add classification op t) ops let check_discarded_contains_ops ~discarded_hashes ~ops = - let excess_hashes = List.map (fun op -> op.Prevalidation.hash) ops in + let excess_hashes = List.map (fun op -> op.hash) ops in if not (List.for_all @@ -546,9 +543,7 @@ module Bounded = struct (custom_gen discarded_operations_rev) @@ fun (t, error_classification, first_ops, other_ops) -> (* We must not have duplicate operation hashes otherwise we may not go over the bound *) - let hashes = - first_ops @ other_ops |> List.map (fun op -> op.Prevalidation.hash) - in + let hashes = first_ops @ other_ops |> List.map (fun op -> op.hash) in let unique_hashes = Tezos_crypto.Operation_hash.Set.of_list hashes in QCheck2.assume Compare.List_length_with.( @@ -594,7 +589,7 @@ module To_map = struct fmt "%a:%a" Tezos_crypto.Operation_hash.pp - op.Prevalidation.hash + op.hash Operation.pp op.raw in @@ -602,7 +597,7 @@ module To_map = struct let map_eq = Tezos_crypto.Operation_hash.Map.equal (fun op1 op2 -> - Operation.equal op1.Prevalidation.raw op2.raw) + Operation.equal op1.raw op2.raw) (** [remove_all m1 m2] returns the subset of [m1] thas is not within [m2]. Said differently, [remove_all m1 m2] removes from [m1] all keys @@ -628,7 +623,7 @@ module To_map = struct | [], _ -> true | [(kdiff, vdiff)], Some v when Tezos_crypto.Operation_hash.equal kdiff k - && Operation.equal v.Prevalidation.raw vdiff.Prevalidation.raw -> + && Operation.equal v.raw vdiff.raw -> true | [(kdiff, _)], None when Tezos_crypto.Operation_hash.equal kdiff k -> true | _ -> false @@ -675,8 +670,7 @@ module To_map = struct if [oph] is in [initial] already, we have [initial = to_map_all t] *) qcheck_eq' ~expected:true - ~actual: - (eq_mod_op initial (op.Prevalidation.hash, Some op) (to_map_all t)) + ~actual:(eq_mod_op initial (op.hash, Some op) (to_map_all t)) () (** Tests the relationship between [Classification.remove] @@ -688,13 +682,13 @@ module To_map = struct Generators.t_with_operation_gen @@ fun (t, op) -> let initial = to_map_all t in - drop op.Prevalidation.hash t ; + drop op.hash t ; (* We need to use [eq_mod_binding] because it covers the two possible cases: if [oph] is not in [initial], we have [initial = to_map_all t] if [oph] is in [initial], we have [initial = to_map_all t @@ [(oph, op)] ] *) qcheck_eq' ~expected:true - ~actual:(eq_mod_op (to_map_all t) (op.Prevalidation.hash, None) initial) + ~actual:(eq_mod_op (to_map_all t) (op.hash, None) initial) () let to_string ((t, op), _classification) = @@ -703,7 +697,7 @@ module To_map = struct Operation_map.pp (to_map_all t) Tezos_crypto.Operation_hash.pp - op.Prevalidation.hash + op.hash let test_map_remove_add = (* Property checked: @@ -725,11 +719,9 @@ module To_map = struct Generators.classification_gen) @@ fun ((t, op), classification) -> let t' = Classification.Internal_for_tests.copy t in - drop op.Prevalidation.hash t ; + drop op.hash t ; let initial = to_map_all t in - let left = - Tezos_crypto.Operation_hash.Map.add op.Prevalidation.hash op initial - in + let left = Tezos_crypto.Operation_hash.Map.add op.hash op initial in Classification.add classification op t' ; let right = to_map_all t' in qcheck_eq' @@ -737,7 +729,7 @@ module To_map = struct ~actual:right ~eq: (Tezos_crypto.Operation_hash.Map.equal (fun op1 op2 -> - Tezos_crypto.Operation_hash.equal op1.Prevalidation.hash op2.hash)) + Tezos_crypto.Operation_hash.equal op1.hash op2.hash)) ~pp:map_pp () @@ -762,18 +754,15 @@ module To_map = struct let t' = Classification.Internal_for_tests.copy t in Classification.add classification op t ; let initial = to_map_all t in - let oph = op.Prevalidation.hash in - let left = Tezos_crypto.Operation_hash.Map.remove oph initial in - drop oph t' ; + let left = Tezos_crypto.Operation_hash.Map.remove op.hash initial in + drop op.hash t' ; let right = to_map_all t' in qcheck_eq' ~expected:left ~actual:right ~eq: (Tezos_crypto.Operation_hash.Map.equal (fun op1 op2 -> - Tezos_crypto.Operation_hash.equal - op1.Prevalidation.hash - op2.Prevalidation.hash)) + Tezos_crypto.Operation_hash.equal op1.hash op2.hash)) ~pp:map_pp () @@ -807,7 +796,7 @@ module To_map = struct ~name:"[is_in_mempool] can be emulated by [to_map]" Generators.t_with_operation_gen @@ fun (t, op) -> - let oph = op.Prevalidation.hash in + let oph = op.hash in let is_in_mempool = is_in_mempool oph t in let map = to_map_all t diff --git a/src/lib_shell/test/test_prevalidator_classification_operations.ml b/src/lib_shell/test/test_prevalidator_classification_operations.ml index 46ad3eebee63969b5bd5abdf944319b9f140065b..11969fac0efc4751474597da44a689b945187b75 100644 --- a/src/lib_shell/test/test_prevalidator_classification_operations.ml +++ b/src/lib_shell/test/test_prevalidator_classification_operations.ml @@ -42,12 +42,15 @@ *) open Lib_test.Qcheck2_helpers +open Shell_operation module Op_map = Tezos_crypto.Operation_hash.Map module Classification = Prevalidator_classification module Tree = Generators_tree.Tree module List_extra = Generators_tree.List_extra module Block = Generators_tree.Block +let make_operation = Shell_operation.Internal_for_tests.make_operation + (** Function to unwrap an [option] when it MUST be a [Some] *) let force_opt ~loc = function | Some x -> x @@ -79,7 +82,7 @@ let op_map_pp fmt x = Tezos_crypto.Operation_hash.pp hash Operation.pp - op.Prevalidation.raw + op.raw in Format.fprintf fmt @@ -113,20 +116,15 @@ let blocks_to_oph_set (blocks : Tezos_crypto.Operation_hash.t list list list) : (** [is_subset m1 m2] returns whether all bindings of [m1] are in [m2]. In other words, it returns whether [m2] is a superset of [m1]. *) -let is_subset (m1 : unit Prevalidation.operation Op_map.t) - (m2 : unit Prevalidation.operation Op_map.t) = - let rec go - (m1_seq : - (Tezos_crypto.Operation_hash.t * unit Prevalidation.operation) Seq.t) = +let is_subset (m1 : unit operation Op_map.t) (m2 : unit operation Op_map.t) = + let rec go (m1_seq : (Tezos_crypto.Operation_hash.t * unit operation) Seq.t) = match m1_seq () with | Seq.Nil -> true | Seq.Cons ((m1_key, m1_value), m1_rest) -> ( match Op_map.find m1_key m2 with | None -> (* A key in [m1] that is not in [m2] *) false | Some m2_value -> - Tezos_crypto.Operation_hash.equal - m1_value.Prevalidation.hash - m2_value.Prevalidation.hash + Tezos_crypto.Operation_hash.equal m1_value.hash m2_value.hash && go m1_rest) in go (Op_map.to_seq m1) @@ -137,8 +135,7 @@ module Handle_operations = struct Classification.( create {map_size_limit = 1; on_discarded_operation = (fun _oph -> ())}) - let parse raw hash = - Some (Prevalidation.Internal_for_tests.make_operation hash raw ()) + let parse raw hash = Some (make_operation hash raw ()) (** Test that operations returned by [handle_live_operations] are all in the alive branch. *) @@ -154,7 +151,7 @@ module Handle_operations = struct in let* live_blocks = sublist (Tree.values tree) in let live_blocks = - List.map (fun (blk : Block.t) -> blk.hash) live_blocks + List.map (fun (blk : Block.t) -> blk.bhash) live_blocks in return ( tree, @@ -169,20 +166,20 @@ module Handle_operations = struct QCheck2.assume @@ Option.is_some pair_blocks_opt ; let from_branch, to_branch = force_opt ~loc:__LOC__ pair_blocks_opt in let chain = Generators_tree.classification_chain_tools tree in - let expected_superset : unit Prevalidation.operation Op_map.t = + let expected_superset : unit operation Op_map.t = (* Take all blocks *) Tree.values tree (* Keep only the ones in live_blocks *) |> List.to_seq |> Seq.filter (fun (blk : Block.t) -> - Tezos_crypto.Block_hash.Set.mem blk.hash live_blocks) + Tezos_crypto.Block_hash.Set.mem blk.bhash live_blocks) (* Then extract (oph, op) pairs from them *) |> Seq.flat_map (fun (blk : Block.t) -> List.to_seq blk.operations) |> Seq.flat_map List.to_seq - |> Seq.map (fun op -> (op.Prevalidation.hash, op)) + |> Seq.map (fun op -> (op.hash, op)) |> Op_map.of_seq in - let actual : unit Prevalidation.operation Op_map.t = + let actual : unit operation Op_map.t = Classification.Internal_for_tests.handle_live_operations ~classes:dummy_classes ~block_store:Block.tools @@ -350,7 +347,7 @@ module Recyle_operations = struct given operations and hashes, spreading them among the different classes of {!Prevalidator_classification.t}. This generator is NOT a fully random generator like {!Prevalidator_generators.t_gen}. *) - let classification_of_ops_gen (ops : unit Prevalidation.operation Op_map.t) : + let classification_of_ops_gen (ops : unit operation Op_map.t) : unit Classification.t QCheck2.Gen.t = let open QCheck2.Gen in let ops = Tezos_crypto.Operation_hash.Map.bindings ops |> List.map snd in @@ -395,7 +392,7 @@ module Recyle_operations = struct let oph_op_list_to_map l = List.to_seq l |> Op_map.of_seq in let blocks_ops = List.concat_map to_ops blocks - |> List.map (fun op -> (op.Prevalidation.hash, op)) + |> List.map (fun op -> (op.hash, op)) |> oph_op_list_to_map in let blocks_hashes = List.map Block.to_hash blocks in @@ -446,10 +443,8 @@ module Recyle_operations = struct assume @@ Option.is_some pair_blocks_opt ; let from_branch, to_branch = force_opt ~loc:__LOC__ pair_blocks_opt in let chain = Generators_tree.classification_chain_tools tree in - let parse raw hash = - Some (Prevalidation.Internal_for_tests.make_operation hash raw ()) - in - let actual : unit Prevalidation.operation Op_map.t = + let parse raw hash = Some (make_operation hash raw ()) in + let actual : unit operation Op_map.t = Classification.recycle_operations ~block_store:Block.tools ~chain @@ -517,9 +512,7 @@ module Recyle_operations = struct expected_from_classification) expected_from_pending in - let parse raw hash = - Some (Prevalidation.Internal_for_tests.make_operation hash raw ()) - in + let parse raw hash = Some (make_operation hash raw ()) in let actual : Tezos_crypto.Operation_hash.Set.t = Classification.recycle_operations ~block_store:Block.tools @@ -553,7 +546,7 @@ module Recyle_operations = struct Tree.values tree |> List.map Block.to_hash |> Tezos_crypto.Block_hash.Set.of_list in - let expected : unit Prevalidation.operation Op_map.t = + let expected : unit operation Op_map.t = Classification.Internal_for_tests.to_map ~applied:false ~prechecked:false @@ -565,9 +558,7 @@ module Recyle_operations = struct in let from_branch, to_branch = force_opt ~loc:__LOC__ pair_blocks_opt in let chain = Generators_tree.classification_chain_tools tree in - let parse raw hash = - Some (Prevalidation.Internal_for_tests.make_operation hash raw ()) - in + let parse raw hash = Some (make_operation hash raw ()) in let () = Classification.recycle_operations ~block_store:Block.tools diff --git a/src/lib_shell/test/test_prevalidator_pending_operations.ml b/src/lib_shell/test/test_prevalidator_pending_operations.ml index 511ba194105e11ac05c8f7c14f9ba2f6e813a80a..20f7ef9a28287dc2b32d7f9dc43bd5add6ab975a 100644 --- a/src/lib_shell/test/test_prevalidator_pending_operations.ml +++ b/src/lib_shell/test/test_prevalidator_pending_operations.ml @@ -49,7 +49,7 @@ let pending_of_list = (fun pendings (op, priority) -> if Tezos_crypto.Operation_hash.Set.mem - (Prevalidation.Internal_for_tests.hash_of op) + (Shell_operation.Internal_for_tests.hash_of op) (Pending_ops.hashes pendings) then (* no duplicate hashes *) pendings diff --git a/src/lib_shell/test/test_prevalidation.ml b/src/lib_shell/test/test_shell_operation.ml similarity index 93% rename from src/lib_shell/test/test_prevalidation.ml rename to src/lib_shell/test/test_shell_operation.ml index 2c76a04d72ca3dba7acda2d00ea278934df87a7b..1dce02e0e9fbc260898a5c77ca0a074574228d94 100644 --- a/src/lib_shell/test/test_prevalidation.ml +++ b/src/lib_shell/test/test_shell_operation.ml @@ -35,9 +35,12 @@ (** Testing ------- - Component: Prevalidation - Invocation: dune exec src/lib_shell/test/test_prevalidation.exe - Subject: Unit tests for [Prevalidation] + Component: Shell_operation and others + Invocation: dune exec src/lib_shell/test/test_shell_operation.exe + Subject: Unit tests for [Shell_operation], and for other + components e.g. [Requester] when the tests rely on + the operation representation provided by + [Shell_operation]. *) let test_safe_decode () = @@ -49,7 +52,7 @@ let test_safe_decode () = Data_encoding.unit in let actual = - Prevalidation.Internal_for_tests.safe_binary_of_bytes + Shell_operation.Internal_for_tests.safe_binary_of_bytes broken_encoding Bytes.empty in @@ -130,7 +133,7 @@ let test_db_leak f (nb_ops : int) (_ : unit) = let handle i = let op = mk_operation i in let oph = Operation.hash op in - let op = Prevalidation.Internal_for_tests.make_operation op oph () in + let op = Shell_operation.Internal_for_tests.make_operation op oph () in let injected = Lwt_main.run @@ Test_Requester.inject requester oph i in assert injected ; f [] op classes @@ -167,7 +170,7 @@ let test_in_mempool_leak f (nb_ops : int) (_ : unit) = let handle i = let op = mk_operation i in let oph = Operation.hash op in - let op = Prevalidation.Internal_for_tests.make_operation op oph () in + let op = Shell_operation.Internal_for_tests.make_operation op oph () in let injected = Lwt_main.run @@ Test_Requester.inject requester oph i in assert injected ; f [] op classes @@ -205,7 +208,7 @@ let test_db_do_not_clear_right_away f (nb_ops : int) (_ : unit) = let handle i = let op = mk_operation i in let oph = Operation.hash op in - let op = Prevalidation.Internal_for_tests.make_operation op oph () in + let op = Shell_operation.Internal_for_tests.make_operation op oph () in Format.printf "Injecting op: %a\n" Tezos_crypto.Operation_hash.pp oph ; let injected = Lwt_main.run @@ Test_Requester.inject requester oph i in assert injected ; @@ -263,7 +266,7 @@ let () = handle_branch_pairs in Alcotest.run - "Prevalidation" + "Shell_operation" [ ( "Corner cases", [ diff --git a/src/lib_test/qcheck2_helpers.ml b/src/lib_test/qcheck2_helpers.ml index e0896e621f59fa4a0707f4c76c4bf7dd5aeea613..b8df1033b8933483ae7fc475e303ac46cf432153 100644 --- a/src/lib_test/qcheck2_helpers.ml +++ b/src/lib_test/qcheck2_helpers.ml @@ -73,22 +73,25 @@ let qcheck_make_result_lwt ?count ?print ?pp_error ?check ~extract ~name in QCheck2.Test.make ~name ?print ?count gen (fun x -> extract (f x) |> check) -let qcheck_eq ?pp ?cmp ?eq expected actual = +let qcheck_eq ?pp ?cmp ?eq ?__LOC__ expected actual = let pass = match (eq, cmp) with | Some eq, _ -> eq expected actual | None, Some cmp -> cmp expected actual = 0 | None, None -> Stdlib.compare expected actual = 0 in + let loc = match __LOC__ with Some s -> s ^ "\n" | None -> "" in if pass then true else match pp with | None -> QCheck2.Test.fail_reportf - "@[Values are not equal, but no pretty printer was provided.@]" + "@[%sValues are not equal, but no pretty printer was provided.@]" + loc | Some pp -> QCheck2.Test.fail_reportf - "@[Equality check failed!@,expected:@,%a@,actual:@,%a@]" + "@[%sEquality check failed!@,expected:@,%a@,actual:@,%a@]" + loc pp expected pp diff --git a/src/lib_test/qcheck2_helpers.mli b/src/lib_test/qcheck2_helpers.mli index 320b9eb416667d611323e3e623cb7b1fd6f541b8..411a8eeed06b432e3cdf4cea5e0cafdd987ad5fc 100644 --- a/src/lib_test/qcheck2_helpers.mli +++ b/src/lib_test/qcheck2_helpers.mli @@ -100,11 +100,15 @@ val qcheck_eq_tests : - if no [eq] is provided, use a provided [cmp] - if neither [eq] nor [cmp] is provided, use {!Stdlib.compare} - If [pp] is provided, use this to print [x] and [y] if they are not equal. *) + If [pp] is provided, use this to print [x] and [y] if they are not equal. + + If [__LOC__] is provided, print it at the beginning of the error message + when applicable. *) val qcheck_eq : ?pp:(Format.formatter -> 'a -> unit) -> ?cmp:('a -> 'a -> int) -> ?eq:('a -> 'a -> bool) -> + ?__LOC__:string -> 'a -> 'a -> bool diff --git a/src/proto_012_Psithaca/lib_plugin/plugin_registerer.ml b/src/proto_012_Psithaca/lib_plugin/plugin_registerer.ml index 8073f4644dbc187968f65026ccfceca4384a39a2..926ed3dee3230be1fe2af5d9a8b247153870eb44 100644 --- a/src/proto_012_Psithaca/lib_plugin/plugin_registerer.ml +++ b/src/proto_012_Psithaca/lib_plugin/plugin_registerer.ml @@ -39,7 +39,7 @@ module Metrics = struct let hash = Registerer.Registered.hash end -let () = Shell_plugin.register_filter (module Filter) +let () = Shell_plugin.register_legacy_filter (module Filter) let () = Shell_plugin.register_rpc (module RPC) diff --git a/src/proto_013_PtJakart/lib_plugin/plugin_registerer.ml b/src/proto_013_PtJakart/lib_plugin/plugin_registerer.ml index 8073f4644dbc187968f65026ccfceca4384a39a2..926ed3dee3230be1fe2af5d9a8b247153870eb44 100644 --- a/src/proto_013_PtJakart/lib_plugin/plugin_registerer.ml +++ b/src/proto_013_PtJakart/lib_plugin/plugin_registerer.ml @@ -39,7 +39,7 @@ module Metrics = struct let hash = Registerer.Registered.hash end -let () = Shell_plugin.register_filter (module Filter) +let () = Shell_plugin.register_legacy_filter (module Filter) let () = Shell_plugin.register_rpc (module RPC) diff --git a/src/proto_014_PtKathma/lib_plugin/plugin_registerer.ml b/src/proto_014_PtKathma/lib_plugin/plugin_registerer.ml index ad4a3eac57c074570f71ccd681cfdc449d908d00..7111a6ab395a6b70c3783b7e1e565051cba75c21 100644 --- a/src/proto_014_PtKathma/lib_plugin/plugin_registerer.ml +++ b/src/proto_014_PtKathma/lib_plugin/plugin_registerer.ml @@ -39,7 +39,7 @@ module Metrics = struct let hash = Registerer.Registered.hash end -let () = Shell_plugin.register_filter (module Filter) +let () = Shell_plugin.register_legacy_filter (module Filter) let () = Shell_plugin.register_rpc (module RPC) diff --git a/src/proto_015_PtLimaPt/lib_plugin/mempool.ml b/src/proto_015_PtLimaPt/lib_plugin/mempool.ml index 626f5b82e4ea2c13d3831a679c87d3837b9fbdf8..8a44d504708deccc44111aa23cdf13542ebb7618 100644 --- a/src/proto_015_PtLimaPt/lib_plugin/mempool.ml +++ b/src/proto_015_PtLimaPt/lib_plugin/mempool.ml @@ -87,11 +87,8 @@ let default_minimal_nanotez_per_gas_unit = Q.of_int 100 let default_minimal_nanotez_per_byte = Q.of_int 1000 -let quota = Main.validation_passes - -let managers_index = 3 (* in Main.validation_passes *) - -let managers_quota = Stdlib.List.nth quota managers_index +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. @@ -478,14 +475,6 @@ let weight_and_resources_manager_operation ~validation_state ?size ~fee ~gas op let resources = Q.max size_ratio gas_ratio in (Q.(fee_f / resources), resources) -(** Returns the weight of an operation, i.e. the fees w.r.t the gas and size - consumption in the block. *) -let weight_manager_operation ~validation_state ?size ~fee ~gas op = - let weight, _resources = - weight_and_resources_manager_operation ~validation_state ?size ~fee ~gas op - in - weight - (** Return fee for an operation that consumes [op_resources] for its weight to be strictly greater than [min_weight]. *) let required_fee_manager_operation_weight ~op_resources ~min_weight = @@ -846,229 +835,6 @@ let pre_filter config ~(filter_state : state) ?validation_state_before | Single (Manager_operation _) as op -> prefilter_manager_op op | Cons (Manager_operation _, _) as op -> prefilter_manager_op op -(** Call the protocol's {!Validate.validate_operation} and - return either: - - - the updated {!validation_state} when the validation is - successful, or - - - the protocol error trace converted to an [error trace], together - with the corresponding {!error_classification}. - - The signature check is skipped when the operation has previously - been validated successfully, ie. [nb_successful_prechecks > 0]. *) -let proto_validate_operation validation_state oph ~nb_successful_prechecks - (operation : packed_operation) : - (validation_state, error trace * error_classification) result Lwt.t = - let open Lwt_result_syntax in - let*! res = - Validate.validate_operation - ~check_signature:(nb_successful_prechecks <= 0) - validation_state - oph - operation - in - match res with - | Ok validation_state -> return validation_state - | Error tztrace -> - let err = Environment.wrap_tztrace tztrace in - let error_classification = - match classify_trace err with - | Branch -> `Branch_refused err - | Permanent -> `Refused err - | Temporary -> `Branch_delayed err - | Outdated -> `Outdated err - in - fail (err, error_classification) - -(** Call the protocol's {!Validate.validate_operation} on a - manager operation and return: - - - [`Success] containing the updated [validation_state] when the - validation is successful; - - - [`Conflict] containing the hash of the conflicting operation, - and the {!error_classification} corresponding to the protocol error - trace, when the validation fails because of the - one-manager-operation-per-manager-per-block restriction; - - - an error containing the relevant {!error_classification} when - the validation fails with any other protocol error. - - The signature check is skipped when the operation has previously - been validated successfully, ie. [nb_successful_prechecks > 0]. *) -let proto_validate_manager_operation validation_state oph - ~nb_successful_prechecks - (operation : 'a Kind.manager Alpha_context.operation) : - ( [> `Success of validation_state - | `Conflict of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = - let open Lwt_result_syntax in - let*! res = - proto_validate_operation - validation_state - oph - ~nb_successful_prechecks - (Operation.pack operation) - in - match res with - | Ok validation_state -> return (`Success validation_state) - | Error (err, error_classification) -> ( - match err with - | Environment.Ecoproto_error - (Validate_errors.Manager.Manager_restriction - { - source = _manager; - conflict = Operation_conflict {existing; new_operation = _}; - }) - :: _ -> - return (`Conflict (existing, error_classification)) - | _ -> fail error_classification) - -(** Remove a manager operation from the protocol's [validation_state]. *) -let remove_from_validation_state validation_state (Manager_op op) = - let operation_state = - Validate.remove_operation validation_state.Validate.operation_state op - in - {validation_state with operation_state} - -(** Call the protocol validation on a manager operation and handle - potential conflicts: if either the 1M restriction is triggered or - the mempool exceeds the maximal number of prechecked operations, - then this function is responsible for either discarding the new - operation, or removing an old operation to free up space for the - new operation. - - Return the updated protocol [validation_state] and, when - applicable, the replaced operation accompanied by its new - classification. - - Note that this function does not handle the update of the - [filter_state]. *) -let validate_manager_operation_and_handle_conflicts config filter_state - validation_state oph ~nb_successful_prechecks fee gas_limit - (operation : 'manager_kind Kind.manager operation) : - ( validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = - let open Lwt_result_syntax in - let* proto_validation_outcome = - proto_validate_manager_operation - validation_state - oph - ~nb_successful_prechecks - operation - in - match proto_validation_outcome with - | `Success validation_state -> ( - (* The operation has been successfully validated and there is no - 1M conflict. We now need to ensure that the mempool does not - exceed its maximal number of prechecked manager operations. *) - match - check_minimal_weight - ~validation_state - config - filter_state - ~fee - ~gas_limit - (Operation_data operation.protocol_data) - with - | `Weight_ok (`No_replace, _weight) -> - (* The mempool is not full: no need to replace any operation. *) - return (validation_state, `No_replace) - | `Weight_ok (`Replace min_weight_oph, _weight) -> ( - (* The mempool is full yet the new operation has enough weight - to be included: the old operation with the lowest weight is - reclassified as [Branch_delayed]. *) - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2347 The - branch_delayed ring is bounded to 1000, so we may loose - operations. We can probably do better. *) - match - Tezos_crypto.Operation_hash.Map.find - min_weight_oph - filter_state.prechecked_manager_ops - with - | None -> - (* This only occurs for a [Drain_delegate] - operation: it has a higher priority than a manager - therefore we keep the drain delegate *) - return (validation_state, `No_replace) - | Some {manager_op; _} -> - let validation_state = - remove_from_validation_state validation_state manager_op - in - let replace_err = - Environment.wrap_tzerror Removed_fees_too_low_for_mempool - in - let replacement = - `Replace (min_weight_oph, `Branch_delayed [replace_err]) - in - return (validation_state, replacement)) - | `Fail err -> - (* The mempool is full and the weight of the new operation is - too low: raise the error returned by {!check_minimal_weight}. *) - fail err) - | `Conflict (old_oph, _proto_error) -> ( - (* The protocol [validation_state] already contains an operation - from the same manager. We look at the fees and gas limits of - both operations to decide whether to replace the old one. *) - match - Tezos_crypto.Operation_hash.Map.find - old_oph - filter_state.prechecked_manager_ops - with - | None -> - (* This only occurs for a [Drain_delegate] operation: it has - a higher priority than a manager therefore we keep the - drain delegate *) - return (validation_state, `No_replace) - | Some old_info -> - if - better_fees_and_ratio - config - old_info.gas_limit - old_info.fee - gas_limit - fee - then - (* The new operation is better and replaces the old one from - the same manager. Note that there is no need to check the - number of prechecked operations in the mempool - here. Indeed, the removal of the old operation frees up a - spot in the mempool anyway. *) - let validation_state = - remove_from_validation_state validation_state old_info.manager_op - in - let* proto_validation_outcome2 = - proto_validate_manager_operation - validation_state - oph - ~nb_successful_prechecks - operation - in - match proto_validation_outcome2 with - | `Success validation_state -> - let replace_err = - Environment.wrap_tzerror - (Manager_operation_replaced - {old_hash = old_oph; new_hash = oph}) - in - let replacement = `Replace (old_oph, `Outdated [replace_err]) in - return (validation_state, replacement) - | `Conflict (_oph, conflict_proto_error) -> - (* This should not happen: a manager operation should not - conflict with multiple operations. *) - fail conflict_proto_error - else - (* The new operation is not interesting enough so it is rejected. *) - let err = Manager_restriction {oph = old_oph; fee = old_info.fee} in - fail (`Branch_delayed [Environment.wrap_tzerror err])) - (** Remove a manager operation hash from the filter state. Do nothing if the operation was not in the state. *) let remove ~filter_state oph = @@ -1148,247 +914,136 @@ let add_manager_op filter_state oph info replacement = min_prechecked_op_weight; } -(** Call {!validate_manager_operation_and_handle_conflicts} then - update the [filter_state] by adding the newly validated operation, - and removing the replaced one one when applicable. - - Return either the updated [filter_state], updated - [validation_state], and operation replacement, or an error - containing the appropriate classification. *) -let precheck_manager_result config filter_state validation_state oph - ~nb_successful_prechecks (operation : 'manager_kind Kind.manager operation) - : - ( state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = +let add_manager_op_and_enforce_mempool_bound validation_state config + filter_state oph (op : 'manager_kind Kind.manager operation) = let open Lwt_result_syntax in let*? fee, gas_limit = Result.map_error (fun err -> `Refused (Environment.wrap_tztrace err)) - (get_manager_operation_gas_and_fee operation.protocol_data.contents) - in - let* validation_state, replacement = - validate_manager_operation_and_handle_conflicts - config - filter_state - validation_state - oph - ~nb_successful_prechecks - fee - gas_limit - operation + (get_manager_operation_gas_and_fee op.protocol_data.contents) in - let weight = - weight_manager_operation - ~validation_state - ~fee - ~gas:gas_limit - (Operation_data operation.protocol_data) + let* replacement, weight = + match + check_minimal_weight + ~validation_state + config + filter_state + ~fee + ~gas_limit + (Operation_data op.protocol_data) + with + | `Weight_ok (`No_replace, weight) -> + (* The mempool is not full: no need to replace any operation. *) + return (`No_replace, weight) + | `Weight_ok (`Replace min_weight_oph, weight) -> + (* The mempool is full yet the new operation has enough weight + to be included: the old operation with the lowest weight is + reclassified as [Branch_delayed]. *) + (* TODO: https://gitlab.com/tezos/tezos/-/issues/2347 The + branch_delayed ring is bounded to 1000, so we may loose + operations. We can probably do better. *) + let replace_err = + Environment.wrap_tzerror Removed_fees_too_low_for_mempool + in + let replacement = + `Replace (min_weight_oph, `Branch_delayed [replace_err]) + in + return (replacement, weight) + | `Fail err -> + (* The mempool is full and the weight of the new operation is + too low: raise the error returned by {!check_minimal_weight}. *) + fail err in - let info = {manager_op = Manager_op operation; gas_limit; fee; weight} in + let weight = match weight with [x] -> x | _ -> assert false in + let info = {manager_op = Manager_op op; gas_limit; fee; weight} in let filter_state = add_manager_op filter_state oph info replacement in - return (filter_state, validation_state, replacement) - -(** Call {!precheck_manager_result} then convert its error monad - result into the appropriate return type for [precheck]. *) -let precheck_manager config filter_state validation_state oph - ~nb_successful_prechecks operation : - [> `Passed_precheck of - state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ] - | error_classification ] - Lwt.t = - precheck_manager_result - config - filter_state - validation_state - oph - ~nb_successful_prechecks - operation - >>= function - | Ok (filter_state, validation_state, replacement) -> - Lwt.return - (`Passed_precheck (filter_state, validation_state, replacement)) - | Error - ((`Refused _ | `Branch_delayed _ | `Branch_refused _ | `Outdated _) as - err) -> - Lwt.return err - -(** Call the protocol's {!Validate.validate_operation}. If - successful, return the updated [validation_state], the unchanged - [filter_state], and no operation replacement. Otherwise, return the - classification associated with the protocol error. Note that when - there is a conflict with a previously validated operation, the new - operation is always discarded. As it does not allow for any fee - market, this function is designed for non-manager operations. *) -let precheck_non_manager filter_state validation_state oph - ~nb_successful_prechecks operation = - proto_validate_operation - validation_state - oph - ~nb_successful_prechecks - operation - >>= function - | Ok validation_state -> - Lwt.return - (`Passed_precheck (filter_state, validation_state, `No_replace)) - | Error - ( _err, - ((`Refused _ | `Branch_delayed _ | `Branch_refused _ | `Outdated _) as - error_classification) ) -> - Lwt.return error_classification - -(* Now that [precheck] uses {!Validate.validate_operation} - for every kind of operation, it must never return - [`Undecided]. Indeed, this would cause the prevalidator to call - {!Apply.apply_operation}, which relies on updates to the alpha - context to detect incompatible operations, whereas - [validate_operation] only updates the - {!Validate.validate_operation_state}. Therefore, it would - be possible for the mempool to accept conflicting operations. *) -let precheck : - config -> - filter_state:state -> - validation_state:validation_state -> - Tezos_crypto.Operation_hash.t -> - Main.operation -> - nb_successful_prechecks:int -> - [ `Passed_precheck of - state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ] - | `Undecided - | error_classification ] - Lwt.t = - fun config - ~filter_state - ~validation_state - oph - operation - ~nb_successful_prechecks -> - let {protocol_data = Operation_data protocol_data; _} = operation in - let call_precheck_manager (protocol_data : _ Kind.manager protocol_data) = - precheck_manager + return (filter_state, replacement) + +(** If the provided operation is a manager operation, add it to the + filter_state. If the mempool is full, either return an error if the + operation does not have enough weight to be included, or return the + operation with minimal weight that gets removed to make room. + + Do nothing on non-manager operations. + + If [replace] is provided, then it is removed from [filter_state] + before processing [op]. (If [replace] is a non-manager operation, + this does nothing since it was never in [filter_state] to begin with.) + Note that when this happens, the mempool can no longer be full after + the operation has been removed, so this function always returns + [`No_replace]. + + This function is designed to be called by the shell each time a + new operation has been validated by the protocol. It will be + removed in the future once the shell is able to bound the number of + operations in the mempool by itself. *) +let add_operation_and_enforce_mempool_bound ?replace validation_state config + filter_state (oph, op) = + let filter_state = + match replace with + | Some replace_oph -> + (* If the operation to replace is not a manager operation, then + it cannot be present in the [filter_state]. But then, + [remove] does nothing anyway. *) + remove ~filter_state replace_oph + | None -> filter_state + in + let {protocol_data = Operation_data protocol_data; _} = op in + let call_manager protocol_data = + add_manager_op_and_enforce_mempool_bound + validation_state config filter_state - validation_state oph - ~nb_successful_prechecks - {shell = operation.shell; protocol_data} + {shell = op.shell; protocol_data} in match protocol_data.contents with - | Single (Manager_operation _) -> call_precheck_manager protocol_data - | Cons (Manager_operation _, _) -> call_precheck_manager protocol_data - | Single _ -> - precheck_non_manager - filter_state - validation_state - oph - ~nb_successful_prechecks - operation - -open Apply_results - -type Environment.Error_monad.error += Skipped_operation - -let () = - Environment.Error_monad.register_error_kind - `Temporary - ~id:"postfilter.skipped_operation" - ~title:"The operation has been skipped by the protocol" - ~description:"The operation has been skipped by the protocol" - ~pp:(fun ppf () -> - Format.fprintf ppf "The operation has been skipped by the protocol") - Data_encoding.unit - (function Skipped_operation -> Some () | _ -> None) - (fun () -> Skipped_operation) - -type Environment.Error_monad.error += Backtracked_operation - -let () = - Environment.Error_monad.register_error_kind - `Temporary - ~id:"postfilter.backtracked_operation" - ~title:"The operation has been backtracked by the protocol" - ~description:"The operation has been backtracked by the protocol" - ~pp:(fun ppf () -> - Format.fprintf ppf "The operation has been backtracked by the protocol") - Data_encoding.unit - (function Backtracked_operation -> Some () | _ -> None) - (fun () -> Backtracked_operation) - -let rec post_filter_manager : - type t. - Alpha_context.t -> - state -> - t Kind.manager contents_result_list -> - config -> - [`Passed_postfilter of state | `Refused of tztrace] = - fun ctxt filter_state result config -> - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2181 - This function should be unit tested. - The errors that can be raised if allow_script_failure is enable should - be tested. *) - match result with - | Single_result (Manager_operation_result {operation_result; _}) -> ( - let check_allow_script_failure errs = - if config.allow_script_failure then `Passed_postfilter filter_state - else `Refused errs + | Single (Manager_operation _) -> call_manager protocol_data + | Cons (Manager_operation _, _) -> call_manager protocol_data + | Single _ -> return (filter_state, `No_replace) + +let is_manager_operation op = + match Operation.acceptable_pass op with + | Some pass -> Compare.Int.equal pass Operation_repr.manager_pass + | None -> false + +(** [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 (_ : Tezos_crypto.Operation_hash.t), old_op = existing_operation in + let (_ : Tezos_crypto.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 {protocol_data = Operation_data old_protocol_data; _} = old_op in + let {protocol_data = Operation_data new_protocol_data; _} = new_op in + let* old_fee, old_gas_limit = + get_manager_operation_gas_and_fee old_protocol_data.contents in - match operation_result with - | Applied _ -> `Passed_postfilter filter_state - | Skipped _ -> - check_allow_script_failure - [Environment.wrap_tzerror Skipped_operation] - | Failed (_, errors) -> - check_allow_script_failure (Environment.wrap_tztrace errors) - | Backtracked (_, errors) -> - check_allow_script_failure - (match errors with - | Some e -> Environment.wrap_tztrace e - | None -> [Environment.wrap_tzerror Backtracked_operation])) - | Cons_result (Manager_operation_result res, rest) -> ( - post_filter_manager - ctxt - filter_state - (Single_result (Manager_operation_result res)) - config - |> function - | `Passed_postfilter filter_state -> - post_filter_manager ctxt filter_state rest config - | `Refused _ as errs -> errs) - -let post_filter config ~(filter_state : state) ~validation_state_before:_ - ~validation_state_after (_op, receipt) = - match receipt with - | No_operation_metadata -> assert false (* only for multipass validator *) - | Operation_metadata {contents} -> ( - let handle_manager result = - let ctxt = Validate.get_initial_ctxt validation_state_after in - Lwt.return (post_filter_manager ctxt filter_state result config) + let* new_fee, new_gas_limit = + get_manager_operation_gas_and_fee new_protocol_data.contents in - match contents with - | Single_result (Preendorsement_result _) - | Single_result (Endorsement_result _) - | Single_result (Dal_slot_availability_result _) - | Single_result (Seed_nonce_revelation_result _) - | Single_result (Double_preendorsement_evidence_result _) - | Single_result (Double_endorsement_evidence_result _) - | Single_result (Double_baking_evidence_result _) - | Single_result (Activate_account_result _) - | Single_result Proposals_result - | Single_result (Vdf_revelation_result _) - | Single_result (Drain_delegate_result _) - | Single_result Ballot_result -> - Lwt.return (`Passed_postfilter filter_state) - | Single_result (Manager_operation_result _) as result -> - handle_manager result - | Cons_result (Manager_operation_result _, _) as result -> - handle_manager result) + 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 diff --git a/src/proto_015_PtLimaPt/lib_plugin/test/dune b/src/proto_015_PtLimaPt/lib_plugin/test/dune index 5ab55d70a0e7e5baf7451c1f382b2a6aebf07662..e72e557e0bf155053193effddc49e3bc43e71059 100644 --- a/src/proto_015_PtLimaPt/lib_plugin/test/dune +++ b/src/proto_015_PtLimaPt/lib_plugin/test/dune @@ -2,7 +2,11 @@ ; Edit file manifest/main.ml instead. (executables - (names test_consensus_filter test_filter_state test_plugin) + (names + test_consensus_filter + test_filter_state + test_plugin + test_conflict_handler) (libraries tezos-base tezos-base-test-helpers @@ -42,3 +46,8 @@ (alias runtest) (package tezos-protocol-plugin-015-PtLimaPt-tests) (action (run %{dep:./test_plugin.exe}))) + +(rule + (alias runtest) + (package tezos-protocol-plugin-015-PtLimaPt-tests) + (action (run %{dep:./test_conflict_handler.exe}))) diff --git a/src/proto_015_PtLimaPt/lib_plugin/test/test_conflict_handler.ml b/src/proto_015_PtLimaPt/lib_plugin/test/test_conflict_handler.ml new file mode 100644 index 0000000000000000000000000000000000000000..0e7f09d4e187a02846071a0a2b37f7394ef13b68 --- /dev/null +++ b/src/proto_015_PtLimaPt/lib_plugin/test/test_conflict_handler.ml @@ -0,0 +1,275 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 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. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Plugin.Mempool + Invocation: dune exec src/proto_alpha/lib_plugin/test/test_conflict_handler.exe + Subject: Unit tests the Mempool.conflict_handler fonction of the plugin +*) + +let pp_answer fmt = function + | `Keep -> Format.fprintf fmt "Keep" + | `Replace -> Format.fprintf fmt "Replace" + +let check_answer ?__LOC__ expected actual = + assert + (Lib_test.Qcheck2_helpers.qcheck_eq ~pp:pp_answer ?__LOC__ expected actual + : bool) + +let is_manager_op ((_ : Tezos_crypto.Operation_hash.t), op) = + (* This is implemented differently from + [Plugin.Mempool.is_manager_operation] (which relies on + [Alpha_context.Operation.acceptable_pass]), used in + [Plugin.Mempool.conflict_handler], to avoid the test being just a + copy of the code. *) + let {Alpha_context.protocol_data = Operation_data proto_data; _} = op in + match proto_data.contents with + | Single (Manager_operation _) | Cons (Manager_operation _, _) -> true + | _ -> false + +(** Test that when the operations are not both manager operations, the + conflict handler picks the higher operation according to + [Operation.compare]. *) +let test_random_ops () = + let ops = + let open Operation_generator in + QCheck2.Gen.(generate ~n:100 (pair generate_operation generate_operation)) + in + List.iter + (fun ((_, op1), (_, op2)) -> + let answer = + Plugin.Mempool.conflict_handler + Plugin.Mempool.default_config + ~existing_operation:op1 + ~new_operation:op2 + in + if is_manager_op op1 && is_manager_op op2 then + (* When both operations are manager operations, the result is + complicated and depends on the [config]. Testing it here + would mean basically reimplementing + [conflict_handler]. Instead, we test this case in + [test_manager_ops] below. *) + () + else if + (* When there is at least one non-manager operation, the + conflict handler defers to [Operation.compare]: the higher + operation is selected. *) + Alpha_context.Operation.compare op1 op2 >= 0 + then check_answer ~__LOC__ `Keep answer + else check_answer ~__LOC__ `Replace answer) + ops ; + return_unit + +(** Generator for a manager batch with the specified total fee and gas. *) +let generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas = + let open Alpha_context in + let open QCheck2.Gen in + let rec set_fee_and_gas : + type kind. _ -> _ -> kind contents_list -> kind contents_list t = + fun desired_total_fee desired_total_gas -> function + | Single (Manager_operation data) -> + let fee = Tez.of_mutez_exn (Int64.of_int desired_total_fee) in + let gas_limit = Gas.Arith.integral_of_int_exn desired_total_gas in + return (Single (Manager_operation {data with fee; gas_limit})) + | Cons (Manager_operation data, tail) -> + let* local_fee = + (* We generate some corner cases where some individual + operations in the batch have zero fees. *) + let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in + match r with + | `Random -> int_range 0 desired_total_fee + | `Zero -> return 0 + | `All -> return desired_total_fee + in + let* local_gas = int_range 0 desired_total_gas in + let fee = Tez.of_mutez_exn (Int64.of_int local_fee) in + let gas_limit = Gas.Arith.integral_of_int_exn local_gas in + let* tail = + set_fee_and_gas + (desired_total_fee - local_fee) + (desired_total_gas - local_gas) + tail + in + return (Cons (Manager_operation {data with fee; gas_limit}, tail)) + | Single _ -> + (* This function is only called on a manager operation. *) assert false + in + (* Generate a random manager operation. *) + let* batch_size = int_range 1 Operation_generator.max_batch_size in + let* op = Operation_generator.generate_manager_operation batch_size in + (* Modify its fee and gas to match the [fee_in_mutez] and [gas] inputs. *) + let {shell = _; protocol_data = Operation_data protocol_data} = op in + let* contents = set_fee_and_gas fee_in_mutez gas protocol_data.contents in + let protocol_data = {protocol_data with contents} in + let op = {op with protocol_data = Operation_data protocol_data} in + return (Operation.hash_packed op, op) + +let check_conflict_handler ~__LOC__ config ~old ~nw expected = + let answer = + Plugin.Mempool.conflict_handler + config + ~existing_operation:old + ~new_operation:nw + in + check_answer ~__LOC__ expected answer + +(** Test the semantics of the conflict handler on manager operations, + with either hand-picked or carefully generated fee and gas. *) +let test_manager_ops () = + let make_op ~fee_in_mutez ~gas = + QCheck2.Gen.generate1 + (generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas) + in + + (* Test operations with specific fee and gas, using the default + configuration. This configuration replaces the old operation when + the new one is at least 5% better, in terms of both fees and + fee/gas ratios. *) + let default = Plugin.Mempool.default_config in + let ref_fee = 10_000_000 in + let ref_gas = 2100 in + (* Reference operation arbitrarily has 10 tez of fees and 2100 + gas. The gas is chosen to still give an integer when multiplied + by 100/105. *) + let old = make_op ~fee_in_mutez:ref_fee ~gas:ref_gas in + (* Operation with same fee and ratio. *) + let op_same = make_op ~fee_in_mutez:ref_fee ~gas:ref_gas in + check_conflict_handler ~__LOC__ default ~old ~nw:op_same `Keep ; + (* 5% better fee but same ratio (because gas is also 5% more). *) + let more5 = Q.make (Z.of_int 105) (Z.of_int 100) in + let fee_more5 = Q.(to_int (mul more5 (of_int ref_fee))) in + let gas_more5 = Q.(to_int (mul more5 (of_int ref_gas))) in + let op_fee5 = make_op ~fee_in_mutez:fee_more5 ~gas:gas_more5 in + check_conflict_handler ~__LOC__ default ~old ~nw:op_fee5 `Keep ; + (* 5% better ratio but same fee (because gas is multiplied by 100/105). *) + let less5 = Q.make (Z.of_int 100) (Z.of_int 105) in + let gas_less5 = Q.(to_int (mul less5 (of_int ref_gas))) in + let op_ratio5 = make_op ~fee_in_mutez:ref_fee ~gas:gas_less5 in + check_conflict_handler ~__LOC__ default ~old ~nw:op_ratio5 `Keep ; + (* Both 5% better fee and 5% better ratio. *) + let op_both5 = make_op ~fee_in_mutez:fee_more5 ~gas:ref_gas in + check_conflict_handler ~__LOC__ default ~old ~nw:op_both5 `Replace ; + + (* Config that requires 10% better fee and ratio to replace. *) + let config10 = + { + Plugin.Mempool.default_config with + replace_by_fee_factor = Q.make (Z.of_int 11) (Z.of_int 10); + } + in + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_same `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_fee5 `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_ratio5 `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_both5 `Keep ; + (* Config that replaces when the new op has at least as much fee and ratio. *) + let config0 = + {Plugin.Mempool.default_config with replace_by_fee_factor = Q.one} + in + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_same `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_fee5 `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_ratio5 `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_both5 `Replace ; + (* This config does not replace when the new operation has worse + fees (even when the ratio is higher). *) + let op_less_fee = make_op ~fee_in_mutez:(ref_fee - 1) ~gas:(ref_gas - 1) in + check_conflict_handler ~__LOC__ default ~old ~nw:op_less_fee `Keep ; + (* This config does not replace either when the ratio is smaller. *) + let op_worse_ratio = make_op ~fee_in_mutez:ref_fee ~gas:(ref_gas + 1) in + check_conflict_handler ~__LOC__ default ~old ~nw:op_worse_ratio `Keep ; + + (* Generate random operations which do not have 5% better fees than + the reference [op]: they should not replace [op] when using the + default config. *) + let open QCheck2.Gen in + let repeat = 30 in + let max_gas = 5 * ref_gas in + let generator_not_5more_fee = + let* fee_in_mutez = int_range 0 (fee_more5 - 1) in + let* gas = int_range 0 max_gas in + Format.eprintf "op_not_fee5: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_not_5more_fee = generate ~n:repeat generator_not_5more_fee in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Keep) + ops_not_5more_fee ; + (* Generate random operations which do not have 5% better ratio than + the reference [op]: they should not replace [op] when using the + default config. *) + let ratio_5more = + Q.(mul more5 (make (Z.of_int ref_fee) (Z.of_int ref_gas))) + in + let generator_not_5more_ratio = + let* gas = int_range 0 max_gas in + let fee_for_5more_ratio = Q.(mul (of_int gas) ratio_5more) in + let fee_upper_bound = Q.to_int fee_for_5more_ratio - 1 in + let* fee_in_mutez = int_range 0 (max 0 fee_upper_bound) in + Format.eprintf "op_not_ratio5: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_not_5more_ratio = generate ~n:repeat generator_not_5more_ratio in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Keep) + ops_not_5more_ratio ; + (* Generate random operations which have both 5% higher fees and 5% + better ratio than the reference [op]: they should replace [op] + when using the default config. *) + let max_fee = + (* We use a significantly higher factor to define [max_fee] from + [ref_fee] than [max_gas] from [ref_gas]. Therefore, even if we + generate a gas equal to [max_gas], we can still generate a fee + that makes the ratio at least 5% better than the reference + operation's. *) + 10 * ref_fee + in + let generator_both_5more = + let* gas = int_range 0 max_gas in + let fee_for_5more_ratio = Q.(mul (of_int gas) ratio_5more) in + let fee_lower_bound = max fee_more5 (Q.to_int fee_for_5more_ratio + 1) in + let* fee_in_mutez = int_range fee_lower_bound max_fee in + Format.eprintf "op_both_better: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_both_5more = generate ~n:repeat generator_both_5more in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Replace) + ops_both_5more ; + return_unit + +let () = + Alcotest_lwt.run + "conflict_handler" + [ + ( "conflict_handler", + [ + Tztest.tztest + "Random operations (not both manager)" + `Quick + test_random_ops; + Tztest.tztest "Manager operations" `Quick test_manager_ops; + ] ); + ] + |> Lwt_main.run diff --git a/src/proto_015_PtLimaPt/lib_protocol/test/helpers/operation_generator.ml b/src/proto_015_PtLimaPt/lib_protocol/test/helpers/operation_generator.ml index de1f90105310a22547ac9a11fb0ba9e0ccf3bbe6..06b2c0f01df6d439ffc3783161886d433ce8f289 100644 --- a/src/proto_015_PtLimaPt/lib_protocol/test/helpers/operation_generator.ml +++ b/src/proto_015_PtLimaPt/lib_protocol/test/helpers/operation_generator.ml @@ -827,6 +827,19 @@ let generate_manager_operation batch_size = let protocol_data = {contents = contents_list; signature} in return (Operation.pack {shell = first_op.shell; protocol_data}) +(** The default upper bound on the number of manager operations in a batch. + + As of December 2022, there is no batch maximal size enforced + anywhere in the protocol. However, the Octez Shell only accepts + batches of at most [operations_batch_size] operations, which has a + default value of [50] in [src/lib_shell_services/shell_limits.ml]. + The protocol tests do not necessarily have to align with this + value, but there is no reason either to choose a different + one. Therefore, they use the same bound, but decremented once to + account for some tests adding a reveal at the front of the batch as + needed. *) +let max_batch_size = 49 + let generate_operation = let open QCheck2.Gen in let* pass = oneofl all_passes in @@ -847,7 +860,7 @@ let generate_operation = | `KProposals -> generate_operation generate_proposals | `KBallot -> generate_operation generate_ballot | `KManager -> - let* batch_size = int_range 1 49 in + let* batch_size = int_range 1 max_batch_size in generate_manager_operation batch_size in (kind, (Operation.hash_packed packed_operation, packed_operation)) diff --git a/src/proto_015_PtLimaPt/lib_protocol/test/integration/validate/test_covalidity.ml b/src/proto_015_PtLimaPt/lib_protocol/test/integration/validate/test_covalidity.ml index 8d4cc266d810bf1d8a74a023a260505cd5a91708..7e8cccf98b55ab4001a26bcd4f775e380585eb98 100644 --- a/src/proto_015_PtLimaPt/lib_protocol/test/integration/validate/test_covalidity.ml +++ b/src/proto_015_PtLimaPt/lib_protocol/test/integration/validate/test_covalidity.ml @@ -40,8 +40,6 @@ open Alpha_context (** Values of number of bootstraps to create.*) -let default_batch_max_size = 49 - let default_nb_bootstrap = 7 let nb_permutations = 30 @@ -98,7 +96,7 @@ let print_candidates candidates = let covalid_permutation_and_bake ks nb_bootstrap = let open Lwt_result_syntax in let* state, candidates = - covalid ks ~nb_bootstrap ~max_batch_size:default_batch_max_size + covalid ks ~nb_bootstrap ~max_batch_size:Operation_generator.max_batch_size in print_candidates candidates ; let* () = sequential_validate state.block candidates in diff --git a/src/proto_016_PtMumbai/lib_plugin/mempool.ml b/src/proto_016_PtMumbai/lib_plugin/mempool.ml index 2c578221bfdcb938e8059378ab8e01f421584375..90a632d477548ef8f06a22adef41b0c4e9b85743 100644 --- a/src/proto_016_PtMumbai/lib_plugin/mempool.ml +++ b/src/proto_016_PtMumbai/lib_plugin/mempool.ml @@ -87,11 +87,8 @@ let default_minimal_nanotez_per_gas_unit = Q.of_int 100 let default_minimal_nanotez_per_byte = Q.of_int 1000 -let quota = Main.validation_passes - -let managers_index = 3 (* in Main.validation_passes *) - -let managers_quota = Stdlib.List.nth quota managers_index +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. @@ -478,14 +475,6 @@ let weight_and_resources_manager_operation ~validation_state ?size ~fee ~gas op let resources = Q.max size_ratio gas_ratio in (Q.(fee_f / resources), resources) -(** Returns the weight of an operation, i.e. the fees w.r.t the gas and size - consumption in the block. *) -let weight_manager_operation ~validation_state ?size ~fee ~gas op = - let weight, _resources = - weight_and_resources_manager_operation ~validation_state ?size ~fee ~gas op - in - weight - (** Return fee for an operation that consumes [op_resources] for its weight to be strictly greater than [min_weight]. *) let required_fee_manager_operation_weight ~op_resources ~min_weight = @@ -846,229 +835,6 @@ let pre_filter config ~(filter_state : state) ?validation_state_before | Single (Manager_operation _) as op -> prefilter_manager_op op | Cons (Manager_operation _, _) as op -> prefilter_manager_op op -(** Call the protocol's {!Validate.validate_operation} and - return either: - - - the updated {!validation_state} when the validation is - successful, or - - - the protocol error trace converted to an [error trace], together - with the corresponding {!error_classification}. - - The signature check is skipped when the operation has previously - been validated successfully, ie. [nb_successful_prechecks > 0]. *) -let proto_validate_operation validation_state oph ~nb_successful_prechecks - (operation : packed_operation) : - (validation_state, error trace * error_classification) result Lwt.t = - let open Lwt_result_syntax in - let*! res = - Validate.validate_operation - ~check_signature:(nb_successful_prechecks <= 0) - validation_state - oph - operation - in - match res with - | Ok validation_state -> return validation_state - | Error tztrace -> - let err = Environment.wrap_tztrace tztrace in - let error_classification = - match classify_trace err with - | Branch -> `Branch_refused err - | Permanent -> `Refused err - | Temporary -> `Branch_delayed err - | Outdated -> `Outdated err - in - fail (err, error_classification) - -(** Call the protocol's {!Validate.validate_operation} on a - manager operation and return: - - - [`Success] containing the updated [validation_state] when the - validation is successful; - - - [`Conflict] containing the hash of the conflicting operation, - and the {!error_classification} corresponding to the protocol error - trace, when the validation fails because of the - one-manager-operation-per-manager-per-block restriction; - - - an error containing the relevant {!error_classification} when - the validation fails with any other protocol error. - - The signature check is skipped when the operation has previously - been validated successfully, ie. [nb_successful_prechecks > 0]. *) -let proto_validate_manager_operation validation_state oph - ~nb_successful_prechecks - (operation : 'a Kind.manager Alpha_context.operation) : - ( [> `Success of validation_state - | `Conflict of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = - let open Lwt_result_syntax in - let*! res = - proto_validate_operation - validation_state - oph - ~nb_successful_prechecks - (Operation.pack operation) - in - match res with - | Ok validation_state -> return (`Success validation_state) - | Error (err, error_classification) -> ( - match err with - | Environment.Ecoproto_error - (Validate_errors.Manager.Manager_restriction - { - source = _manager; - conflict = Operation_conflict {existing; new_operation = _}; - }) - :: _ -> - return (`Conflict (existing, error_classification)) - | _ -> fail error_classification) - -(** Remove a manager operation from the protocol's [validation_state]. *) -let remove_from_validation_state validation_state (Manager_op op) = - let operation_state = - Validate.remove_operation validation_state.Validate.operation_state op - in - {validation_state with operation_state} - -(** Call the protocol validation on a manager operation and handle - potential conflicts: if either the 1M restriction is triggered or - the mempool exceeds the maximal number of prechecked operations, - then this function is responsible for either discarding the new - operation, or removing an old operation to free up space for the - new operation. - - Return the updated protocol [validation_state] and, when - applicable, the replaced operation accompanied by its new - classification. - - Note that this function does not handle the update of the - [filter_state]. *) -let validate_manager_operation_and_handle_conflicts config filter_state - validation_state oph ~nb_successful_prechecks fee gas_limit - (operation : 'manager_kind Kind.manager operation) : - ( validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = - let open Lwt_result_syntax in - let* proto_validation_outcome = - proto_validate_manager_operation - validation_state - oph - ~nb_successful_prechecks - operation - in - match proto_validation_outcome with - | `Success validation_state -> ( - (* The operation has been successfully validated and there is no - 1M conflict. We now need to ensure that the mempool does not - exceed its maximal number of prechecked manager operations. *) - match - check_minimal_weight - ~validation_state - config - filter_state - ~fee - ~gas_limit - (Operation_data operation.protocol_data) - with - | `Weight_ok (`No_replace, _weight) -> - (* The mempool is not full: no need to replace any operation. *) - return (validation_state, `No_replace) - | `Weight_ok (`Replace min_weight_oph, _weight) -> ( - (* The mempool is full yet the new operation has enough weight - to be included: the old operation with the lowest weight is - reclassified as [Branch_delayed]. *) - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2347 The - branch_delayed ring is bounded to 1000, so we may loose - operations. We can probably do better. *) - match - Tezos_crypto.Operation_hash.Map.find - min_weight_oph - filter_state.prechecked_manager_ops - with - | None -> - (* This only occurs for a [Drain_delegate] - operation: it has a higher priority than a manager - therefore we keep the drain delegate *) - return (validation_state, `No_replace) - | Some {manager_op; _} -> - let validation_state = - remove_from_validation_state validation_state manager_op - in - let replace_err = - Environment.wrap_tzerror Removed_fees_too_low_for_mempool - in - let replacement = - `Replace (min_weight_oph, `Branch_delayed [replace_err]) - in - return (validation_state, replacement)) - | `Fail err -> - (* The mempool is full and the weight of the new operation is - too low: raise the error returned by {!check_minimal_weight}. *) - fail err) - | `Conflict (old_oph, _proto_error) -> ( - (* The protocol [validation_state] already contains an operation - from the same manager. We look at the fees and gas limits of - both operations to decide whether to replace the old one. *) - match - Tezos_crypto.Operation_hash.Map.find - old_oph - filter_state.prechecked_manager_ops - with - | None -> - (* This only occurs for a [Drain_delegate] operation: it has - a higher priority than a manager therefore we keep the - drain delegate *) - return (validation_state, `No_replace) - | Some old_info -> - if - better_fees_and_ratio - config - old_info.gas_limit - old_info.fee - gas_limit - fee - then - (* The new operation is better and replaces the old one from - the same manager. Note that there is no need to check the - number of prechecked operations in the mempool - here. Indeed, the removal of the old operation frees up a - spot in the mempool anyway. *) - let validation_state = - remove_from_validation_state validation_state old_info.manager_op - in - let* proto_validation_outcome2 = - proto_validate_manager_operation - validation_state - oph - ~nb_successful_prechecks - operation - in - match proto_validation_outcome2 with - | `Success validation_state -> - let replace_err = - Environment.wrap_tzerror - (Manager_operation_replaced - {old_hash = old_oph; new_hash = oph}) - in - let replacement = `Replace (old_oph, `Outdated [replace_err]) in - return (validation_state, replacement) - | `Conflict (_oph, conflict_proto_error) -> - (* This should not happen: a manager operation should not - conflict with multiple operations. *) - fail conflict_proto_error - else - (* The new operation is not interesting enough so it is rejected. *) - let err = Manager_restriction {oph = old_oph; fee = old_info.fee} in - fail (`Branch_delayed [Environment.wrap_tzerror err])) - (** Remove a manager operation hash from the filter state. Do nothing if the operation was not in the state. *) let remove ~filter_state oph = @@ -1148,247 +914,136 @@ let add_manager_op filter_state oph info replacement = min_prechecked_op_weight; } -(** Call {!validate_manager_operation_and_handle_conflicts} then - update the [filter_state] by adding the newly validated operation, - and removing the replaced one one when applicable. - - Return either the updated [filter_state], updated - [validation_state], and operation replacement, or an error - containing the appropriate classification. *) -let precheck_manager_result config filter_state validation_state oph - ~nb_successful_prechecks (operation : 'manager_kind Kind.manager operation) - : - ( state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = +let add_manager_op_and_enforce_mempool_bound validation_state config + filter_state oph (op : 'manager_kind Kind.manager operation) = let open Lwt_result_syntax in let*? fee, gas_limit = Result.map_error (fun err -> `Refused (Environment.wrap_tztrace err)) - (get_manager_operation_gas_and_fee operation.protocol_data.contents) - in - let* validation_state, replacement = - validate_manager_operation_and_handle_conflicts - config - filter_state - validation_state - oph - ~nb_successful_prechecks - fee - gas_limit - operation + (get_manager_operation_gas_and_fee op.protocol_data.contents) in - let weight = - weight_manager_operation - ~validation_state - ~fee - ~gas:gas_limit - (Operation_data operation.protocol_data) + let* replacement, weight = + match + check_minimal_weight + ~validation_state + config + filter_state + ~fee + ~gas_limit + (Operation_data op.protocol_data) + with + | `Weight_ok (`No_replace, weight) -> + (* The mempool is not full: no need to replace any operation. *) + return (`No_replace, weight) + | `Weight_ok (`Replace min_weight_oph, weight) -> + (* The mempool is full yet the new operation has enough weight + to be included: the old operation with the lowest weight is + reclassified as [Branch_delayed]. *) + (* TODO: https://gitlab.com/tezos/tezos/-/issues/2347 The + branch_delayed ring is bounded to 1000, so we may loose + operations. We can probably do better. *) + let replace_err = + Environment.wrap_tzerror Removed_fees_too_low_for_mempool + in + let replacement = + `Replace (min_weight_oph, `Branch_delayed [replace_err]) + in + return (replacement, weight) + | `Fail err -> + (* The mempool is full and the weight of the new operation is + too low: raise the error returned by {!check_minimal_weight}. *) + fail err in - let info = {manager_op = Manager_op operation; gas_limit; fee; weight} in + let weight = match weight with [x] -> x | _ -> assert false in + let info = {manager_op = Manager_op op; gas_limit; fee; weight} in let filter_state = add_manager_op filter_state oph info replacement in - return (filter_state, validation_state, replacement) - -(** Call {!precheck_manager_result} then convert its error monad - result into the appropriate return type for [precheck]. *) -let precheck_manager config filter_state validation_state oph - ~nb_successful_prechecks operation : - [> `Passed_precheck of - state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ] - | error_classification ] - Lwt.t = - precheck_manager_result - config - filter_state - validation_state - oph - ~nb_successful_prechecks - operation - >>= function - | Ok (filter_state, validation_state, replacement) -> - Lwt.return - (`Passed_precheck (filter_state, validation_state, replacement)) - | Error - ((`Refused _ | `Branch_delayed _ | `Branch_refused _ | `Outdated _) as - err) -> - Lwt.return err - -(** Call the protocol's {!Validate.validate_operation}. If - successful, return the updated [validation_state], the unchanged - [filter_state], and no operation replacement. Otherwise, return the - classification associated with the protocol error. Note that when - there is a conflict with a previously validated operation, the new - operation is always discarded. As it does not allow for any fee - market, this function is designed for non-manager operations. *) -let precheck_non_manager filter_state validation_state oph - ~nb_successful_prechecks operation = - proto_validate_operation - validation_state - oph - ~nb_successful_prechecks - operation - >>= function - | Ok validation_state -> - Lwt.return - (`Passed_precheck (filter_state, validation_state, `No_replace)) - | Error - ( _err, - ((`Refused _ | `Branch_delayed _ | `Branch_refused _ | `Outdated _) as - error_classification) ) -> - Lwt.return error_classification - -(* Now that [precheck] uses {!Validate.validate_operation} - for every kind of operation, it must never return - [`Undecided]. Indeed, this would cause the prevalidator to call - {!Apply.apply_operation}, which relies on updates to the alpha - context to detect incompatible operations, whereas - [validate_operation] only updates the - {!Validate.validate_operation_state}. Therefore, it would - be possible for the mempool to accept conflicting operations. *) -let precheck : - config -> - filter_state:state -> - validation_state:validation_state -> - Tezos_crypto.Operation_hash.t -> - Main.operation -> - nb_successful_prechecks:int -> - [ `Passed_precheck of - state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ] - | `Undecided - | error_classification ] - Lwt.t = - fun config - ~filter_state - ~validation_state - oph - operation - ~nb_successful_prechecks -> - let {protocol_data = Operation_data protocol_data; _} = operation in - let call_precheck_manager (protocol_data : _ Kind.manager protocol_data) = - precheck_manager + return (filter_state, replacement) + +(** If the provided operation is a manager operation, add it to the + filter_state. If the mempool is full, either return an error if the + operation does not have enough weight to be included, or return the + operation with minimal weight that gets removed to make room. + + Do nothing on non-manager operations. + + If [replace] is provided, then it is removed from [filter_state] + before processing [op]. (If [replace] is a non-manager operation, + this does nothing since it was never in [filter_state] to begin with.) + Note that when this happens, the mempool can no longer be full after + the operation has been removed, so this function always returns + [`No_replace]. + + This function is designed to be called by the shell each time a + new operation has been validated by the protocol. It will be + removed in the future once the shell is able to bound the number of + operations in the mempool by itself. *) +let add_operation_and_enforce_mempool_bound ?replace validation_state config + filter_state (oph, op) = + let filter_state = + match replace with + | Some replace_oph -> + (* If the operation to replace is not a manager operation, then + it cannot be present in the [filter_state]. But then, + [remove] does nothing anyway. *) + remove ~filter_state replace_oph + | None -> filter_state + in + let {protocol_data = Operation_data protocol_data; _} = op in + let call_manager protocol_data = + add_manager_op_and_enforce_mempool_bound + validation_state config filter_state - validation_state oph - ~nb_successful_prechecks - {shell = operation.shell; protocol_data} + {shell = op.shell; protocol_data} in match protocol_data.contents with - | Single (Manager_operation _) -> call_precheck_manager protocol_data - | Cons (Manager_operation _, _) -> call_precheck_manager protocol_data - | Single _ -> - precheck_non_manager - filter_state - validation_state - oph - ~nb_successful_prechecks - operation - -open Apply_results - -type Environment.Error_monad.error += Skipped_operation - -let () = - Environment.Error_monad.register_error_kind - `Temporary - ~id:"postfilter.skipped_operation" - ~title:"The operation has been skipped by the protocol" - ~description:"The operation has been skipped by the protocol" - ~pp:(fun ppf () -> - Format.fprintf ppf "The operation has been skipped by the protocol") - Data_encoding.unit - (function Skipped_operation -> Some () | _ -> None) - (fun () -> Skipped_operation) - -type Environment.Error_monad.error += Backtracked_operation - -let () = - Environment.Error_monad.register_error_kind - `Temporary - ~id:"postfilter.backtracked_operation" - ~title:"The operation has been backtracked by the protocol" - ~description:"The operation has been backtracked by the protocol" - ~pp:(fun ppf () -> - Format.fprintf ppf "The operation has been backtracked by the protocol") - Data_encoding.unit - (function Backtracked_operation -> Some () | _ -> None) - (fun () -> Backtracked_operation) - -let rec post_filter_manager : - type t. - Alpha_context.t -> - state -> - t Kind.manager contents_result_list -> - config -> - [`Passed_postfilter of state | `Refused of tztrace] = - fun ctxt filter_state result config -> - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2181 - This function should be unit tested. - The errors that can be raised if allow_script_failure is enable should - be tested. *) - match result with - | Single_result (Manager_operation_result {operation_result; _}) -> ( - let check_allow_script_failure errs = - if config.allow_script_failure then `Passed_postfilter filter_state - else `Refused errs + | Single (Manager_operation _) -> call_manager protocol_data + | Cons (Manager_operation _, _) -> call_manager protocol_data + | Single _ -> return (filter_state, `No_replace) + +let is_manager_operation op = + match Operation.acceptable_pass op with + | Some pass -> Compare.Int.equal pass Operation_repr.manager_pass + | None -> false + +(** [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 (_ : Tezos_crypto.Operation_hash.t), old_op = existing_operation in + let (_ : Tezos_crypto.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 {protocol_data = Operation_data old_protocol_data; _} = old_op in + let {protocol_data = Operation_data new_protocol_data; _} = new_op in + let* old_fee, old_gas_limit = + get_manager_operation_gas_and_fee old_protocol_data.contents in - match operation_result with - | Applied _ -> `Passed_postfilter filter_state - | Skipped _ -> - check_allow_script_failure - [Environment.wrap_tzerror Skipped_operation] - | Failed (_, errors) -> - check_allow_script_failure (Environment.wrap_tztrace errors) - | Backtracked (_, errors) -> - check_allow_script_failure - (match errors with - | Some e -> Environment.wrap_tztrace e - | None -> [Environment.wrap_tzerror Backtracked_operation])) - | Cons_result (Manager_operation_result res, rest) -> ( - post_filter_manager - ctxt - filter_state - (Single_result (Manager_operation_result res)) - config - |> function - | `Passed_postfilter filter_state -> - post_filter_manager ctxt filter_state rest config - | `Refused _ as errs -> errs) - -let post_filter config ~(filter_state : state) ~validation_state_before:_ - ~validation_state_after (_op, receipt) = - match receipt with - | No_operation_metadata -> assert false (* only for multipass validator *) - | Operation_metadata {contents} -> ( - let handle_manager result = - let ctxt = Validate.get_initial_ctxt validation_state_after in - Lwt.return (post_filter_manager ctxt filter_state result config) + let* new_fee, new_gas_limit = + get_manager_operation_gas_and_fee new_protocol_data.contents in - match contents with - | Single_result (Preendorsement_result _) - | Single_result (Endorsement_result _) - | Single_result (Dal_attestation_result _) - | Single_result (Seed_nonce_revelation_result _) - | Single_result (Double_preendorsement_evidence_result _) - | Single_result (Double_endorsement_evidence_result _) - | Single_result (Double_baking_evidence_result _) - | Single_result (Activate_account_result _) - | Single_result Proposals_result - | Single_result (Vdf_revelation_result _) - | Single_result (Drain_delegate_result _) - | Single_result Ballot_result -> - Lwt.return (`Passed_postfilter filter_state) - | Single_result (Manager_operation_result _) as result -> - handle_manager result - | Cons_result (Manager_operation_result _, _) as result -> - handle_manager result) + 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 diff --git a/src/proto_016_PtMumbai/lib_plugin/test/dune b/src/proto_016_PtMumbai/lib_plugin/test/dune index 0bab03714d0e587e4b267129e8d32a6e5e486acd..bf8aecf9efc7957c7f0f789bac894303074bb4e5 100644 --- a/src/proto_016_PtMumbai/lib_plugin/test/dune +++ b/src/proto_016_PtMumbai/lib_plugin/test/dune @@ -2,7 +2,11 @@ ; Edit file manifest/main.ml instead. (executables - (names test_consensus_filter test_filter_state test_plugin) + (names + test_consensus_filter + test_filter_state + test_plugin + test_conflict_handler) (libraries tezos-base tezos-base-test-helpers @@ -42,3 +46,8 @@ (alias runtest) (package tezos-protocol-plugin-016-PtMumbai-tests) (action (run %{dep:./test_plugin.exe}))) + +(rule + (alias runtest) + (package tezos-protocol-plugin-016-PtMumbai-tests) + (action (run %{dep:./test_conflict_handler.exe}))) diff --git a/src/proto_016_PtMumbai/lib_plugin/test/test_conflict_handler.ml b/src/proto_016_PtMumbai/lib_plugin/test/test_conflict_handler.ml new file mode 100644 index 0000000000000000000000000000000000000000..0e7f09d4e187a02846071a0a2b37f7394ef13b68 --- /dev/null +++ b/src/proto_016_PtMumbai/lib_plugin/test/test_conflict_handler.ml @@ -0,0 +1,275 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 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. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Plugin.Mempool + Invocation: dune exec src/proto_alpha/lib_plugin/test/test_conflict_handler.exe + Subject: Unit tests the Mempool.conflict_handler fonction of the plugin +*) + +let pp_answer fmt = function + | `Keep -> Format.fprintf fmt "Keep" + | `Replace -> Format.fprintf fmt "Replace" + +let check_answer ?__LOC__ expected actual = + assert + (Lib_test.Qcheck2_helpers.qcheck_eq ~pp:pp_answer ?__LOC__ expected actual + : bool) + +let is_manager_op ((_ : Tezos_crypto.Operation_hash.t), op) = + (* This is implemented differently from + [Plugin.Mempool.is_manager_operation] (which relies on + [Alpha_context.Operation.acceptable_pass]), used in + [Plugin.Mempool.conflict_handler], to avoid the test being just a + copy of the code. *) + let {Alpha_context.protocol_data = Operation_data proto_data; _} = op in + match proto_data.contents with + | Single (Manager_operation _) | Cons (Manager_operation _, _) -> true + | _ -> false + +(** Test that when the operations are not both manager operations, the + conflict handler picks the higher operation according to + [Operation.compare]. *) +let test_random_ops () = + let ops = + let open Operation_generator in + QCheck2.Gen.(generate ~n:100 (pair generate_operation generate_operation)) + in + List.iter + (fun ((_, op1), (_, op2)) -> + let answer = + Plugin.Mempool.conflict_handler + Plugin.Mempool.default_config + ~existing_operation:op1 + ~new_operation:op2 + in + if is_manager_op op1 && is_manager_op op2 then + (* When both operations are manager operations, the result is + complicated and depends on the [config]. Testing it here + would mean basically reimplementing + [conflict_handler]. Instead, we test this case in + [test_manager_ops] below. *) + () + else if + (* When there is at least one non-manager operation, the + conflict handler defers to [Operation.compare]: the higher + operation is selected. *) + Alpha_context.Operation.compare op1 op2 >= 0 + then check_answer ~__LOC__ `Keep answer + else check_answer ~__LOC__ `Replace answer) + ops ; + return_unit + +(** Generator for a manager batch with the specified total fee and gas. *) +let generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas = + let open Alpha_context in + let open QCheck2.Gen in + let rec set_fee_and_gas : + type kind. _ -> _ -> kind contents_list -> kind contents_list t = + fun desired_total_fee desired_total_gas -> function + | Single (Manager_operation data) -> + let fee = Tez.of_mutez_exn (Int64.of_int desired_total_fee) in + let gas_limit = Gas.Arith.integral_of_int_exn desired_total_gas in + return (Single (Manager_operation {data with fee; gas_limit})) + | Cons (Manager_operation data, tail) -> + let* local_fee = + (* We generate some corner cases where some individual + operations in the batch have zero fees. *) + let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in + match r with + | `Random -> int_range 0 desired_total_fee + | `Zero -> return 0 + | `All -> return desired_total_fee + in + let* local_gas = int_range 0 desired_total_gas in + let fee = Tez.of_mutez_exn (Int64.of_int local_fee) in + let gas_limit = Gas.Arith.integral_of_int_exn local_gas in + let* tail = + set_fee_and_gas + (desired_total_fee - local_fee) + (desired_total_gas - local_gas) + tail + in + return (Cons (Manager_operation {data with fee; gas_limit}, tail)) + | Single _ -> + (* This function is only called on a manager operation. *) assert false + in + (* Generate a random manager operation. *) + let* batch_size = int_range 1 Operation_generator.max_batch_size in + let* op = Operation_generator.generate_manager_operation batch_size in + (* Modify its fee and gas to match the [fee_in_mutez] and [gas] inputs. *) + let {shell = _; protocol_data = Operation_data protocol_data} = op in + let* contents = set_fee_and_gas fee_in_mutez gas protocol_data.contents in + let protocol_data = {protocol_data with contents} in + let op = {op with protocol_data = Operation_data protocol_data} in + return (Operation.hash_packed op, op) + +let check_conflict_handler ~__LOC__ config ~old ~nw expected = + let answer = + Plugin.Mempool.conflict_handler + config + ~existing_operation:old + ~new_operation:nw + in + check_answer ~__LOC__ expected answer + +(** Test the semantics of the conflict handler on manager operations, + with either hand-picked or carefully generated fee and gas. *) +let test_manager_ops () = + let make_op ~fee_in_mutez ~gas = + QCheck2.Gen.generate1 + (generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas) + in + + (* Test operations with specific fee and gas, using the default + configuration. This configuration replaces the old operation when + the new one is at least 5% better, in terms of both fees and + fee/gas ratios. *) + let default = Plugin.Mempool.default_config in + let ref_fee = 10_000_000 in + let ref_gas = 2100 in + (* Reference operation arbitrarily has 10 tez of fees and 2100 + gas. The gas is chosen to still give an integer when multiplied + by 100/105. *) + let old = make_op ~fee_in_mutez:ref_fee ~gas:ref_gas in + (* Operation with same fee and ratio. *) + let op_same = make_op ~fee_in_mutez:ref_fee ~gas:ref_gas in + check_conflict_handler ~__LOC__ default ~old ~nw:op_same `Keep ; + (* 5% better fee but same ratio (because gas is also 5% more). *) + let more5 = Q.make (Z.of_int 105) (Z.of_int 100) in + let fee_more5 = Q.(to_int (mul more5 (of_int ref_fee))) in + let gas_more5 = Q.(to_int (mul more5 (of_int ref_gas))) in + let op_fee5 = make_op ~fee_in_mutez:fee_more5 ~gas:gas_more5 in + check_conflict_handler ~__LOC__ default ~old ~nw:op_fee5 `Keep ; + (* 5% better ratio but same fee (because gas is multiplied by 100/105). *) + let less5 = Q.make (Z.of_int 100) (Z.of_int 105) in + let gas_less5 = Q.(to_int (mul less5 (of_int ref_gas))) in + let op_ratio5 = make_op ~fee_in_mutez:ref_fee ~gas:gas_less5 in + check_conflict_handler ~__LOC__ default ~old ~nw:op_ratio5 `Keep ; + (* Both 5% better fee and 5% better ratio. *) + let op_both5 = make_op ~fee_in_mutez:fee_more5 ~gas:ref_gas in + check_conflict_handler ~__LOC__ default ~old ~nw:op_both5 `Replace ; + + (* Config that requires 10% better fee and ratio to replace. *) + let config10 = + { + Plugin.Mempool.default_config with + replace_by_fee_factor = Q.make (Z.of_int 11) (Z.of_int 10); + } + in + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_same `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_fee5 `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_ratio5 `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_both5 `Keep ; + (* Config that replaces when the new op has at least as much fee and ratio. *) + let config0 = + {Plugin.Mempool.default_config with replace_by_fee_factor = Q.one} + in + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_same `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_fee5 `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_ratio5 `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_both5 `Replace ; + (* This config does not replace when the new operation has worse + fees (even when the ratio is higher). *) + let op_less_fee = make_op ~fee_in_mutez:(ref_fee - 1) ~gas:(ref_gas - 1) in + check_conflict_handler ~__LOC__ default ~old ~nw:op_less_fee `Keep ; + (* This config does not replace either when the ratio is smaller. *) + let op_worse_ratio = make_op ~fee_in_mutez:ref_fee ~gas:(ref_gas + 1) in + check_conflict_handler ~__LOC__ default ~old ~nw:op_worse_ratio `Keep ; + + (* Generate random operations which do not have 5% better fees than + the reference [op]: they should not replace [op] when using the + default config. *) + let open QCheck2.Gen in + let repeat = 30 in + let max_gas = 5 * ref_gas in + let generator_not_5more_fee = + let* fee_in_mutez = int_range 0 (fee_more5 - 1) in + let* gas = int_range 0 max_gas in + Format.eprintf "op_not_fee5: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_not_5more_fee = generate ~n:repeat generator_not_5more_fee in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Keep) + ops_not_5more_fee ; + (* Generate random operations which do not have 5% better ratio than + the reference [op]: they should not replace [op] when using the + default config. *) + let ratio_5more = + Q.(mul more5 (make (Z.of_int ref_fee) (Z.of_int ref_gas))) + in + let generator_not_5more_ratio = + let* gas = int_range 0 max_gas in + let fee_for_5more_ratio = Q.(mul (of_int gas) ratio_5more) in + let fee_upper_bound = Q.to_int fee_for_5more_ratio - 1 in + let* fee_in_mutez = int_range 0 (max 0 fee_upper_bound) in + Format.eprintf "op_not_ratio5: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_not_5more_ratio = generate ~n:repeat generator_not_5more_ratio in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Keep) + ops_not_5more_ratio ; + (* Generate random operations which have both 5% higher fees and 5% + better ratio than the reference [op]: they should replace [op] + when using the default config. *) + let max_fee = + (* We use a significantly higher factor to define [max_fee] from + [ref_fee] than [max_gas] from [ref_gas]. Therefore, even if we + generate a gas equal to [max_gas], we can still generate a fee + that makes the ratio at least 5% better than the reference + operation's. *) + 10 * ref_fee + in + let generator_both_5more = + let* gas = int_range 0 max_gas in + let fee_for_5more_ratio = Q.(mul (of_int gas) ratio_5more) in + let fee_lower_bound = max fee_more5 (Q.to_int fee_for_5more_ratio + 1) in + let* fee_in_mutez = int_range fee_lower_bound max_fee in + Format.eprintf "op_both_better: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_both_5more = generate ~n:repeat generator_both_5more in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Replace) + ops_both_5more ; + return_unit + +let () = + Alcotest_lwt.run + "conflict_handler" + [ + ( "conflict_handler", + [ + Tztest.tztest + "Random operations (not both manager)" + `Quick + test_random_ops; + Tztest.tztest "Manager operations" `Quick test_manager_ops; + ] ); + ] + |> Lwt_main.run diff --git a/src/proto_016_PtMumbai/lib_protocol/test/helpers/operation_generator.ml b/src/proto_016_PtMumbai/lib_protocol/test/helpers/operation_generator.ml index 6503b38e7574fac4fa3b797090b319cb60b22fb3..9b75b07c352db6336d8ca9cc70f2ab9c7da09f3f 100644 --- a/src/proto_016_PtMumbai/lib_protocol/test/helpers/operation_generator.ml +++ b/src/proto_016_PtMumbai/lib_protocol/test/helpers/operation_generator.ml @@ -828,6 +828,19 @@ let generate_manager_operation batch_size = let protocol_data = {contents = contents_list; signature} in return (Operation.pack {shell = first_op.shell; protocol_data}) +(** The default upper bound on the number of manager operations in a batch. + + As of December 2022, there is no batch maximal size enforced + anywhere in the protocol. However, the Octez Shell only accepts + batches of at most [operations_batch_size] operations, which has a + default value of [50] in [src/lib_shell_services/shell_limits.ml]. + The protocol tests do not necessarily have to align with this + value, but there is no reason either to choose a different + one. Therefore, they use the same bound, but decremented once to + account for some tests adding a reveal at the front of the batch as + needed. *) +let max_batch_size = 49 + let generate_operation = let open QCheck2.Gen in let* pass = oneofl all_passes in @@ -848,7 +861,7 @@ let generate_operation = | `KProposals -> generate_operation generate_proposals | `KBallot -> generate_operation generate_ballot | `KManager -> - let* batch_size = int_range 1 49 in + let* batch_size = int_range 1 max_batch_size in generate_manager_operation batch_size in (kind, (Operation.hash_packed packed_operation, packed_operation)) diff --git a/src/proto_016_PtMumbai/lib_protocol/test/integration/validate/test_covalidity.ml b/src/proto_016_PtMumbai/lib_protocol/test/integration/validate/test_covalidity.ml index 046d4cf44a9568160b4c5653276251d6913f4c37..a13aaf0fd367880411289d9450bdff5f2adfe7b8 100644 --- a/src/proto_016_PtMumbai/lib_protocol/test/integration/validate/test_covalidity.ml +++ b/src/proto_016_PtMumbai/lib_protocol/test/integration/validate/test_covalidity.ml @@ -40,8 +40,6 @@ open Alpha_context (** Values of number of bootstraps to create.*) -let default_batch_max_size = 49 - let default_nb_bootstrap = 7 let nb_permutations = 30 @@ -98,7 +96,7 @@ let print_candidates candidates = let covalid_permutation_and_bake ks nb_bootstrap = let open Lwt_result_syntax in let* state, candidates = - covalid ks ~nb_bootstrap ~max_batch_size:default_batch_max_size + covalid ks ~nb_bootstrap ~max_batch_size:Operation_generator.max_batch_size in print_candidates candidates ; let* () = sequential_validate state.block candidates in diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 2c578221bfdcb938e8059378ab8e01f421584375..90a632d477548ef8f06a22adef41b0c4e9b85743 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -87,11 +87,8 @@ let default_minimal_nanotez_per_gas_unit = Q.of_int 100 let default_minimal_nanotez_per_byte = Q.of_int 1000 -let quota = Main.validation_passes - -let managers_index = 3 (* in Main.validation_passes *) - -let managers_quota = Stdlib.List.nth quota managers_index +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. @@ -478,14 +475,6 @@ let weight_and_resources_manager_operation ~validation_state ?size ~fee ~gas op let resources = Q.max size_ratio gas_ratio in (Q.(fee_f / resources), resources) -(** Returns the weight of an operation, i.e. the fees w.r.t the gas and size - consumption in the block. *) -let weight_manager_operation ~validation_state ?size ~fee ~gas op = - let weight, _resources = - weight_and_resources_manager_operation ~validation_state ?size ~fee ~gas op - in - weight - (** Return fee for an operation that consumes [op_resources] for its weight to be strictly greater than [min_weight]. *) let required_fee_manager_operation_weight ~op_resources ~min_weight = @@ -846,229 +835,6 @@ let pre_filter config ~(filter_state : state) ?validation_state_before | Single (Manager_operation _) as op -> prefilter_manager_op op | Cons (Manager_operation _, _) as op -> prefilter_manager_op op -(** Call the protocol's {!Validate.validate_operation} and - return either: - - - the updated {!validation_state} when the validation is - successful, or - - - the protocol error trace converted to an [error trace], together - with the corresponding {!error_classification}. - - The signature check is skipped when the operation has previously - been validated successfully, ie. [nb_successful_prechecks > 0]. *) -let proto_validate_operation validation_state oph ~nb_successful_prechecks - (operation : packed_operation) : - (validation_state, error trace * error_classification) result Lwt.t = - let open Lwt_result_syntax in - let*! res = - Validate.validate_operation - ~check_signature:(nb_successful_prechecks <= 0) - validation_state - oph - operation - in - match res with - | Ok validation_state -> return validation_state - | Error tztrace -> - let err = Environment.wrap_tztrace tztrace in - let error_classification = - match classify_trace err with - | Branch -> `Branch_refused err - | Permanent -> `Refused err - | Temporary -> `Branch_delayed err - | Outdated -> `Outdated err - in - fail (err, error_classification) - -(** Call the protocol's {!Validate.validate_operation} on a - manager operation and return: - - - [`Success] containing the updated [validation_state] when the - validation is successful; - - - [`Conflict] containing the hash of the conflicting operation, - and the {!error_classification} corresponding to the protocol error - trace, when the validation fails because of the - one-manager-operation-per-manager-per-block restriction; - - - an error containing the relevant {!error_classification} when - the validation fails with any other protocol error. - - The signature check is skipped when the operation has previously - been validated successfully, ie. [nb_successful_prechecks > 0]. *) -let proto_validate_manager_operation validation_state oph - ~nb_successful_prechecks - (operation : 'a Kind.manager Alpha_context.operation) : - ( [> `Success of validation_state - | `Conflict of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = - let open Lwt_result_syntax in - let*! res = - proto_validate_operation - validation_state - oph - ~nb_successful_prechecks - (Operation.pack operation) - in - match res with - | Ok validation_state -> return (`Success validation_state) - | Error (err, error_classification) -> ( - match err with - | Environment.Ecoproto_error - (Validate_errors.Manager.Manager_restriction - { - source = _manager; - conflict = Operation_conflict {existing; new_operation = _}; - }) - :: _ -> - return (`Conflict (existing, error_classification)) - | _ -> fail error_classification) - -(** Remove a manager operation from the protocol's [validation_state]. *) -let remove_from_validation_state validation_state (Manager_op op) = - let operation_state = - Validate.remove_operation validation_state.Validate.operation_state op - in - {validation_state with operation_state} - -(** Call the protocol validation on a manager operation and handle - potential conflicts: if either the 1M restriction is triggered or - the mempool exceeds the maximal number of prechecked operations, - then this function is responsible for either discarding the new - operation, or removing an old operation to free up space for the - new operation. - - Return the updated protocol [validation_state] and, when - applicable, the replaced operation accompanied by its new - classification. - - Note that this function does not handle the update of the - [filter_state]. *) -let validate_manager_operation_and_handle_conflicts config filter_state - validation_state oph ~nb_successful_prechecks fee gas_limit - (operation : 'manager_kind Kind.manager operation) : - ( validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = - let open Lwt_result_syntax in - let* proto_validation_outcome = - proto_validate_manager_operation - validation_state - oph - ~nb_successful_prechecks - operation - in - match proto_validation_outcome with - | `Success validation_state -> ( - (* The operation has been successfully validated and there is no - 1M conflict. We now need to ensure that the mempool does not - exceed its maximal number of prechecked manager operations. *) - match - check_minimal_weight - ~validation_state - config - filter_state - ~fee - ~gas_limit - (Operation_data operation.protocol_data) - with - | `Weight_ok (`No_replace, _weight) -> - (* The mempool is not full: no need to replace any operation. *) - return (validation_state, `No_replace) - | `Weight_ok (`Replace min_weight_oph, _weight) -> ( - (* The mempool is full yet the new operation has enough weight - to be included: the old operation with the lowest weight is - reclassified as [Branch_delayed]. *) - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2347 The - branch_delayed ring is bounded to 1000, so we may loose - operations. We can probably do better. *) - match - Tezos_crypto.Operation_hash.Map.find - min_weight_oph - filter_state.prechecked_manager_ops - with - | None -> - (* This only occurs for a [Drain_delegate] - operation: it has a higher priority than a manager - therefore we keep the drain delegate *) - return (validation_state, `No_replace) - | Some {manager_op; _} -> - let validation_state = - remove_from_validation_state validation_state manager_op - in - let replace_err = - Environment.wrap_tzerror Removed_fees_too_low_for_mempool - in - let replacement = - `Replace (min_weight_oph, `Branch_delayed [replace_err]) - in - return (validation_state, replacement)) - | `Fail err -> - (* The mempool is full and the weight of the new operation is - too low: raise the error returned by {!check_minimal_weight}. *) - fail err) - | `Conflict (old_oph, _proto_error) -> ( - (* The protocol [validation_state] already contains an operation - from the same manager. We look at the fees and gas limits of - both operations to decide whether to replace the old one. *) - match - Tezos_crypto.Operation_hash.Map.find - old_oph - filter_state.prechecked_manager_ops - with - | None -> - (* This only occurs for a [Drain_delegate] operation: it has - a higher priority than a manager therefore we keep the - drain delegate *) - return (validation_state, `No_replace) - | Some old_info -> - if - better_fees_and_ratio - config - old_info.gas_limit - old_info.fee - gas_limit - fee - then - (* The new operation is better and replaces the old one from - the same manager. Note that there is no need to check the - number of prechecked operations in the mempool - here. Indeed, the removal of the old operation frees up a - spot in the mempool anyway. *) - let validation_state = - remove_from_validation_state validation_state old_info.manager_op - in - let* proto_validation_outcome2 = - proto_validate_manager_operation - validation_state - oph - ~nb_successful_prechecks - operation - in - match proto_validation_outcome2 with - | `Success validation_state -> - let replace_err = - Environment.wrap_tzerror - (Manager_operation_replaced - {old_hash = old_oph; new_hash = oph}) - in - let replacement = `Replace (old_oph, `Outdated [replace_err]) in - return (validation_state, replacement) - | `Conflict (_oph, conflict_proto_error) -> - (* This should not happen: a manager operation should not - conflict with multiple operations. *) - fail conflict_proto_error - else - (* The new operation is not interesting enough so it is rejected. *) - let err = Manager_restriction {oph = old_oph; fee = old_info.fee} in - fail (`Branch_delayed [Environment.wrap_tzerror err])) - (** Remove a manager operation hash from the filter state. Do nothing if the operation was not in the state. *) let remove ~filter_state oph = @@ -1148,247 +914,136 @@ let add_manager_op filter_state oph info replacement = min_prechecked_op_weight; } -(** Call {!validate_manager_operation_and_handle_conflicts} then - update the [filter_state] by adding the newly validated operation, - and removing the replaced one one when applicable. - - Return either the updated [filter_state], updated - [validation_state], and operation replacement, or an error - containing the appropriate classification. *) -let precheck_manager_result config filter_state validation_state oph - ~nb_successful_prechecks (operation : 'manager_kind Kind.manager operation) - : - ( state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ], - error_classification ) - result - Lwt.t = +let add_manager_op_and_enforce_mempool_bound validation_state config + filter_state oph (op : 'manager_kind Kind.manager operation) = let open Lwt_result_syntax in let*? fee, gas_limit = Result.map_error (fun err -> `Refused (Environment.wrap_tztrace err)) - (get_manager_operation_gas_and_fee operation.protocol_data.contents) - in - let* validation_state, replacement = - validate_manager_operation_and_handle_conflicts - config - filter_state - validation_state - oph - ~nb_successful_prechecks - fee - gas_limit - operation + (get_manager_operation_gas_and_fee op.protocol_data.contents) in - let weight = - weight_manager_operation - ~validation_state - ~fee - ~gas:gas_limit - (Operation_data operation.protocol_data) + let* replacement, weight = + match + check_minimal_weight + ~validation_state + config + filter_state + ~fee + ~gas_limit + (Operation_data op.protocol_data) + with + | `Weight_ok (`No_replace, weight) -> + (* The mempool is not full: no need to replace any operation. *) + return (`No_replace, weight) + | `Weight_ok (`Replace min_weight_oph, weight) -> + (* The mempool is full yet the new operation has enough weight + to be included: the old operation with the lowest weight is + reclassified as [Branch_delayed]. *) + (* TODO: https://gitlab.com/tezos/tezos/-/issues/2347 The + branch_delayed ring is bounded to 1000, so we may loose + operations. We can probably do better. *) + let replace_err = + Environment.wrap_tzerror Removed_fees_too_low_for_mempool + in + let replacement = + `Replace (min_weight_oph, `Branch_delayed [replace_err]) + in + return (replacement, weight) + | `Fail err -> + (* The mempool is full and the weight of the new operation is + too low: raise the error returned by {!check_minimal_weight}. *) + fail err in - let info = {manager_op = Manager_op operation; gas_limit; fee; weight} in + let weight = match weight with [x] -> x | _ -> assert false in + let info = {manager_op = Manager_op op; gas_limit; fee; weight} in let filter_state = add_manager_op filter_state oph info replacement in - return (filter_state, validation_state, replacement) - -(** Call {!precheck_manager_result} then convert its error monad - result into the appropriate return type for [precheck]. *) -let precheck_manager config filter_state validation_state oph - ~nb_successful_prechecks operation : - [> `Passed_precheck of - state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ] - | error_classification ] - Lwt.t = - precheck_manager_result - config - filter_state - validation_state - oph - ~nb_successful_prechecks - operation - >>= function - | Ok (filter_state, validation_state, replacement) -> - Lwt.return - (`Passed_precheck (filter_state, validation_state, replacement)) - | Error - ((`Refused _ | `Branch_delayed _ | `Branch_refused _ | `Outdated _) as - err) -> - Lwt.return err - -(** Call the protocol's {!Validate.validate_operation}. If - successful, return the updated [validation_state], the unchanged - [filter_state], and no operation replacement. Otherwise, return the - classification associated with the protocol error. Note that when - there is a conflict with a previously validated operation, the new - operation is always discarded. As it does not allow for any fee - market, this function is designed for non-manager operations. *) -let precheck_non_manager filter_state validation_state oph - ~nb_successful_prechecks operation = - proto_validate_operation - validation_state - oph - ~nb_successful_prechecks - operation - >>= function - | Ok validation_state -> - Lwt.return - (`Passed_precheck (filter_state, validation_state, `No_replace)) - | Error - ( _err, - ((`Refused _ | `Branch_delayed _ | `Branch_refused _ | `Outdated _) as - error_classification) ) -> - Lwt.return error_classification - -(* Now that [precheck] uses {!Validate.validate_operation} - for every kind of operation, it must never return - [`Undecided]. Indeed, this would cause the prevalidator to call - {!Apply.apply_operation}, which relies on updates to the alpha - context to detect incompatible operations, whereas - [validate_operation] only updates the - {!Validate.validate_operation_state}. Therefore, it would - be possible for the mempool to accept conflicting operations. *) -let precheck : - config -> - filter_state:state -> - validation_state:validation_state -> - Tezos_crypto.Operation_hash.t -> - Main.operation -> - nb_successful_prechecks:int -> - [ `Passed_precheck of - state - * validation_state - * [ `No_replace - | `Replace of Tezos_crypto.Operation_hash.t * error_classification ] - | `Undecided - | error_classification ] - Lwt.t = - fun config - ~filter_state - ~validation_state - oph - operation - ~nb_successful_prechecks -> - let {protocol_data = Operation_data protocol_data; _} = operation in - let call_precheck_manager (protocol_data : _ Kind.manager protocol_data) = - precheck_manager + return (filter_state, replacement) + +(** If the provided operation is a manager operation, add it to the + filter_state. If the mempool is full, either return an error if the + operation does not have enough weight to be included, or return the + operation with minimal weight that gets removed to make room. + + Do nothing on non-manager operations. + + If [replace] is provided, then it is removed from [filter_state] + before processing [op]. (If [replace] is a non-manager operation, + this does nothing since it was never in [filter_state] to begin with.) + Note that when this happens, the mempool can no longer be full after + the operation has been removed, so this function always returns + [`No_replace]. + + This function is designed to be called by the shell each time a + new operation has been validated by the protocol. It will be + removed in the future once the shell is able to bound the number of + operations in the mempool by itself. *) +let add_operation_and_enforce_mempool_bound ?replace validation_state config + filter_state (oph, op) = + let filter_state = + match replace with + | Some replace_oph -> + (* If the operation to replace is not a manager operation, then + it cannot be present in the [filter_state]. But then, + [remove] does nothing anyway. *) + remove ~filter_state replace_oph + | None -> filter_state + in + let {protocol_data = Operation_data protocol_data; _} = op in + let call_manager protocol_data = + add_manager_op_and_enforce_mempool_bound + validation_state config filter_state - validation_state oph - ~nb_successful_prechecks - {shell = operation.shell; protocol_data} + {shell = op.shell; protocol_data} in match protocol_data.contents with - | Single (Manager_operation _) -> call_precheck_manager protocol_data - | Cons (Manager_operation _, _) -> call_precheck_manager protocol_data - | Single _ -> - precheck_non_manager - filter_state - validation_state - oph - ~nb_successful_prechecks - operation - -open Apply_results - -type Environment.Error_monad.error += Skipped_operation - -let () = - Environment.Error_monad.register_error_kind - `Temporary - ~id:"postfilter.skipped_operation" - ~title:"The operation has been skipped by the protocol" - ~description:"The operation has been skipped by the protocol" - ~pp:(fun ppf () -> - Format.fprintf ppf "The operation has been skipped by the protocol") - Data_encoding.unit - (function Skipped_operation -> Some () | _ -> None) - (fun () -> Skipped_operation) - -type Environment.Error_monad.error += Backtracked_operation - -let () = - Environment.Error_monad.register_error_kind - `Temporary - ~id:"postfilter.backtracked_operation" - ~title:"The operation has been backtracked by the protocol" - ~description:"The operation has been backtracked by the protocol" - ~pp:(fun ppf () -> - Format.fprintf ppf "The operation has been backtracked by the protocol") - Data_encoding.unit - (function Backtracked_operation -> Some () | _ -> None) - (fun () -> Backtracked_operation) - -let rec post_filter_manager : - type t. - Alpha_context.t -> - state -> - t Kind.manager contents_result_list -> - config -> - [`Passed_postfilter of state | `Refused of tztrace] = - fun ctxt filter_state result config -> - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2181 - This function should be unit tested. - The errors that can be raised if allow_script_failure is enable should - be tested. *) - match result with - | Single_result (Manager_operation_result {operation_result; _}) -> ( - let check_allow_script_failure errs = - if config.allow_script_failure then `Passed_postfilter filter_state - else `Refused errs + | Single (Manager_operation _) -> call_manager protocol_data + | Cons (Manager_operation _, _) -> call_manager protocol_data + | Single _ -> return (filter_state, `No_replace) + +let is_manager_operation op = + match Operation.acceptable_pass op with + | Some pass -> Compare.Int.equal pass Operation_repr.manager_pass + | None -> false + +(** [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 (_ : Tezos_crypto.Operation_hash.t), old_op = existing_operation in + let (_ : Tezos_crypto.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 {protocol_data = Operation_data old_protocol_data; _} = old_op in + let {protocol_data = Operation_data new_protocol_data; _} = new_op in + let* old_fee, old_gas_limit = + get_manager_operation_gas_and_fee old_protocol_data.contents in - match operation_result with - | Applied _ -> `Passed_postfilter filter_state - | Skipped _ -> - check_allow_script_failure - [Environment.wrap_tzerror Skipped_operation] - | Failed (_, errors) -> - check_allow_script_failure (Environment.wrap_tztrace errors) - | Backtracked (_, errors) -> - check_allow_script_failure - (match errors with - | Some e -> Environment.wrap_tztrace e - | None -> [Environment.wrap_tzerror Backtracked_operation])) - | Cons_result (Manager_operation_result res, rest) -> ( - post_filter_manager - ctxt - filter_state - (Single_result (Manager_operation_result res)) - config - |> function - | `Passed_postfilter filter_state -> - post_filter_manager ctxt filter_state rest config - | `Refused _ as errs -> errs) - -let post_filter config ~(filter_state : state) ~validation_state_before:_ - ~validation_state_after (_op, receipt) = - match receipt with - | No_operation_metadata -> assert false (* only for multipass validator *) - | Operation_metadata {contents} -> ( - let handle_manager result = - let ctxt = Validate.get_initial_ctxt validation_state_after in - Lwt.return (post_filter_manager ctxt filter_state result config) + let* new_fee, new_gas_limit = + get_manager_operation_gas_and_fee new_protocol_data.contents in - match contents with - | Single_result (Preendorsement_result _) - | Single_result (Endorsement_result _) - | Single_result (Dal_attestation_result _) - | Single_result (Seed_nonce_revelation_result _) - | Single_result (Double_preendorsement_evidence_result _) - | Single_result (Double_endorsement_evidence_result _) - | Single_result (Double_baking_evidence_result _) - | Single_result (Activate_account_result _) - | Single_result Proposals_result - | Single_result (Vdf_revelation_result _) - | Single_result (Drain_delegate_result _) - | Single_result Ballot_result -> - Lwt.return (`Passed_postfilter filter_state) - | Single_result (Manager_operation_result _) as result -> - handle_manager result - | Cons_result (Manager_operation_result _, _) as result -> - handle_manager result) + 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 diff --git a/src/proto_alpha/lib_plugin/test/dune b/src/proto_alpha/lib_plugin/test/dune index 8217d9534bc0ed5f9d60f5e9c2979d6c9f849691..d6e493eece8d16ccb96967c5da1ff27d1cfd7ba3 100644 --- a/src/proto_alpha/lib_plugin/test/dune +++ b/src/proto_alpha/lib_plugin/test/dune @@ -2,7 +2,11 @@ ; Edit file manifest/main.ml instead. (executables - (names test_consensus_filter test_filter_state test_plugin) + (names + test_consensus_filter + test_filter_state + test_plugin + test_conflict_handler) (libraries tezos-base tezos-base-test-helpers @@ -42,3 +46,8 @@ (alias runtest) (package tezos-protocol-plugin-alpha-tests) (action (run %{dep:./test_plugin.exe}))) + +(rule + (alias runtest) + (package tezos-protocol-plugin-alpha-tests) + (action (run %{dep:./test_conflict_handler.exe}))) diff --git a/src/proto_alpha/lib_plugin/test/test_conflict_handler.ml b/src/proto_alpha/lib_plugin/test/test_conflict_handler.ml new file mode 100644 index 0000000000000000000000000000000000000000..0e7f09d4e187a02846071a0a2b37f7394ef13b68 --- /dev/null +++ b/src/proto_alpha/lib_plugin/test/test_conflict_handler.ml @@ -0,0 +1,275 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 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. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Plugin.Mempool + Invocation: dune exec src/proto_alpha/lib_plugin/test/test_conflict_handler.exe + Subject: Unit tests the Mempool.conflict_handler fonction of the plugin +*) + +let pp_answer fmt = function + | `Keep -> Format.fprintf fmt "Keep" + | `Replace -> Format.fprintf fmt "Replace" + +let check_answer ?__LOC__ expected actual = + assert + (Lib_test.Qcheck2_helpers.qcheck_eq ~pp:pp_answer ?__LOC__ expected actual + : bool) + +let is_manager_op ((_ : Tezos_crypto.Operation_hash.t), op) = + (* This is implemented differently from + [Plugin.Mempool.is_manager_operation] (which relies on + [Alpha_context.Operation.acceptable_pass]), used in + [Plugin.Mempool.conflict_handler], to avoid the test being just a + copy of the code. *) + let {Alpha_context.protocol_data = Operation_data proto_data; _} = op in + match proto_data.contents with + | Single (Manager_operation _) | Cons (Manager_operation _, _) -> true + | _ -> false + +(** Test that when the operations are not both manager operations, the + conflict handler picks the higher operation according to + [Operation.compare]. *) +let test_random_ops () = + let ops = + let open Operation_generator in + QCheck2.Gen.(generate ~n:100 (pair generate_operation generate_operation)) + in + List.iter + (fun ((_, op1), (_, op2)) -> + let answer = + Plugin.Mempool.conflict_handler + Plugin.Mempool.default_config + ~existing_operation:op1 + ~new_operation:op2 + in + if is_manager_op op1 && is_manager_op op2 then + (* When both operations are manager operations, the result is + complicated and depends on the [config]. Testing it here + would mean basically reimplementing + [conflict_handler]. Instead, we test this case in + [test_manager_ops] below. *) + () + else if + (* When there is at least one non-manager operation, the + conflict handler defers to [Operation.compare]: the higher + operation is selected. *) + Alpha_context.Operation.compare op1 op2 >= 0 + then check_answer ~__LOC__ `Keep answer + else check_answer ~__LOC__ `Replace answer) + ops ; + return_unit + +(** Generator for a manager batch with the specified total fee and gas. *) +let generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas = + let open Alpha_context in + let open QCheck2.Gen in + let rec set_fee_and_gas : + type kind. _ -> _ -> kind contents_list -> kind contents_list t = + fun desired_total_fee desired_total_gas -> function + | Single (Manager_operation data) -> + let fee = Tez.of_mutez_exn (Int64.of_int desired_total_fee) in + let gas_limit = Gas.Arith.integral_of_int_exn desired_total_gas in + return (Single (Manager_operation {data with fee; gas_limit})) + | Cons (Manager_operation data, tail) -> + let* local_fee = + (* We generate some corner cases where some individual + operations in the batch have zero fees. *) + let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in + match r with + | `Random -> int_range 0 desired_total_fee + | `Zero -> return 0 + | `All -> return desired_total_fee + in + let* local_gas = int_range 0 desired_total_gas in + let fee = Tez.of_mutez_exn (Int64.of_int local_fee) in + let gas_limit = Gas.Arith.integral_of_int_exn local_gas in + let* tail = + set_fee_and_gas + (desired_total_fee - local_fee) + (desired_total_gas - local_gas) + tail + in + return (Cons (Manager_operation {data with fee; gas_limit}, tail)) + | Single _ -> + (* This function is only called on a manager operation. *) assert false + in + (* Generate a random manager operation. *) + let* batch_size = int_range 1 Operation_generator.max_batch_size in + let* op = Operation_generator.generate_manager_operation batch_size in + (* Modify its fee and gas to match the [fee_in_mutez] and [gas] inputs. *) + let {shell = _; protocol_data = Operation_data protocol_data} = op in + let* contents = set_fee_and_gas fee_in_mutez gas protocol_data.contents in + let protocol_data = {protocol_data with contents} in + let op = {op with protocol_data = Operation_data protocol_data} in + return (Operation.hash_packed op, op) + +let check_conflict_handler ~__LOC__ config ~old ~nw expected = + let answer = + Plugin.Mempool.conflict_handler + config + ~existing_operation:old + ~new_operation:nw + in + check_answer ~__LOC__ expected answer + +(** Test the semantics of the conflict handler on manager operations, + with either hand-picked or carefully generated fee and gas. *) +let test_manager_ops () = + let make_op ~fee_in_mutez ~gas = + QCheck2.Gen.generate1 + (generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas) + in + + (* Test operations with specific fee and gas, using the default + configuration. This configuration replaces the old operation when + the new one is at least 5% better, in terms of both fees and + fee/gas ratios. *) + let default = Plugin.Mempool.default_config in + let ref_fee = 10_000_000 in + let ref_gas = 2100 in + (* Reference operation arbitrarily has 10 tez of fees and 2100 + gas. The gas is chosen to still give an integer when multiplied + by 100/105. *) + let old = make_op ~fee_in_mutez:ref_fee ~gas:ref_gas in + (* Operation with same fee and ratio. *) + let op_same = make_op ~fee_in_mutez:ref_fee ~gas:ref_gas in + check_conflict_handler ~__LOC__ default ~old ~nw:op_same `Keep ; + (* 5% better fee but same ratio (because gas is also 5% more). *) + let more5 = Q.make (Z.of_int 105) (Z.of_int 100) in + let fee_more5 = Q.(to_int (mul more5 (of_int ref_fee))) in + let gas_more5 = Q.(to_int (mul more5 (of_int ref_gas))) in + let op_fee5 = make_op ~fee_in_mutez:fee_more5 ~gas:gas_more5 in + check_conflict_handler ~__LOC__ default ~old ~nw:op_fee5 `Keep ; + (* 5% better ratio but same fee (because gas is multiplied by 100/105). *) + let less5 = Q.make (Z.of_int 100) (Z.of_int 105) in + let gas_less5 = Q.(to_int (mul less5 (of_int ref_gas))) in + let op_ratio5 = make_op ~fee_in_mutez:ref_fee ~gas:gas_less5 in + check_conflict_handler ~__LOC__ default ~old ~nw:op_ratio5 `Keep ; + (* Both 5% better fee and 5% better ratio. *) + let op_both5 = make_op ~fee_in_mutez:fee_more5 ~gas:ref_gas in + check_conflict_handler ~__LOC__ default ~old ~nw:op_both5 `Replace ; + + (* Config that requires 10% better fee and ratio to replace. *) + let config10 = + { + Plugin.Mempool.default_config with + replace_by_fee_factor = Q.make (Z.of_int 11) (Z.of_int 10); + } + in + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_same `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_fee5 `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_ratio5 `Keep ; + check_conflict_handler ~__LOC__ config10 ~old ~nw:op_both5 `Keep ; + (* Config that replaces when the new op has at least as much fee and ratio. *) + let config0 = + {Plugin.Mempool.default_config with replace_by_fee_factor = Q.one} + in + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_same `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_fee5 `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_ratio5 `Replace ; + check_conflict_handler ~__LOC__ config0 ~old ~nw:op_both5 `Replace ; + (* This config does not replace when the new operation has worse + fees (even when the ratio is higher). *) + let op_less_fee = make_op ~fee_in_mutez:(ref_fee - 1) ~gas:(ref_gas - 1) in + check_conflict_handler ~__LOC__ default ~old ~nw:op_less_fee `Keep ; + (* This config does not replace either when the ratio is smaller. *) + let op_worse_ratio = make_op ~fee_in_mutez:ref_fee ~gas:(ref_gas + 1) in + check_conflict_handler ~__LOC__ default ~old ~nw:op_worse_ratio `Keep ; + + (* Generate random operations which do not have 5% better fees than + the reference [op]: they should not replace [op] when using the + default config. *) + let open QCheck2.Gen in + let repeat = 30 in + let max_gas = 5 * ref_gas in + let generator_not_5more_fee = + let* fee_in_mutez = int_range 0 (fee_more5 - 1) in + let* gas = int_range 0 max_gas in + Format.eprintf "op_not_fee5: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_not_5more_fee = generate ~n:repeat generator_not_5more_fee in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Keep) + ops_not_5more_fee ; + (* Generate random operations which do not have 5% better ratio than + the reference [op]: they should not replace [op] when using the + default config. *) + let ratio_5more = + Q.(mul more5 (make (Z.of_int ref_fee) (Z.of_int ref_gas))) + in + let generator_not_5more_ratio = + let* gas = int_range 0 max_gas in + let fee_for_5more_ratio = Q.(mul (of_int gas) ratio_5more) in + let fee_upper_bound = Q.to_int fee_for_5more_ratio - 1 in + let* fee_in_mutez = int_range 0 (max 0 fee_upper_bound) in + Format.eprintf "op_not_ratio5: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_not_5more_ratio = generate ~n:repeat generator_not_5more_ratio in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Keep) + ops_not_5more_ratio ; + (* Generate random operations which have both 5% higher fees and 5% + better ratio than the reference [op]: they should replace [op] + when using the default config. *) + let max_fee = + (* We use a significantly higher factor to define [max_fee] from + [ref_fee] than [max_gas] from [ref_gas]. Therefore, even if we + generate a gas equal to [max_gas], we can still generate a fee + that makes the ratio at least 5% better than the reference + operation's. *) + 10 * ref_fee + in + let generator_both_5more = + let* gas = int_range 0 max_gas in + let fee_for_5more_ratio = Q.(mul (of_int gas) ratio_5more) in + let fee_lower_bound = max fee_more5 (Q.to_int fee_for_5more_ratio + 1) in + let* fee_in_mutez = int_range fee_lower_bound max_fee in + Format.eprintf "op_both_better: fee = %d; gas = %d@." fee_in_mutez gas ; + generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + let ops_both_5more = generate ~n:repeat generator_both_5more in + List.iter + (fun nw -> check_conflict_handler ~__LOC__ default ~old ~nw `Replace) + ops_both_5more ; + return_unit + +let () = + Alcotest_lwt.run + "conflict_handler" + [ + ( "conflict_handler", + [ + Tztest.tztest + "Random operations (not both manager)" + `Quick + test_random_ops; + Tztest.tztest "Manager operations" `Quick test_manager_ops; + ] ); + ] + |> Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/test/helpers/operation_generator.ml b/src/proto_alpha/lib_protocol/test/helpers/operation_generator.ml index 79c454ce0df0a2d4bf60695a39c84c2e9f6c2d9d..95269de6f6924bbef189a0f38397616677be519a 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/operation_generator.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/operation_generator.ml @@ -828,6 +828,19 @@ let generate_manager_operation batch_size = let protocol_data = {contents = contents_list; signature} in return (Operation.pack {shell = first_op.shell; protocol_data}) +(** The default upper bound on the number of manager operations in a batch. + + As of December 2022, there is no batch maximal size enforced + anywhere in the protocol. However, the Octez Shell only accepts + batches of at most [operations_batch_size] operations, which has a + default value of [50] in [src/lib_shell_services/shell_limits.ml]. + The protocol tests do not necessarily have to align with this + value, but there is no reason either to choose a different + one. Therefore, they use the same bound, but decremented once to + account for some tests adding a reveal at the front of the batch as + needed. *) +let max_batch_size = 49 + let generate_operation = let open QCheck2.Gen in let* pass = oneofl all_passes in @@ -848,7 +861,7 @@ let generate_operation = | `KProposals -> generate_operation generate_proposals | `KBallot -> generate_operation generate_ballot | `KManager -> - let* batch_size = int_range 1 49 in + let* batch_size = int_range 1 max_batch_size in generate_manager_operation batch_size in (kind, (Operation.hash_packed packed_operation, packed_operation)) diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/test_covalidity.ml b/src/proto_alpha/lib_protocol/test/integration/validate/test_covalidity.ml index 046d4cf44a9568160b4c5653276251d6913f4c37..a13aaf0fd367880411289d9450bdff5f2adfe7b8 100644 --- a/src/proto_alpha/lib_protocol/test/integration/validate/test_covalidity.ml +++ b/src/proto_alpha/lib_protocol/test/integration/validate/test_covalidity.ml @@ -40,8 +40,6 @@ open Alpha_context (** Values of number of bootstraps to create.*) -let default_batch_max_size = 49 - let default_nb_bootstrap = 7 let nb_permutations = 30 @@ -98,7 +96,7 @@ let print_candidates candidates = let covalid_permutation_and_bake ks nb_bootstrap = let open Lwt_result_syntax in let* state, candidates = - covalid ks ~nb_bootstrap ~max_batch_size:default_batch_max_size + covalid ks ~nb_bootstrap ~max_batch_size:Operation_generator.max_batch_size in print_candidates candidates ; let* () = sequential_validate state.block candidates in diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index f9c997b9661e88f3db498c284d894a139f63b185..e6bbc9518d040b3037b54b7f35dcb69b97d6b12d 100644 --- a/src/proto_demo_counter/lib_protocol/main.ml +++ b/src/proto_demo_counter/lib_protocol/main.ml @@ -260,9 +260,8 @@ let value_of_key ~chain_id:_ ~predecessor_context:_ ~predecessor_timestamp:_ let rpc_services = Services.rpc_services -(* Fake mempool *) module Mempool = struct - type t = unit + type t = State.t type validation_info = unit @@ -290,16 +289,34 @@ module Mempool = struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) - - let encoding = Data_encoding.unit - - let add_operation ?check_signature:_ ?conflict_handler:_ _ _ _ = - Lwt.return_ok ((), Unchanged) - - let remove_operation () _ = () - - let merge ?conflict_handler:_ () () = Ok () - - let operations () = Operation_hash.Map.empty + let init ctxt _chain_id ~head_hash:_ ~(head : Block_header.shell_header) = + let open Lwt_result_syntax in + Logging.log + Notice + "Mempool.init: head fitness = %a%!" + Fitness.pp + head.fitness ; + let*! state = State.get_state ctxt in + return ((), state) + + let encoding = State.encoding + + let add_operation ?check_signature:_ ?conflict_handler:_ + (_info : validation_info) state ((_oph : Operation_hash.t), op) = + match Apply.apply state op.protocol_data with + | None -> + Lwt.return_error + (Validation_error (trace_of_error Error.Invalid_operation)) + | Some state -> return (state, Added) + + (* This mempool does not currently support removing an operation. *) + let remove_operation _ _ = assert false + + (* This mempool does not currently support merging. *) + let merge ?conflict_handler:_ _ _ = assert false + + (* This function is not currently used in the context of + [proto_demo_counter]. If it is needed in the future, the type [t] + will need to be extended to remember all added operations. *) + let operations _ = assert false end diff --git a/tezt/tests/consensus_key.ml b/tezt/tests/consensus_key.ml index 7392fdaa8abf0f9d06fa95f6bd06fbc2a5bc09fc..32e33c41b1d39380c464f7317d4423356517b89d 100644 --- a/tezt/tests/consensus_key.ml +++ b/tezt/tests/consensus_key.ml @@ -66,6 +66,11 @@ let blocks_per_cycle = 4 let preserved_cycles = 1 +(* FIXME: https://gitlab.com/tezos/tezos/-/issues/4243 + Instead of [~expect_failure:true], the helpers should take a + function that identifies which error should happen, to avoid the + tests succeeding for wrong reasons. *) + let test_update_consensus_key = Protocol.register_test ~__FILE__ @@ -333,10 +338,7 @@ let test_update_consensus_key = client in - let* old_balance = Client.get_balance_for ~account:destination.alias client in - let* old_balance5 = - Client.get_balance_for ~account:Constant.bootstrap5.alias client - in + Log.info "Inject a valid drain..." ; let* () = Client.drain_delegate ~delegate:Constant.bootstrap4.alias @@ -344,49 +346,34 @@ let test_update_consensus_key = ~destination:destination.alias client in + Log.info + "Check that after a drain, the mempool rejects a manager operation from \ + the same manager..." ; let* () = Client.transfer + ~expect_failure:true ~burn_cap:Tez.one ~amount:(Tez.of_int 1) ~giver:Constant.bootstrap4.alias ~receiver:Constant.bootstrap5.alias client in + Log.info "Bake and check the effects of the valid drain..." ; + let* old_balance = Client.get_balance_for ~account:destination.alias client in let* () = Client.bake_for_and_wait ~keys:[Constant.bootstrap1.alias] client in - Log.info - "Check that other manager operations are not included after a drain..." ; - let* () = - let* json = - RPC.get_chain_mempool_pending_operations () |> RPC.Client.call client - in - let delayed_op_kind = - JSON.( - json |-> "branch_delayed" |> geti 0 |-> "contents" |> geti 0 |-> "kind" - |> encode) - in - Check.((delayed_op_kind = "\"transaction\"") string) - ~error_msg: - "The transaction is not in the branch_delayed pool (expected %R, got \ - %L)" ; - Lwt.return_unit + let* new_balance4 = + Client.get_balance_for ~account:Constant.bootstrap4.alias client in - Log.info "The manager account has been drained..." ; - let* b = Client.get_balance_for ~account:Constant.bootstrap4.alias client in - Check.((b = Tez.zero) Tez.typ) ~error_msg:"Manager balance is not empty" ; + Check.(new_balance4 = Tez.zero) + Tez.typ + ~error_msg:"Drained account should be empty but its balance is %L." ; let* new_balance = Client.get_balance_for ~account:destination.alias client in Check.(old_balance < new_balance) Tez.typ - ~error_msg:"Destination account has not been credited" ; - let* new_balance5 = - Client.get_balance_for ~account:Constant.bootstrap5.alias client - in - Check.(new_balance5 = old_balance5) - Tez.typ - ~error_msg:"Manager operation was included" ; + ~error_msg:"Destination account of the drain has not been credited." ; Log.info - "Check that a drain conflicts with (ie is not included after) a manager \ - operation of the same delegate..." ; + "Check that a drain replaces a manager operation from the same delegate..." ; let* () = Client.transfer ~burn_cap:Tez.one @@ -397,37 +384,53 @@ let test_update_consensus_key = in let* () = Client.drain_delegate - ~expect_failure:true ~delegate:Constant.bootstrap3.alias ~consensus_key:key_a.alias ~destination:destination.alias client in - let* old_balance3 = - Client.get_balance_for ~account:Constant.bootstrap3.alias client + let* () = + let* json = + RPC.get_chain_mempool_pending_operations () |> RPC.Client.call client + in + let replaced_op = JSON.(json |-> "outdated" |> geti 0) in + let replaced_op_kind = + JSON.(replaced_op |-> "contents" |> geti 0 |-> "kind" |> as_string) + in + Check.((replaced_op_kind = "transaction") string) + ~error_msg: + "Expected the replaced transaction to be in the outdated pool, but \ + instead found %L." ; + let replaced_op_err = + JSON.(replaced_op |-> "error" |> geti 0 |-> "id" |> as_string) + in + Check.((replaced_op_err = "prevalidation.operation_replacement") string) + ~error_msg: + "The replaced transaction has an unexpected error (expected %R, got \ + %L)." ; + Lwt.return_unit in + let* old_balance = Client.get_balance_for ~account:destination.alias client in let* old_balance5 = Client.get_balance_for ~account:Constant.bootstrap5.alias client in - let* old_balance = Client.get_balance_for ~account:destination.alias client in - let* () = Client.bake_for_and_wait ~keys:[Constant.bootstrap1.alias] client in - - let* new_balance5 = - Client.get_balance_for ~account:Constant.bootstrap5.alias client + let* new_balance3 = + Client.get_balance_for ~account:Constant.bootstrap3.alias client in - let* new_balance = Client.get_balance_for ~account:destination.alias client in - Check.(old_balance = new_balance) + Check.(new_balance3 = Tez.zero) Tez.typ - ~error_msg:"Drain operation was included (destination balance changed)" ; - Check.(old_balance3 > Tez.zero) + ~error_msg:"Drained account should be empty but its balance is %L." ; + let* new_balance = Client.get_balance_for ~account:destination.alias client in + Check.(old_balance < new_balance) Tez.typ - ~error_msg: - "Drain operation was included (delegate balance changed: old %L versus \ - new %R)" ; - Check.(old_balance5 < new_balance5) + ~error_msg:"Destination account of the drain has not been credited." ; + let* new_balance5 = + Client.get_balance_for ~account:Constant.bootstrap5.alias client + in + Check.(old_balance5 = new_balance5) Tez.typ - ~error_msg:"Destination account has not been credited" ; + ~error_msg:"Destination of the transaction has been credited." ; unit diff --git a/tezt/tests/operation_validation.ml b/tezt/tests/operation_validation.ml index df517667562490b686f196a9c72db22aff828290..a0838873ef509304d5e484940b81bc87700048cf 100644 --- a/tezt/tests/operation_validation.ml +++ b/tezt/tests/operation_validation.ml @@ -77,13 +77,23 @@ let check_validate_1m_restriction_node = unit in + let new_mempool_conflict_rex = + rex + {|The operation [\w\d]+ cannot be added because the mempool already contains a conflicting operation that should not be replaced \(e\.g\. an operation from the same manager with better fees\)\.|} + in + let conflict_rex_with_precheck, conflict_rex_without_precheck = + if Protocol.number protocol <= 014 (* Kathmandu *) then + ( rex "Only one manager operation per manager per block allowed", + rex "Manager .* already has the operation .* in the current block." ) + else (new_mempool_conflict_rex, new_mempool_conflict_rex) + in let* () = inject_two_manager_operations_and_check_error ~disable_operations_precheck:false - (rex "Only one manager operation per manager per block allowed") + conflict_rex_with_precheck in inject_two_manager_operations_and_check_error ~disable_operations_precheck:true - (rex "Manager.*already has the operation.*in the current block.") + conflict_rex_without_precheck let register ~protocols = check_validate_1m_restriction_node protocols diff --git a/tezt/tests/prevalidator.ml b/tezt/tests/prevalidator.ml index c8a5bec05e5c9f40b79307e4a187c3de9d7c7de2..8c55aaee97e7e87a33d09bb9bfa52409d1b15386 100644 --- a/tezt/tests/prevalidator.ml +++ b/tezt/tests/prevalidator.ml @@ -35,24 +35,24 @@ These events are defined in [lib_workers/worker_events.ml], and the section name comes from the [Name] module given as argument to [Worker.MakeGroup] in either [lib_shell/prevalidator_internal.ml] - (for Lima and Alpha) or [lib_shell/legacy_prevalidator_internal.ml] - (for Kathmandu). They should not be confused with the + (for protocols Lima and up) or [lib_shell/legacy_prevalidator_internal.ml] + (for Kathmandu and older). They should not be confused with the prevalidator-specific events from [lib_shell/prevalidator_events.ml], which are always in the "prevalidator" section regardless of the protocol version. *) -let prevalidator_worker_event_section = function - | Protocol.Kathmandu -> "legacy_prevalidator" - | Lima | Mumbai | Alpha -> "prevalidator" +let prevalidator_worker_event_section protocol = + if Protocol.number protocol <= 014 (* Kathmandu *) then "legacy_prevalidator" + else "prevalidator" (** The [event_sections_levels] argument that should be provided to {!Node.init} in order to observe all debug-level prevalidator events, depending on the protocol version. See {!prevalidator_worker_event_section} regarding the section names. *) -let prevalidator_debug = function - | Protocol.Kathmandu -> - [("prevalidator", `Debug); ("legacy_prevalidator", `Debug)] - | Lima | Mumbai | Alpha -> [("prevalidator", `Debug)] +let prevalidator_debug protocol = + if Protocol.number protocol <= 014 (* Kathmandu *) then + [("prevalidator", `Debug); ("legacy_prevalidator", `Debug)] + else [("prevalidator", `Debug)] (* FIXME: https://gitlab.com/tezos/tezos/-/issues/1657 @@ -829,9 +829,11 @@ module Revamped = struct the [force] argument of [inject] defaults to [false] so the faulty \ injected operation is discarded." ; let error = - rex - ~opts:[`Dotall] - "Only one manager operation per manager per block allowed" + if Protocol.number protocol <= 014 (* Kathmandu *) then + rex "Only one manager operation per manager per block allowed" + else + rex + {|The operation [\w\d]+ cannot be added because the mempool already contains a conflicting operation that should not be replaced \(e\.g\. an operation from the same manager with better fees\)\.|} in let* (`OpHash _) = Operation.Manager.( @@ -1048,7 +1050,7 @@ module Revamped = struct Check.( (!to_reclassified = false) bool - ~error_msg:"a flush have been triggered after the ban") ; + ~error_msg:"A flush has been triggered after the ban.") ; unit (* This test checks that on a ban of an applied operation the flush respect diff --git a/tezt/tests/replace_by_fees.ml b/tezt/tests/replace_by_fees.ml index 7962d9b3aa5bc7edc717e1423945322ae8766501..66e34d7709a2e8e00b422d0f8d3747099a334a89 100644 --- a/tezt/tests/replace_by_fees.ml +++ b/tezt/tests/replace_by_fees.ml @@ -191,7 +191,11 @@ let mk_batch client op_data size = *) let replacement_test_helper ~title ~__LOC__ ~op1 ?(size1 = 1) ~op2 ?(size2 = 1) ~incheck1 ~incheck2 ~postcheck2 ?op3 ?(size3 = 1) ?incheck3 ?postcheck3 () = - Protocol.register_test ~__FILE__ ~title ~tags:["replace"; "fee"; "manager"] + Protocol.register_test + ~__FILE__ + ~title + ~tags:["replace"; "fee"; "manager"] + ~supports:(Protocol.From_protocol 015) @@ fun protocol -> let* nodes = Helpers.init ~protocol () in let client = nodes.main.client in @@ -474,7 +478,10 @@ let sum_fees_overflow = ~op2:{default_op with fee = max_int} ~size2:10 ~incheck1:check_applied - ~incheck2:check_refused + (* We notice that the source cannot afford the fees before finding + out that the fees overflow, hence the branch_delayed + classification instead of refused. *) + ~incheck2:check_branch_delayed ~postcheck2:(fun nodes h1 _h2 -> op_is_applied ~__LOC__ nodes h1) ()