From 332a23a9d5aa6dbdd12990d0fc2588ea50de29c1 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Tue, 11 Oct 2022 10:31:18 +0200 Subject: [PATCH 01/17] Shell: extract operation def and parsing from Prevalidation into a new module Shell_operation. Indeed, these are mostly independent from the rest of Prevalidation. Moreover, this will allow Prevalidation to use Prevalidator_classification.classification without causing cyclic dependencies (since Prevalidator_classification uses the operation type that gets moved from Prevalidation to Shell_operation). --- manifest/main.ml | 2 +- src/lib_shell/prevalidation.ml | 65 +-------- src/lib_shell/prevalidation.mli | 63 +-------- src/lib_shell/prevalidator_classification.ml | 39 +++--- src/lib_shell/prevalidator_classification.mli | 41 +++--- src/lib_shell/prevalidator_internal.ml | 46 +++---- .../prevalidator_pending_operations.ml | 6 +- .../prevalidator_pending_operations.mli | 16 +-- src/lib_shell/shell_operation.ml | 99 ++++++++++++++ src/lib_shell/shell_operation.mli | 104 ++++++++++++++ src/lib_shell/test/dune | 4 +- src/lib_shell/test/generators.ml | 33 ++--- src/lib_shell/test/generators_tree.ml | 36 ++--- src/lib_shell/test/test_prevalidation_t.ml | 127 +++++++----------- .../test/test_prevalidator_classification.ml | 73 +++++----- ..._prevalidator_classification_operations.ml | 49 +++---- .../test_prevalidator_pending_operations.ml | 2 +- ...evalidation.ml => test_shell_operation.ml} | 19 +-- 18 files changed, 423 insertions(+), 401 deletions(-) create mode 100644 src/lib_shell/shell_operation.ml create mode 100644 src/lib_shell/shell_operation.mli rename src/lib_shell/test/{test_prevalidation.ml => test_shell_operation.ml} (93%) diff --git a/manifest/main.ml b/manifest/main.ml index 7b1274be0846..68b55b4d32fd 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -5375,7 +5375,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_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index aeb1fa3d3ce6..481bfb97ca86 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -35,14 +35,7 @@ start with the "legacy" prefix and will be removed when Lima is activated on Mainnet. *) -open Validation_errors - -type 'protocol_operation operation = { - hash : Tezos_crypto.Operation_hash.t; - raw : Operation.t; - protocol : 'protocol_operation; - count_successful_prechecks : int; -} +open Shell_operation type error += Endorsement_branch_not_live @@ -80,14 +73,6 @@ module type T = sig type t - val parse : - Tezos_crypto.Operation_hash.t -> - Operation.t -> - protocol_operation operation tzresult - - val increment_successful_precheck : - protocol_operation operation -> protocol_operation operation - val create : chain_store -> predecessor:Store.Block.t -> @@ -117,14 +102,6 @@ module type T = sig 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) : @@ -155,35 +132,6 @@ module MakeAbstract | 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 () = (* The prevalidation module receives input from the system byt handles protocol values. It translates timestamps here. *) @@ -301,17 +249,6 @@ module Make (Proto : Tezos_protocol_environment.PROTOCOL) : MakeAbstract (Production_chain_store) (Proto) 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 2e673b9e5428..88927c634d96 100644 --- a/src/lib_shell/prevalidation.mli +++ b/src/lib_shell/prevalidation.mli @@ -39,24 +39,6 @@ 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} *) @@ -78,26 +60,6 @@ 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. *) val create : @@ -120,7 +82,8 @@ module type T = sig (** [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 + val apply_operation : + t -> protocol_operation Shell_operation.operation -> result Lwt.t (** [validation_state t] returns the subset of [t] corresponding to the type {!validation_state} of the protocol. *) @@ -136,7 +99,8 @@ module type T = sig (** Returns operations for which {!apply_operation} returned [Applied _] so far. *) val to_applied : - t -> (protocol_operation operation * operation_receipt) list + t -> + (protocol_operation Shell_operation.operation * operation_receipt) list end end @@ -151,25 +115,6 @@ module Make : functor (Proto : Tezos_protocol_environment.PROTOCOL) -> (**/**) 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 diff --git a/src/lib_shell/prevalidator_classification.ml b/src/lib_shell/prevalidator_classification.ml index ecfa3230605a..580c26d9a634 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 1176538c8d73..59e98c2fcb04 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 fb43a78be04b..b4d958ef4d3c 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 @@ -146,7 +147,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 +196,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; @@ -282,15 +282,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 +333,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 @@ -434,7 +430,7 @@ module Make_s prevalidation_t validation_state in - let new_op = Prevalidation_t.increment_successful_precheck op in + let new_op = increment_successful_precheck op in `Passed_precheck (filter_state, prevalidation_t, new_op, replacement) | (`Branch_delayed _ | `Branch_refused _ | `Refused _ | `Outdated _) as errs -> @@ -625,7 +621,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 +717,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 +726,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 +778,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." @@ -928,7 +926,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 @@ -1199,7 +1197,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 +1207,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 +1220,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 +1250,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 +1289,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 +1301,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 +1309,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 +1371,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 diff --git a/src/lib_shell/prevalidator_pending_operations.ml b/src/lib_shell/prevalidator_pending_operations.ml index c47cb1045b3d..9f6762fec385 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 cf7ffbd4b5c2..0e2d9f7b3589 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 000000000000..39f03f970572 --- /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 000000000000..d24888df6283 --- /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/test/dune b/src/lib_shell/test/dune index 140ed6254f84..f887b38a42fe 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 31204b79b23e..3e0a097294e1 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 11a77b1e37ea..2cb2f9e91e33 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 cd59889aa279..5178b88bbbbc 100644 --- a/src/lib_shell/test/test_prevalidation_t.ml +++ b/src/lib_shell/test/test_prevalidation_t.ml @@ -60,8 +60,6 @@ module Mock_protocol : Lwt_result_syntax.return_unit end -module Internal_for_tests = Prevalidation.Internal_for_tests - module Init = struct let genesis_protocol = Tezos_crypto.Protocol_hash.of_b58check_exn @@ -108,13 +106,8 @@ module Init = struct 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 +116,18 @@ let create_prevalidation let chain_id () = Init.chain_id end in - let module Prevalidation_t = - Internal_for_tests.Make (Chain_store) (Mock_protocol) + (module Chain_store : Prevalidation.Internal_for_tests.CHAIN_STORE + with type chain_store = unit) + +module MakePrevalidation = Prevalidation.Internal_for_tests.Make + +let make_prevalidation_mock_protocol ctxt = + let (module Chain_store) = make_chain_store ctxt in + let module Prevalidation_t = MakePrevalidation (Chain_store) (Mock_protocol) in (module Prevalidation_t : Prevalidation.T - with type operation_receipt = unit - and type validation_state = unit - and type chain_store = Chain_store.chain_store) + with type protocol_operation = Mock_protocol.operation + and type chain_store = unit) let now () = Time.System.to_protocol (Tezos_base.Time.System.now ()) @@ -141,26 +139,21 @@ let test_create 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 Prevalidation) = - create_prevalidation (module Mock_protocol) ctxt - in + let (module P) = make_prevalidation_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* _ = P.create chain_store ~predecessor ~live_operations ~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,7 +161,7 @@ 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) = @@ -179,12 +172,8 @@ let prevalidation_operations_gen (type a) (** 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 @@ -194,13 +183,11 @@ 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) - in + let ops = mk_ops () in let predecessor : Store.Block.t = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in + let (module P) = make_prevalidation_mock_protocol 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 @@ -229,54 +216,50 @@ let mk_rand () = (** [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) = +let mk_live_operations rand ops = List.fold_left - (fun acc (op : _ Prevalidation.operation) -> + (fun acc op -> if Random.State.bool rand then Tezos_crypto.Operation_hash.Set.add - (Internal_for_tests.to_raw op |> Operation.hash) + (Shell_operation.Internal_for_tests.to_raw op |> Operation.hash) acc else acc) Tezos_crypto.Operation_hash.Set.empty ops +module Proto_random_apply : + Tezos_protocol_environment.PROTOCOL + with type operation_data = unit + and type operation = Mock_protocol.operation = struct + include Mock_protocol + + let apply_operation _ _ _ = + let b = QCheck2.Gen.(generate1 bool) in + Lwt.return (if b then Ok ((), ()) else error_with "Operation doesn't apply") +end + (** Test that [Prevalidation.apply_operations] returns [Outdated] for operations in [live_operations] *) let test_apply_operation_live_operations 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 ops = mk_ops () 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 (module Chain_store) = make_chain_store ctxt in + let module P = MakePrevalidation (Chain_store) (Proto_random_apply) 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) + (Shell_operation.Internal_for_tests.to_raw op |> Operation.hash) live_operations in - let apply_op pv (op : _ Prevalidation.operation) = + let apply_op pv op = let*! application_result = P.apply_operation pv op in let next_pv, result_is_outdated = match application_result with @@ -298,32 +281,18 @@ 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) - in - let (module P) = create_prevalidation (module Protocol) ctxt in - let ops : P.protocol_operation Prevalidation.operation list = - mk_ops (module P) - in + let ops = mk_ops () 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 (module Chain_store) = make_chain_store ctxt in + let module P = MakePrevalidation (Chain_store) (Proto_random_apply) 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 apply_op pv op = let applied_before = to_applied pv in let*! application_result = P.apply_operation pv op in let next_pv, result_is_applied = diff --git a/src/lib_shell/test/test_prevalidator_classification.ml b/src/lib_shell/test/test_prevalidator_classification.ml index ecb79bf1fba6..34187e058e96 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 46ad3eebee63..11969fac0efc 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 511ba194105e..20f7ef9a2828 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 2c76a04d72ca..1dce02e0e9fb 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", [ -- GitLab From d9cc56aa30cc990d76b8556fd1a7decc0daf6c0c Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Thu, 20 Oct 2022 16:24:39 +0200 Subject: [PATCH 02/17] Plugin: implement a conflict_handler for add_operation This function will be needed by the shell mempool, to give as argument to Proto.Mempool.add_operation --- src/proto_alpha/lib_plugin/mempool.ml | 46 +++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 2c578221bfdc..be9f1a6205cd 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -1392,3 +1392,49 @@ let post_filter config ~(filter_state : state) ~validation_state_before:_ handle_manager result | Cons_result (Manager_operation_result _, _) as result -> handle_manager result) + +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 + let* new_fee, new_gas_limit = + get_manager_operation_gas_and_fee new_protocol_data.contents + in + return + (better_fees_and_ratio + config + old_gas_limit + old_fee + new_gas_limit + new_fee) + in + match new_op_is_better with + | Ok b when b -> `Replace + | Ok _ | Error _ -> `Keep + else if Operation.compare existing_operation new_operation < 0 then `Replace + else `Keep -- GitLab From 3e203fa2a743a584e9b1916165d35d2155cbf7cd Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Tue, 8 Nov 2022 18:01:47 +0100 Subject: [PATCH 03/17] Plugin: implement add_operation_and_enforce_mempool_bound This function will be called by the shell after validating each operation. It will be removed in the future once the shell becomes responsible for bounding the number of operations in the mempool. However, this will not happen in this MR, just to avoid making the MR too large. --- src/proto_alpha/lib_plugin/mempool.ml | 88 +++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index be9f1a6205cd..8a4d842e21b6 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -1393,6 +1393,94 @@ let post_filter config ~(filter_state : state) ~validation_state_before:_ | Cons_result (Manager_operation_result _, _) as result -> handle_manager result) +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 op.protocol_data.contents) + in + 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 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, 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 + oph + {shell = op.shell; protocol_data} + in + match protocol_data.contents with + | 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 -- GitLab From 84179bc03d2df15c98ba9d37d8b8dd377346dd72 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Wed, 19 Oct 2022 16:14:09 +0200 Subject: [PATCH 04/17] Shell: make a legacy copy of Shell_plugin.FILTER --- src/lib_shell/legacy_mempool_plugin.ml | 125 ++++++++++++++++++++ src/lib_shell/legacy_mempool_plugin.mli | 146 ++++++++++++++++++++++++ 2 files changed, 271 insertions(+) create mode 100644 src/lib_shell/legacy_mempool_plugin.ml create mode 100644 src/lib_shell/legacy_mempool_plugin.mli diff --git a/src/lib_shell/legacy_mempool_plugin.ml b/src/lib_shell/legacy_mempool_plugin.ml new file mode 100644 index 000000000000..cabf30d120a8 --- /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 000000000000..8c85ccf59808 --- /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 -- GitLab From 81bef0fd216ae5ef27ae175d3b31a07c8647259b Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Wed, 19 Oct 2022 16:16:20 +0200 Subject: [PATCH 05/17] Shell & old plugins: use recent or legacy filter depending on proto --- src/lib_shell/chain_validator.ml | 8 ++-- src/lib_shell/legacy_prevalidator_internal.ml | 9 ++-- .../legacy_prevalidator_internal.mli | 4 +- src/lib_shell/prevalidator.ml | 26 ++++++----- src/lib_shell/prevalidator.mli | 2 +- src/lib_shell/shell_plugin.ml | 43 +++++++++++++------ src/lib_shell/shell_plugin.mli | 27 ++++++++++-- .../lib_plugin/plugin_registerer.ml | 2 +- .../lib_plugin/plugin_registerer.ml | 2 +- .../lib_plugin/plugin_registerer.ml | 2 +- 10 files changed, 83 insertions(+), 42 deletions(-) diff --git a/src/lib_shell/chain_validator.ml b/src/lib_shell/chain_validator.ml index a4850c9fcd1a..c178ec4d624b 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_prevalidator_internal.ml b/src/lib_shell/legacy_prevalidator_internal.ml index 119dd32bef9e..c439968208a7 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 3da7595c1114..e00d725e9580 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/prevalidator.ml b/src/lib_shell/prevalidator.ml index 356c0011b23b..fb3e77128312 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 644163bdf931..68756c2aabde 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/shell_plugin.ml b/src/lib_shell/shell_plugin.ml index f0c87be4b192..e4140335400f 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"),*) @@ -96,7 +97,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 = struct module Proto = Proto module Mempool = struct @@ -148,23 +150,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 +166,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 +178,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 1e01d7cedf01..9ef88ae8593d 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 @@ -168,9 +172,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 +199,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/proto_012_Psithaca/lib_plugin/plugin_registerer.ml b/src/proto_012_Psithaca/lib_plugin/plugin_registerer.ml index 8073f4644dbc..926ed3dee323 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 8073f4644dbc..926ed3dee323 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 ad4a3eac57c0..7111a6ab395a 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) -- GitLab From 19119063d02074cf7457040aa2b4a05fbd97ac3e Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Thu, 20 Oct 2022 16:22:10 +0200 Subject: [PATCH 06/17] Shell & Lima Mumbai plugins: add signatures of new plugin functions and copy alpha plugin changes to Lima and Mumbai plugins --- src/lib_shell/shell_plugin.ml | 25 ++++ src/lib_shell/shell_plugin.mli | 40 ++++++ src/proto_015_PtLimaPt/lib_plugin/mempool.ml | 134 +++++++++++++++++++ src/proto_016_PtMumbai/lib_plugin/mempool.ml | 134 +++++++++++++++++++ 4 files changed, 333 insertions(+) diff --git a/src/lib_shell/shell_plugin.ml b/src/lib_shell/shell_plugin.ml index e4140335400f..718db29b841e 100644 --- a/src/lib_shell/shell_plugin.ml +++ b/src/lib_shell/shell_plugin.ml @@ -87,6 +87,23 @@ module type FILTER = sig validation_state_after:Proto.validation_state -> Proto.operation * Proto.operation_receipt -> [`Passed_postfilter of state | `Refused of tztrace] Lwt.t + + val add_operation_and_enforce_mempool_bound : + ?replace:Tezos_crypto.Operation_hash.t -> + Proto.validation_state -> + config -> + 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 @@ -128,6 +145,14 @@ module No_filter (Proto : Registered_protocol.T) : 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 diff --git a/src/lib_shell/shell_plugin.mli b/src/lib_shell/shell_plugin.mli index 9ef88ae8593d..b7c7e9bc9959 100644 --- a/src/lib_shell/shell_plugin.mli +++ b/src/lib_shell/shell_plugin.mli @@ -138,6 +138,46 @@ module type FILTER = sig validation_state_after:Proto.validation_state -> Proto.operation * Proto.operation_receipt -> [`Passed_postfilter of state | `Refused of tztrace] Lwt.t + + (** 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 -> + 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 diff --git a/src/proto_015_PtLimaPt/lib_plugin/mempool.ml b/src/proto_015_PtLimaPt/lib_plugin/mempool.ml index 626f5b82e4ea..8f99da4451d2 100644 --- a/src/proto_015_PtLimaPt/lib_plugin/mempool.ml +++ b/src/proto_015_PtLimaPt/lib_plugin/mempool.ml @@ -1392,3 +1392,137 @@ let post_filter config ~(filter_state : state) ~validation_state_before:_ handle_manager result | Cons_result (Manager_operation_result _, _) as result -> handle_manager result) + +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 op.protocol_data.contents) + in + 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 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, 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 + oph + {shell = op.shell; protocol_data} + in + match protocol_data.contents with + | 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 + let* new_fee, new_gas_limit = + get_manager_operation_gas_and_fee new_protocol_data.contents + in + return + (better_fees_and_ratio + config + old_gas_limit + old_fee + new_gas_limit + new_fee) + in + match new_op_is_better with + | Ok b when b -> `Replace + | Ok _ | Error _ -> `Keep + else if Operation.compare existing_operation new_operation < 0 then `Replace + else `Keep diff --git a/src/proto_016_PtMumbai/lib_plugin/mempool.ml b/src/proto_016_PtMumbai/lib_plugin/mempool.ml index 2c578221bfdc..8a4d842e21b6 100644 --- a/src/proto_016_PtMumbai/lib_plugin/mempool.ml +++ b/src/proto_016_PtMumbai/lib_plugin/mempool.ml @@ -1392,3 +1392,137 @@ let post_filter config ~(filter_state : state) ~validation_state_before:_ handle_manager result | Cons_result (Manager_operation_result _, _) as result -> handle_manager result) + +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 op.protocol_data.contents) + in + 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 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, 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 + oph + {shell = op.shell; protocol_data} + in + match protocol_data.contents with + | 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 + let* new_fee, new_gas_limit = + get_manager_operation_gas_and_fee new_protocol_data.contents + in + return + (better_fees_and_ratio + config + old_gas_limit + old_fee + new_gas_limit + new_fee) + in + match new_op_is_better with + | Ok b when b -> `Replace + | Ok _ | Error _ -> `Keep + else if Operation.compare existing_operation new_operation < 0 then `Replace + else `Keep -- GitLab From f2f030af3f9866d32a8efa71aafc610c9791bff6 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 7 Nov 2022 14:18:07 +0100 Subject: [PATCH 07/17] Shell: pass plugin filter on to prevalidation --- src/lib_shell/prevalidation.ml | 24 +++++++++++----------- src/lib_shell/prevalidation.mli | 16 +++++++-------- src/lib_shell/prevalidator_internal.ml | 2 +- src/lib_shell/test/test_prevalidation_t.ml | 22 ++++++++++++++++---- 4 files changed, 39 insertions(+), 25 deletions(-) diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index 481bfb97ca86..9e60cfc3a24e 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -102,14 +102,14 @@ module type T = sig end end -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 + with type protocol_operation = Filter.Proto.operation + and type operation_receipt = Filter.Proto.operation_receipt + and type validation_state = Filter.Proto.validation_state and type chain_store = Chain_store.chain_store = struct + module Proto = Filter.Proto + type protocol_operation = Proto.operation type operation_receipt = Proto.operation_receipt @@ -240,13 +240,13 @@ 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 operation_receipt = Filter.Proto.operation_receipt + and type validation_state = Filter.Proto.validation_state + and type chain_store = Store.chain_store = + MakeAbstract (Production_chain_store) (Filter) module Internal_for_tests = struct module type CHAIN_STORE = CHAIN_STORE diff --git a/src/lib_shell/prevalidation.mli b/src/lib_shell/prevalidation.mli index 88927c634d96..1c936d3ba3a0 100644 --- a/src/lib_shell/prevalidation.mli +++ b/src/lib_shell/prevalidation.mli @@ -105,11 +105,11 @@ module type T = sig 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 operation_receipt = Filter.Proto.operation_receipt + and type validation_state = Filter.Proto.validation_state and type chain_store = Store.chain_store (**/**) @@ -136,11 +136,11 @@ 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 operation_receipt = Filter.Proto.operation_receipt + and type validation_state = Filter.Proto.validation_state and type chain_store = Chain_store.chain_store end diff --git a/src/lib_shell/prevalidator_internal.ml b/src/lib_shell/prevalidator_internal.ml index b4d958ef4d3c..3620449abad9 100644 --- a/src/lib_shell/prevalidator_internal.ml +++ b/src/lib_shell/prevalidator_internal.ml @@ -1645,7 +1645,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) diff --git a/src/lib_shell/test/test_prevalidation_t.ml b/src/lib_shell/test/test_prevalidation_t.ml index 5178b88bbbbc..859d187b800e 100644 --- a/src/lib_shell/test/test_prevalidation_t.ml +++ b/src/lib_shell/test/test_prevalidation_t.ml @@ -60,6 +60,19 @@ module Mock_protocol : Lwt_result_syntax.return_unit 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 = Shell_plugin.No_filter (struct + let hash = Protocol_hash.zero + + include Proto + + let complete_b58prefix _ = assert false +end) + +module Mock_filter = MakeFilter (Mock_protocol) + module Init = struct let genesis_protocol = Tezos_crypto.Protocol_hash.of_b58check_exn @@ -123,8 +136,7 @@ module MakePrevalidation = Prevalidation.Internal_for_tests.Make let make_prevalidation_mock_protocol ctxt = let (module Chain_store) = make_chain_store ctxt in - let module Prevalidation_t = MakePrevalidation (Chain_store) (Mock_protocol) - in + let module Prevalidation_t = MakePrevalidation (Chain_store) (Mock_filter) in (module Prevalidation_t : Prevalidation.T with type protocol_operation = Mock_protocol.operation and type chain_store = unit) @@ -238,6 +250,8 @@ module Proto_random_apply : Lwt.return (if b then Ok ((), ()) else error_with "Operation doesn't apply") end +module Filter_random_apply = MakeFilter (Proto_random_apply) + (** Test that [Prevalidation.apply_operations] returns [Outdated] for operations in [live_operations] *) let test_apply_operation_live_operations ctxt = @@ -252,7 +266,7 @@ let test_apply_operation_live_operations ctxt = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in let (module Chain_store) = make_chain_store ctxt in - let module P = MakePrevalidation (Chain_store) (Proto_random_apply) in + let module P = MakePrevalidation (Chain_store) (Filter_random_apply) in let* pv = P.create chain_store ~predecessor ~live_operations ~timestamp () in let op_in_live_operations op = Tezos_crypto.Operation_hash.Set.mem @@ -289,7 +303,7 @@ let test_apply_operation_applied ctxt = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in let (module Chain_store) = make_chain_store ctxt in - let module P = MakePrevalidation (Chain_store) (Proto_random_apply) in + let module P = MakePrevalidation (Chain_store) (Filter_random_apply) 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 = -- GitLab From 95e1832193c79fa3b753d4c9538d409fec4c575f Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Fri, 7 Oct 2022 17:10:03 +0200 Subject: [PATCH 08/17] Shell: call Proto.Mempool.add_operation instead of plugin precheck and remove no longer reachable calls to apply_operation and post_filter. Also remove the live_operations field of the prevalidation state because it was only used in apply_operation. The tests in test_prevalidation_t.ml will be further updated in future commits. --- src/lib_shell/prevalidation.ml | 351 ++++++++++++++------- src/lib_shell/prevalidation.mli | 89 ++++-- src/lib_shell/prevalidator_internal.ml | 192 +++-------- src/lib_shell/prevalidator_internal.mli | 9 +- src/lib_shell/shell_plugin.ml | 2 +- src/lib_shell/shell_plugin.mli | 2 +- src/lib_shell/test/test_prevalidation_t.ml | 237 +++++++------- 7 files changed, 452 insertions(+), 430 deletions(-) diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index 9e60cfc3a24e..bd622cfaadb9 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -37,19 +37,53 @@ open Shell_operation -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 @@ -65,169 +99,245 @@ end module type T = sig type protocol_operation - type operation_receipt - type validation_state + type filter_state + + type filter_config + type chain_store 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 - - val pp_result : Format.formatter -> result -> unit - module Internal_for_tests : sig - val to_applied : - t -> (protocol_operation operation * operation_receipt) list + val get_valid_operations : + t -> protocol_operation Tezos_crypto.Operation_hash.Map.t end end module MakeAbstract (Chain_store : CHAIN_STORE) (Filter : Shell_plugin.FILTER) : T with type protocol_operation = Filter.Proto.operation - and type operation_receipt = Filter.Proto.operation_receipt 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 = struct module Proto = Filter.Proto type protocol_operation = Proto.operation - type operation_receipt = Proto.operation_receipt - 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 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 + 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 {validation_state; application_state; applied = []; live_operations} + 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} - - 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 - module Internal_for_tests = struct - let to_applied {applied; _} = applied + let get_valid_operations {mempool; _} = Proto.Mempool.operations mempool end end @@ -243,8 +353,9 @@ end module Make (Filter : Shell_plugin.FILTER) : T with type protocol_operation = Filter.Proto.operation - and type operation_receipt = Filter.Proto.operation_receipt 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) diff --git a/src/lib_shell/prevalidation.mli b/src/lib_shell/prevalidation.mli index 1c936d3ba3a0..7fc231437f82 100644 --- a/src/lib_shell/prevalidation.mli +++ b/src/lib_shell/prevalidation.mli @@ -44,14 +44,16 @@ module type T = sig 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 @@ -61,46 +63,63 @@ module type T = sig type t (** 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 Shell_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 - - val pp_result : Format.formatter -> result -> unit - module Internal_for_tests : sig - (** Returns operations for which {!apply_operation} returned [Applied _] - so far. *) - val to_applied : - t -> - (protocol_operation Shell_operation.operation * operation_receipt) list + (** 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 end end @@ -108,8 +127,9 @@ end module Make : functor (Filter : Shell_plugin.FILTER) -> T with type protocol_operation = Filter.Proto.operation - and type operation_receipt = Filter.Proto.operation_receipt 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 (**/**) @@ -140,7 +160,8 @@ module Internal_for_tests : sig -> T with type protocol_operation = Filter.Proto.operation - and type operation_receipt = Filter.Proto.operation_receipt 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 end diff --git a/src/lib_shell/prevalidator_internal.ml b/src/lib_shell/prevalidator_internal.ml index 3620449abad9..e663c6f40143 100644 --- a/src/lib_shell/prevalidator_internal.ml +++ b/src/lib_shell/prevalidator_internal.ml @@ -76,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; @@ -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 @@ -366,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 @@ -406,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 = 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: @@ -467,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]. @@ -902,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 = @@ -1053,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 @@ -1449,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 () @@ -1494,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 @@ -1503,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 @@ -1530,7 +1424,7 @@ module Make { classification; parameters; - predecessor; + predecessor = head; timestamp = timestamp_system; live_blocks; live_operations; @@ -1572,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 = @@ -1702,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 8338ec39be4c..f115b4776c56 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/shell_plugin.ml b/src/lib_shell/shell_plugin.ml index 718db29b841e..b944e303bc36 100644 --- a/src/lib_shell/shell_plugin.ml +++ b/src/lib_shell/shell_plugin.ml @@ -115,7 +115,7 @@ module type RPC = sig end module No_filter (Proto : Registered_protocol.T) : - FILTER with module Proto = Proto = struct + FILTER with module Proto = Proto and type Mempool.state = unit = struct module Proto = Proto module Mempool = struct diff --git a/src/lib_shell/shell_plugin.mli b/src/lib_shell/shell_plugin.mli index b7c7e9bc9959..e9abdce5b172 100644 --- a/src/lib_shell/shell_plugin.mli +++ b/src/lib_shell/shell_plugin.mli @@ -191,7 +191,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 diff --git a/src/lib_shell/test/test_prevalidation_t.ml b/src/lib_shell/test/test_prevalidation_t.ml index 859d187b800e..751dbc3056f5 100644 --- a/src/lib_shell/test/test_prevalidation_t.ml +++ b/src/lib_shell/test/test_prevalidation_t.ml @@ -63,8 +63,9 @@ 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 = Shell_plugin.No_filter (struct - let hash = Protocol_hash.zero + and type Proto.operation = Proto.operation + and type Mempool.state = unit = Shell_plugin.No_filter (struct + let hash = Tezos_crypto.Protocol_hash.zero include Proto @@ -73,6 +74,10 @@ end) module Mock_filter = MakeFilter (Mock_protocol) +let filter_state : Mock_filter.Mempool.state = () + +let filter_config = Mock_filter.Mempool.default_config + module Init = struct let genesis_protocol = Tezos_crypto.Protocol_hash.of_b58check_exn @@ -139,6 +144,8 @@ let make_prevalidation_mock_protocol ctxt = let module Prevalidation_t = MakePrevalidation (Chain_store) (Mock_filter) in (module Prevalidation_t : Prevalidation.T with type protocol_operation = Mock_protocol.operation + and type filter_state = Mock_filter.Mempool.state + and type filter_config = Mock_filter.Mempool.config and type chain_store = unit) let now () = Time.System.to_protocol (Tezos_base.Time.System.now ()) @@ -149,13 +156,10 @@ 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 timestamp : Time.Protocol.t = now () in let (module P) = make_prevalidation_mock_protocol ctxt in - let predecessor : Store.Block.t = - Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt - in - let* _ = P.create chain_store ~predecessor ~live_operations ~timestamp () in + let head = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in + let* _ = P.create chain_store ~head ~timestamp () in return_unit module Parser = Shell_operation.MakeParser (Mock_protocol) @@ -193,144 +197,142 @@ let mk_ops () = 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 ops = mk_ops () in - let predecessor : Store.Block.t = - Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt - in + let head = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in let (module P) = make_prevalidation_mock_protocol 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 _ -> + let* pv = P.create chain_store ~head ~timestamp () in + let add_op pv op = + let*! ( pv, + (_filter_state : P.filter_state), + (_op : Mock_protocol.operation Shell_operation.operation), + classification, + (_replacement : P.replacement) ) = + P.add_operation pv filter_state filter_config op + in + match classification with + | `Applied | `Prechecked | `Branch_refused _ | `Refused _ | `Outdated _ -> (* These cases should not happen because [Mock_protocol.apply_operation] is [assert false]. *) assert false - | Branch_delayed _ -> + | `Branch_delayed _ -> (* This is the only allowed case. *) Lwt.return pv in - let*! _ = List.fold_left_s apply_op pv ops in + let*! _ = List.fold_left_s add_op pv ops in return_unit -(** 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 rand ops = - List.fold_left - (fun acc op -> - if Random.State.bool rand then - Tezos_crypto.Operation_hash.Set.add - (Shell_operation.Internal_for_tests.to_raw op |> Operation.hash) - acc - else acc) - Tezos_crypto.Operation_hash.Set.empty - ops - -module Proto_random_apply : +module Proto_random_add_operation : Tezos_protocol_environment.PROTOCOL with type operation_data = unit and type operation = Mock_protocol.operation = struct include Mock_protocol - let apply_operation _ _ _ = - let b = QCheck2.Gen.(generate1 bool) in - Lwt.return (if b then Ok ((), ()) else error_with "Operation doesn't apply") + (** Toy mempool with a random [add_operation] function. + + Unlike [Mock_protocol.Mempool], this mempool's type [t] is an + actual state that keeps track of validated operations and can be + retrieved with [operations]. This allows the test below to check + that operations were correctly added or removed. *) + module Mempool = struct + include Mempool + open Tezos_crypto + + type t = operation Operation_hash.Map.t + + type validation_info = unit + + let init _ctxt _chain_id ~head_hash:_ ~head:_ ~cache:_ = + Lwt_result.return ((), 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 + QCheck2.Gen.( + generate1 (oneofl [`Added; `Replaced; `Unchanged; `Error; `Crash])) + with + | `Added -> + let state = Operation_hash.Map.add oph op state in + Lwt_result.return (state, Added) + | `Replaced -> + let removed = + match Operation_hash.Map.choose state with + | Some (hash, _) -> hash + | None -> Tezos_crypto.Operation_hash.zero + 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}) + | `Unchanged -> Lwt_result.return (state, Unchanged) + | `Error -> + let err = error_of_fmt "Error during protocol validation." in + Lwt_result.fail (Validation_error [err]) + | `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 -module Filter_random_apply = MakeFilter (Proto_random_apply) +module Filter_random_add_operation = MakeFilter (Proto_random_add_operation) -(** Test that [Prevalidation.apply_operations] returns [Outdated] - for operations in [live_operations] *) -let test_apply_operation_live_operations ctxt = - let open Lwt_result_syntax in - let timestamp : Time.Protocol.t = now () in - let rand : Random.State.t = mk_rand () in - let ops = mk_ops () 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 (module Chain_store) = make_chain_store ctxt in - let module P = MakePrevalidation (Chain_store) (Filter_random_apply) in - let* pv = P.create chain_store ~predecessor ~live_operations ~timestamp () in - let op_in_live_operations op = - Tezos_crypto.Operation_hash.Set.mem - (Shell_operation.Internal_for_tests.to_raw op |> Operation.hash) - live_operations - in - let apply_op pv op = - 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) - in - (* Here is the main check of this test: *) - assert (op_in_live_operations op ==> result_is_outdated) ; - Lwt.return next_pv - in - let*! _ = List.fold_left_s apply_op pv ops in - return_unit +let filter_config = Filter_random_add_operation.Mempool.default_config (** 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 open Tezos_crypto in let timestamp : Time.Protocol.t = now () in - let rand : Random.State.t = mk_rand () in let ops = mk_ops () 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 head = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in let (module Chain_store) = make_chain_store ctxt in - let module P = MakePrevalidation (Chain_store) (Filter_random_apply) in - let* pv = P.create chain_store ~predecessor ~live_operations ~timestamp () in - let to_applied = P.Internal_for_tests.to_applied in + let module P = MakePrevalidation (Chain_store) (Filter_random_add_operation) + in + let* pv = P.create chain_store ~head ~timestamp () in let apply_op pv op = - 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 + let*! ( pv, + (_filter_state : P.filter_state), + (_op : Mock_protocol.operation Shell_operation.operation), + classification, + replacement ) = + P.add_operation pv filter_state filter_config op 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 + let valid_ops = P.Internal_for_tests.get_valid_operations pv in + (match classification with + | `Prechecked -> ( + assert (Operation_hash.Map.mem op.hash valid_ops) ; + match replacement with + | None -> () + | Some (removed, _) -> + assert (not (Operation_hash.Map.mem removed valid_ops))) + | `Branch_delayed _ -> + assert (not (Operation_hash.Map.mem op.hash valid_ops)) ; + assert (Option.is_none replacement) + | `Branch_refused _ | `Refused _ | `Outdated _ | `Applied -> + (* These cases cannot happen because the only possible error in + [Proto_random_add_operation.Mempool.add_operation] has a + [Branch_delayed] classification, protocol crashes are wrapped + into a [Branch_delayed] error by [protect], and operation + conflicts are also [Branch_delayed]. *) + QCheck2.Test.fail_reportf "%s:@.Unexpected classification." __LOC__) ; + Lwt.return pv in let*! _ = List.fold_left_s apply_op pv ops in return_unit @@ -357,11 +359,6 @@ let () = 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)" -- GitLab From 786d40ce46e7b0ddd31f23f8d05d3df2ee9f66a4 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Thu, 20 Oct 2022 11:51:36 +0200 Subject: [PATCH 09/17] Shell & plugins: remove precheck and post_filter from new filter --- src/lib_shell/shell_plugin.ml | 34 -- src/lib_shell/shell_plugin.mli | 54 --- src/proto_015_PtLimaPt/lib_plugin/mempool.ml | 483 +------------------ src/proto_016_PtMumbai/lib_plugin/mempool.ml | 483 +------------------ src/proto_alpha/lib_plugin/mempool.ml | 483 +------------------ 5 files changed, 6 insertions(+), 1531 deletions(-) diff --git a/src/lib_shell/shell_plugin.ml b/src/lib_shell/shell_plugin.ml index b944e303bc36..373f0b1b65de 100644 --- a/src/lib_shell/shell_plugin.ml +++ b/src/lib_shell/shell_plugin.ml @@ -53,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 -> @@ -80,14 +62,6 @@ module type FILTER = sig | 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 - val add_operation_and_enforce_mempool_bound : ?replace:Tezos_crypto.Operation_hash.t -> Proto.validation_state -> @@ -135,17 +109,9 @@ module No_filter (Proto : Registered_protocol.T) : 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) diff --git a/src/lib_shell/shell_plugin.mli b/src/lib_shell/shell_plugin.mli index e9abdce5b172..081ad0841b9b 100644 --- a/src/lib_shell/shell_plugin.mli +++ b/src/lib_shell/shell_plugin.mli @@ -65,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 @@ -123,22 +85,6 @@ 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 : - 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 - (** Add an operation to the filter {!state}. The operation should have been previously validated by the protocol. diff --git a/src/proto_015_PtLimaPt/lib_plugin/mempool.ml b/src/proto_015_PtLimaPt/lib_plugin/mempool.ml index 8f99da4451d2..8a44d504708d 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,251 +914,6 @@ 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 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 - in - let weight = - weight_manager_operation - ~validation_state - ~fee - ~gas:gas_limit - (Operation_data operation.protocol_data) - in - let info = {manager_op = Manager_op operation; 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 - config - filter_state - validation_state - oph - ~nb_successful_prechecks - {shell = operation.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 - 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) - 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) - 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 diff --git a/src/proto_016_PtMumbai/lib_plugin/mempool.ml b/src/proto_016_PtMumbai/lib_plugin/mempool.ml index 8a4d842e21b6..90a632d47754 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,251 +914,6 @@ 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 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 - in - let weight = - weight_manager_operation - ~validation_state - ~fee - ~gas:gas_limit - (Operation_data operation.protocol_data) - in - let info = {manager_op = Manager_op operation; 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 - config - filter_state - validation_state - oph - ~nb_successful_prechecks - {shell = operation.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 - 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) - 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) - 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 diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 8a4d842e21b6..90a632d47754 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,251 +914,6 @@ 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 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 - in - let weight = - weight_manager_operation - ~validation_state - ~fee - ~gas:gas_limit - (Operation_data operation.protocol_data) - in - let info = {manager_op = Manager_op operation; 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 - config - filter_state - validation_state - oph - ~nb_successful_prechecks - {shell = operation.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 - 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) - 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) - 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 -- GitLab From 23d7857f2f152fe10f588d0b917c1719898912a0 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Wed, 16 Nov 2022 18:38:01 +0100 Subject: [PATCH 10/17] Shell/test & env: update test on proto add_operation crash --- .../environment_protocol_T_test.ml | 14 +++-- src/lib_shell/test/test_prevalidation_t.ml | 62 +++++++++++++------ 2 files changed, 51 insertions(+), 25 deletions(-) diff --git a/src/lib_protocol_environment/environment_protocol_T_test.ml b/src/lib_protocol_environment/environment_protocol_T_test.ml index 375fa26e267a..da6bc2b21cae 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/test/test_prevalidation_t.ml b/src/lib_shell/test/test_prevalidation_t.ml index 751dbc3056f5..7941d35704aa 100644 --- a/src/lib_shell/test/test_prevalidation_t.ml +++ b/src/lib_shell/test/test_prevalidation_t.ml @@ -56,8 +56,11 @@ module Mock_protocol : 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 + module Mempool = struct + include Mempool + + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt_result.return ((), ()) + end end module MakeFilter (Proto : Tezos_protocol_environment.PROTOCOL) : @@ -87,7 +90,7 @@ module Init = struct let genesis_time = Time.Protocol.of_seconds 0L - (** [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 @@ -193,9 +196,37 @@ let mk_ops () = 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 pp_classification fmt classification = + let print_error_classification name trace = + Format.fprintf fmt "%s: %a" name pp_print_trace trace + in + 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 + +(** Test that [Prevalidation.add_operation] always returns + [Branch_delayed [Exn _]] when the protocol's + [Mempool.add_operation] crashes. + + Indeed, recall that [Mock_protocol] is built from + [Environment_protocol_T_test.Mock_all_unit] which implements all + functions as [assert false]. *) +let test_add_operation_crash ctxt = let open Lwt_result_syntax in let timestamp : Time.Protocol.t = now () in let ops = mk_ops () in @@ -210,14 +241,8 @@ let test_apply_operation_crash ctxt = (_replacement : P.replacement) ) = P.add_operation pv filter_state filter_config op in - match classification with - | `Applied | `Prechecked | `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 + check_classification_is_exn __LOC__ classification ; + Lwt.return pv in let*! _ = List.fold_left_s add_op pv ops in return_unit @@ -351,14 +376,13 @@ let () = (Init.wrap_tzresult_lwt_disk 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..1' *) + ( "add_operation", [ Tztest.tztest - "[apply_operation] returns [Branch_delayed] when [apply_operation] \ - from the protocol crashes" + "Proto [add_operation] crash" `Quick - (Init.wrap_tzresult_lwt_disk test_apply_operation_crash); + (Init.wrap_tzresult_lwt_disk test_add_operation_crash); Tztest.tztest "[apply_operation] makes the [applied] field grow for [Applied] \ operations (and only for them)" -- GitLab From 75ed1ffa45a2ea88189a682efa6a0d20f61cac7c Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Fri, 18 Nov 2022 16:56:46 +0100 Subject: [PATCH 11/17] Shell: improve tests on Prevalidation.add_operation - Test Prevalidation.add_operation for various outcomes of the relevant protocol and filter functions. Check the returned classification and the updates of internal states. - Factorize prevalidation test registration. - Remove test_add_operation_crash, which is now covered by the updated test_add_operation. --- src/lib_shell/prevalidation.ml | 12 +- src/lib_shell/prevalidation.mli | 8 + src/lib_shell/test/test_prevalidation_t.ml | 544 ++++++++++++++------- 3 files changed, 391 insertions(+), 173 deletions(-) diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index bd622cfaadb9..281f2cb8af0c 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -140,6 +140,10 @@ module type T = sig module Internal_for_tests : sig val get_valid_operations : t -> protocol_operation Tezos_crypto.Operation_hash.Map.t + + type validation_info + + val set_validation_info : t -> validation_info -> t end end @@ -149,7 +153,9 @@ module MakeAbstract (Chain_store : CHAIN_STORE) (Filter : Shell_plugin.FILTER) : 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 = struct + 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 protocol_operation = Proto.operation @@ -338,6 +344,10 @@ module MakeAbstract (Chain_store : CHAIN_STORE) (Filter : Shell_plugin.FILTER) : module Internal_for_tests = struct let get_valid_operations {mempool; _} = Proto.Mempool.operations mempool + + type validation_info = Proto.Mempool.validation_info + + let set_validation_info state validation_info = {state with validation_info} end end diff --git a/src/lib_shell/prevalidation.mli b/src/lib_shell/prevalidation.mli index 7fc231437f82..c91eddb951c3 100644 --- a/src/lib_shell/prevalidation.mli +++ b/src/lib_shell/prevalidation.mli @@ -120,6 +120,12 @@ module type T = sig representation of the mempool. *) val get_valid_operations : t -> protocol_operation Tezos_crypto.Operation_hash.Map.t + + (** Type {!Tezos_protocol_environment.PROTOCOL.Mempool.validation_info}. *) + type validation_info + + (** Modify the [validation_info] field of the internal state [t]. *) + val set_validation_info : t -> validation_info -> t end end @@ -164,4 +170,6 @@ module Internal_for_tests : sig 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/test/test_prevalidation_t.ml b/src/lib_shell/test/test_prevalidation_t.ml index 7941d35704aa..5293ef514af3 100644 --- a/src/lib_shell/test/test_prevalidation_t.ml +++ b/src/lib_shell/test/test_prevalidation_t.ml @@ -40,55 +40,10 @@ 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 - - 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 = Shell_plugin.No_filter (struct - let hash = Tezos_crypto.Protocol_hash.zero - - include Proto - - let complete_b58prefix _ = assert false -end) - -module Mock_filter = MakeFilter (Mock_protocol) - -let filter_state : Mock_filter.Mempool.state = () - -let filter_config = Mock_filter.Mempool.default_config +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_disk f ()] provides an instance of {!Context.t} to a test [f]. For this, it creates a temporary directory on disk, @@ -106,23 +61,19 @@ 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 @@ -140,16 +91,43 @@ let make_chain_store ctxt = (module Chain_store : Prevalidation.Internal_for_tests.CHAIN_STORE with type chain_store = unit) -module MakePrevalidation = Prevalidation.Internal_for_tests.Make +(** 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 application_state = unit = struct + open Tezos_protocol_environment.Internal_for_tests + include Environment_protocol_T_test.Mock_all_unit -let make_prevalidation_mock_protocol ctxt = - let (module Chain_store) = make_chain_store ctxt in - let module Prevalidation_t = MakePrevalidation (Chain_store) (Mock_filter) in - (module Prevalidation_t : Prevalidation.T - with type protocol_operation = Mock_protocol.operation - and type filter_state = Mock_filter.Mempool.state - and type filter_config = Mock_filter.Mempool.config - and type chain_store = 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 ()) @@ -159,9 +137,11 @@ let chain_store = () (** Test that [create] returns [Ok] in a pristine context. *) let test_create ctxt = let open Lwt_result_syntax 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 P) = make_prevalidation_mock_protocol ctxt in - let head = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in + let head = Init.genesis_block ~timestamp ctxt in let* _ = P.create chain_store ~head ~timestamp () in return_unit @@ -182,11 +162,11 @@ let operations_gen ~(n : int) = (* We need to specify the protocol bytes generator to always generate 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 @@ -219,56 +199,110 @@ let check_classification_is_exn loc pp_classification classification -(** Test that [Prevalidation.add_operation] always returns - [Branch_delayed [Exn _]] when the protocol's - [Mempool.add_operation] crashes. +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" - Indeed, recall that [Mock_protocol] is built from - [Environment_protocol_T_test.Mock_all_unit] which implements all - functions as [assert false]. *) -let test_add_operation_crash ctxt = - let open Lwt_result_syntax in - let timestamp : Time.Protocol.t = now () in - let ops = mk_ops () in - let head = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in - let (module P) = make_prevalidation_mock_protocol ctxt in - let* pv = P.create chain_store ~head ~timestamp () in - let add_op pv op = - let*! ( pv, - (_filter_state : P.filter_state), - (_op : Mock_protocol.operation Shell_operation.operation), - classification, - (_replacement : P.replacement) ) = - P.add_operation pv filter_state filter_config op - in - check_classification_is_exn __LOC__ classification ; - Lwt.return pv +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 add_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); + ] -module Proto_random_add_operation : +(** 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 = struct + and type operation = Mock_protocol.operation + and type Mempool.validation_info = proto_add_outcome = struct include Mock_protocol - (** Toy mempool with a random [add_operation] function. - - Unlike [Mock_protocol.Mempool], this mempool's type [t] is an - actual state that keeps track of validated operations and can be - retrieved with [operations]. This allows the test below to check - that operations were correctly added or removed. *) module Mempool = struct include Mempool - open Tezos_crypto type t = operation Operation_hash.Map.t - type validation_info = unit + (* 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 ((), Operation_hash.Map.empty) + Lwt_result.return (Proto_crash, Operation_hash.Map.empty) let operation_encoding = Data_encoding.conv @@ -278,33 +312,35 @@ module Proto_random_add_operation : let encoding = Operation_hash.Map.encoding operation_encoding - let add_operation ?check_signature:_ ?conflict_handler _info state (oph, op) + 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 - QCheck2.Gen.( - generate1 (oneofl [`Added; `Replaced; `Unchanged; `Error; `Crash])) - with - | `Added -> + match (info : proto_add_outcome) with + | Proto_added -> let state = Operation_hash.Map.add oph op state in Lwt_result.return (state, Added) - | `Replaced -> + | Proto_replaced -> let removed = match Operation_hash.Map.choose state with | Some (hash, _) -> hash - | None -> Tezos_crypto.Operation_hash.zero + | 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}) - | `Unchanged -> Lwt_result.return (state, Unchanged) - | `Error -> - let err = error_of_fmt "Error during protocol validation." in - Lwt_result.fail (Validation_error [err]) - | `Crash -> assert false + | 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 @@ -314,80 +350,244 @@ module Proto_random_add_operation : end end -module Filter_random_add_operation = MakeFilter (Proto_random_add_operation) +(** 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); + ] + +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); + ] -let filter_config = Filter_random_add_operation.Mempool.default_config +(** 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) -(** 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 = + 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 open Tezos_crypto in - let timestamp : Time.Protocol.t = now () in - let ops = mk_ops () in - let head = Init.genesis_block @@ Context_ops.hash ~time:timestamp ctxt in let (module Chain_store) = make_chain_store ctxt in - let module P = MakePrevalidation (Chain_store) (Filter_random_add_operation) - in - let* pv = P.create chain_store ~head ~timestamp () in - let apply_op pv op = - let*! ( pv, - (_filter_state : P.filter_state), + 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 pv filter_state filter_config op + P.add_operation state filter_state_before filter_outcome op in - let valid_ops = P.Internal_for_tests.get_valid_operations pv in - (match classification with - | `Prechecked -> ( + (* 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 -> () + | None -> assert false | Some (removed, _) -> - assert (not (Operation_hash.Map.mem removed valid_ops))) - | `Branch_delayed _ -> + 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 (Option.is_none replacement) - | `Branch_refused _ | `Refused _ | `Outdated _ | `Applied -> - (* These cases cannot happen because the only possible error in - [Proto_random_add_operation.Mempool.add_operation] has a - [Branch_delayed] classification, protocol crashes are wrapped - into a [Branch_delayed] error by [protect], and operation - conflicts are also [Branch_delayed]. *) - QCheck2.Test.fail_reportf "%s:@.Unexpected classification." __LOC__) ; - Lwt.return pv + assert (not (Operation_hash.Set.mem op.hash filter_state)) ; + assert (Option.is_none replacement)) ; + Lwt.return (state, filter_state) + in + let timestamp : Time.Protocol.t = now () in + 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*! _ = List.fold_left_s apply_op pv ops in + let ops = mk_ops () in + let outcomes = + QCheck2.Gen.( + generate ~n:nb_ops (pair proto_add_outcome_gen filter_add_outcome_gen)) + in + 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 final_valid_ops = + P.Internal_for_tests.get_valid_operations final_prevalidation_state + 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 add_operation '0..1' *) + dune exec src/lib_shell/test/test_prevalidation_t.exe -- test add_operation '0' *) ( "add_operation", [ - Tztest.tztest - "Proto [add_operation] crash" - `Quick - (Init.wrap_tzresult_lwt_disk test_add_operation_crash); - 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 -- GitLab From 9462070ca48393066e6226ea20c31d419bf9a25c Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Fri, 25 Nov 2022 18:27:47 +0100 Subject: [PATCH 12/17] Plugin: test the new conflict_handler --- manifest/main.ml | 3 +- src/lib_test/qcheck2_helpers.ml | 9 +- src/lib_test/qcheck2_helpers.mli | 6 +- src/proto_015_PtLimaPt/lib_plugin/test/dune | 11 +- .../lib_plugin/test/test_conflict_handler.ml | 275 ++++++++++++++++++ .../test/helpers/operation_generator.ml | 15 +- .../integration/validate/test_covalidity.ml | 4 +- src/proto_016_PtMumbai/lib_plugin/test/dune | 11 +- .../lib_plugin/test/test_conflict_handler.ml | 275 ++++++++++++++++++ .../test/helpers/operation_generator.ml | 15 +- .../integration/validate/test_covalidity.ml | 4 +- src/proto_alpha/lib_plugin/test/dune | 11 +- .../lib_plugin/test/test_conflict_handler.ml | 275 ++++++++++++++++++ .../test/helpers/operation_generator.ml | 15 +- .../integration/validate/test_covalidity.ml | 4 +- 15 files changed, 913 insertions(+), 20 deletions(-) create mode 100644 src/proto_015_PtLimaPt/lib_plugin/test/test_conflict_handler.ml create mode 100644 src/proto_016_PtMumbai/lib_plugin/test/test_conflict_handler.ml create mode 100644 src/proto_alpha/lib_plugin/test/test_conflict_handler.ml diff --git a/manifest/main.ml b/manifest/main.ml index 68b55b4d32fd..418b15aff90c 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) diff --git a/src/lib_test/qcheck2_helpers.ml b/src/lib_test/qcheck2_helpers.ml index e0896e621f59..b8df1033b893 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 320b9eb41666..411a8eeed06b 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_015_PtLimaPt/lib_plugin/test/dune b/src/proto_015_PtLimaPt/lib_plugin/test/dune index 5ab55d70a0e7..e72e557e0bf1 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 000000000000..0e7f09d4e187 --- /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 de1f90105310..06b2c0f01df6 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 8d4cc266d810..7e8cccf98b55 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/test/dune b/src/proto_016_PtMumbai/lib_plugin/test/dune index 0bab03714d0e..bf8aecf9efc7 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 000000000000..0e7f09d4e187 --- /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 6503b38e7574..9b75b07c352d 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 046d4cf44a95..a13aaf0fd367 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/test/dune b/src/proto_alpha/lib_plugin/test/dune index 8217d9534bc0..d6e493eece8d 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 000000000000..0e7f09d4e187 --- /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 79c454ce0df0..95269de6f692 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 046d4cf44a95..a13aaf0fd367 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 -- GitLab From 177113c61c4645635188b7a0c0f2d62fd27068c9 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 14 Nov 2022 16:01:37 +0100 Subject: [PATCH 13/17] Proto_demo_counter: implement a non-fake mempool to fix test_inject_operations in tests_python/tests_alpha/test_proto_demo_counter.py and the test in tezt/tests/demo_counter.ml --- src/proto_demo_counter/lib_protocol/main.ml | 45 ++++++++++++++------- 1 file changed, 31 insertions(+), 14 deletions(-) diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index f9c997b9661e..e6bbc9518d04 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 -- GitLab From 5f38b4ac915c796c0668fa6af90a2c95b5ceae35 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Tue, 8 Nov 2022 10:35:58 +0100 Subject: [PATCH 14/17] Tezt: update conflict error --- tezt/tests/operation_validation.ml | 14 ++++++++++++-- tezt/tests/prevalidator.ml | 28 +++++++++++++++------------- 2 files changed, 27 insertions(+), 15 deletions(-) diff --git a/tezt/tests/operation_validation.ml b/tezt/tests/operation_validation.ml index df5176675624..a0838873ef50 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 c8a5bec05e5c..8c55aaee97e7 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 -- GitLab From e02905e8c87ed0a7c6bc198883098a3aca7b71bd Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 7 Nov 2022 18:23:02 +0100 Subject: [PATCH 15/17] Tezt: update error classification in sum_fees_overflow test The operation with overflowing fees is classified as branch_delayed only since the new mempool for Lima. Since Kathmandu is no longer active on mainnet, we restrict the replace_by_fees tests to Lima and up rather than introduced a complicated special case for Kathmandu. --- tezt/tests/replace_by_fees.ml | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/tezt/tests/replace_by_fees.ml b/tezt/tests/replace_by_fees.ml index 7962d9b3aa5b..66e34d7709a2 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) () -- GitLab From a8ffb60fff2e2b7ccbd7ac75a6708a6fb11a04bf Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Tue, 15 Nov 2022 14:13:15 +0100 Subject: [PATCH 16/17] Tezt: update consensus key test --- tezt/tests/consensus_key.ml | 101 +++++++++++++++++++----------------- 1 file changed, 52 insertions(+), 49 deletions(-) diff --git a/tezt/tests/consensus_key.ml b/tezt/tests/consensus_key.ml index 7392fdaa8abf..32e33c41b1d3 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 -- GitLab From 6820d61325c36f763680bb9dc7409c235dacdd7c Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 5 Dec 2022 17:05:13 +0100 Subject: [PATCH 17/17] Changelog: add mempool replacement, error updates, and minor fix --- CHANGES.rst | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/CHANGES.rst b/CHANGES.rst index 7e8878d1962e..f6c2f2b9e5f9 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 -- GitLab