diff --git a/docs/protocols/alpha.rst b/docs/protocols/alpha.rst index 44310210785b520121eab4c8c8ec9075a6896ccb..9c9943561643d62d8523048c0f7f86b11da1c1d5 100644 --- a/docs/protocols/alpha.rst +++ b/docs/protocols/alpha.rst @@ -91,7 +91,7 @@ Two new operations have been added: proposer and the baker. :: - + "proposer_consensus_key": "[PUBLIC_KEY_HASH]", "baker_consensus_key": "[PUBLIC_KEY_HASH]", @@ -364,3 +364,9 @@ Internal - Rely on the protocol for 1M and precheck all operations. (MR :gl:`!6070`) - Split the validation from the application of blocks. (MR :gl:`!6152`) + +- Expose a new ``Mempool`` mode on the protocol side that offers an + API allowing a light validation of operations. This as well as + maintaining a commutative set of operations that may also be + efficiently merged with another. This enables the implementation of + a parallelized shell's mempool. (MR :gl:`!6274`) diff --git a/src/bin_client/test/proto_test_injection/main.ml b/src/bin_client/test/proto_test_injection/main.ml index e856e9ce8842232caabdf4399027efd32ee2f38f..bb03954f4801ea8a9abcf2723c2f93d4c2b9863c 100644 --- a/src/bin_client/test/proto_test_injection/main.ml +++ b/src/bin_client/test/proto_test_injection/main.ml @@ -149,3 +149,48 @@ type error += Missing_value_in_cache let value_of_key ~chain_id:_ ~predecessor_context:_ ~predecessor_timestamp:_ ~predecessor_level:_ ~predecessor_fitness:_ ~predecessor:_ ~timestamp:_ = return (fun _ -> fail Missing_value_in_cache) + +(* Fake mempool *) +module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = + 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 +end diff --git a/src/lib_protocol_environment/environment_V0.ml b/src/lib_protocol_environment/environment_V0.ml index dc576b5930b1a956d5f8e9025ff8da4325d65148..5e61852a95c9af8ef855bb4300cd4b3c2a44860e 100644 --- a/src/lib_protocol_environment/environment_V0.ml +++ b/src/lib_protocol_environment/environment_V0.ml @@ -700,6 +700,7 @@ struct and type quota := quota and type validation_result := validation_result and type rpc_context := rpc_context + and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult end diff --git a/src/lib_protocol_environment/environment_V1.ml b/src/lib_protocol_environment/environment_V1.ml index 09cbd61ca346eb76e2d123b1f341416e8ed34551..c9c1cb6b39c541bba6c47bbd079e08e27e33e0d2 100644 --- a/src/lib_protocol_environment/environment_V1.ml +++ b/src/lib_protocol_environment/environment_V1.ml @@ -830,6 +830,7 @@ struct and type quota := quota and type validation_result := validation_result and type rpc_context := rpc_context + and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult end diff --git a/src/lib_protocol_environment/environment_V2.ml b/src/lib_protocol_environment/environment_V2.ml index bb000236537c996d9163779090ecd0126307f792..5bb0386b46dcf4c4e9611459751f9847c5e6481d 100644 --- a/src/lib_protocol_environment/environment_V2.ml +++ b/src/lib_protocol_environment/environment_V2.ml @@ -843,6 +843,7 @@ struct and type quota := quota and type validation_result := validation_result and type rpc_context := rpc_context + and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult end diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index c88ffabe3040812857d6749cce01f001f6c6cc4f..f079a8b7f1e24ff13cf7774c33f54816898e2e1e 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -1173,6 +1173,51 @@ struct let acceptable_pass op = match acceptable_passes op with [n] -> Some n | _ -> None + + (* Fake mempool *) + module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = + 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 + end end class ['chain, 'block] proto_rpc_context (t : Tezos_rpc.RPC_context.t) diff --git a/src/lib_protocol_environment/environment_V4.ml b/src/lib_protocol_environment/environment_V4.ml index 14784e089d595e8d4296b4f89b561f48a3942a70..3436a6bdeb441ef2bb991a8ff2146696fc2f8ffe 100644 --- a/src/lib_protocol_environment/environment_V4.ml +++ b/src/lib_protocol_environment/environment_V4.ml @@ -1190,6 +1190,51 @@ struct let acceptable_pass op = match acceptable_passes op with [n] -> Some n | _ -> None + + (* Fake mempool *) + module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = + 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 + end end class ['chain, 'block] proto_rpc_context (t : Tezos_rpc.RPC_context.t) diff --git a/src/lib_protocol_environment/environment_V5.ml b/src/lib_protocol_environment/environment_V5.ml index 46e97c4ebbf75568266e03c68aa70086e260c26e..d5c46e84fe3d6924909f4de1df6a7ba2a4c0b740 100644 --- a/src/lib_protocol_environment/environment_V5.ml +++ b/src/lib_protocol_environment/environment_V5.ml @@ -1167,6 +1167,51 @@ struct let acceptable_pass op = match acceptable_passes op with [n] -> Some n | _ -> None + + (* Fake mempool *) + module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = + 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 + end end class ['chain, 'block] proto_rpc_context (t : Tezos_rpc.RPC_context.t) diff --git a/src/lib_protocol_environment/environment_V6.ml b/src/lib_protocol_environment/environment_V6.ml index 15c8957bdc1814cf91ca0e1efa4a780ade7397db..9c2e32c4cbe9c458a7c5288e6d15b8126adb64d4 100644 --- a/src/lib_protocol_environment/environment_V6.ml +++ b/src/lib_protocol_environment/environment_V6.ml @@ -1259,6 +1259,51 @@ struct let acceptable_pass op = match acceptable_passes op with [n] -> Some n | _ -> None + + (* Fake mempool *) + module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = + 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 + end end class ['chain, 'block] proto_rpc_context (t : Tezos_rpc.RPC_context.t) diff --git a/src/lib_protocol_environment/environment_V7.ml b/src/lib_protocol_environment/environment_V7.ml index 4fe2ccb8ed58a93ccf51dd8bda5b8ac4b1091c7d..6cc621ea0506bd0b8afcf181b1519e6c81245c07 100644 --- a/src/lib_protocol_environment/environment_V7.ml +++ b/src/lib_protocol_environment/environment_V7.ml @@ -1002,6 +1002,7 @@ struct and type quota := quota and type validation_result := validation_result and type rpc_context := rpc_context + and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult end @@ -1215,6 +1216,49 @@ struct wrap_tzresult r let set_log_message_consumer f = Logging.logging_function := Some f + + module Mempool = struct + include Mempool + + type add_error = + | Validation_error of Error_monad.shell_tztrace + | Add_conflict of operation_conflict + + let add_operation ?check_signature ?conflict_handler info mempool op : + (t * add_result, add_error) result Lwt.t = + let open Lwt_syntax in + let+ r = + Mempool.add_operation + ?check_signature + ?conflict_handler + info + mempool + op + in + match r with + | Ok v -> Ok v + | Error (Mempool.Validation_error e) -> + Error (Validation_error (wrap_tztrace e)) + | Error (Mempool.Add_conflict c) -> Error (Add_conflict c) + + let init ctxt chain_id ~head_hash ~head_header ~current_timestamp ~cache = + let open Lwt_result_syntax in + let* ctxt = + load_predecessor_cache + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:head_header.Block_header.timestamp + ~predecessor_level:head_header.Block_header.level + ~predecessor_fitness:head_header.Block_header.fitness + ~predecessor:head_hash + ~timestamp:current_timestamp + ~cache + in + let*! r = + init ctxt chain_id ~head_hash ~head_header ~current_timestamp + in + Lwt.return (wrap_tzresult r) + end end class ['chain, 'block] proto_rpc_context (t : Tezos_rpc.RPC_context.t) diff --git a/src/lib_protocol_environment/environment_protocol_T.ml b/src/lib_protocol_environment/environment_protocol_T.ml index 7b92a18ebc658ff621a02287f0140087b86ab526..5414af7f3b9fb33b8a4c53b75399720d008e917c 100644 --- a/src/lib_protocol_environment/environment_protocol_T.ml +++ b/src/lib_protocol_environment/environment_protocol_T.ml @@ -59,12 +59,14 @@ module V0toV7 and type quota := quota and type validation_result := validation_result and type rpc_context := rpc_context + and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult) : Environment_protocol_T_V7.T with type context := Context.t and type quota := quota and type validation_result := validation_result and type rpc_context := rpc_context + and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult and type block_header_data = E.block_header_data and type block_header = E.block_header @@ -96,6 +98,51 @@ module V0toV7 type cache_value = Context.Cache.value let init _chain_id c hd = init c hd + + (* Fake mempool *) + module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = + 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 + end end (* [module type PROTOCOL] is protocol signature that the shell can use. @@ -111,6 +158,7 @@ module type PROTOCOL = sig and type quota := quota and type validation_result := validation_result and type rpc_context := rpc_context + and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult and type cache_key := Context.Cache.key and type cache_value := Context.Cache.value @@ -127,7 +175,7 @@ module type PROTOCOL = sig predecessor_hash:Block_hash.t -> cache:Context.source_of_cache -> block_header -> - (validation_state, tztrace) result Lwt.t + validation_state Error_monad.tzresult Lwt.t val begin_application : chain_id:Chain_id.t -> @@ -155,6 +203,19 @@ module type PROTOCOL = sig validation_state -> Block_header.shell_header option -> (validation_result * block_header_metadata) tzresult Lwt.t + + module Mempool : sig + include module type of Mempool + + val init : + Context.t -> + Chain_id.t -> + head_hash:Block_hash.t -> + head_header:Block_header.shell_header -> + current_timestamp:Time.Protocol.t -> + cache:Context.source_of_cache -> + (validation_info * t) tzresult Lwt.t + end end (* @@ -170,6 +231,7 @@ module IgnoreCaches and type quota := quota and type validation_result := validation_result and type rpc_context := rpc_context + and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult) = struct include P @@ -213,4 +275,11 @@ struct () let finalize_block c shell_header = P.finalize_block c shell_header + + module Mempool = struct + include Mempool + + let init ctxt chain_id ~head_hash ~head_header ~current_timestamp ~cache:_ = + init ctxt chain_id ~head_hash ~head_header ~current_timestamp + end end diff --git a/src/lib_protocol_environment/environment_protocol_T_V0.ml b/src/lib_protocol_environment/environment_protocol_T_V0.ml index dabd2ff47bdb8f579006e3eb5eb49d7ad98f11ed..beaadd26b3ef6d2c7c3ba750b180243cea60f5a6 100644 --- a/src/lib_protocol_environment/environment_protocol_T_V0.ml +++ b/src/lib_protocol_environment/environment_protocol_T_V0.ml @@ -33,6 +33,8 @@ module type T = sig type rpc_context + type tztrace + type 'a tzresult val max_block_length : int diff --git a/src/lib_protocol_environment/environment_protocol_T_V7.ml b/src/lib_protocol_environment/environment_protocol_T_V7.ml index 95c488248ba87e0b74e50cff74d37093fe7d5cc0..36b72de4c7be219e9d92828c1330f78b4921b816 100644 --- a/src/lib_protocol_environment/environment_protocol_T_V7.ml +++ b/src/lib_protocol_environment/environment_protocol_T_V7.ml @@ -25,7 +25,7 @@ (*****************************************************************************) (* Documentation for this interface can be found in - module type [PROTOCOL] of [sigs/v3/updater.mli]. *) + module type [PROTOCOL] of [sigs/v7/updater.mli]. *) module type T = sig type context @@ -36,6 +36,8 @@ module type T = sig type rpc_context + type tztrace + type 'a tzresult val max_block_length : int @@ -139,4 +141,59 @@ module type T = sig predecessor:Block_hash.t -> timestamp:Time.Protocol.t -> (cache_key -> cache_value tzresult Lwt.t) tzresult Lwt.t + + module Mempool : sig + type t + + type validation_info + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of tztrace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + val init : + context -> + Chain_id.t -> + head_hash:Block_hash.t -> + head_header:Block_header.shell_header -> + current_timestamp:Time.Protocol.t -> + (validation_info * t) tzresult Lwt.t + + val encoding : t Data_encoding.t + + val add_operation : + ?check_signature:bool -> + ?conflict_handler:conflict_handler -> + validation_info -> + t -> + Operation_hash.t * operation -> + (t * add_result, add_error) result Lwt.t + + val remove_operation : t -> Operation_hash.t -> t + + val merge : + ?conflict_handler:conflict_handler -> t -> t -> (t, merge_error) result + + val operations : t -> operation Operation_hash.Map.t + end end diff --git a/src/lib_protocol_environment/environment_protocol_T_test.ml b/src/lib_protocol_environment/environment_protocol_T_test.ml index fb7206ebcd01f765fcb53df16ba1b1f50ab05893..7b6c3a7abe850dc4b05b4fbd2ba8e8f78a950f60 100644 --- a/src/lib_protocol_environment/environment_protocol_T_test.ml +++ b/src/lib_protocol_environment/environment_protocol_T_test.ml @@ -104,4 +104,49 @@ module Mock_all_unit : assert false let set_log_message_consumer _ = () + + (* Fake mempool *) + module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = + 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 + end end diff --git a/src/lib_protocol_environment/sigs/v7.ml b/src/lib_protocol_environment/sigs/v7.ml index e130af9c23c0f1f4999d9f81207ad3f71916f4d1..34fdaf29dc6218a632c4ea906d4dd580ad336d4f 100644 --- a/src/lib_protocol_environment/sigs/v7.ml +++ b/src/lib_protocol_environment/sigs/v7.ml @@ -11355,6 +11355,138 @@ module type PROTOCOL = sig predecessor:Block_hash.t -> timestamp:Time.t -> (Context.Cache.key -> Context.Cache.value tzresult Lwt.t) tzresult Lwt.t + + module Mempool : sig + (** Mempool type *) + type t + + (** Validation info type required to validate and add operations to a + mempool. *) + type validation_info + + (** Type of the function that may be provided in order to resolve a + potential conflict when adding an operation to an existing mempool + or when merging two mempools. This handler may be defined as a + simple order relation over operations (e.g. prioritize the most + profitable operations) or an arbitrary one (e.g. prioritize + operations where the source is a specific manager). + + Returning [`Keep] will leave the mempool unchanged and retain the + [existing_operation] while returning [`Replace] will remove + [existing_operation] and add [new_operation] instead. *) + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + (** Return type when adding an operation to the mempool *) + type add_result = + | Added + (** [Added] means that an operation was successfully added to + the mempool without any conflict. *) + | Replaced of {removed : Operation_hash.t} + (** [Replaced {removed}] means that an operation was + successfully added but there was a conflict with the [removed] + operation which was removed from the mempool. *) + | Unchanged + (** [Unchanged] means that there was a conflict with an existing + operation which was considered better by the + [conflict_handler], therefore the new operation is discarded + and the mempool remains unchanged.*) + + (** Error type returned when adding an operation to the mempool fails. *) + type add_error = + | Validation_error of error trace + (** [Validation_error _] means that the operation is invalid. *) + | Add_conflict of operation_conflict + (** [Add_conflict _] means that an operation conflicts with + an existing one. This error will only be obtained when + no [conflict_handler] was provided. Moreover, + [Validation_error _] takes precedence over [Add_conflict + _] which implies that we have the implicit invariant + that the operation would be valid if there was no + conflict. Therefore, if [add_operation] would have to be + called again, it would be redondant to check the + operation's signature. *) + + (** Error type returned when the merge of two mempools fails. *) + type merge_error = + | Incompatible_mempool + (** [Incompatible_mempool _] means that the two mempools are not built + ontop of the same head and therefore cannot be considered. *) + | Merge_conflict of operation_conflict + (** [Merge_conflict _] arises when two mempool contains conflicting + operations and no [conflict_handler] was provided.*) + + (** Initialize a static [validation_info] and [mempool], required + to validate and add operations, and an incremental and + serializable {!mempool}. *) + val init : + Context.t -> + Chain_id.t -> + head_hash:Block_hash.t -> + head_header:Block_header.shell_header -> + current_timestamp:Time.t -> + (validation_info * t) tzresult Lwt.t + + (** Mempool encoding *) + val encoding : t Data_encoding.t + + (** Adds an operation to a [mempool] if and only if it is valid and + does not conflict with previously added operation. + + This function checks the validity of an operation and tries to + add it to the mempool. + + If a validation error is triggered, the result will be a + [Validation_error]. If a conflict with a previous operation + exists, the result will be [Add_conflict] is then checked. + Important: no [Add_conflict] will be raised if a + [conflict_handler] is provided (see [add_result]). + + If no error is raised the operation is potentially added to the + [mempool] depending on the [add_result] value. *) + val add_operation : + ?check_signature:bool -> + ?conflict_handler:conflict_handler -> + validation_info -> + t -> + Operation_hash.t * operation -> + (t * add_result, add_error) result Lwt.t + + (** [remove_operation mempool oph] removes the operation [oph] from + the [mempool]. The [mempool] remains unchanged when [oph] is not + present in the [mempool] *) + val remove_operation : t -> Operation_hash.t -> t + + (** [merge ?conflict_handler mempool mempool'] merges [mempool'] + {b into} [mempool]. + + Mempools may only be merged if they are compatible: i.e. both have + been initialised with the same predecessor block. Otherwise, the + [Incompatible_mempool] error is returned. + + Conflicts between operations from the two mempools can + occur. Similarly as [add_operation], a [Merge_conflict] error + may be raised when no [conflict_handler] is provided. + + [existing_operation] in [conflict_handler ~existing_operation ~new_operation] + references operations present in [mempool] while + [new_operation] will reference operations present in + [mempool']. *) + val merge : + ?conflict_handler:conflict_handler -> t -> t -> (t, merge_error) result + + (** [operations mempool] returns the map of operations present in + [mempool]. *) + val operations : t -> operation Operation_hash.Map.t + end end (** [activate ctxt ph] activates an economic protocol (given by its diff --git a/src/lib_protocol_environment/sigs/v7/updater.mli b/src/lib_protocol_environment/sigs/v7/updater.mli index 641c5d83eac11f1f52b8456835a3406ff93f4f98..299685d6887dd6faeb38f810d387a1fd9c658d82 100644 --- a/src/lib_protocol_environment/sigs/v7/updater.mli +++ b/src/lib_protocol_environment/sigs/v7/updater.mli @@ -297,6 +297,138 @@ module type PROTOCOL = sig predecessor:Block_hash.t -> timestamp:Time.t -> (Context.Cache.key -> Context.Cache.value tzresult Lwt.t) tzresult Lwt.t + + module Mempool : sig + (** Mempool type *) + type t + + (** Validation info type required to validate and add operations to a + mempool. *) + type validation_info + + (** Type of the function that may be provided in order to resolve a + potential conflict when adding an operation to an existing mempool + or when merging two mempools. This handler may be defined as a + simple order relation over operations (e.g. prioritize the most + profitable operations) or an arbitrary one (e.g. prioritize + operations where the source is a specific manager). + + Returning [`Keep] will leave the mempool unchanged and retain the + [existing_operation] while returning [`Replace] will remove + [existing_operation] and add [new_operation] instead. *) + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + (** Return type when adding an operation to the mempool *) + type add_result = + | Added + (** [Added] means that an operation was successfully added to + the mempool without any conflict. *) + | Replaced of {removed : Operation_hash.t} + (** [Replaced {removed}] means that an operation was + successfully added but there was a conflict with the [removed] + operation which was removed from the mempool. *) + | Unchanged + (** [Unchanged] means that there was a conflict with an existing + operation which was considered better by the + [conflict_handler], therefore the new operation is discarded + and the mempool remains unchanged.*) + + (** Error type returned when adding an operation to the mempool fails. *) + type add_error = + | Validation_error of error trace + (** [Validation_error _] means that the operation is invalid. *) + | Add_conflict of operation_conflict + (** [Add_conflict _] means that an operation conflicts with + an existing one. This error will only be obtained when + no [conflict_handler] was provided. Moreover, + [Validation_error _] takes precedence over [Add_conflict + _] which implies that we have the implicit invariant + that the operation would be valid if there was no + conflict. Therefore, if [add_operation] would have to be + called again, it would be redondant to check the + operation's signature. *) + + (** Error type returned when the merge of two mempools fails. *) + type merge_error = + | Incompatible_mempool + (** [Incompatible_mempool _] means that the two mempools are not built + ontop of the same head and therefore cannot be considered. *) + | Merge_conflict of operation_conflict + (** [Merge_conflict _] arises when two mempool contains conflicting + operations and no [conflict_handler] was provided.*) + + (** Initialize a static [validation_info] and [mempool], required + to validate and add operations, and an incremental and + serializable {!mempool}. *) + val init : + Context.t -> + Chain_id.t -> + head_hash:Block_hash.t -> + head_header:Block_header.shell_header -> + current_timestamp:Time.t -> + (validation_info * t) tzresult Lwt.t + + (** Mempool encoding *) + val encoding : t Data_encoding.t + + (** Adds an operation to a [mempool] if and only if it is valid and + does not conflict with previously added operation. + + This function checks the validity of an operation and tries to + add it to the mempool. + + If a validation error is triggered, the result will be a + [Validation_error]. If a conflict with a previous operation + exists, the result will be [Add_conflict] is then checked. + Important: no [Add_conflict] will be raised if a + [conflict_handler] is provided (see [add_result]). + + If no error is raised the operation is potentially added to the + [mempool] depending on the [add_result] value. *) + val add_operation : + ?check_signature:bool -> + ?conflict_handler:conflict_handler -> + validation_info -> + t -> + Operation_hash.t * operation -> + (t * add_result, add_error) result Lwt.t + + (** [remove_operation mempool oph] removes the operation [oph] from + the [mempool]. The [mempool] remains unchanged when [oph] is not + present in the [mempool] *) + val remove_operation : t -> Operation_hash.t -> t + + (** [merge ?conflict_handler mempool mempool'] merges [mempool'] + {b into} [mempool]. + + Mempools may only be merged if they are compatible: i.e. both have + been initialised with the same predecessor block. Otherwise, the + [Incompatible_mempool] error is returned. + + Conflicts between operations from the two mempools can + occur. Similarly as [add_operation], a [Merge_conflict] error + may be raised when no [conflict_handler] is provided. + + [existing_operation] in [conflict_handler ~existing_operation ~new_operation] + references operations present in [mempool] while + [new_operation] will reference operations present in + [mempool']. *) + val merge : + ?conflict_handler:conflict_handler -> t -> t -> (t, merge_error) result + + (** [operations mempool] returns the map of operations present in + [mempool]. *) + val operations : t -> operation Operation_hash.Map.t + end end (** [activate ctxt ph] activates an economic protocol (given by its diff --git a/src/lib_protocol_updater/registered_protocol.ml b/src/lib_protocol_updater/registered_protocol.ml index 13ff8cc0f567c3baaf0467f17d17d896a77c48a2..fa53062447772bd44ee18dc31325dbe002d3b3a4 100644 --- a/src/lib_protocol_updater/registered_protocol.ml +++ b/src/lib_protocol_updater/registered_protocol.ml @@ -24,15 +24,9 @@ (*****************************************************************************) module type T = sig - module P : sig - val hash : Protocol_hash.t + val hash : Protocol_hash.t - include Tezos_protocol_environment.PROTOCOL - end - - include module type of struct - include P - end + include Tezos_protocol_environment.PROTOCOL val complete_b58prefix : Tezos_protocol_environment.Context.t -> string -> string list Lwt.t diff --git a/src/lib_protocol_updater/registered_protocol.mli b/src/lib_protocol_updater/registered_protocol.mli index 1967dfe96b2198d9a43ad9716f8981e77f5e81aa..74689c42fd02f940fcbec1464cf2d63466b1b532 100644 --- a/src/lib_protocol_updater/registered_protocol.mli +++ b/src/lib_protocol_updater/registered_protocol.mli @@ -24,15 +24,9 @@ (*****************************************************************************) module type T = sig - module P : sig - val hash : Protocol_hash.t + val hash : Protocol_hash.t - include Tezos_protocol_environment.PROTOCOL - end - - include module type of struct - include P - end + include Tezos_protocol_environment.PROTOCOL val complete_b58prefix : Tezos_protocol_environment.Context.t -> string -> string list Lwt.t @@ -64,10 +58,10 @@ module Register_embedded_V0 val sources : Protocol.t end) : T - with type P.block_header_data = Proto.block_header_data - and type P.operation_data = Proto.operation_data - and type P.operation_receipt = Proto.operation_receipt - and type P.validation_state = Proto.validation_state + with type block_header_data = Proto.block_header_data + and type operation_data = Proto.operation_data + and type operation_receipt = Proto.operation_receipt + and type validation_state = Proto.validation_state module Register_embedded_V1 (Env : Tezos_protocol_environment.V1.T) @@ -77,10 +71,10 @@ module Register_embedded_V1 val sources : Protocol.t end) : T - with type P.block_header_data = Proto.block_header_data - and type P.operation_data = Proto.operation_data - and type P.operation_receipt = Proto.operation_receipt - and type P.validation_state = Proto.validation_state + with type block_header_data = Proto.block_header_data + and type operation_data = Proto.operation_data + and type operation_receipt = Proto.operation_receipt + and type validation_state = Proto.validation_state module Register_embedded_V2 (Env : Tezos_protocol_environment.V2.T) @@ -90,11 +84,11 @@ module Register_embedded_V2 val sources : Protocol.t end) : T - with type P.block_header_data = Proto.block_header_data - and type P.operation_data = Proto.operation_data - and type P.operation = Proto.operation - and type P.operation_receipt = Proto.operation_receipt - and type P.validation_state = Proto.validation_state + with type block_header_data = Proto.block_header_data + and type operation_data = Proto.operation_data + and type operation = Proto.operation + and type operation_receipt = Proto.operation_receipt + and type validation_state = Proto.validation_state module Register_embedded_V3 (Env : Tezos_protocol_environment.V3.T) @@ -104,11 +98,11 @@ module Register_embedded_V3 val sources : Protocol.t end) : T - with type P.block_header_data = Proto.block_header_data - and type P.operation_data = Proto.operation_data - and type P.operation = Proto.operation - and type P.operation_receipt = Proto.operation_receipt - and type P.validation_state = Proto.validation_state + with type block_header_data = Proto.block_header_data + and type operation_data = Proto.operation_data + and type operation = Proto.operation + and type operation_receipt = Proto.operation_receipt + and type validation_state = Proto.validation_state module Register_embedded_V4 (Env : Tezos_protocol_environment.V4.T) @@ -118,11 +112,11 @@ module Register_embedded_V4 val sources : Protocol.t end) : T - with type P.block_header_data = Proto.block_header_data - and type P.operation_data = Proto.operation_data - and type P.operation = Proto.operation - and type P.operation_receipt = Proto.operation_receipt - and type P.validation_state = Proto.validation_state + with type block_header_data = Proto.block_header_data + and type operation_data = Proto.operation_data + and type operation = Proto.operation + and type operation_receipt = Proto.operation_receipt + and type validation_state = Proto.validation_state module Register_embedded_V5 (Env : Tezos_protocol_environment.V5.T) @@ -132,11 +126,11 @@ module Register_embedded_V5 val sources : Protocol.t end) : T - with type P.block_header_data = Proto.block_header_data - and type P.operation_data = Proto.operation_data - and type P.operation = Proto.operation - and type P.operation_receipt = Proto.operation_receipt - and type P.validation_state = Proto.validation_state + with type block_header_data = Proto.block_header_data + and type operation_data = Proto.operation_data + and type operation = Proto.operation + and type operation_receipt = Proto.operation_receipt + and type validation_state = Proto.validation_state module Register_embedded_V6 (Env : Tezos_protocol_environment.V6.T) @@ -146,11 +140,11 @@ module Register_embedded_V6 val sources : Protocol.t end) : T - with type P.block_header_data = Proto.block_header_data - and type P.operation_data = Proto.operation_data - and type P.operation = Proto.operation - and type P.operation_receipt = Proto.operation_receipt - and type P.validation_state = Proto.validation_state + with type block_header_data = Proto.block_header_data + and type operation_data = Proto.operation_data + and type operation = Proto.operation + and type operation_receipt = Proto.operation_receipt + and type validation_state = Proto.validation_state module Register_embedded_V7 (Env : Tezos_protocol_environment.V7.T) @@ -160,8 +154,8 @@ module Register_embedded_V7 val sources : Protocol.t end) : T - with type P.block_header_data = Proto.block_header_data - and type P.operation_data = Proto.operation_data - and type P.operation = Proto.operation - and type P.operation_receipt = Proto.operation_receipt - and type P.validation_state = Proto.validation_state + with type block_header_data = Proto.block_header_data + and type operation_data = Proto.operation_data + and type operation = Proto.operation + and type operation_receipt = Proto.operation_receipt + and type validation_state = Proto.validation_state diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 10fba5fb7e6d94e9ae4d873badb9e5bdf6e27d83..74c6c924cd38efc701dae4418a3b16f928fbc586 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -883,9 +883,7 @@ let proto_validate_operation validation_state oph ~nb_successful_prechecks operation in match res with - | Ok state -> - let validity_state = {validation_state.validity_state with state} in - return {validation_state with validity_state} + | Ok validity_state -> return {validation_state with validity_state} | Error tztrace -> let err = Environment.wrap_tztrace tztrace in let error_classification = @@ -935,17 +933,20 @@ let proto_validate_manager_operation validation_state oph match err with | Environment.Ecoproto_error (Validate_errors.Manager.Manager_restriction - (_manager, conflicting_oph)) + { + source = _manager; + conflict = Operation_conflict {existing; new_operation = _}; + }) :: _ -> - return (`Conflict (conflicting_oph, error_classification)) + 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 state = - Validate.remove_manager_operation validation_state.validity_state op + let operation_state = + Validate.remove_operation validation_state.validity_state.operation_state op in - let validity_state = {validation_state.validity_state with state} in + let validity_state = {validation_state.validity_state with operation_state} in {validation_state with validity_state} (** Call the protocol validation on a manager operation and handle diff --git a/src/proto_alpha/lib_plugin/test/generators.ml b/src/proto_alpha/lib_plugin/test/generators.ml index e1309201f5412bddf06dff59bdc3832d6a28ec37..014defb7a3660a06757100eede11ad60253e4552 100644 --- a/src/proto_alpha/lib_plugin/test/generators.ml +++ b/src/proto_alpha/lib_plugin/test/generators.ml @@ -23,6 +23,8 @@ (* *) (*****************************************************************************) +module Mempool = Plugin.Mempool + let string_gen = QCheck2.Gen.small_string ?gen:None let public_key_hash_gen : diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index b97667dbb8e11258bd0206db329b7dbb7290e5e9..7983533e9dc13f3df0ced1c7c18232e15a376bf9 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -239,6 +239,7 @@ "Validate_errors", "Amendment", "Validate", + "Mempool_validation", "Apply", "Services_registration", diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index abdb7af44a5939a814abf50aac09e02efcca8653..e2b6d4436f099ac733569f72229f3faa4604ec8a 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -227,19 +227,6 @@ module Gas = struct | Some remaining_gas -> ok remaining_gas | None -> error Operation_quota_exceeded - let check_limit_and_consume_from_block_gas - ~(hard_gas_limit_per_operation : Arith.integral) - ~(remaining_block_gas : Arith.fp) ~(gas_limit : Arith.integral) = - let open Result_syntax in - let* () = check_gas_limit ~hard_gas_limit_per_operation ~gas_limit in - let gas_limit_fp = Arith.fp gas_limit in - let* () = - error_unless - Arith.(gas_limit_fp <= remaining_block_gas) - Block_quota_exceeded - in - return (Arith.sub remaining_block_gas gas_limit_fp) - let remaining_operation_gas = Raw_context.remaining_operation_gas let update_remaining_operation_gas = diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 17e2d4147ae485b47c2aa29ead0582252d1ba447..19c8289a7b533f641cb01134a03e4344340d47af 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -238,6 +238,8 @@ module Raw_level : sig val of_int32_exn : int32 -> raw_level module Set : Set.S with type elt = raw_level + + module Map : Map.S with type key = raw_level end (** This module re-exports definitions from {!Cycle_repr}. *) @@ -422,6 +424,8 @@ module Gas : sig val pp_cost : Format.formatter -> cost -> unit + val pp_cost_as_gas : Format.formatter -> cost -> unit + type error += Operation_quota_exceeded (* `Temporary *) (** [consume ctxt cost] subtracts [cost] to the current operation @@ -444,23 +448,15 @@ module Gas : sig (** See {!Raw_context.consume_gas_limit_in_block}. *) val consume_limit_in_block : context -> 'a Arith.t -> context tzresult - (** Check that [gas_limit] is a valid operation gas limit (at most - [hard_gas_limit_per_operation] and nonnegative), then subtract it - from [remaining_block_gas] and return the difference. + (** Check that [gas_limit] is a valid operation gas limit: at most + [hard_gas_limit_per_operation] and nonnegative. @return [Error Gas_limit_too_high] if [gas_limit] is greater - than [hard_gas_limit_per_operation] or negative. - - @return [Error Block_quota_exceeded] if [gas_limit] is greater - than [remaining_block_gas]. - - This function mimics {!consume_limit_in_block} but bypasses the - context. *) - val check_limit_and_consume_from_block_gas : + than [hard_gas_limit_per_operation] or negative. *) + val check_gas_limit : hard_gas_limit_per_operation:Arith.integral -> - remaining_block_gas:Arith.fp -> gas_limit:Arith.integral -> - Arith.fp tzresult + unit tzresult (** The cost of free operation is [0]. *) val free : cost diff --git a/src/proto_alpha/lib_protocol/amendment.ml b/src/proto_alpha/lib_protocol/amendment.ml index d59452cbbd22cb3680dd0bd4f2c0f378bf79da03..07f6ff809c9c9b0ae0ade0fd53c337919496dcb2 100644 --- a/src/proto_alpha/lib_protocol/amendment.ml +++ b/src/proto_alpha/lib_protocol/amendment.ml @@ -148,11 +148,16 @@ let may_start_new_voting_period ctxt = Voting_period.is_last_block ctxt >>=? fun is_last -> if is_last then start_new_voting_period ctxt else return ctxt +let get_testnet_dictator ctxt chain_id = + (* This function should always, ALWAYS, return None on mainnet!!!! *) + match Constants.testnet_dictator ctxt with + | Some pkh when Chain_id.(chain_id <> Constants.mainnet_id) -> Some pkh + | _ -> None + let is_testnet_dictator ctxt chain_id delegate = (* This function should always, ALWAYS, return false on mainnet!!!! *) - match Constants.testnet_dictator ctxt with - | Some pkh when Chain_id.(chain_id <> Constants.mainnet_id) -> - Signature.Public_key_hash.equal pkh delegate + match get_testnet_dictator ctxt chain_id with + | Some pkh -> Signature.Public_key_hash.equal pkh delegate | _ -> false (** {2 Application of voting operations} *) diff --git a/src/proto_alpha/lib_protocol/amendment.mli b/src/proto_alpha/lib_protocol/amendment.mli index 328b30691826fccca861b6eb1c5e91234b0ce8a9..6bbc74d2f069f93790711a7e71e3c6fdd487e579 100644 --- a/src/proto_alpha/lib_protocol/amendment.mli +++ b/src/proto_alpha/lib_protocol/amendment.mli @@ -74,6 +74,10 @@ open Alpha_context the state machine of the amendment procedure. *) val may_start_new_voting_period : context -> context tzresult Lwt.t +(** Return the registered testchain dictator, if any. This function will always + return None on mainnet. *) +val get_testnet_dictator : context -> Chain_id.t -> public_key_hash option + (** Check whether the given public key hash corresponds to the registered testchain dictator, if any. This function will always return false on mainnet. *) diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index e62bcc544f93eb81edfff1de0a9b9914d949bd89..fd48cc31ab929af60bc85980413f11beeb290d16 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -248,6 +248,7 @@ Validate_errors Amendment Validate + Mempool_validation Apply Services_registration Constants_services @@ -513,6 +514,7 @@ validate_errors.ml validate_errors.mli amendment.ml amendment.mli validate.ml validate.mli + mempool_validation.ml mempool_validation.mli apply.ml apply.mli services_registration.ml services_registration.mli constants_services.ml constants_services.mli @@ -758,6 +760,7 @@ validate_errors.ml validate_errors.mli amendment.ml amendment.mli validate.ml validate.mli + mempool_validation.ml mempool_validation.mli apply.ml apply.mli services_registration.ml services_registration.mli constants_services.ml constants_services.mli @@ -1008,6 +1011,7 @@ validate_errors.ml validate_errors.mli amendment.ml amendment.mli validate.ml validate.mli + mempool_validation.ml mempool_validation.mli apply.ml apply.mli services_registration.ml services_registration.mli constants_services.ml constants_services.mli diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index b865772010ef14e211619f0988620e77c65652ef..a6a8f428496a0d3ee4f7ad898a7aa8602608d70f 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -32,7 +32,9 @@ type integral_tag module S = Saturation_repr (* 1 gas unit *) -let scaling_factor = S.mul_safe_of_int_exn 1000 +let scaling_factor = 1000 + +let mul_scaling_factor = S.mul_safe_of_int_exn scaling_factor module Arith = struct type 'a t = S.may_saturate S.t @@ -41,7 +43,7 @@ module Arith = struct type integral = integral_tag t - let scaling_factor = scaling_factor + let mul_scaling_factor = mul_scaling_factor let sub = S.sub @@ -82,7 +84,7 @@ module Arith = struct match of_int_opt i with | None -> fatally_saturated_int i | Some i' -> - let r = scale_fast scaling_factor i' in + let r = scale_fast mul_scaling_factor i' in if r = saturated then fatally_saturated_int i else r) let integral_exn z = @@ -90,19 +92,19 @@ module Arith = struct | i -> integral_of_int_exn i | exception Z.Overflow -> fatally_saturated_z z - let integral_to_z (i : integral) : Z.t = S.(to_z (ediv i scaling_factor)) + let integral_to_z (i : integral) : Z.t = S.(to_z (ediv i mul_scaling_factor)) let ceil x = - let r = S.erem x scaling_factor in - if r = zero then x else add x (sub scaling_factor r) + let r = S.erem x mul_scaling_factor in + if r = zero then x else add x (sub mul_scaling_factor r) - let floor x = sub x (S.erem x scaling_factor) + let floor x = sub x (S.erem x mul_scaling_factor) let fp x = x let pp fmtr fp = - let q = S.(ediv fp scaling_factor |> to_int) in - let r = S.(erem fp scaling_factor |> to_int) in + let q = S.(ediv fp mul_scaling_factor |> to_int) in + let r = S.(erem fp mul_scaling_factor |> to_int) in if Compare.Int.(r = 0) then Format.fprintf fmtr "%d" q else Format.fprintf fmtr "%d.%0*d" q decimals r @@ -157,27 +159,30 @@ let cost_encoding = S.z_encoding let pp_cost fmt z = S.pp fmt z +let pp_cost_as_gas fmt z = + Format.pp_print_int fmt (S.to_int (Arith.ceil z) / scaling_factor) + (* 2 units of gas *) let allocation_weight = - S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 2)) |> S.mul_safe_exn + S.(mul_fast mul_scaling_factor (S.mul_safe_of_int_exn 2)) |> S.mul_safe_exn -let step_weight = scaling_factor +let step_weight = mul_scaling_factor (* 100 units of gas *) let read_base_weight = - S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 100)) |> S.mul_safe_exn + S.(mul_fast mul_scaling_factor (S.mul_safe_of_int_exn 100)) |> S.mul_safe_exn (* 160 units of gas *) let write_base_weight = - S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 160)) |> S.mul_safe_exn + S.(mul_fast mul_scaling_factor (S.mul_safe_of_int_exn 160)) |> S.mul_safe_exn (* 10 units of gas *) let byte_read_weight = - S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 10)) |> S.mul_safe_exn + S.(mul_fast mul_scaling_factor (S.mul_safe_of_int_exn 10)) |> S.mul_safe_exn (* 15 units of gas *) let byte_written_weight = - S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 15)) |> S.mul_safe_exn + S.(mul_fast mul_scaling_factor (S.mul_safe_of_int_exn 15)) |> S.mul_safe_exn let cost_to_milligas (cost : cost) : Arith.fp = cost diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.mli b/src/proto_alpha/lib_protocol/gas_limit_repr.mli index dbecfda6fd6ba8bfac509213198043d919899597..891fd46f1c0bebbf15dd7e966f4de517bd74508f 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.mli +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.mli @@ -60,6 +60,9 @@ val cost_encoding : cost Data_encoding.encoding val pp_cost : Format.formatter -> cost -> unit +(** Print the gas cost as gas unit *) +val pp_cost_as_gas : Format.formatter -> cost -> unit + (** Subtracts the cost from the current limit. Returns [None] if the limit would fall below [0]. *) val raw_consume : Arith.fp -> cost -> Arith.fp option diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 7ae483137744d311d7c7e6d7dc3da8893eed6dc4..2f0c42c1788bc2951ae36314383487b52638c561 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -271,8 +271,8 @@ let begin_full_construction ~chain_id ~predecessor_context return {validity_state; application_state} let begin_partial_construction ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness ~predecessor - ~timestamp = + ~predecessor_timestamp ~predecessor_level ~predecessor_fitness + ~predecessor:_ ~timestamp = let open Lwt_tzresult_syntax in let open Alpha_context in let level = Int32.succ predecessor_level in @@ -295,13 +295,12 @@ let begin_partial_construction ~chain_id ~predecessor_context let*? grandparent_round = Alpha_context.Fitness.predecessor_round_from_raw predecessor_fitness in - let* validity_state = + let validity_state = Validate.begin_partial_construction ctxt chain_id ~predecessor_level ~predecessor_round - ~predecessor_hash:predecessor ~grandparent_round in let* application_state = @@ -352,7 +351,7 @@ let validate_operation validity_state let apply_operation (state : validation_state) (packed_operation : Alpha_context.packed_operation) = let open Lwt_result_syntax in - let* validate_state = + let* validation_state = validate_operation state.validity_state packed_operation in let operation_hash = Alpha_context.Operation.hash_packed packed_operation in @@ -363,11 +362,7 @@ let apply_operation (state : validation_state) packed_operation in return - ( { - validity_state = {state.validity_state with state = validate_state}; - application_state; - }, - operation_receipt ) + ({validity_state = validation_state; application_state}, operation_receipt) let finalize_block state shell_header = let open Lwt_result_syntax in @@ -448,4 +443,40 @@ let value_of_key ~chain_id:_ ~predecessor_context:ctxt ~predecessor_timestamp Alpha_context.prepare ctxt ~level ~predecessor_timestamp ~timestamp >>=? fun (ctxt, _, _) -> return (Apply.value_of_key ctxt) +module Mempool = struct + include Mempool_validation + + let init ctxt chain_id ~head_hash ~(head_header : Block_header.shell_header) + ~current_timestamp = + let open Lwt_tzresult_syntax in + let open Alpha_context in + let level = Int32.succ head_header.level in + let* ctxt, _migration_balance_updates, _migration_operation_results = + prepare + ~level + ~predecessor_timestamp:head_header.timestamp + ~timestamp:current_timestamp + ctxt + in + let*? raw_pred_level = Raw_level.of_int32 head_header.level in + let head_level = Level.from_raw ctxt raw_pred_level in + let* ctxt = + init_allowed_consensus_operations + ctxt + ~endorsement_level:head_level + ~preendorsement_level:head_level + in + let*? fitness = Fitness.from_raw head_header.fitness in + let predecessor_round = Fitness.round fitness in + let grandparent_round = Fitness.predecessor_round fitness in + return + (init + ctxt + chain_id + ~predecessor_level:head_level + ~predecessor_round + ~predecessor_hash:head_hash + ~grandparent_round) +end + (* Vanity nonce: TBD *) diff --git a/src/proto_alpha/lib_protocol/mempool_validation.ml b/src/proto_alpha/lib_protocol/mempool_validation.ml new file mode 100644 index 0000000000000000000000000000000000000000..2debf1f8e6cb83bbd749ec0718a090bbfbe6a36e --- /dev/null +++ b/src/proto_alpha/lib_protocol/mempool_validation.ml @@ -0,0 +1,223 @@ +(*****************************************************************************) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Validate + +type t = { + predecessor_hash : Block_hash.t; + operation_state : operation_conflict_state; + operations : packed_operation Operation_hash.Map.t; +} + +type validation_info = Validate.info + +type add_result = Added | Replaced of {removed : Operation_hash.t} | Unchanged + +type operation_conflict = Validate_errors.operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + +type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + +type merge_error = Incompatible_mempool | Merge_conflict of operation_conflict + +let encoding : t Data_encoding.t = + let open Data_encoding in + def "mempool" + @@ conv + (fun {predecessor_hash; operation_state; operations} -> + (predecessor_hash, operation_state, operations)) + (fun (predecessor_hash, operation_state, operations) -> + {predecessor_hash; operation_state; operations}) + @@ obj3 + (req "predecessor_hash" Block_hash.encoding) + (req "operation_state" Validate.operation_conflict_state_encoding) + (req + "operations" + (Operation_hash.Map.encoding + (dynamic_size ~kind:`Uint30 Operation.encoding))) + +let init ctxt chain_id ~predecessor_level ~predecessor_round ~predecessor_hash + ~grandparent_round : validation_info * t = + let {info; operation_state; _} = + begin_partial_construction + ctxt + chain_id + ~predecessor_level + ~predecessor_round + ~grandparent_round + in + ( info, + {predecessor_hash; operation_state; operations = Operation_hash.Map.empty} + ) + +type conflict_handler = + existing_operation:Operation_hash.t * packed_operation -> + new_operation:Operation_hash.t * packed_operation -> + [`Keep | `Replace] + +let remove_operation mempool oph = + match Operation_hash.Map.find_opt oph mempool.operations with + | None -> mempool + | Some {shell; protocol_data = Operation_data protocol_data} -> + let operations = Operation_hash.Map.remove oph mempool.operations in + let operation_state = + remove_operation mempool.operation_state {shell; protocol_data} + in + {mempool with operations; operation_state} + +let add_operation ?(check_signature = true) + ?(conflict_handler : conflict_handler option) info mempool + (oph, (packed_op : packed_operation)) : + (t * add_result, add_error) result Lwt.t = + let open Lwt_syntax in + let {shell; protocol_data = Operation_data protocol_data} = packed_op in + let operation : _ Alpha_context.operation = {shell; protocol_data} in + let* validate_result = + check_operation info ~should_check_signature:check_signature operation + in + match validate_result with + | Error err -> Lwt.return_error (Validation_error err) + | Ok () -> ( + match check_operation_conflict mempool.operation_state oph operation with + | Ok () -> + let operation_state = + add_valid_operation mempool.operation_state oph operation + in + let operations = + Operation_hash.Map.add oph packed_op mempool.operations + in + let result = Added in + Lwt.return_ok ({mempool with operation_state; operations}, result) + | Error + (Validate_errors.Operation_conflict + {existing; new_operation = new_oph} as x) -> ( + match conflict_handler with + | Some handler -> ( + let new_operation = (new_oph, packed_op) in + let existing_operation = + match + Operation_hash.Map.find_opt existing mempool.operations + with + | None -> assert false + | Some op -> (existing, op) + in + match handler ~existing_operation ~new_operation with + | `Keep -> Lwt.return_ok (mempool, Unchanged) + | `Replace -> + let mempool = remove_operation mempool existing in + let operation_state = + add_valid_operation + mempool.operation_state + new_oph + operation + in + let operations = + Operation_hash.Map.add oph packed_op mempool.operations + in + Lwt.return_ok + ( {mempool with operations; operation_state}, + Replaced {removed = existing} )) + | None -> Lwt.return_error (Add_conflict x))) + +let merge ?conflict_handler existing_mempool new_mempool = + if + Block_hash.( + existing_mempool.predecessor_hash <> new_mempool.predecessor_hash) + then Error Incompatible_mempool + else + let open Result_syntax in + let unique_new_operations = + (* only retain unique operations that are in new_mempool *) + Operation_hash.Map.( + merge + (fun _ l r -> + match (l, r) with + | None, Some r -> Some r + | Some _, None -> None + | Some _, Some _ -> None + | None, None -> None) + existing_mempool.operations + new_mempool.operations) + in + let unopt_assert = function None -> assert false | Some o -> o in + let handle_conflict new_operation_content conflict = + match (conflict, conflict_handler) with + | Ok (), _ -> Ok `Add_new + | Error conflict, None -> Error (Merge_conflict conflict) + | ( Error (Operation_conflict {existing; new_operation}), + Some (f : conflict_handler) ) -> ( + (* New operations can only conflict with operations + already present in the existing mempool. *) + let existing_operation_content = + Operation_hash.Map.find_opt existing existing_mempool.operations + |> unopt_assert + in + match + f + ~existing_operation:(existing, existing_operation_content) + ~new_operation:(new_operation, new_operation_content) + with + | `Keep -> Ok `Do_nothing + | `Replace -> Ok (`Replace existing)) + in + Operation_hash.Map.fold_e + (fun roph packed_right_op mempool_acc -> + let {shell; protocol_data = Operation_data protocol_data} = + packed_right_op + in + let right_op = ({shell; protocol_data} : _ operation) in + let* conflict = + check_operation_conflict mempool_acc.operation_state roph right_op + |> handle_conflict packed_right_op + in + match conflict with + | `Do_nothing -> return mempool_acc + | `Add_new -> + let operation_state = + add_valid_operation mempool_acc.operation_state roph right_op + in + let operations = + Operation_hash.Map.add roph packed_right_op mempool_acc.operations + in + return {mempool_acc with operation_state; operations} + | `Replace loph -> + let mempool_acc = remove_operation mempool_acc loph in + let operation_state = + add_valid_operation mempool_acc.operation_state roph right_op + in + let operations = + Operation_hash.Map.add roph packed_right_op mempool_acc.operations + in + return {mempool_acc with operation_state; operations}) + unique_new_operations + existing_mempool + +let operations mempool = mempool.operations diff --git a/src/proto_alpha/lib_protocol/mempool_validation.mli b/src/proto_alpha/lib_protocol/mempool_validation.mli new file mode 100644 index 0000000000000000000000000000000000000000..6ed036b88545c2155cc00b92934456a720d238d5 --- /dev/null +++ b/src/proto_alpha/lib_protocol/mempool_validation.mli @@ -0,0 +1,185 @@ +(*****************************************************************************) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** This module implements a mempool structure meant to be used by a + shell and bakers in order to incrementally accumulate commutative + operations which could then be safely used to bake a new + block. These mempool components guarantee a set of properties + useful for these purposes: + + - Every operation contained in a mempool is valid; + + - All the mempool's operations can safely be included (and + applicable) in a block in an arbitrary order which means + operations commutes. However, to build a valid block with these + operations: + + - Operations must be reorganized with regards to their validation + passes. + - Block's operations quota are ignored, it is the baker's + responsability to ensure that the set of selected operations + does not exceed gas/size operations quota. + - The baker must also include the required preendorsements and + endorsements. + + - The merging of two mempools also maintains the aforementioned + properties. + + Mempools do not depend on local data and therefore are + serializable. This is useful when a node needs to send a mempool + to another (remote-)process (e.g. the baker). +*) + +open Alpha_context + +(** Mempool type *) +type t + +(** Validation info type required to validate and add operations to a + mempool. *) +type validation_info + +(** Type of the function that may be provided in order to resolve a + potential conflict when adding an operation to an existing mempool + or when merging two mempools. This handler may be defined as a + simple order relation over operations (e.g. prioritize the most + profitable operations) or an arbitrary one (e.g. prioritize + operations where the source is a specific manager). + + Returning [`Keep] will leave the mempool unchanged and retain the + [existing_operation] while returning [`Replace] will remove + [existing_operation] and add [new_operation] instead. *) +type conflict_handler = + existing_operation:Operation_hash.t * packed_operation -> + new_operation:Operation_hash.t * packed_operation -> + [`Keep | `Replace] + +(** Return type when adding an operation to the mempool *) +type add_result = + | Added + (** [Added] means that an operation was successfully added to + the mempool without any conflict. *) + | Replaced of {removed : Operation_hash.t} + (** [Replaced {removed}] means that an operation was + successfully added but there was a conflict with the [removed] + operation which was removed from the mempool. *) + | Unchanged + (** [Unchanged] means that there was a conflict with an existing + operation which was considered better by the + [conflict_handler], therefore the new operation is discarded + and the mempool remains unchanged. *) + +type operation_conflict = Validate_errors.operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + +(** Error type returned when adding an operation to the mempool fails. *) +type add_error = + | Validation_error of error trace + (** [Validation_error _] means that the operation is invalid. *) + | Add_conflict of operation_conflict + (** [Add_conflict _] means that an operation conflicts with an + existing one. This error will only be obtained when no + [conflict_handler] was provided. Moreover, [Validation_error _] + takes precedence over [Add_conflict _] which implies that + we have the implicit invariant that the operation would be + valid if there was no conflict. Therefore, if + [add_operation] would have to be called again, it would be + redondant to check the operation's signature. *) + +(** Error type returned when the merge of two mempools fails. *) +type merge_error = + | Incompatible_mempool + (** [Incompatible_mempool _] means that the two mempools are not built + ontop of the same head and therefore cannot be considered. *) + | Merge_conflict of operation_conflict + (** [Merge_conflict _] arises when two mempools contain conflicting + operations and no [conflict_handler] was provided. *) + +(** Mempool encoding *) +val encoding : t Data_encoding.t + +(** Initialize a static [validation_info] and [mempool], required to validate and add + operations, and an incremental and serializable [mempool]. *) +val init : + context -> + Chain_id.t -> + predecessor_level:Level.t -> + predecessor_round:Round.t -> + predecessor_hash:Block_hash.t -> + grandparent_round:Round.t -> + validation_info * t + +(** Adds an operation to a [mempool] if and only if it is valid and + does not conflict with previously added operations. + + This function checks the validity of an operation (see + {!Validate.check_operation}) and tries to add it to the mempool. + + If an error occurs during the validation, the result will be a + [Validation_error ]. If a conflict with a previous operation + exists, the result will be an [Add_conflict] (see + {!Validate.check_operation_conflict}). Important: no + [Add_conflict] will be raised if a [conflict_handler] is + provided (see [add_result]). + + If no error is raised the operation is potentially added to the + [mempool] depending on the [add_result] value. *) +val add_operation : + ?check_signature:bool -> + ?conflict_handler:conflict_handler -> + validation_info -> + t -> + Operation_hash.t * packed_operation -> + (t * add_result, add_error) result Lwt.t + +(** [remove_operation mempool oph] removes the operation [oph] from + the [mempool]. The [mempool] remains unchanged when [oph] is not + present in the [mempool] *) +val remove_operation : t -> Operation_hash.t -> t + +(** [merge ?conflict_handler existing_mempool new_mempool] merges [new_mempool] + {b into} [existing_mempool]. + + Mempools may only be merged if they are compatible: i.e. both have + been initialised with the same predecessor block. Otherwise, the + [Incompatible_mempool] error is returned. + + Conflicts between operations from the two mempools can + occur. Similarly as [add_operation], a [Merge_conflict] error + may be raised when no [conflict_handler] is provided. + + [existing_operation] in [conflict_handler ~existing_operation ~new_operation] + references operations present in [existing_mempool] while + [new_operation] will reference operations present in + [new_mempool]. *) +val merge : + ?conflict_handler:conflict_handler -> t -> t -> (t, merge_error) result + +(** [operations mempool] returns the map of operations present in + [mempool]. *) +val operations : t -> packed_operation Operation_hash.Map.t diff --git a/src/proto_alpha/lib_protocol/raw_level_repr.ml b/src/proto_alpha/lib_protocol/raw_level_repr.ml index bb30979dad49625e7872a475c983f0c87fa90d91..24ac0327882eb05f10cab7a13eee9434d448a66b 100644 --- a/src/proto_alpha/lib_protocol/raw_level_repr.ml +++ b/src/proto_alpha/lib_protocol/raw_level_repr.ml @@ -30,6 +30,7 @@ type raw_level = t include (Compare.Int32 : Compare.S with type t := t) module Set = Set.Make (Compare.Int32) +module Map = Map.Make (Compare.Int32) let pp ppf level = Format.fprintf ppf "%ld" level diff --git a/src/proto_alpha/lib_protocol/raw_level_repr.mli b/src/proto_alpha/lib_protocol/raw_level_repr.mli index 2a0f5bf695b785632301f5d7eddcdf9d3debbe65..cdfcb175d57d435abc66b904e74ccfd7e35e9bb3 100644 --- a/src/proto_alpha/lib_protocol/raw_level_repr.mli +++ b/src/proto_alpha/lib_protocol/raw_level_repr.mli @@ -32,6 +32,8 @@ type raw_level = t module Set : Set.S with type elt = t +module Map : Map.S with type key = t + (** @raise Invalid_argument when the level to encode is not positive *) val encoding : raw_level Data_encoding.t diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_seed.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_seed.ml index 4025164abc26b788c55dd191c3f9ef33799414f7..c284eb3552aaab8f039658b62f8137fd6394e276 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_seed.ml +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_seed.ml @@ -202,7 +202,7 @@ let test_revelation_early_wrong_right_twice () = in let* () = Assert.proto_error ~loc:__LOC__ e (function - | Validate_errors.Anonymous.Conflicting_nonce_revelation -> true + | Validate_errors.Anonymous.Conflicting_nonce_revelation _ -> true | _ -> false) in let* b = Block.bake ~policy:(Block.By_account baker_pkh) ~operation b in @@ -492,7 +492,7 @@ let test_early_incorrect_unverified_correct_already_vdf () = in let* () = Assert.proto_error ~loc:__LOC__ e (function - | Seed_storage.Already_accepted -> true + | Validate_errors.Anonymous.Conflicting_vdf_revelation _ -> true | _ -> false) in (* verify the balance was credited following operation inclusion *) diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml index 9981dd0f803ee6915da761656bbb4335ecb34555..6d1f908f3d357f50b302021dd51e218a3b050075 100644 --- a/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml +++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_voting.ml @@ -362,28 +362,20 @@ let proposals_contain_duplicate duplicate_proposal loc = function | err -> wrong_error "Proposals_contain_duplicate" err loc let too_many_proposals loc = function - | [Environment.Ecoproto_error Too_many_proposals] -> return_unit + | [Environment.Ecoproto_error (Too_many_proposals _)] -> return_unit | err -> wrong_error "Too_many_proposals" err loc let already_proposed already_proposed_proposal loc = function - | [Environment.Ecoproto_error (Already_proposed {proposal})] -> + | [Environment.Ecoproto_error (Already_proposed {proposal; _})] -> Assert.equal_protocol_hash ~loc:(append_loc ~caller_loc:loc __LOC__) proposal already_proposed_proposal | err -> wrong_error "Already_proposed" err loc -let conflict_too_many_proposals loc = function - | [Environment.Ecoproto_error (Conflict_too_many_proposals _)] -> return_unit - | err -> wrong_error "Conflict_too_many_proposals" err loc - -let conflict_already_proposed already_proposed_proposal loc = function - | [Environment.Ecoproto_error (Conflict_already_proposed {proposal; _})] -> - Assert.equal_protocol_hash - ~loc:(append_loc ~caller_loc:loc __LOC__) - proposal - already_proposed_proposal - | err -> wrong_error "Conflict_already_proposed" err loc +let conflicting_proposals loc = function + | [Environment.Ecoproto_error (Conflicting_proposals _)] -> return_unit + | err -> wrong_error "Conflicting_proposals" err loc let ballot_for_wrong_proposal ~current_proposal ~op_proposal loc = function | [ @@ -1483,16 +1475,15 @@ let test_conflict_too_many_proposals () = let* op = Op.proposals (B block) proposer [protos.(0)] in let* _i = Incremental.validate_operation - ~expect_failure:(conflict_too_many_proposals __LOC__) + ~expect_failure:(conflicting_proposals __LOC__) current_block_state op in return_unit -(** Test that a Proposals operation fails when one of its proposals - has already been submitted by the same proposer in a previously - validated operation of the current block/mempool. *) -let test_conflict_already_proposed () = +(** Test that a Proposals operation fails when its source has already + submitted a Proposals operation in the current block/mempool. *) +let test_conflicting_proposal () = let open Lwt_result_syntax in let* block, proposer = context_init1 () in let proposal = protos.(0) in @@ -1504,10 +1495,18 @@ let test_conflict_already_proposed () = let* op = Op.proposals (B block) proposer [proposal] in let* _i = Incremental.validate_operation - ~expect_failure:(conflict_already_proposed proposal __LOC__) + ~expect_failure:(conflicting_proposals __LOC__) current_block_state op in + let proposal' = protos.(1) in + let* op' = Op.proposals (B block) proposer [proposal'] in + let* _i = + Incremental.validate_operation + ~expect_failure:(conflicting_proposals __LOC__) + current_block_state + op' + in return_unit (** {3 Proposals -- Positive test} @@ -1639,7 +1638,7 @@ let test_too_many_proposals_in_one_operation () = try let* _ = Op.proposals (B b0) proposer0 protos in failwith - "Encoding of proposals operation with too many proposal should fail" + "Encoding of proposals operation with too many proposals should fail" with Data_encoding.Binary.(Write_error List_invalid_length) -> return_unit in return_unit @@ -2060,9 +2059,9 @@ let tests = `Quick test_conflict_too_many_proposals; Tztest.tztest - "Conflict: proposal already proposed in current block/mempool" + "Conflicting proposals in current block/mempool" `Quick - test_conflict_already_proposed; + test_conflicting_proposal; Tztest.tztest "Valid Proposals operations" `Quick test_valid_proposals; (* Validity tests on Ballot *) Tztest.tztest diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/generators.ml b/src/proto_alpha/lib_protocol/test/integration/validate/generators.ml index 08f8d5ae24ecd4113036ad78212ba254a595b1b2..5ab558db05f0752b8b6ec1bf7b39b0893e0e1bd4 100644 --- a/src/proto_alpha/lib_protocol/test/integration/validate/generators.ml +++ b/src/proto_alpha/lib_protocol/test/integration/validate/generators.ml @@ -246,6 +246,7 @@ let gen_ctxt_req : ctxt_cstrs -> ctxt_req QCheck2.Gen.t = fund_src; fund_dest; fund_del; + reveal_accounts = true; fund_tx; fund_sc; fund_zk; diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/main.ml b/src/proto_alpha/lib_protocol/test/integration/validate/main.ml index 5613c918c335d8287e8c3d41f401b3ec3d021094..1da1e1a439667b7bb53a4c4f15df788ea46718d3 100644 --- a/src/proto_alpha/lib_protocol/test/integration/validate/main.ml +++ b/src/proto_alpha/lib_protocol/test/integration/validate/main.ml @@ -48,5 +48,6 @@ let () = Test_batched_manager_operation_validation.fee_tests ); ( "Flags: feature flag checks", Test_manager_operation_validation.flags_tests ); + ("Mempool", Test_mempool.tests); ] |> Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml b/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml index 1a191fb004c23ce73727b38f4615fd095d9d9963..df515965ba124be42164af6fee3ae0faff004644 100644 --- a/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/integration/validate/manager_operation_helpers.ml @@ -121,6 +121,7 @@ type ctxt_req = { fund_src : Tez.t option; fund_dest : Tez.t option; fund_del : Tez.t option; + reveal_accounts : bool; fund_tx : Tez.t option; fund_sc : Tez.t option; fund_zk : Tez.t option; @@ -152,6 +153,7 @@ let ctxt_req_default_to_flag flags = fund_src = Some Tez.one; fund_dest = Some Tez.one; fund_del = Some Tez.one; + reveal_accounts = true; fund_tx = Some Tez.one; fund_sc = Some Tez.one; fund_zk = Some Tez.one; @@ -251,6 +253,7 @@ let pp_ctxt_req pp fund_src; fund_dest; fund_del; + reveal_accounts; fund_tx; fund_sc; fund_zk; @@ -263,6 +266,7 @@ let pp_ctxt_req pp fund_src: %a tz@,\ fund_dest: %a tz@,\ fund_del: %a tz@,\ + reveal_accounts: %b tz@,\ fund_tx: %a tz@,\ fund_sc: %a tz@,\ fund_zk: %a tz@,\ @@ -279,6 +283,7 @@ let pp_ctxt_req pp fund_dest (pp_opt Tez.pp) fund_del + reveal_accounts (pp_opt Tez.pp) fund_tx (pp_opt Tez.pp) @@ -434,6 +439,7 @@ let init_ctxt : ctxt_req -> infos tzresult Lwt.t = fund_src; fund_dest; fund_del; + reveal_accounts; fund_tx; fund_sc; fund_zk; @@ -467,6 +473,15 @@ let init_ctxt : ctxt_req -> infos tzresult Lwt.t = ~zk_rollup_enable:flags.zkru () in + let reveal_accounts_operations b l = + List.filter_map_es + (function + | None -> return_none + | Some account -> + let* op = Op.revelation ~gas_limit:Low (B b) account.Account.pk in + return_some op) + l + in let get_bootstrap bootstraps n = Stdlib.List.nth bootstraps n in let source = Account.new_account () in let* block = @@ -512,7 +527,13 @@ let init_ctxt : ctxt_req -> infos tzresult Lwt.t = ~fee:Tez.zero ~script:Op.dummy_script in - let+ block = Block.bake ~operation:create_contract_hash block in + let* reveal_operations = + if reveal_accounts then + reveal_accounts_operations block [Some source; dest; del] + else return [] + in + let operations = create_contract_hash :: reveal_operations in + let+ block = Block.bake ~operations block in let ctxt = {block; originated_contract; tx_rollup; sc_rollup; zk_rollup} in {ctxt; accounts = {source; dest; del; tx; sc; zk}} diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/test_manager_operation_validation.ml b/src/proto_alpha/lib_protocol/test/integration/validate/test_manager_operation_validation.ml index 4ce862ab8a77f9b595e499ebfa69c65cbaeb2914..5d352f63cd9951a10cb4532247169ecad21b85bc 100644 --- a/src/proto_alpha/lib_protocol/test/integration/validate/test_manager_operation_validation.ml +++ b/src/proto_alpha/lib_protocol/test/integration/validate/test_manager_operation_validation.ml @@ -370,7 +370,7 @@ let unrevealed_key_diagnostic (infos : infos) op = let test_unrevealed_key kind () = let open Lwt_result_syntax in - let* infos = default_init_ctxt () in + let* infos = init_ctxt {ctxt_req_default with reveal_accounts = false} in let* op = select_op {(operation_req_default kind) with force_reveal = Some false} diff --git a/src/proto_alpha/lib_protocol/test/integration/validate/test_mempool.ml b/src/proto_alpha/lib_protocol/test/integration/validate/test_mempool.ml new file mode 100644 index 0000000000000000000000000000000000000000..a6ab57cc546efd25ab5df30868cbed237721aecc --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/validate/test_mempool.ml @@ -0,0 +1,387 @@ +(*****************************************************************************) +(* *) +(* 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: Protocol + Invocation: dune exec \ + src/proto_alpha/lib_protocol/test/integration/validate/main.exe \ + -- test "^Mempool" + Subject: Integration > Validate > Mempool mode +*) + +open Protocol +open Alpha_context +module Mempool = Mempool_validation + +let extract_values ctxt (b : Block.t) = + let predecessor_level = + Level.from_raw ctxt (Raw_level.of_int32_exn b.header.shell.level) + in + let fitness = + Fitness.from_raw b.header.shell.fitness |> function + | Ok v -> v + | Error _ -> assert false + in + let predecessor_round = Fitness.round fitness in + let predecessor_hash = b.header.shell.predecessor in + let grandparent_round = Fitness.predecessor_round fitness in + (predecessor_level, predecessor_round, predecessor_hash, grandparent_round) + +let op_with_hash op = (Operation.hash_packed op, op) + +let expect_ok_added ~__LOC__ x = + match x with + | Ok (mempool, Mempool.Added) -> mempool + | _ -> Format.kasprintf Stdlib.failwith "%s: expected added" __LOC__ + +let expect_conflict ~__LOC__ x = + match (x : ('a, Mempool.add_error) result) with + | Error (Add_conflict _) -> () + | _ -> Format.kasprintf Stdlib.failwith "%s: expected conflict" __LOC__ + +let expect_conflict_handled ~__LOC__ kind x = + match (x : (Mempool.t * Mempool.add_result, Mempool.add_error) result) with + | Ok (mempool, kind') when kind = kind' -> mempool + | _ -> + Format.kasprintf Stdlib.failwith "%s: expected handled conflict" __LOC__ + +let handler_always_keep ~existing_operation:_ ~new_operation:_ = `Keep + +let handler_always_replace ~existing_operation:_ ~new_operation:_ = `Replace + +let assert_empty_mempool ~__LOC__ mempool = + let operations = Mempool.operations mempool in + Assert.equal_bool + ~loc:__LOC__ + true + (Environment.Operation_hash.Map.is_empty operations) + +let assert_operation_present_in_mempool ~__LOC__ mempool ophl = + let operations = Mempool.operations mempool in + let resulting_mempool_operations = + Environment.Operation_hash.Map.bindings operations + |> List.map fst + |> List.sort Operation_hash.compare + in + let expected_operations = List.sort Operation_hash.compare ophl in + Assert.assert_equal_list + ~loc:__LOC__ + Operation_hash.equal + "operations present in mempool" + Operation_hash.pp + resulting_mempool_operations + expected_operations + +let test_simple () = + let open Lwt_result_syntax in + let* block, (c1, c2) = Context.init2 () in + let* ctxt = Block.to_alpha_ctxt block in + let predecessor_level, predecessor_round, predecessor_hash, grandparent_round + = + extract_values ctxt block + in + let vs, mempool = + Mempool.init + ctxt + Chain_id.zero + ~predecessor_level + ~predecessor_round + ~predecessor_hash + ~grandparent_round + in + let* op1 = Op.transaction (B block) c1 c2 Tez.one_cent in + let op1 = op_with_hash op1 in + let* op1' = Op.transaction (B block) c1 c2 Tez.one in + let op1' = op_with_hash op1' in + let* op2 = Op.transaction (B block) c2 c1 Tez.one in + let op2 = op_with_hash op2 in + let*! res = Mempool.add_operation vs mempool op1 in + let mempool = expect_ok_added ~__LOC__ res in + let*! res = Mempool.add_operation vs mempool op2 in + let mempool = expect_ok_added ~__LOC__ res in + let*! res = Mempool.add_operation vs mempool op1' in + let () = expect_conflict ~__LOC__ res in + return_unit + +let test_imcompatible_mempool () = + let open Lwt_result_syntax in + let* block, _ = Context.init1 ~consensus_threshold:0 () in + let* block = Block.bake block in + let* ctxt = Block.to_alpha_ctxt block in + let predecessor_level, predecessor_round, predecessor_hash, grandparent_round + = + extract_values ctxt block + in + let _vs, mempool1 = + Mempool.init + ctxt + Chain_id.zero + ~predecessor_level + ~predecessor_round + ~predecessor_hash + ~grandparent_round + in + (* Create a second mempool on a different block *) + let* block2 = Block.bake block in + let* ctxt2 = Block.to_alpha_ctxt block2 in + let predecessor_level, predecessor_round, predecessor_hash2, grandparent_round + = + extract_values ctxt2 block2 + in + let _vs, mempool2 = + Mempool.init + ctxt2 + Chain_id.zero + ~predecessor_level + ~predecessor_round + ~predecessor_hash:predecessor_hash2 + ~grandparent_round + in + let () = + match Mempool.merge mempool1 mempool2 with + | Error Mempool.Incompatible_mempool -> () + | Error (Merge_conflict _) -> + Format.kasprintf + Stdlib.failwith + "%s: expected incompatible mempool" + __LOC__ + | Ok _ -> Format.kasprintf Stdlib.failwith "%s: expected conflict" __LOC__ + in + return_unit + +let test_merge () = + let open Lwt_result_syntax in + let* block, (c1, c2) = Context.init2 () in + let* ctxt = Block.to_alpha_ctxt block in + let predecessor_level, predecessor_round, predecessor_hash, grandparent_round + = + extract_values ctxt block + in + let vs, mempool_i = + Mempool.init + ctxt + Chain_id.zero + ~predecessor_level + ~predecessor_round + ~predecessor_hash + ~grandparent_round + in + (* Build two mempool with a conflicting operation and check that the + merge fails and succeeds when a conflict handler is provided *) + let* op1 = Op.transaction (B block) c1 c2 Tez.one_cent in + let op1 = op_with_hash op1 in + let* op2 = Op.transaction (B block) c2 c1 Tez.one in + let op2 = op_with_hash op2 in + let*! res = Mempool.add_operation vs mempool_i op1 in + let mempool1 = expect_ok_added ~__LOC__ res in + let*! res = Mempool.add_operation vs mempool_i op2 in + let mempool2 = expect_ok_added ~__LOC__ res in + let merged_non_conflicting_mempool = + match Mempool.merge mempool1 mempool2 with + | Ok mempool -> mempool + | _ -> + Format.kasprintf Stdlib.failwith "%s: expected succesful merge" __LOC__ + in + let* op1' = Op.transaction (B block) c1 c2 Tez.one in + let op1' = op_with_hash op1' in + let*! res = Mempool.add_operation vs mempool_i op1' in + let mempool3 = expect_ok_added ~__LOC__ res in + let*! res = Mempool.add_operation vs mempool3 op2 in + let mempool3 = expect_ok_added ~__LOC__ res in + let () = + match Mempool.merge merged_non_conflicting_mempool mempool3 with + | Error (Merge_conflict _) -> () + | _ -> Format.kasprintf Stdlib.failwith "%s: expected conflict" __LOC__ + in + let merged_mempool_replace = + match + Mempool.merge + ~conflict_handler:handler_always_replace + merged_non_conflicting_mempool + mempool3 + with + | Ok mempool -> mempool + | _ -> + Format.kasprintf Stdlib.failwith "%s: expected succesful merge" __LOC__ + in + let* () = + assert_operation_present_in_mempool + ~__LOC__ + merged_mempool_replace + (List.map fst [op1'; op2]) + in + let merged_mempool_keep = + match + Mempool.merge + ~conflict_handler:handler_always_keep + merged_non_conflicting_mempool + mempool3 + with + | Ok mempool -> mempool + | _ -> + Format.kasprintf Stdlib.failwith "%s: expected succesful merge" __LOC__ + in + let* () = + assert_operation_present_in_mempool + ~__LOC__ + merged_mempool_keep + (List.map fst [op1; op2]) + in + (* Check that merging a mempool with itself is a success and returns + the identity *) + let* () = + match Mempool.merge mempool1 mempool1 with + | Ok mempool -> + let expected_operations = + Environment.Operation_hash.Map.bindings (Mempool.operations mempool1) + |> List.map fst + in + assert_operation_present_in_mempool ~__LOC__ mempool expected_operations + | Error _ -> assert false + in + return_unit + +let test_add_invalid_operation () = + let open Lwt_result_syntax in + let* block, c1 = Context.init1 () in + let* ctxt = Block.to_alpha_ctxt block in + let predecessor_level, predecessor_round, predecessor_hash, grandparent_round + = + extract_values ctxt block + in + let vs, mempool_i = + Mempool.init + ctxt + Chain_id.zero + ~predecessor_level + ~predecessor_round + ~predecessor_hash + ~grandparent_round + in + let* op1 = Op.transaction (B block) c1 c1 ~gas_limit:Zero Tez.one_cent in + let op1 = op_with_hash op1 in + let*! res = Mempool.add_operation vs mempool_i op1 in + match res with + | Error (Mempool.Validation_error _) -> return_unit + | Error _ -> Stdlib.failwith "unexpected error" + | Ok _ -> Stdlib.failwith "unexpected success" + +let test_add_and_replace () = + let open Lwt_result_syntax in + let* block, (c1, c2) = Context.init2 () in + let* ctxt = Block.to_alpha_ctxt block in + let predecessor_level, predecessor_round, predecessor_hash, grandparent_round + = + extract_values ctxt block + in + let info, mempool_i = + Mempool.init + ctxt + Chain_id.zero + ~predecessor_level + ~predecessor_round + ~predecessor_hash + ~grandparent_round + in + (* Try adding a conflicting operation using both handler strategy *) + let* op1 = Op.transaction (B block) c1 c2 Tez.one_cent in + let op1 = op_with_hash op1 in + let* op1' = Op.transaction (B block) c1 c2 Tez.one in + let op1' = op_with_hash op1' in + let*! res = Mempool.add_operation info mempool_i op1 in + let mempool = expect_ok_added ~__LOC__ res in + let*! res = Mempool.add_operation info mempool op1' in + let () = expect_conflict ~__LOC__ res in + let*! res = + Mempool.add_operation + ~conflict_handler:handler_always_keep + info + mempool + op1' + in + let final_mempool = expect_conflict_handled ~__LOC__ Unchanged res in + let* () = + assert_operation_present_in_mempool ~__LOC__ final_mempool [fst op1] + in + let*! res = + Mempool.add_operation + ~conflict_handler:handler_always_replace + info + mempool + op1' + in + let final_mempool = + expect_conflict_handled ~__LOC__ (Replaced {removed = fst op1}) res + in + let* () = + assert_operation_present_in_mempool ~__LOC__ final_mempool [fst op1'] + in + return_unit + +let test_remove_operation () = + let open Lwt_result_syntax in + let* block, (c1, c2) = Context.init2 () in + let* ctxt = Block.to_alpha_ctxt block in + let predecessor_level, predecessor_round, predecessor_hash, grandparent_round + = + extract_values ctxt block + in + let info, mempool_i = + Mempool.init + ctxt + Chain_id.zero + ~predecessor_level + ~predecessor_round + ~predecessor_hash + ~grandparent_round + in + let* op1 = Op.transaction (B block) c1 c2 Tez.one_cent in + let op1 = op_with_hash op1 in + let* op2 = Op.transaction (B block) c1 c2 Tez.one in + let op2 = op_with_hash op2 in + (* Add one operation to the mempoolg *) + let*! res = Mempool.add_operation info mempool_i op1 in + let mempool = expect_ok_added ~__LOC__ res in + let* () = assert_operation_present_in_mempool ~__LOC__ mempool [fst op1] in + (* Try removing unknown operation and check that the mempool is unchanged *) + let mempool = Mempool.remove_operation mempool (fst op2) in + let* () = assert_operation_present_in_mempool ~__LOC__ mempool [fst op1] in + (* Try removing known operation and ensure that the mempool is empty *) + let empty_mempool = Mempool.remove_operation mempool (fst op1) in + assert_empty_mempool ~__LOC__ empty_mempool + +let tests = + [ + Tztest.tztest "simple" `Quick test_simple; + Tztest.tztest "incompatible mempool" `Quick test_imcompatible_mempool; + Tztest.tztest "merge" `Quick test_merge; + Tztest.tztest "adding invalid operation" `Quick test_add_invalid_operation; + Tztest.tztest + "adding operation with conflict handler" + `Quick + test_add_and_replace; + Tztest.tztest "remove operations" `Quick test_remove_operation; + ] diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml index 5cb0651960337bbd6c45c42eefdf271de971e304..4c2a0549fe43ddcaf45bfff024a1a43b2d4719ae 100644 --- a/src/proto_alpha/lib_protocol/validate.ml +++ b/src/proto_alpha/lib_protocol/validate.ml @@ -23,21 +23,17 @@ (* *) (*****************************************************************************) +open Validate_errors open Alpha_context -(** {2 Definition and initialization of [info] and [state]} - - These live in memory during the validation of a block, or until a - change of head block; they are never put in the storage. *) - (** Since the expected features of preendorsement and endorsement are the same for all operations in the considered block, we compute them once and for all at the begining of the block. - See [expected_features_for_block_validation], - [expected_features_for_block_construction], and - [expected_features_for_mempool] in the [Consensus] module below. *) - + See [expected_features_for_application], + [expected_features_for_construction], and + [expected_features_for_partial_construction] in the [Consensus] + module below. *) type expected_features = { level : Raw_level.t; round : Round.t option; @@ -52,19 +48,20 @@ type expected_preendorsement = | Expected_preendorsement of { expected_features : expected_features; block_round : Round.t option; - (** During block validation or construction, we must also check - that the preendorsement round is lower than the block - round. In mempool mode, this field is [None]. *) } + (** During block validation or construction, we must also check + that the preendorsement round is lower than the block + round. In mempool mode, this field is [None]. *) | No_locked_round_for_block_validation_preendorsement (** A preexisting block whose fitness indicates no locked round should contain no preendorsements. *) - | Fresh_proposal_for_block_construction_preendorsement + | Fresh_proposal_for_construction_preendorsement (** A constructed block with a fresh proposal should contain no preendorsements. *) - | No_expected_branch_for_mempool_preendorsement of { + | No_expected_branch_for_partial_construction_preendorsement of { expected_level : Raw_level.t; - } (** See [No_expected_branch_for_mempool_endorsement] below. *) + } + (** See [No_expected_branch_for_partial_construction_endorsement] below. *) | No_predecessor_info_cannot_validate_preendorsement (** We do not have access to predecessor level, round, etc. so any preendorsement validation will fail. *) @@ -75,7 +72,9 @@ type expected_endorsement = (** The context contains no branch: this happens to the first block that uses the Tenderbake consensus algorithm. This block contains no endorsements. *) - | No_expected_branch_for_mempool_endorsement of {expected_level : Raw_level.t} + | No_expected_branch_for_partial_construction_endorsement of { + expected_level : Raw_level.t; + } (** Same as [No_expected_branch_for_block_endorsement]. This has a separate constructor because the error raised is distinct: in mempool mode, we simply assume that we have received a @@ -88,9 +87,10 @@ type expected_endorsement = type all_expected_consensus_features = { expected_preendorsement : expected_preendorsement; expected_endorsement : expected_endorsement; - expected_grandparent_endorsement_for_mempool : expected_features option; + expected_grandparent_endorsement_for_partial_construction : + expected_features option; (** This only has a value in Mempool mode and when the [ctxt] has a - [grand_parent_branch]; it is [None] in all other cases. *) + [grandparent_branch]; it is [None] in all other cases. *) } type consensus_info = { @@ -106,72 +106,150 @@ let init_consensus_info ctxt all_expected_features = endorsement_slot_map = Consensus.allowed_endorsements ctxt; } +module Consensus_content_map = Map.Make (struct + type t = consensus_content + + let compare {slot; level; round; block_payload_hash} + { + slot = slot'; + level = level'; + round = round'; + block_payload_hash = block_payload_hash'; + } = + Compare.or_else (Raw_level.compare level level') @@ fun () -> + Compare.or_else (Slot.compare slot slot') @@ fun () -> + Compare.or_else (Round.compare round round') @@ fun () -> + Compare.or_else + (Block_payload_hash.compare block_payload_hash block_payload_hash') + @@ fun () -> 0 +end) + type consensus_state = { - preendorsements_seen : Slot.Set.t; - endorsements_seen : Slot.Set.t; - endorsement_power : int; - grandparent_endorsements_seen : Signature.Public_key_hash.Set.t; - locked_round_evidence : (Round.t * int) option; - dal_slot_availability_seen : Signature.Public_key_hash.Set.t; + predecessor_level : Raw_level.t; + preendorsements_seen : Operation_hash.t Slot.Map.t; + endorsements_seen : Operation_hash.t Slot.Map.t; + grandparent_endorsements_seen : Operation_hash.t Slot.Map.t; + dal_slot_availability_seen : Operation_hash.t Signature.Public_key_hash.Map.t; } -let empty_consensus_state = +let slot_map_encoding element_encoding = + let open Data_encoding in + conv + (fun slot_map -> Slot.Map.bindings slot_map) + (fun l -> Slot.Map.(List.fold_left (fun m (k, v) -> add k v m) empty l)) + (list (tup2 Slot.encoding element_encoding)) + +let consensus_state_encoding = + let open Data_encoding in + def "consensus_state" + @@ conv + (fun { + predecessor_level; + preendorsements_seen; + endorsements_seen; + grandparent_endorsements_seen; + dal_slot_availability_seen; + } -> + ( predecessor_level, + preendorsements_seen, + endorsements_seen, + grandparent_endorsements_seen, + dal_slot_availability_seen )) + (fun ( predecessor_level, + preendorsements_seen, + endorsements_seen, + grandparent_endorsements_seen, + dal_slot_availability_seen ) -> + { + predecessor_level; + preendorsements_seen; + endorsements_seen; + grandparent_endorsements_seen; + dal_slot_availability_seen; + }) + (obj5 + (req "predecessor_level" Raw_level.encoding) + (req + "preendorsements_seen" + (slot_map_encoding Operation_hash.encoding)) + (req "endorsements_seen" (slot_map_encoding Operation_hash.encoding)) + (req + "grandparent_endorsements_seen" + (slot_map_encoding Operation_hash.encoding)) + (req + "dal_slot_availability_seen" + (Signature.Public_key_hash.Map.encoding Operation_hash.encoding))) + +let init_consensus_state ~predecessor_level = { - preendorsements_seen = Slot.Set.empty; - endorsements_seen = Slot.Set.empty; - endorsement_power = 0; - grandparent_endorsements_seen = Signature.Public_key_hash.Set.empty; - locked_round_evidence = None; - dal_slot_availability_seen = Signature.Public_key_hash.Set.empty; + predecessor_level; + preendorsements_seen = Slot.Map.empty; + endorsements_seen = Slot.Map.empty; + grandparent_endorsements_seen = Slot.Map.empty; + dal_slot_availability_seen = Signature.Public_key_hash.Map.empty; } -(** Summary of previously validated Proposals operations by a given - proposer in the current block/mempool. *) -type proposer_history = { - count : int; - (** Total number of protocols submitted by the proposer in - previously validated operations. *) - operations : Operation_hash.t list; - (** Hashes of the previously validated Proposals operations from - the proposer. *) - proposed : Operation_hash.t Protocol_hash.Map.t; - (** A map indexed by the protocols that have been submitted by the - proposer in previously validated operations. Each protocol - points to the operation in which it was proposed. *) -} - type voting_state = { - proposals_validated : proposer_history Signature.Public_key_hash.Map.t; + proposals_seen : Operation_hash.t Signature.Public_key_hash.Map.t; (** Summary of all Proposals operations validated in the current block/mempool, indexed by the operation's source aka - proposer. *) - dictator_proposals_validated : Operation_hash.t option; - (** If a testnet dictator Proposals operation has been validated - in the current block/mempool, then its hash is recorded - here. Since such an operation can change the voting period - kind, it is mutually exclusive with any other voting operation - in a single block (otherwise we would loose the commutativity - of validated operation application: see - {!Validate_operation}). *) - ballots_validated : Operation_hash.t Signature.Public_key_hash.Map.t; + proposer. This includes Testnet dictators proposals. *) + ballots_seen : Operation_hash.t Signature.Public_key_hash.Map.t; (** To each delegate that has submitted a ballot in a previously validated operation, associates the hash of this operation. *) } -let empty_voting_state = - { - proposals_validated = Signature.Public_key_hash.Map.empty; - dictator_proposals_validated = None; - ballots_validated = Signature.Public_key_hash.Map.empty; - } - -module Double_evidence = Map.Make (struct - type t = Signature.Public_key_hash.t * Level.t +let voting_state_encoding = + let open Data_encoding in + def "voting_state" + @@ conv + (fun {proposals_seen; ballots_seen} -> (proposals_seen, ballots_seen)) + (fun (proposals_seen, ballots_seen) -> {proposals_seen; ballots_seen}) + (obj2 + (req + "proposals_seen" + (Signature.Public_key_hash.Map.encoding Operation_hash.encoding)) + (req + "ballots_seen" + (Signature.Public_key_hash.Map.encoding Operation_hash.encoding))) + +module Double_baking_evidence_map = struct + include Map.Make (struct + type t = Raw_level.t * Round.t + + let compare (l, r) (l', r') = + Compare.or_else (Raw_level.compare l l') @@ fun () -> + Compare.or_else (Round.compare r r') @@ fun () -> 0 + end) + + let encoding elt_encoding = + Data_encoding.conv + (fun map -> bindings map) + (fun l -> List.fold_left (fun m (k, v) -> add k v m) empty l) + Data_encoding.( + list (tup2 (tup2 Raw_level.encoding Round.encoding) elt_encoding)) +end - let compare (d1, l1) (d2, l2) = - let res = Signature.Public_key_hash.compare d1 d2 in - if Compare.Int.equal res 0 then Level.compare l1 l2 else res -end) +module Double_endorsing_evidence_map = struct + include Map.Make (struct + type t = Raw_level.t * Round.t * Slot.t + + let compare (l, r, s) (l', r', s') = + Compare.or_else (Raw_level.compare l l') @@ fun () -> + Compare.or_else (Round.compare r r') @@ fun () -> + Compare.or_else (Slot.compare s s') @@ fun () -> 0 + end) + + let encoding elt_encoding = + Data_encoding.conv + (fun map -> bindings map) + (fun l -> List.fold_left (fun m (k, v) -> add k v m) empty l) + Data_encoding.( + list + (tup2 + (tup3 Raw_level.encoding Round.encoding Slot.encoding) + elt_encoding)) +end (** State used and modified when validating anonymous operations. These fields are used to enforce that we do not validate the same @@ -186,20 +264,72 @@ end) - In mempool mode, bounding the number of operations in this map is the responsability of the prevalidator on the shell side. *) type anonymous_state = { - blinded_pkhs_seen : Operation_hash.t Blinded_public_key_hash.Map.t; - double_baking_evidences_seen : Operation_hash.t Double_evidence.t; - double_consensus_evidences_seen : Operation_hash.t Double_evidence.t; - seed_nonce_levels_seen : Raw_level.Set.t; - vdf_solution_seen : bool; + activation_pkhs_seen : Operation_hash.t Ed25519.Public_key_hash.Map.t; + double_baking_evidences_seen : Operation_hash.t Double_baking_evidence_map.t; + double_endorsing_evidences_seen : + Operation_hash.t Double_endorsing_evidence_map.t; + seed_nonce_levels_seen : Operation_hash.t Raw_level.Map.t; + vdf_solution_seen : Operation_hash.t option; } +let raw_level_map_encoding elt_encoding = + let open Data_encoding in + conv + (fun map -> Raw_level.Map.bindings map) + (fun l -> + Raw_level.Map.(List.fold_left (fun m (k, v) -> add k v m) empty l)) + (list (tup2 Raw_level.encoding elt_encoding)) + +let anonymous_state_encoding = + let open Data_encoding in + def "anonymous_state" + @@ conv + (fun { + activation_pkhs_seen; + double_baking_evidences_seen; + double_endorsing_evidences_seen; + seed_nonce_levels_seen; + vdf_solution_seen; + } -> + ( activation_pkhs_seen, + double_baking_evidences_seen, + double_endorsing_evidences_seen, + seed_nonce_levels_seen, + vdf_solution_seen )) + (fun ( activation_pkhs_seen, + double_baking_evidences_seen, + double_endorsing_evidences_seen, + seed_nonce_levels_seen, + vdf_solution_seen ) -> + { + activation_pkhs_seen; + double_baking_evidences_seen; + double_endorsing_evidences_seen; + seed_nonce_levels_seen; + vdf_solution_seen; + }) + (obj5 + (req + "activation_pkhs_seen" + (Ed25519.Public_key_hash.Map.encoding Operation_hash.encoding)) + (req + "double_baking_evidences_seen" + (Double_baking_evidence_map.encoding Operation_hash.encoding)) + (req + "double_endorsing_evidences_seen" + (Double_endorsing_evidence_map.encoding Operation_hash.encoding)) + (req + "seed_nonce_levels_seen" + (raw_level_map_encoding Operation_hash.encoding)) + (opt "vdf_solution_seen" Operation_hash.encoding)) + let empty_anonymous_state = { - blinded_pkhs_seen = Blinded_public_key_hash.Map.empty; - double_baking_evidences_seen = Double_evidence.empty; - double_consensus_evidences_seen = Double_evidence.empty; - seed_nonce_levels_seen = Raw_level.Set.empty; - vdf_solution_seen = false; + activation_pkhs_seen = Ed25519.Public_key_hash.Map.empty; + double_baking_evidences_seen = Double_baking_evidence_map.empty; + double_endorsing_evidences_seen = Double_endorsing_evidence_map.empty; + seed_nonce_levels_seen = Raw_level.Map.empty; + vdf_solution_seen = None; } (** Static information used to validate manager operations. *) @@ -232,14 +362,20 @@ type manager_state = { map is the responsability of the mempool. (E.g. the plugin used by Octez has a [max_prechecked_manager_operations] parameter to ensure this.) *) - remaining_block_gas : Gas.Arith.fp; } -let init_manager_state ctxt = - { - managers_seen = Signature.Public_key_hash.Map.empty; - remaining_block_gas = Gas.Arith.fp (Constants.hard_gas_limit_per_block ctxt); - } +let manager_state_encoding = + let open Data_encoding in + def "manager_state" + @@ conv + (fun {managers_seen} -> managers_seen) + (fun managers_seen -> {managers_seen}) + (obj1 + (req + "managers_seen" + (Signature.Public_key_hash.Map.encoding Operation_hash.encoding))) + +let empty_manager_state = {managers_seen = Signature.Public_key_hash.Map.empty} (** Mode-dependent information needed in final checks. *) type application_info = { @@ -281,8 +417,7 @@ type mode = } | Mempool -(** {2 Definition and initialization of [info] and - [state]} *) +(** {2 Definition and initialization of [info] and [state]} *) type info = { ctxt : t; (** The context at the beginning of the block or mempool. *) @@ -293,17 +428,43 @@ type info = { manager_info : manager_info; } -type state = { +type operation_conflict_state = { consensus_state : consensus_state; voting_state : voting_state; anonymous_state : anonymous_state; manager_state : manager_state; +} + +let operation_conflict_state_encoding = + let open Data_encoding in + def "operation_conflict_state" + @@ conv + (fun {consensus_state; voting_state; anonymous_state; manager_state} -> + (consensus_state, voting_state, anonymous_state, manager_state)) + (fun (consensus_state, voting_state, anonymous_state, manager_state) -> + {consensus_state; voting_state; anonymous_state; manager_state}) + (obj4 + (req "consensus_state" consensus_state_encoding) + (req "voting_state" voting_state_encoding) + (req "anonymous_state" anonymous_state_encoding) + (req "manager_state" manager_state_encoding)) + +type block_state = { op_count : int; + remaining_block_gas : Gas.Arith.fp; recorded_operations_rev : Operation_hash.t list; last_op_validation_pass : int option; + locked_round_evidence : (Round.t * int) option; + endorsement_power : int; +} + +type validation_state = { + info : info; + operation_state : operation_conflict_state; + block_state : block_state; } -type validation_state = {info : info; state : state} +let ok_unit = Result_syntax.return_unit let init_info ctxt mode chain_id all_expected_consensus_characteristics = { @@ -316,18 +477,29 @@ let init_info ctxt mode chain_id all_expected_consensus_characteristics = manager_info = init_manager_info ctxt; } -let init_info ctxt mode chain_id all_expected_consensus_characteristics = - init_info ctxt mode chain_id all_expected_consensus_characteristics +let empty_voting_state = + { + proposals_seen = Signature.Public_key_hash.Map.empty; + ballots_seen = Signature.Public_key_hash.Map.empty; + } -let init_state ctxt = +let init_operation_conflict_state ~predecessor_level = { - consensus_state = empty_consensus_state; + consensus_state = init_consensus_state ~predecessor_level; voting_state = empty_voting_state; anonymous_state = empty_anonymous_state; - manager_state = init_manager_state ctxt; + manager_state = empty_manager_state; + } + +let init_block_state vi = + { op_count = 0; + remaining_block_gas = + Gas.Arith.fp (Constants.hard_gas_limit_per_block vi.ctxt); recorded_operations_rev = []; last_op_validation_pass = None; + locked_round_evidence = None; + endorsement_power = 0; } (** Validation of consensus operations (validation pass [0]): @@ -356,7 +528,7 @@ module Consensus = struct in Expected_endorsement {expected_features} - let expected_features_for_block_validation ctxt fitness payload_hash + let expected_features_for_application ctxt fitness payload_hash ~predecessor_level ~predecessor_round ~predecessor_hash = let expected_preendorsement = match Fitness.locked_round fitness with @@ -379,17 +551,17 @@ module Consensus = struct { expected_preendorsement; expected_endorsement; - expected_grandparent_endorsement_for_mempool = None; + expected_grandparent_endorsement_for_partial_construction = None; } - let expected_features_for_block_construction ctxt round payload_hash + let expected_features_for_construction ctxt round payload_hash ~predecessor_level ~predecessor_round ~predecessor_hash = let expected_preendorsement = if Block_payload_hash.(payload_hash = zero) then (* When the proposal is fresh, a fake [payload_hash] of [zero] has been provided. In this case, the block should not contain any preendorsements. *) - Fresh_proposal_for_block_construction_preendorsement + Fresh_proposal_for_construction_preendorsement else let expected_features = { @@ -407,17 +579,19 @@ module Consensus = struct { expected_preendorsement; expected_endorsement; - expected_grandparent_endorsement_for_mempool = None; + expected_grandparent_endorsement_for_partial_construction = None; } - let expected_features_for_mempool ctxt ~predecessor_level ~predecessor_round - ~grandparent_round = + let expected_features_for_partial_construction ctxt ~predecessor_level + ~predecessor_round ~grandparent_round = let expected_preendorsement, expected_endorsement = match Consensus.endorsement_branch ctxt with | None -> let expected_level = predecessor_level.Level.level in - ( No_expected_branch_for_mempool_preendorsement {expected_level}, - No_expected_branch_for_mempool_endorsement {expected_level} ) + ( No_expected_branch_for_partial_construction_preendorsement + {expected_level}, + No_expected_branch_for_partial_construction_endorsement + {expected_level} ) | Some (branch, payload_hash) -> let expected_features = expected_endorsement_features @@ -429,7 +603,7 @@ module Consensus = struct ( Expected_preendorsement {expected_features; block_round = None}, Expected_endorsement {expected_features} ) in - let expected_grandparent_endorsement_for_mempool = + let expected_grandparent_endorsement_for_partial_construction = match ( Consensus.grand_parent_branch ctxt, Raw_level.pred predecessor_level.level ) @@ -441,13 +615,13 @@ module Consensus = struct { expected_preendorsement; expected_endorsement; - expected_grandparent_endorsement_for_mempool; + expected_grandparent_endorsement_for_partial_construction; } open Validate_errors.Consensus let check_frozen_deposits_are_positive ctxt delegate_pkh = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let* frozen_deposits = Delegate.frozen_deposits ctxt delegate_pkh in fail_unless Tez.(frozen_deposits.current_amount > zero) @@ -463,32 +637,19 @@ module Consensus = struct Consensus_operation_for_old_level {kind; expected; provided} else Consensus_operation_for_future_level {kind; expected; provided}) - let check_round_equal vs kind expected_features + let check_round kind expected (consensus_content : consensus_content) = + let provided = consensus_content.round in + error_unless + (Round.equal expected provided) + (if Round.(expected > provided) then + Consensus_operation_for_old_round {kind; expected; provided} + else Consensus_operation_for_future_round {kind; expected; provided}) + + let check_round_equal kind expected_features (consensus_content : consensus_content) = - let check expected = - let provided = consensus_content.round in - error_unless - (Round.equal expected provided) - (if Round.(expected > provided) then - Consensus_operation_for_old_round {kind; expected; provided} - else Consensus_operation_for_future_round {kind; expected; provided}) - in match expected_features.round with - | Some expected -> check expected - | None -> ( - (* For preendorsements in block construction mode, - [expected_features.round] has been set to [None] because we - could not know yet whether there is a locked round. *) - match vs.consensus_state.locked_round_evidence with - | None -> - (* This is the first validated preendorsement in - construction mode: there is nothing to check. *) - ok () - | Some (expected, _power) -> - (* Other preendorsements have already been validated: we - check that the current operation has the same round as - them. *) - check expected) + | Some expected -> check_round kind expected consensus_content + | None -> ok_unit let check_branch_equal kind expected_features (operation : 'a operation) = let expected = expected_features.branch in @@ -505,53 +666,23 @@ module Consensus = struct (Block_payload_hash.equal expected provided) (Wrong_payload_hash_for_consensus_operation {kind; expected; provided}) - let check_consensus_features vs kind (expected : expected_features) + let check_consensus_features kind (expected : expected_features) (consensus_content : consensus_content) (operation : 'a operation) = let open Result_syntax in let* () = check_level_equal kind expected consensus_content in - let* () = check_round_equal vs kind expected consensus_content in + let* () = check_round_equal kind expected consensus_content in let* () = check_branch_equal kind expected operation in check_payload_hash_equal kind expected consensus_content - let ensure_conflict_free_preendorsement vs slot = - error_unless - (not (Slot.Set.mem slot vs.consensus_state.preendorsements_seen)) - (Conflicting_consensus_operation {kind = Preendorsement}) - - let update_validity_state_preendorsement vs slot round voting_power = - let locked_round_evidence = - match vs.consensus_state.locked_round_evidence with - | None -> Some (round, voting_power) - | Some (_stored_round, evidences) -> Some (round, evidences + voting_power) - (* In mempool mode, round and stored_round can be different when - one of them corresponds to a grandparent preendorsement; this - doesn't matter because quorum certificates are not used in - mempool mode. For other cases, {!check_round_equal} ensures - that all preendorsements have the same round. Indeed, during - block validation, they are all checked to be the same - {!recfield:expected_features.round}; and during block - construction, the round of the first validated preendorsement - is stored in [locked_round_evidence] then all subsequent - preendorsements are checked to have the same round in - {!check_round_equal}. *) - in - let preendorsements_seen = - Slot.Set.add slot vs.consensus_state.preendorsements_seen - in - { - vs with - consensus_state = - {vs.consensus_state with locked_round_evidence; preendorsements_seen}; - } - let get_expected_preendorsements_features consensus_info consensus_content = match consensus_info.all_expected_features.expected_preendorsement with | Expected_preendorsement {expected_features; block_round} -> ok (expected_features, block_round) | No_locked_round_for_block_validation_preendorsement - | Fresh_proposal_for_block_construction_preendorsement -> + | Fresh_proposal_for_construction_preendorsement -> error Unexpected_preendorsement_in_block - | No_expected_branch_for_mempool_preendorsement {expected_level} -> + | No_expected_branch_for_partial_construction_preendorsement + {expected_level} -> error (Consensus_operation_for_future_level { @@ -564,7 +695,7 @@ module Consensus = struct let check_round_not_too_high ~block_round ~provided = match block_round with - | None -> ok () + | None -> ok_unit | Some block_round -> error_unless Round.(provided < block_round) @@ -575,14 +706,13 @@ module Consensus = struct (Slot.Map.find consensus_content.slot slot_map) ~error:(trace_of_error (Wrong_slot_used_for_consensus_operation {kind})) - let validate_preendorsement vi vs ~should_check_signature + let check_preendorsement vi ~should_check_signature (operation : Kind.preendorsement operation) = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let (Single (Preendorsement consensus_content)) = operation.protocol_data.contents in let kind = Preendorsement in - let*? () = ensure_conflict_free_preendorsement vs consensus_content.slot in let*? expected_features, block_round = get_expected_preendorsements_features vi.consensus_info consensus_content in @@ -591,7 +721,6 @@ module Consensus = struct in let*? () = check_consensus_features - vs kind expected_features consensus_content @@ -612,51 +741,88 @@ module Consensus = struct consensus_key.consensus_pk vi.chain_id operation - else ok () + else ok_unit in - return - (update_validity_state_preendorsement - vs - consensus_content.slot - consensus_content.round - voting_power) + return voting_power - let ensure_conflict_free_grandparent_endorsement vs delegate = - error_unless - (not - (Signature.Public_key_hash.Set.mem - delegate - vs.consensus_state.grandparent_endorsements_seen)) - (Conflicting_consensus_operation {kind = Grandparent_endorsement}) + let check_preendorsement_conflict vs oph (op : Kind.preendorsement operation) + = + let (Single (Preendorsement consensus_content)) = + op.protocol_data.contents + in + match + Slot.Map.find_opt + consensus_content.slot + vs.consensus_state.preendorsements_seen + with + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph}) + | None -> ok_unit - let update_validity_state_grandparent_endorsement vs delegate = - { - vs with - consensus_state = - { - vs.consensus_state with - grandparent_endorsements_seen = - Signature.Public_key_hash.Set.add - delegate - vs.consensus_state.grandparent_endorsements_seen; - }; - } + let wrap_preendorsement_conflict = function + | Ok () -> ok_unit + | Error conflict -> + error + Validate_errors.Consensus.( + Conflicting_consensus_operation {kind = Preendorsement; conflict}) + + let add_preendorsement vs oph (op : Kind.preendorsement operation) = + let (Single (Preendorsement consensus_content)) = + op.protocol_data.contents + in + let preendorsements_seen = + Slot.Map.add + consensus_content.slot + oph + vs.consensus_state.preendorsements_seen + in + {vs with consensus_state = {vs.consensus_state with preendorsements_seen}} + + let may_update_locked_round_evidence block_state mode + (consensus_content : consensus_content) voting_power = + let locked_round_evidence = + match mode with + | Mempool -> None + | Application _ | Partial_application _ | Construction _ -> ( + match block_state.locked_round_evidence with + | None -> Some (consensus_content.round, voting_power) + | Some (_stored_round, evidences) -> + (* [_stored_round] is always equal to + [consensus_content.round]: this is ensured by + {!check_round_equal} in application and partial + application modes, and by + {!check_locked_round_evidence} in construction + mode. *) + Some (consensus_content.round, evidences + voting_power)) + in + {block_state with locked_round_evidence} + + (* Hypothesis: this function will only be called in mempool mode *) + let remove_preendorsement vs (operation : Kind.preendorsement operation) = + (* As we are in mempool mode, we do not update + [locked_round_evidence]. *) + let (Single (Preendorsement consensus_content)) = + operation.protocol_data.contents + in + let preendorsements_seen = + Slot.Map.remove + consensus_content.slot + vs.consensus_state.preendorsements_seen + in + {vs with consensus_state = {vs.consensus_state with preendorsements_seen}} - (** Validate an endorsement pointing to the grandparent block. This - function will only be called in [Mempool] mode. *) - let validate_grandparent_endorsement vi vs ~should_check_signature expected - (consensus_content : consensus_content) (operation : 'kind operation) = - let open Lwt_result_syntax in + (** Validates an endorsement pointing to the grandparent block. This + function will only be called in [Partial_construction] mode. *) + let check_grandparent_endorsement vi ~should_check_signature expected + operation (consensus_content : consensus_content) = + let open Lwt_tzresult_syntax in let kind = Grandparent_endorsement in let level = Level.from_raw vi.ctxt consensus_content.level in - let* _ctxt, consensus_key = + let* (_ctxt : t), consensus_key = Stake_distribution.slot_owner vi.ctxt level consensus_content.slot in let*? () = - ensure_conflict_free_grandparent_endorsement vs consensus_key.delegate - in - let*? () = - check_consensus_features vs kind expected consensus_content operation + check_consensus_features kind expected consensus_content operation in let*? () = if should_check_signature then @@ -664,35 +830,55 @@ module Consensus = struct consensus_key.consensus_pk vi.chain_id operation - else ok () + else ok_unit in - return - (update_validity_state_grandparent_endorsement vs consensus_key.delegate) - - let ensure_conflict_free_endorsement vs slot = - error_unless - (not (Slot.Set.mem slot vs.consensus_state.endorsements_seen)) - (Conflicting_consensus_operation {kind = Endorsement}) + return_unit - let update_validity_state_endorsement vs slot voting_power = + let add_grandparent_endorsement vs oph (consensus_content : consensus_content) + = { vs with consensus_state = { vs.consensus_state with - endorsements_seen = - Slot.Set.add slot vs.consensus_state.endorsements_seen; - endorsement_power = - vs.consensus_state.endorsement_power + voting_power; + grandparent_endorsements_seen = + Slot.Map.add + consensus_content.slot + oph + vs.consensus_state.grandparent_endorsements_seen; }; } + let check_grandparent_endorsement_conflict vs oph + (consensus_content : consensus_content) = + match + Slot.Map.find_opt + consensus_content.slot + vs.consensus_state.grandparent_endorsements_seen + with + | None -> ok_unit + | Some existing -> + Error (Operation_conflict {existing; new_operation = oph}) + + let remove_grandparent_endorsement vs (consensus_content : consensus_content) + = + let grandparent_endorsements_seen = + Slot.Map.remove + consensus_content.slot + vs.consensus_state.grandparent_endorsements_seen + in + { + vs with + consensus_state = {vs.consensus_state with grandparent_endorsements_seen}; + } + let get_expected_endorsements_features consensus_info consensus_content = match consensus_info.all_expected_features.expected_endorsement with | Expected_endorsement {expected_features} -> ok expected_features | No_expected_branch_for_block_endorsement -> error Unexpected_endorsement_in_block - | No_expected_branch_for_mempool_endorsement {expected_level} -> + | No_expected_branch_for_partial_construction_endorsement {expected_level} + -> error (Consensus_operation_for_future_level { @@ -703,20 +889,23 @@ module Consensus = struct | No_predecessor_info_cannot_validate_endorsement -> error Consensus_operation_not_allowed + type endorsement_kind = Grandparent_endorsement | Normal_endorsement of int + (** Validate an endorsement pointing to the predecessor, aka a "normal" endorsement. Only this kind of endorsement may be found during block validation or construction. *) - let validate_normal_endorsement vi vs ~should_check_signature - (consensus_content : consensus_content) (operation : 'kind operation) = - let open Lwt_result_syntax in + let check_normal_endorsement vi ~should_check_signature + (operation : Kind.endorsement operation) = + let open Lwt_tzresult_syntax in + let (Single (Endorsement consensus_content)) = + operation.protocol_data.contents + in let kind = Endorsement in - let*? () = ensure_conflict_free_endorsement vs consensus_content.slot in let*? expected_features = get_expected_endorsements_features vi.consensus_info consensus_content in let*? () = check_consensus_features - vs kind expected_features consensus_content @@ -737,64 +926,121 @@ module Consensus = struct consensus_key.consensus_pk vi.chain_id operation - else ok () + else ok_unit in - return - (update_validity_state_endorsement vs consensus_content.slot voting_power) + return voting_power - let validate_endorsement vi vs ~should_check_signature + let check_normal_endorsement_conflict vs oph + (consensus_content : consensus_content) = + match + Slot.Map.find_opt + consensus_content.slot + vs.consensus_state.endorsements_seen + with + | None -> ok_unit + | Some existing -> + Error (Operation_conflict {existing; new_operation = oph}) + + let add_normal_endorsement vs oph (consensus_content : consensus_content) = + { + vs with + consensus_state = + { + vs.consensus_state with + endorsements_seen = + Slot.Map.add + consensus_content.slot + oph + vs.consensus_state.endorsements_seen; + }; + } + + (* Hypothesis: this function will only be called in mempool mode *) + let remove_normal_endorsement vs (consensus_content : consensus_content) = + (* We do not remove the endorsement power because it is not + relevant for the mempool mode. *) + let endorsements_seen = + Slot.Map.remove + consensus_content.slot + vs.consensus_state.endorsements_seen + in + {vs with consensus_state = {vs.consensus_state with endorsements_seen}} + + let check_endorsement vi ~should_check_signature (operation : Kind.endorsement operation) = + let open Lwt_tzresult_syntax in let (Single (Endorsement consensus_content)) = operation.protocol_data.contents in match vi.consensus_info.all_expected_features - .expected_grandparent_endorsement_for_mempool + .expected_grandparent_endorsement_for_partial_construction with | Some expected_grandparent_endorsement when Raw_level.( consensus_content.level = expected_grandparent_endorsement.level) -> - validate_grandparent_endorsement - vi - vs - ~should_check_signature - expected_grandparent_endorsement - consensus_content - operation + let* () = + check_grandparent_endorsement + vi + ~should_check_signature + expected_grandparent_endorsement + operation + (consensus_content : consensus_content) + in + return Grandparent_endorsement | _ -> - validate_normal_endorsement - vi - vs - ~should_check_signature - consensus_content - operation + let* voting_power = + check_normal_endorsement vi ~should_check_signature operation + in + return (Normal_endorsement voting_power) - let ensure_conflict_free_dal_slot_availability vs endorser = - error_unless - (not - (Signature.Public_key_hash.Set.mem - endorser - vs.consensus_state.dal_slot_availability_seen)) - (Conflicting_dal_slot_availability {endorser}) + let is_normal_endorsement_assuming_valid vs + (consensus_content : consensus_content) = + Raw_level.equal vs.consensus_state.predecessor_level consensus_content.level - let update_validity_state_dal_slot_availabitiy vs endorser = - { - vs with - consensus_state = + let check_endorsement_conflict vs oph (operation : Kind.endorsement operation) + = + let (Single (Endorsement consensus_content)) = + operation.protocol_data.contents + in + if is_normal_endorsement_assuming_valid vs consensus_content then + check_normal_endorsement_conflict vs oph consensus_content + else check_grandparent_endorsement_conflict vs oph consensus_content + + let wrap_endorsement_conflict = function + | Ok () -> ok_unit + | Error conflict -> + error + Validate_errors.Consensus.( + Conflicting_consensus_operation {kind = Endorsement; conflict}) + + let add_endorsement vs oph (op : Kind.endorsement operation) endorsement_kind + = + let (Single (Endorsement consensus_content)) = op.protocol_data.contents in + match endorsement_kind with + | Grandparent_endorsement -> + add_grandparent_endorsement vs oph consensus_content + | Normal_endorsement _voting_power -> + add_normal_endorsement vs oph consensus_content + + let may_update_endorsement_power block_state = function + | Grandparent_endorsement -> block_state + | Normal_endorsement voting_power -> { - vs.consensus_state with - dal_slot_availability_seen = - Signature.Public_key_hash.Set.add - endorser - vs.consensus_state.dal_slot_availability_seen; - }; - } + block_state with + endorsement_power = block_state.endorsement_power + voting_power; + } + + let remove_endorsement vs (op : Kind.endorsement operation) = + let (Single (Endorsement consensus_content)) = op.protocol_data.contents in + if is_normal_endorsement_assuming_valid vs consensus_content then + remove_normal_endorsement vs consensus_content + else remove_grandparent_endorsement vs consensus_content - let validate_dal_slot_availability vi vs ~should_check_signature:_ + let check_dal_slot_availability vi (operation : Kind.dal_slot_availability operation) = (* DAL/FIXME https://gitlab.com/tezos/tezos/-/issues/3115 - This is a temporary operation. Some checks are missing for the moment. In particular, the signature is not checked. Consequently, it is really important to ensure this @@ -803,16 +1049,146 @@ module Consensus = struct endorsement encoding. However, once the DAL is ready, this operation should be merged with an endorsement or at least refined. *) - let open Lwt_result_syntax in - let (Single (Dal_slot_availability (endorser, slot_availability))) = + let open Lwt_tzresult_syntax in + let (Single (Dal_slot_availability (_endorser, slot_availability))) = operation.protocol_data.contents in - let*? () = ensure_conflict_free_dal_slot_availability vs endorser in let*? () = (* Note that this function checks the dal feature flag. *) Dal_apply.validate_data_availability vi.ctxt slot_availability in - return (update_validity_state_dal_slot_availabitiy vs endorser) + return_unit + + let check_dal_slot_availability_conflict vs oph + (operation : Kind.dal_slot_availability operation) = + let (Single (Dal_slot_availability (endorser, _slot_availability))) = + operation.protocol_data.contents + in + match + Signature.Public_key_hash.Map.find_opt + endorser + vs.consensus_state.dal_slot_availability_seen + with + | None -> ok_unit + | Some existing -> + Error (Operation_conflict {existing; new_operation = oph}) + + let wrap_dal_slot_availability_conflict = function + | Ok () -> ok_unit + | Error conflict -> + error + Validate_errors.Consensus.( + Conflicting_consensus_operation + {kind = Dal_slot_availability; conflict}) + + let add_dal_slot_availability vs oph + (operation : Kind.dal_slot_availability operation) = + let (Single (Dal_slot_availability (endorser, _slot_availability))) = + operation.protocol_data.contents + in + { + vs with + consensus_state = + { + vs.consensus_state with + dal_slot_availability_seen = + Signature.Public_key_hash.Map.add + endorser + oph + vs.consensus_state.dal_slot_availability_seen; + }; + } + + let remove_dal_slot_availability vs + (operation : Kind.dal_slot_availability operation) = + let (Single (Dal_slot_availability (endorser, _slot_availability))) = + operation.protocol_data.contents + in + let dal_slot_availability_seen = + Signature.Public_key_hash.Map.remove + endorser + vs.consensus_state.dal_slot_availability_seen + in + { + vs with + consensus_state = {vs.consensus_state with dal_slot_availability_seen}; + } + + let check_construction_preendorsement_round_consistency vi block_state kind + (consensus_content : consensus_content) = + let open Result_syntax in + let* expected_features, _block_round = + get_expected_preendorsements_features vi.consensus_info consensus_content + in + match expected_features.round with + | Some _ -> + (* When [expected_features.round] has a value (ie. in + application and partial application modes when the block + fitness has a [locked_round], and always in mempool mode), + [check_preendorsement] already checks that all + preendorsements have this expected round, so checking + anything here would be redundant. Also note that when the + fitness contains no [locked_round], this code is + unreachable because [get_expected_preendorsements_features] + returns an error. *) + return_unit + | None -> ( + (* For preendorsements in block construction mode, + [expected_features.round] has been set to [None] because we + could not know yet whether there is a locked round. *) + match block_state.locked_round_evidence with + | None -> + (* This is the first validated preendorsement in + construction mode: there is nothing to check. *) + return_unit + | Some (expected, _power) -> + (* Other preendorsements have already been validated: we + check that the current operation has the same round as + them. *) + check_round kind expected consensus_content) + + let validate_preendorsement ~should_check_signature info operation_state + block_state oph (operation : Kind.preendorsement operation) = + let open Lwt_tzresult_syntax in + let (Single (Preendorsement consensus_content)) = + operation.protocol_data.contents + in + let* voting_power = + check_preendorsement info ~should_check_signature operation + in + let*? () = + check_construction_preendorsement_round_consistency + info + block_state + Preendorsement + consensus_content + in + let*? () = + check_preendorsement_conflict operation_state oph operation + |> wrap_preendorsement_conflict + in + (* We need to update the block state *) + let block_state = + may_update_locked_round_evidence + block_state + info.mode + consensus_content + voting_power + in + let operation_state = add_preendorsement operation_state oph operation in + return {info; operation_state; block_state} + + let validate_endorsement ~should_check_signature info operation_state + block_state oph operation = + let open Lwt_tzresult_syntax in + let* kind = check_endorsement info ~should_check_signature operation in + let*? () = + check_endorsement_conflict operation_state oph operation + |> wrap_endorsement_conflict + in + let block_state = may_update_endorsement_power block_state kind in + let operation_state = add_endorsement operation_state oph operation kind in + return {info; operation_state; block_state} end (** {2 Validation of voting operations} @@ -830,153 +1206,6 @@ end module Voting = struct open Validate_errors.Voting - let check_count_conflict ~count_previous_blocks ~count_operation - proposer_history = - let max_allowed = Constants.max_proposals_per_delegate in - let count_before_op = count_previous_blocks + proposer_history.count in - (* [count_before_op] should never have been increased above - [max_proposals_per_delegate]. *) - assert (Compare.Int.(count_before_op <= max_allowed)) ; - error_unless - Compare.Int.(count_before_op + count_operation <= max_allowed) - (Conflict_too_many_proposals - { - max_allowed; - count_previous_blocks; - count_current_block = proposer_history.count; - count_operation; - conflicting_operations = proposer_history.operations; - }) - - (** Check that a regular (ie. non-dictator) Proposals operation is - compatible with previously validated voting operations in the - current block/mempool, and update the [state] with this - operation. - - @return [Error Conflict_too_many_proposals] if the total number - of proposals by [proposer] in previously applied operations in - [ctxt], in previously validated operations in the current - block/mempool, and in the operation to validate, exceeds - {!Constants.max_proposals_per_delegate}. - - @return [Error Conflict_already_proposed] if one of the - operation's [proposals] has already been submitted by [proposer] - in the current block/mempool. - - @return [Error Conflicting_dictator_proposals] if the current - block/mempool already contains a testnet dictator Proposals - operation (see {!recfield:dictator_proposals_validated}). - - Note that this function is designed to be called in addition to - {!check_proposal_list_sanity} and {!check_count} further below, - not instead of them: that's why nothing is done when the - [proposer] is not in {!recfield:proposals_validated}. More - precisely, this function should be called {e after} the - aforementioned functions, whose potential errors - e.g. [Proposals_contain_duplicate] or [Too_many_proposals] should - take precedence because they are independent from the validation - [state]. *) - let check_proposals_conflicts_and_update_state state oph proposer proposals - ~count_in_ctxt ~proposals_length = - let open Tzresult_syntax in - let* new_proposer_history = - match - Signature.Public_key_hash.Map.find proposer state.proposals_validated - with - | None -> - let proposed = - List.fold_left - (fun acc proposal -> Protocol_hash.Map.add proposal oph acc) - Protocol_hash.Map.empty - proposals - in - return {count = proposals_length; operations = [oph]; proposed} - | Some proposer_history -> - let* () = - check_count_conflict - ~count_previous_blocks:count_in_ctxt - ~count_operation:proposals_length - proposer_history - in - let add_proposal proposed_map proposal = - match Protocol_hash.Map.find proposal proposer_history.proposed with - | Some conflicting_operation -> - error - (Conflict_already_proposed {proposal; conflicting_operation}) - | None -> ok (Protocol_hash.Map.add proposal oph proposed_map) - in - let* proposed = - List.fold_left_e add_proposal proposer_history.proposed proposals - in - return - { - count = proposer_history.count + proposals_length; - operations = oph :: proposer_history.operations; - proposed; - } - in - let* () = - match state.dictator_proposals_validated with - | None -> ok () - | Some dictator_oph -> error (Conflicting_dictator_proposals dictator_oph) - in - let proposals_validated = - Signature.Public_key_hash.Map.add - proposer - new_proposer_history - state.proposals_validated - in - return {state with proposals_validated} - - (** Check that a Proposals operation from a testnet dictator is - compatible with previously validated voting operations in the - current block/mempool (ie. that no other voting operation has - been validated), and update the [state] with this operation. - - @return [Error Testnet_dictator_conflicting_operation] if the - current block or mempool already contains any validated voting - operation. *) - let check_dictator_proposals_conflicts_and_update_state state oph = - let open Tzresult_syntax in - let* () = - error_unless - (Signature.Public_key_hash.Map.is_empty state.proposals_validated - && Option.is_none state.dictator_proposals_validated - && Signature.Public_key_hash.Map.is_empty state.ballots_validated) - Testnet_dictator_conflicting_operation - in - return {state with dictator_proposals_validated = Some oph} - - (** Check that a Ballot operation is compatible with previously - validated voting operations in the current block/mempool. - - @return [Error Conflicting_ballot] if the [delegate] has already - submitted a ballot in the current block/mempool. - - @return [Error Conflicting_dictator_proposals] if the current - block/mempool already contains a testnet dictator Proposals - operation (see {!recfield:dictator_proposals_validated}). *) - let check_ballot_conflicts state voter = - let open Tzresult_syntax in - let* () = - match - Signature.Public_key_hash.Map.find voter state.ballots_validated - with - | None -> ok () - | Some conflicting_operation -> - error (Conflicting_ballot {conflicting_operation}) - in - match state.dictator_proposals_validated with - | None -> ok () - | Some dictator_oph -> error (Conflicting_dictator_proposals dictator_oph) - - (** Update the [state] when a Ballot operation is validated. *) - let update_state_on_ballot state oph voter = - let ballots_validated = - Signature.Public_key_hash.Map.add voter oph state.ballots_validated - in - {state with ballots_validated} - (** Check that [record_proposals] below will not fail. This function is designed to be exclusively called by @@ -1002,7 +1231,7 @@ module Voting = struct initialized. However, this cannot happen because the current function is only called in [validate_proposals] after a successful call to {!Voting_period.get_current}. *) - ok () + ok_unit | _ :: _ :: _ -> error Testnet_dictator_multiple_proposals let check_period_index ~expected period_index = @@ -1016,11 +1245,11 @@ module Voting = struct fail_unless is_registered (Proposals_from_unregistered_delegate source) (** Check that the list of proposals is not empty and does not contain - duplicates. *) + duplicates. *) let check_proposal_list_sanity proposals = let open Tzresult_syntax in let* () = - match proposals with [] -> error Empty_proposals | _ :: _ -> ok () + match proposals with [] -> error Empty_proposals | _ :: _ -> ok_unit in let* (_ : Protocol_hash.Set.t) = List.fold_left_e @@ -1038,7 +1267,7 @@ module Voting = struct let check_period_kind_for_proposals current_period = match current_period.Voting_period.kind with - | Proposal -> ok () + | Proposal -> ok_unit | (Exploration | Cooldown | Promotion | Adoption) as current -> error (Wrong_voting_period_kind {current; expected = [Proposal]}) @@ -1054,7 +1283,8 @@ module Voting = struct error_unless Compare.Int.( count_in_ctxt + proposals_length <= Constants.max_proposals_per_delegate) - Too_many_proposals + (Too_many_proposals + {previous_count = count_in_ctxt; operation_count = proposals_length}) let check_already_proposed ctxt proposer proposals = let open Lwt_tzresult_syntax in @@ -1066,7 +1296,7 @@ module Voting = struct let check_period_kind_for_ballot current_period = match current_period.Voting_period.kind with - | Exploration | Promotion -> ok () + | Exploration | Promotion -> ok_unit | (Cooldown | Proposal | Adoption) as current -> error (Wrong_voting_period_kind @@ -1110,14 +1340,10 @@ module Voting = struct @return [Error Source_not_in_vote_listings] if the source is not in the vote listings. - @return [Error Too_many_proposals] if the operation would make the - source's total number of proposals exceed - {!Constants.recorded_proposal_count_for_delegate}. - @return [Error Already_proposed] if one of the proposals has already been proposed by the source. - @return [Error Conflict_too_many_proposals] if the total count of + @return [Error Too_many_proposals] if the total count of proposals submitted by the source in previous blocks, in previously validated operations of the current block/mempool, and in the operation to validate, exceeds @@ -1127,22 +1353,14 @@ module Voting = struct operation's proposals has already been submitted by the source in the current block/mempool. - @return [Error Conflicting_dictator_proposals] if a testnet - dictator Proposals operation has already been validated in the - current block/mempool. - @return [Error Testnet_dictator_multiple_proposals] if the source is a testnet dictator and the operation contains more than one proposal. - @return [Error Testnet_dictator_conflicting_operation] if the - source is a testnet dictator and the current block or mempool - already contains any validated voting operation. - @return [Error Operation.Missing_signature] or [Error Operation.Invalid_signature] if the operation is unsigned or incorrectly signed. *) - let validate_proposals vi vs ~should_check_signature oph + let check_proposals vi ~should_check_signature (operation : Kind.proposals operation) = let open Lwt_tzresult_syntax in let (Single (Proposals {source; period; proposals})) = @@ -1150,13 +1368,10 @@ module Voting = struct in let* current_period = Voting_period.get_current vi.ctxt in let*? () = check_period_index ~expected:current_period.index period in - let* voting_state = + let* () = if Amendment.is_testnet_dictator vi.ctxt vi.chain_id source then let*? () = check_testnet_dictator_proposals vi.chain_id proposals in - Lwt.return - (check_dictator_proposals_conflicts_and_update_state - vs.voting_state - oph) + return_unit else let* () = check_proposals_source_is_registered vi.ctxt source in let*? () = check_proposal_list_sanity proposals in @@ -1165,29 +1380,57 @@ module Voting = struct let* count_in_ctxt = Vote.get_delegate_proposal_count vi.ctxt source in let proposals_length = List.length proposals in let*? () = check_count ~count_in_ctxt ~proposals_length in - let* () = check_already_proposed vi.ctxt source proposals in - Lwt.return - (check_proposals_conflicts_and_update_state - vs.voting_state - oph - source - proposals - ~count_in_ctxt - ~proposals_length) - in - (* The signature check is done last because it is more costly than - most checks. *) - let* () = - when_ should_check_signature (fun () -> - (* Retrieving the public key cannot fail. Indeed, we have - already checked that the delegate is in the vote listings - (or is a testnet dictator), which implies that it is a - manager with a revealed key. *) - let* public_key = Contract.get_manager_key vi.ctxt source in - Lwt.return - (Operation.check_signature public_key vi.chain_id operation)) + check_already_proposed vi.ctxt source proposals + in + if should_check_signature then + (* Retrieving the public key should not fail as it *should* be + called after checking that the delegate is in the vote + listings (or is a testnet dictator), which implies that it + is a manager with a revealed key. *) + let* public_key = Contract.get_manager_key vi.ctxt source in + Lwt.return (Operation.check_signature public_key vi.chain_id operation) + else return_unit + + (** Check that a Proposals operation is compatible with previously + validated voting operations in the current block/mempool.. + + @return [Error Conflicting_proposals] if the current + block/mempool already contains a same source Proposals + operation. *) + let check_proposals_conflict vs oph (operation : Kind.proposals operation) = + let open Tzresult_syntax in + let (Single (Proposals {source; _})) = operation.protocol_data.contents in + match + Signature.Public_key_hash.Map.find_opt + source + vs.voting_state.proposals_seen + with + | None -> return_unit + | Some existing -> + Error (Operation_conflict {existing; new_operation = oph}) + + let wrap_proposals_conflict = function + | Ok () -> ok_unit + | Error conflict -> + error Validate_errors.Voting.(Conflicting_proposals conflict) + + let add_proposals vs oph (operation : Kind.proposals operation) = + let (Single (Proposals {source; _})) = operation.protocol_data.contents in + let proposals_seen = + Signature.Public_key_hash.Map.add + source + oph + vs.voting_state.proposals_seen in - return {vs with voting_state} + let voting_state = {vs.voting_state with proposals_seen} in + {vs with voting_state} + + let remove_proposals vs (operation : Kind.proposals operation) = + let (Single (Proposals {source; _})) = operation.protocol_data.contents in + let proposals_seen = + Signature.Public_key_hash.Map.remove source vs.voting_state.proposals_seen + in + {vs with voting_state = {vs.voting_state with proposals_seen}} (** Check that a Ballot operation can be safely applied. @@ -1197,10 +1440,6 @@ module Voting = struct @return [Error Conflicting_ballot] if the source has already submitted a ballot in the current block/mempool. - @return [Error Conflicting_dictator_proposals] if the current - block/mempool already contains a validated testnet dictator - Proposals operation. - @return [Error Wrong_voting_period_index] if the operation's period and the [context]'s current period do not have the same index. @@ -1220,63 +1459,121 @@ module Voting = struct @return [Error Operation.Missing_signature] or [Error Operation.Invalid_signature] if the operation is unsigned or incorrectly signed. *) - let validate_ballot vi vs ~should_check_signature oph + let check_ballot vi ~should_check_signature (operation : Kind.ballot operation) = let open Lwt_tzresult_syntax in let (Single (Ballot {source; period; proposal; ballot = _})) = operation.protocol_data.contents in let* () = check_ballot_source_is_registered vi.ctxt source in - let*? () = check_ballot_conflicts vs.voting_state source in let* current_period = Voting_period.get_current vi.ctxt in let*? () = check_period_index ~expected:current_period.index period in let*? () = check_period_kind_for_ballot current_period in let* () = check_current_proposal vi.ctxt proposal in let* () = check_source_has_not_already_voted vi.ctxt source in let* () = check_in_listings vi.ctxt source in - (* The signature check is done last because it is more costly than - most checks. *) - let* () = - when_ should_check_signature (fun () -> - (* Retrieving the public key cannot fail. Indeed, we have - already checked that the delegate is in the vote listings, - which implies that it is a manager with a revealed key. *) - let* public_key = Contract.get_manager_key vi.ctxt source in - Lwt.return - (Operation.check_signature public_key vi.chain_id operation)) - in - let voting_state = update_state_on_ballot vs.voting_state oph source in - return {vs with voting_state} + when_ should_check_signature (fun () -> + (* Retrieving the public key cannot fail. Indeed, we have + already checked that the delegate is in the vote listings, + which implies that it is a manager with a revealed key. *) + let* public_key = Contract.get_manager_key vi.ctxt source in + Lwt.return (Operation.check_signature public_key vi.chain_id operation)) + + (** Check that a Ballot operation is compatible with previously + validated voting operations in the current block/mempool. + + @return [Error Conflicting_ballot] if the [delegate] has already + submitted a ballot in the current block/mempool. *) + let check_ballot_conflict vs oph (operation : Kind.ballot operation) = + let (Single (Ballot {source; _})) = operation.protocol_data.contents in + match + Signature.Public_key_hash.Map.find_opt source vs.voting_state.ballots_seen + with + | None -> ok_unit + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph}) + + let wrap_ballot_conflict = function + | Ok () -> ok_unit + | Error conflict -> error (Conflicting_ballot conflict) + + let add_ballot vs oph (operation : Kind.ballot operation) = + let (Single (Ballot {source; _})) = operation.protocol_data.contents in + let ballots_seen = + Signature.Public_key_hash.Map.add source oph vs.voting_state.ballots_seen + in + let voting_state = {vs.voting_state with ballots_seen} in + {vs with voting_state} + + let remove_ballot vs (operation : Kind.ballot operation) = + let (Single (Ballot {source; _})) = operation.protocol_data.contents in + let ballots_seen = + Signature.Public_key_hash.Map.remove source vs.voting_state.ballots_seen + in + {vs with voting_state = {vs.voting_state with ballots_seen}} end module Anonymous = struct open Validate_errors.Anonymous - let validate_activate_account vi vs oph - (Activate_account {id = edpkh; activation_code}) = - let open Lwt_result_syntax in + let check_activate_account vi (operation : Kind.activate_account operation) = + let (Single (Activate_account {id = edpkh; activation_code})) = + operation.protocol_data.contents + in + let open Lwt_tzresult_syntax in let blinded_pkh = Blinded_public_key_hash.of_ed25519_pkh activation_code edpkh in - let*? () = - match - Blinded_public_key_hash.Map.find - blinded_pkh - vs.anonymous_state.blinded_pkhs_seen - with - | None -> ok () - | Some oph' -> error (Conflicting_activation (edpkh, oph')) - in let*! exists = Commitment.exists vi.ctxt blinded_pkh in let*? () = error_unless exists (Invalid_activation {pkh = edpkh}) in - let blinded_pkhs_seen = - Blinded_public_key_hash.Map.add - blinded_pkh + return_unit + + let check_activate_account_conflict vs oph + (operation : Kind.activate_account operation) = + let (Single (Activate_account {id = edpkh; _})) = + operation.protocol_data.contents + in + match + Ed25519.Public_key_hash.Map.find_opt + edpkh + vs.anonymous_state.activation_pkhs_seen + with + | None -> ok_unit + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph}) + + let wrap_activate_account_conflict + (operation : Kind.activate_account operation) = function + | Ok () -> ok_unit + | Error conflict -> + let (Single (Activate_account {id = edpkh; _})) = + operation.protocol_data.contents + in + error (Conflicting_activation {edpkh; conflict}) + + let add_activate_account vs oph (operation : Kind.activate_account operation) + = + let (Single (Activate_account {id = edpkh; _})) = + operation.protocol_data.contents + in + let activation_pkhs_seen = + Ed25519.Public_key_hash.Map.add + edpkh oph - vs.anonymous_state.blinded_pkhs_seen + vs.anonymous_state.activation_pkhs_seen + in + {vs with anonymous_state = {vs.anonymous_state with activation_pkhs_seen}} + + let remove_activate_account vs (operation : Kind.activate_account operation) = + let (Single (Activate_account {id = edpkh; _})) = + operation.protocol_data.contents + in + let activation_pkhs_seen = + Ed25519.Public_key_hash.Map.remove + edpkh + vs.anonymous_state.activation_pkhs_seen in - return - {vs with anonymous_state = {vs.anonymous_state with blinded_pkhs_seen}} + {vs with anonymous_state = {vs.anonymous_state with activation_pkhs_seen}} let check_denunciation_age vi kind given_level = let open Result_syntax in @@ -1295,11 +1592,11 @@ module Anonymous = struct (Outdated_denunciation {kind; level = given_level; last_cycle = last_slashable_cycle}) - let validate_double_consensus (type kind) - ~consensus_operation:denunciation_kind vi vs oph + let check_double_endorsing_evidence (type kind) + ~consensus_operation:denunciation_kind vi (op1 : kind Kind.consensus Operation.t) (op2 : kind Kind.consensus Operation.t) = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in match (op1.protocol_data.contents, op2.protocol_data.contents) with | Single (Preendorsement e1), Single (Preendorsement e2) | Single (Endorsement e1), Single (Endorsement e2) -> @@ -1337,18 +1634,6 @@ module Anonymous = struct {kind = denunciation_kind; delegate1; delegate2}) in let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in - let*? () = - match - Double_evidence.find - (delegate, level) - vs.anonymous_state.double_consensus_evidences_seen - with - | None -> ok () - | Some oph' -> - error - (Conflicting_denunciation - {kind = denunciation_kind; delegate; level; hash = oph'}) - in let* already_slashed = Delegate.already_slashed_for_double_endorsing ctxt delegate level in @@ -1359,36 +1644,121 @@ module Anonymous = struct in let*? () = Operation.check_signature delegate_pk vi.chain_id op1 in let*? () = Operation.check_signature delegate_pk vi.chain_id op2 in - let double_consensus_evidences_seen = - Double_evidence.add - (delegate, level) - oph - vs.anonymous_state.double_consensus_evidences_seen - in - return - { - vs with - anonymous_state = - {vs.anonymous_state with double_consensus_evidences_seen}; - } + return_unit - let validate_double_preendorsement_evidence vi vs oph - (Double_preendorsement_evidence {op1; op2}) = - validate_double_consensus + let check_double_preendorsement_evidence vi + (operation : Kind.double_preendorsement_evidence operation) = + let (Single (Double_preendorsement_evidence {op1; op2})) = + operation.protocol_data.contents + in + check_double_endorsing_evidence ~consensus_operation:Preendorsement vi - vs - oph op1 op2 - let validate_double_endorsement_evidence vi vs oph - (Double_endorsement_evidence {op1; op2}) = - validate_double_consensus ~consensus_operation:Endorsement vi vs oph op1 op2 + let check_double_endorsement_evidence vi + (operation : Kind.double_endorsement_evidence operation) = + let (Single (Double_endorsement_evidence {op1; op2})) = + operation.protocol_data.contents + in + check_double_endorsing_evidence ~consensus_operation:Endorsement vi op1 op2 + + let check_double_endorsing_evidence_conflict (type kind) vs oph + (op1 : kind Kind.consensus Operation.t) = + match op1.protocol_data.contents with + | Single (Preendorsement e1) | Single (Endorsement e1) -> ( + match + Double_endorsing_evidence_map.find + (e1.level, e1.round, e1.slot) + vs.anonymous_state.double_endorsing_evidences_seen + with + | None -> ok_unit + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph})) + + let check_double_preendorsement_evidence_conflict vs oph + (operation : Kind.double_preendorsement_evidence operation) = + let (Single (Double_preendorsement_evidence {op1; _})) = + operation.protocol_data.contents + in + check_double_endorsing_evidence_conflict vs oph op1 + + let check_double_endorsement_evidence_conflict vs oph + (operation : Kind.double_endorsement_evidence operation) = + let (Single (Double_endorsement_evidence {op1; _})) = + operation.protocol_data.contents + in + check_double_endorsing_evidence_conflict vs oph op1 - let validate_double_baking_evidence vi vs oph - (Double_baking_evidence {bh1; bh2}) = - let open Lwt_result_syntax in + let wrap_denunciation_conflict kind = function + | Ok () -> ok_unit + | Error conflict -> error (Conflicting_denunciation {kind; conflict}) + + let add_double_endorsing_evidence (type kind) vs oph + (op1 : kind Kind.consensus Operation.t) = + match op1.protocol_data.contents with + | Single (Preendorsement e1) | Single (Endorsement e1) -> + let double_endorsing_evidences_seen = + Double_endorsing_evidence_map.add + (e1.level, e1.round, e1.slot) + oph + vs.anonymous_state.double_endorsing_evidences_seen + in + { + vs with + anonymous_state = + {vs.anonymous_state with double_endorsing_evidences_seen}; + } + + let add_double_endorsement_evidence vs oph + (operation : Kind.double_endorsement_evidence operation) = + let (Single (Double_endorsement_evidence {op1; _})) = + operation.protocol_data.contents + in + add_double_endorsing_evidence vs oph op1 + + let add_double_preendorsement_evidence vs oph + (operation : Kind.double_preendorsement_evidence operation) = + let (Single (Double_preendorsement_evidence {op1; _})) = + operation.protocol_data.contents + in + add_double_endorsing_evidence vs oph op1 + + let remove_double_endorsing_evidence (type kind) vs + (op : kind Kind.consensus Operation.t) = + match op.protocol_data.contents with + | Single (Endorsement e) | Single (Preendorsement e) -> + let double_endorsing_evidences_seen = + Double_endorsing_evidence_map.remove + (e.level, e.round, e.slot) + vs.anonymous_state.double_endorsing_evidences_seen + in + let anonymous_state = + {vs.anonymous_state with double_endorsing_evidences_seen} + in + {vs with anonymous_state} + + let remove_double_preendorsement_evidence vs + (operation : Kind.double_preendorsement_evidence operation) = + let (Single (Double_preendorsement_evidence {op1; _})) = + operation.protocol_data.contents + in + remove_double_endorsing_evidence vs op1 + + let remove_double_endorsement_evidence vs + (operation : Kind.double_endorsement_evidence operation) = + let (Single (Double_endorsement_evidence {op1; _})) = + operation.protocol_data.contents + in + remove_double_endorsing_evidence vs op1 + + let check_double_baking_evidence vi + (operation : Kind.double_baking_evidence operation) = + let open Lwt_tzresult_syntax in + let (Single (Double_baking_evidence {bh1; bh2})) = + operation.protocol_data.contents + in let hash1 = Block_header.hash bh1 in let hash2 = Block_header.hash bh2 in let*? bh1_fitness = Fitness.from_raw bh1.shell.fitness in @@ -1427,18 +1797,6 @@ module Anonymous = struct (Inconsistent_denunciation {kind = Block; delegate1; delegate2}) in let delegate_pk, delegate = (consensus_key1.consensus_pk, delegate1) in - let*? () = - match - Double_evidence.find - (delegate, level) - vs.anonymous_state.double_baking_evidences_seen - with - | None -> ok () - | Some oph' -> - error - (Conflicting_denunciation - {kind = Block; delegate; level; hash = oph'}) - in let* already_slashed = Delegate.already_slashed_for_double_baking ctxt delegate level in @@ -1449,60 +1807,123 @@ module Anonymous = struct in let*? () = Block_header.check_signature bh1 vi.chain_id delegate_pk in let*? () = Block_header.check_signature bh2 vi.chain_id delegate_pk in + return_unit + + let check_double_baking_evidence_conflict vs oph + (operation : Kind.double_baking_evidence operation) = + let (Single (Double_baking_evidence {bh1; _})) = + operation.protocol_data.contents + in + let bh1_fitness = + Fitness.from_raw bh1.shell.fitness |> function + | Ok f -> f + | Error _ -> + (* We assume the operation valid, it cannot fail anymore *) + assert false + in + let round = Fitness.round bh1_fitness in + let level = Fitness.level bh1_fitness in + match + Double_baking_evidence_map.find + (level, round) + vs.anonymous_state.double_baking_evidences_seen + with + | None -> ok_unit + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph}) + + let add_double_baking_evidence vs oph + (operation : Kind.double_baking_evidence operation) = + let (Single (Double_baking_evidence {bh1; _})) = + operation.protocol_data.contents + in + let bh1_fitness = + Fitness.from_raw bh1.shell.fitness |> function + | Ok f -> f + | Error _ -> assert false + in + let round = Fitness.round bh1_fitness in + let level = Fitness.level bh1_fitness in let double_baking_evidences_seen = - Double_evidence.add - (delegate, level) + Double_baking_evidence_map.add + (level, round) oph vs.anonymous_state.double_baking_evidences_seen in - return - { - vs with - anonymous_state = {vs.anonymous_state with double_baking_evidences_seen}; - } + { + vs with + anonymous_state = {vs.anonymous_state with double_baking_evidences_seen}; + } - let validate_drain_delegate vi vs ~should_check_signature oph + let remove_double_baking_evidence vs + (operation : Kind.double_baking_evidence operation) = + let (Single (Double_baking_evidence {bh1; _})) = + operation.protocol_data.contents + in + let bh1_fitness, level = + match + (Fitness.from_raw bh1.shell.fitness, Raw_level.of_int32 bh1.shell.level) + with + | Ok v, Ok v' -> (v, v') + | _ -> + (* The operation is valid therefore decoding cannot fail *) + assert false + in + let round = Fitness.round bh1_fitness in + let double_baking_evidences_seen = + Double_baking_evidence_map.remove + (level, round) + vs.anonymous_state.double_baking_evidences_seen + in + let anonymous_state = + {vs.anonymous_state with double_baking_evidences_seen} + in + {vs with anonymous_state} + + let check_drain_delegate info ~should_check_signature (operation : Kind.drain_delegate Operation.t) = let open Lwt_tzresult_syntax in let (Single (Drain_delegate {delegate; destination; consensus_key})) = operation.protocol_data.contents in - let*! is_registered = Delegate.registered vi.ctxt delegate in + let*! is_registered = Delegate.registered info.ctxt delegate in let* () = fail_unless is_registered (Drain_delegate_on_unregistered_delegate delegate) in - let* active_pk = Delegate.Consensus_key.active_pubkey vi.ctxt delegate in + let* active_pk = Delegate.Consensus_key.active_pubkey info.ctxt delegate in let* () = - if - not - (Signature.Public_key_hash.equal - active_pk.consensus_pkh - consensus_key) - then - fail - (Invalid_drain_delegate_inactive_key - { - delegate; - consensus_key; - active_consensus_key = active_pk.consensus_pkh; - }) - else if Signature.Public_key_hash.equal active_pk.consensus_pkh delegate - then fail (Invalid_drain_delegate_no_consensus_key delegate) - else if Signature.Public_key_hash.equal destination delegate then - fail (Invalid_drain_delegate_noop delegate) - else return_unit + fail_unless + (Signature.Public_key_hash.equal active_pk.consensus_pkh consensus_key) + (Invalid_drain_delegate_inactive_key + { + delegate; + consensus_key; + active_consensus_key = active_pk.consensus_pkh; + }) + in + let* () = + fail_when + (Signature.Public_key_hash.equal active_pk.consensus_pkh delegate) + (Invalid_drain_delegate_no_consensus_key delegate) + in + let* () = + fail_when + (Signature.Public_key_hash.equal destination delegate) + (Invalid_drain_delegate_noop delegate) in let*! is_destination_allocated = - Contract.allocated vi.ctxt (Contract.Implicit destination) + Contract.allocated info.ctxt (Contract.Implicit destination) + in + let* balance = + Contract.get_balance info.ctxt (Contract.Implicit delegate) in - let* balance = Contract.get_balance vi.ctxt (Contract.Implicit delegate) in let*? origination_burn = if is_destination_allocated then ok Tez.zero else - let cost_per_byte = Constants.cost_per_byte vi.ctxt in - let origination_size = Constants.origination_size vi.ctxt in + let cost_per_byte = Constants.cost_per_byte info.ctxt in + let origination_size = Constants.origination_size info.ctxt in Tez.(cost_per_byte *? Int64.of_int origination_size) in let* drain_fees = @@ -1518,65 +1939,141 @@ module Anonymous = struct in let*? () = if should_check_signature then - Operation.check_signature active_pk.consensus_pk vi.chain_id operation - else ok () + Operation.check_signature active_pk.consensus_pk info.chain_id operation + else ok_unit in - let*? () = - match - Signature.Public_key_hash.Map.find - delegate - vs.manager_state.managers_seen - with - | None -> ok () - | Some _ -> error (Conflicting_drain {delegate}) + return_unit + + let check_drain_delegate_conflict state oph + (operation : Kind.drain_delegate Operation.t) = + let (Single (Drain_delegate {delegate; _})) = + operation.protocol_data.contents + in + match + Signature.Public_key_hash.Map.find_opt + delegate + state.manager_state.managers_seen + with + | None -> ok_unit + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph}) + + let wrap_drain_delegate_conflict (operation : Kind.drain_delegate Operation.t) + = + let (Single (Drain_delegate {delegate; _})) = + operation.protocol_data.contents + in + function + | Ok () -> ok_unit + | Error conflict -> error (Conflicting_drain_delegate {delegate; conflict}) + + let add_drain_delegate state oph (operation : Kind.drain_delegate Operation.t) + = + let (Single (Drain_delegate {delegate; _})) = + operation.protocol_data.contents in let managers_seen = Signature.Public_key_hash.Map.add delegate oph - vs.manager_state.managers_seen + state.manager_state.managers_seen + in + {state with manager_state = {managers_seen}} + + let remove_drain_delegate state (operation : Kind.drain_delegate Operation.t) + = + let (Single (Drain_delegate {delegate; _})) = + operation.protocol_data.contents + in + let managers_seen = + Signature.Public_key_hash.Map.remove + delegate + state.manager_state.managers_seen + in + {state with manager_state = {managers_seen}} + + let check_seed_nonce_revelation vi + (operation : Kind.seed_nonce_revelation operation) = + let open Lwt_tzresult_syntax in + let (Single (Seed_nonce_revelation {level = commitment_raw_level; nonce})) = + operation.protocol_data.contents + in + let commitment_level = Level.from_raw vi.ctxt commitment_raw_level in + let* () = Nonce.check_unrevealed vi.ctxt commitment_level nonce in + return_unit + + let check_seed_nonce_revelation_conflict vs oph + (operation : Kind.seed_nonce_revelation operation) = + let (Single (Seed_nonce_revelation {level = commitment_raw_level; _})) = + operation.protocol_data.contents + in + match + Raw_level.Map.find_opt + commitment_raw_level + vs.anonymous_state.seed_nonce_levels_seen + with + | None -> ok_unit + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph}) + + let wrap_seed_nonce_revelation_conflict = function + | Ok () -> ok_unit + | Error conflict -> error (Conflicting_nonce_revelation conflict) + + let add_seed_nonce_revelation vs oph + (operation : Kind.seed_nonce_revelation operation) = + let (Single (Seed_nonce_revelation {level = commitment_raw_level; _})) = + operation.protocol_data.contents + in + let seed_nonce_levels_seen = + Raw_level.Map.add + commitment_raw_level + oph + vs.anonymous_state.seed_nonce_levels_seen in - return {vs with manager_state = {vs.manager_state with managers_seen}} + let anonymous_state = {vs.anonymous_state with seed_nonce_levels_seen} in + {vs with anonymous_state} - let validate_seed_nonce_revelation vi vs - (Seed_nonce_revelation {level = commitment_raw_level; nonce}) = - let open Lwt_result_syntax in - let commitment_level = Level.from_raw vi.ctxt commitment_raw_level in - let*? () = - error_unless - (not - (Raw_level.Set.mem - commitment_raw_level - vs.anonymous_state.seed_nonce_levels_seen)) - Conflicting_nonce_revelation + let remove_seed_nonce_revelation vs + (operation : Kind.seed_nonce_revelation operation) = + let (Single (Seed_nonce_revelation {level = commitment_raw_level; _})) = + operation.protocol_data.contents in - let* () = Nonce.check_unrevealed vi.ctxt commitment_level nonce in let seed_nonce_levels_seen = - Raw_level.Set.add + Raw_level.Map.remove commitment_raw_level vs.anonymous_state.seed_nonce_levels_seen in - let new_vs = - { - vs with - anonymous_state = {vs.anonymous_state with seed_nonce_levels_seen}; - } - in - return new_vs + let anonymous_state = {vs.anonymous_state with seed_nonce_levels_seen} in + {vs with anonymous_state} - let validate_vdf_revelation vi vs (Vdf_revelation {solution}) = - let open Lwt_result_syntax in - let*? () = - error_unless - (not vs.anonymous_state.vdf_solution_seen) - Seed_storage.Already_accepted + let check_vdf_revelation vi (operation : Kind.vdf_revelation operation) = + let open Lwt_tzresult_syntax in + let (Single (Vdf_revelation {solution})) = + operation.protocol_data.contents in let* () = Seed.check_vdf vi.ctxt solution in - return - { - vs with - anonymous_state = {vs.anonymous_state with vdf_solution_seen = true}; - } + return_unit + + let check_vdf_revelation_conflict vs oph = + match vs.anonymous_state.vdf_solution_seen with + | None -> ok_unit + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph}) + + let wrap_vdf_revelation_conflict = function + | Ok () -> ok_unit + | Error conflict -> error (Conflicting_vdf_revelation conflict) + + let add_vdf_revelation vs oph = + { + vs with + anonymous_state = {vs.anonymous_state with vdf_solution_seen = Some oph}; + } + + let remove_vdf_revelation vs = + let anonymous_state = {vs.anonymous_state with vdf_solution_seen = None} in + {vs with anonymous_state} end module Manager = struct @@ -1596,15 +2093,7 @@ module Manager = struct TODO: https://gitlab.com/tezos/tezos/-/issues/3209 Change empty account cleanup mechanism to avoid the need for this field. *) - remaining_block_gas : Gas.Arith.fp; - (** In Block_validation mode, this is what remains of the block gas - quota after subtracting the gas_limit of all previously - validated operations in the block. In Mempool mode, only - previous gas for previous operations in the same batch has been - subtracted from the block quota. Cf - {!maybe_update_remaining_block_gas}: - [vs.manager_state.remaining_block_gas] is updated only in - Block_validation mode. *) + total_gas_used : Gas.Arith.fp; } (** Check a few simple properties of the batch, and return the @@ -1629,7 +2118,7 @@ module Manager = struct so all operations in the batch are required to originate from the same manager. This may change in the future, in order to allow several managers to group-sign a sequence of operations. *) - let check_sanity_and_find_public_key vi vs + let check_sanity_and_find_public_key vi (contents_list : _ Kind.manager contents_list) = let open Result_syntax in let check_source_and_counter ~expected_source ~source ~previous_counter @@ -1691,7 +2180,7 @@ module Manager = struct check_batch_tail_sanity source counter rest >>? fun () -> ok (source, None, counter) in - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let*? source, revealed_key, first_counter = check_batch contents_list in let* balance = Contract.check_allocated_and_get_balance vi.ctxt source in let* () = Contract.check_counter_increment vi.ctxt source first_counter in @@ -1717,30 +2206,16 @@ module Manager = struct the call to {!Contract.check_allocated_and_get_balance} above. *) is_allocated = true; - remaining_block_gas = vs.manager_state.remaining_block_gas; + total_gas_used = Gas.Arith.zero; } in return (initial_batch_state, pk) - let check_gas_limit_and_consume_from_block_gas vi ~remaining_block_gas - ~gas_limit = - (match vi.mode with - | Application _ | Partial_application _ | Construction _ -> fun res -> res - | Mempool -> - (* [Gas.check_limit_and_consume_from_block_gas] will only - raise a "temporary" error, however when - {!validate_operation} is called on a batch in isolation - (like e.g. in the mempool) it must "refuse" operations - whose total gas limit (the sum of the [gas_limit]s of each - operation) is already above the block limit. We add the - "permanent" error [Gas.Gas_limit_too_high] on top of the - trace to this effect. *) - record_trace Gas.Gas_limit_too_high) - (Gas.check_limit_and_consume_from_block_gas - ~hard_gas_limit_per_operation: - vi.manager_info.hard_gas_limit_per_operation - ~remaining_block_gas - ~gas_limit) + let check_gas_limit info ~gas_limit = + Gas.check_gas_limit + ~hard_gas_limit_per_operation: + info.manager_info.hard_gas_limit_per_operation + ~gas_limit let check_storage_limit vi storage_limit = error_unless @@ -1768,12 +2243,12 @@ module Manager = struct let assert_not_zero_messages messages = match messages with | [] -> error Sc_rollup_errors.Sc_rollup_add_zero_messages - | _ -> ok () + | _ -> ok_unit let assert_zk_rollup_feature_enabled vi = error_unless (Constants.zk_rollup_enable vi.ctxt) Zk_rollup_feature_disabled - let consume_decoding_gas ctxt lexpr = + let consume_decoding_gas remaining_gas lexpr = record_trace Gas_quota_exceeded_init_deserialize @@ (* Fail early if the operation does not have enough gas to cover the deserialization cost. We always consider the full @@ -1783,21 +2258,18 @@ module Manager = struct before (e.g. when retrieved in JSON format). Note that the lazy_expr is not actually decoded here; its deserialization cost is estimated from the size of its bytes. *) - Script.consume_decoding_gas ctxt lexpr + Script.consume_decoding_gas remaining_gas lexpr let validate_tx_rollup_submit_batch vi remaining_gas content = let open Result_syntax in let* () = assert_tx_rollup_feature_enabled vi in - let size_limit = Constants.tx_rollup_hard_size_limit_per_message vi.ctxt in let _message, message_size = Tx_rollup_message.make_batch content in let* cost = Tx_rollup_gas.hash_cost message_size in - let* remaining_gas = Gas.consume_from remaining_gas cost in - let* () = - error_unless - Compare.Int.(message_size <= size_limit) - Tx_rollup_errors.Message_size_exceeds_limit - in - return remaining_gas + let size_limit = Constants.tx_rollup_hard_size_limit_per_message vi.ctxt in + let* (_ : Gas.Arith.fp) = Gas.consume_from remaining_gas cost in + error_unless + Compare.Int.(message_size <= size_limit) + Tx_rollup_errors.Message_size_exceeds_limit let validate_tx_rollup_dispatch_tickets vi remaining_gas operation = let open Result_syntax in @@ -1825,16 +2297,19 @@ module Manager = struct Compare.List_length_with.(tickets_info > max_withdrawals_per_batch) Tx_rollup_errors.Too_many_withdrawals in - record_trace - Gas_quota_exceeded_init_deserialize - (List.fold_left_e - (fun remaining_gas Tx_rollup_reveal.{contents; ty; _} -> - let* remaining_gas = - Script.consume_decoding_gas remaining_gas contents - in - Script.consume_decoding_gas remaining_gas ty) - remaining_gas - tickets_info) + let* (_ : Gas.Arith.fp) = + record_trace + Gas_quota_exceeded_init_deserialize + (List.fold_left_e + (fun remaining_gas Tx_rollup_reveal.{contents; ty; _} -> + let* remaining_gas = + Script.consume_decoding_gas remaining_gas contents + in + Script.consume_decoding_gas remaining_gas ty) + remaining_gas + tickets_info) + in + return_unit let validate_tx_rollup_rejection vi operation = let open Result_syntax in @@ -1864,18 +2339,36 @@ module Manager = struct (Tx_rollup_commitment.Merkle.path_depth previous_message_result_path) ~count_limit:max_messages_per_inbox - let validate_contents (type kind) vi batch_state - (contents : kind Kind.manager contents) = - let open Lwt_result_syntax in + let may_trace_gas_limit_too_high info = + match info.mode with + | Application _ | Partial_application _ | Construction _ -> fun x -> x + | Mempool -> + (* [Gas.check_limit] will only + raise a "temporary" error, however when + {!validate_operation} is called on a batch in isolation + (like e.g. in the mempool) it must "refuse" operations + whose total gas limit (the sum of the [gas_limit]s of each + operation) is already above the block limit. We add the + "permanent" error [Gas.Gas_limit_too_high] on top of the + trace to this effect. *) + record_trace Gas.Gas_limit_too_high + + let check_contents (type kind) vi batch_state + (contents : kind Kind.manager contents) remaining_block_gas = + let open Lwt_tzresult_syntax in let (Manager_operation {source; fee; counter = _; operation; gas_limit; storage_limit}) = contents in - let*? remaining_block_gas = - check_gas_limit_and_consume_from_block_gas - vi - ~remaining_block_gas:batch_state.remaining_block_gas - ~gas_limit + let*? () = check_gas_limit vi ~gas_limit in + let total_gas_used = + Gas.Arith.(add batch_state.total_gas_used (fp gas_limit)) + in + let*? () = + may_trace_gas_limit_too_high vi + @@ error_unless + Gas.Arith.(fp total_gas_used <= remaining_block_gas) + Gas.Block_quota_exceeded in let*? remaining_gas = record_trace @@ -1894,68 +2387,67 @@ module Manager = struct batch_state.is_allocated (Contract_storage.Empty_implicit_contract source) in - let*? (_remaining_gas : Gas.Arith.fp) = + let*? () = let open Result_syntax in match operation with - | Reveal pk -> - let* () = Contract.check_public_key pk source in - return remaining_gas + | Reveal pk -> Contract.check_public_key pk source | Transaction {parameters; _} -> - consume_decoding_gas remaining_gas parameters + let* (_ : Gas.Arith.fp) = + consume_decoding_gas remaining_gas parameters + in + return_unit | Origination {script; _} -> let* remaining_gas = consume_decoding_gas remaining_gas script.code in - consume_decoding_gas remaining_gas script.storage + let* (_ : Gas.Arith.fp) = + consume_decoding_gas remaining_gas script.storage + in + return_unit | Register_global_constant {value} -> - consume_decoding_gas remaining_gas value + let* (_ : Gas.Arith.fp) = consume_decoding_gas remaining_gas value in + return_unit | Delegation _ | Set_deposits_limit _ | Increase_paid_storage _ | Update_consensus_key _ -> - return remaining_gas - | Tx_rollup_origination -> - let* () = assert_tx_rollup_feature_enabled vi in - return remaining_gas + return_unit + | Tx_rollup_origination -> assert_tx_rollup_feature_enabled vi | Tx_rollup_submit_batch {content; _} -> validate_tx_rollup_submit_batch vi remaining_gas content | Tx_rollup_commit _ | Tx_rollup_return_bond _ | Tx_rollup_finalize_commitment _ | Tx_rollup_remove_commitment _ -> - let* () = assert_tx_rollup_feature_enabled vi in - return remaining_gas + assert_tx_rollup_feature_enabled vi | Transfer_ticket {contents; ty; _} -> let* () = assert_tx_rollup_feature_enabled vi in let* remaining_gas = consume_decoding_gas remaining_gas contents in - consume_decoding_gas remaining_gas ty + let* (_ : Gas.Arith.fp) = consume_decoding_gas remaining_gas ty in + return_unit | Tx_rollup_dispatch_tickets _ -> validate_tx_rollup_dispatch_tickets vi remaining_gas operation - | Tx_rollup_rejection _ -> - let* () = validate_tx_rollup_rejection vi operation in - return remaining_gas + | Tx_rollup_rejection _ -> validate_tx_rollup_rejection vi operation | Sc_rollup_originate _ | Sc_rollup_cement _ | Sc_rollup_publish _ | Sc_rollup_refute _ | Sc_rollup_timeout _ | Sc_rollup_execute_outbox_message _ -> - let* () = assert_sc_rollup_feature_enabled vi in - return remaining_gas + assert_sc_rollup_feature_enabled vi | Sc_rollup_add_messages {messages; _} -> let* () = assert_sc_rollup_feature_enabled vi in - let* () = assert_not_zero_messages messages in - return remaining_gas + assert_not_zero_messages messages | Sc_rollup_recover_bond _ -> (* TODO: https://gitlab.com/tezos/tezos/-/issues/3063 Should we successfully precheck Sc_rollup_recover_bond and any (simple) Sc rollup operation, or should we add some some checks to make the operations Branch_delayed if they cannot be successfully prechecked? *) - let* () = assert_sc_rollup_feature_enabled vi in - return remaining_gas + assert_sc_rollup_feature_enabled vi | Sc_rollup_dal_slot_subscribe _ -> let* () = assert_sc_rollup_feature_enabled vi in - let* () = assert_dal_feature_enabled vi in - return remaining_gas + assert_dal_feature_enabled vi | Dal_publish_slot_header {slot} -> - let* () = Dal_apply.validate_publish_slot_header vi.ctxt slot in - return remaining_gas + Dal_apply.validate_publish_slot_header vi.ctxt slot | Zk_rollup_origination _ | Zk_rollup_publish _ -> - let* () = assert_zk_rollup_feature_enabled vi in - return remaining_gas + assert_zk_rollup_feature_enabled vi in + (* Gas should no longer be consumed below this point, because it + would not take into account any gas consumed during the pattern + matching right above. If you really need to consume gas here, then you + need to make this pattern matching return the [remaining_gas].*) let* balance, is_allocated = Contract.simulate_spending vi.ctxt @@ -1963,135 +2455,153 @@ module Manager = struct ~amount:fee source in - return {remaining_block_gas; balance; is_allocated} + return {total_gas_used; balance; is_allocated} - (** This would be [fold_left_es (validate_contents vi) batch_state + (** This would be [fold_left_es (check_contents vi) batch_state contents_list] if [contents_list] were an ordinary [list]. *) - let rec validate_contents_list : + let rec check_contents_list : type kind. info -> batch_state -> kind Kind.manager contents_list -> - batch_state tzresult Lwt.t = - fun vi batch_state contents_list -> - let open Lwt_result_syntax in + Gas.Arith.fp -> + Gas.Arith.fp tzresult Lwt.t = + fun vi batch_state contents_list remaining_gas -> + let open Lwt_tzresult_syntax in match contents_list with - | Single contents -> validate_contents vi batch_state contents + | Single contents -> + let* batch_state = + check_contents vi batch_state contents remaining_gas + in + return batch_state.total_gas_used | Cons (contents, tail) -> - let* batch_state = validate_contents vi batch_state contents in - validate_contents_list vi batch_state tail - - (** Return the new value that [remaining_block_gas] should have in - [state] after the validation of a manager - operation: - - - In [Block] (ie. block validation or block full construction) - mode, this value is [batch_state.remaining_block_gas], in which - the gas from the validated operation has been subtracted. - - - In [Mempool] mode, the [remaining_block_gas] in - [state] should remain unchanged. Indeed, we - only want each batch to not exceed the block limit individually, - without taking other operations into account. *) - let maybe_update_remaining_block_gas vi vs batch_state = - match vi.mode with - | Application _ | Partial_application _ | Construction _ -> - batch_state.remaining_block_gas - | Mempool -> vs.manager_state.remaining_block_gas + let* batch_state = + check_contents vi batch_state contents remaining_gas + in + check_contents_list vi batch_state tail remaining_gas - let validate_manager_operation vi vs ~should_check_signature source oph - (type kind) (operation : kind Kind.manager operation) = - let open Lwt_result_syntax in - let*? () = - (* One-operation-per-manager-per-block restriction (1M). - - We want to check 1M before we call - {!Contract.check_counter_increment} in - {!check_batch_sanity_and_find_public_key}. Indeed, if a block - contains two operations from the same manager, it is more - relevant to fail the second one with {!Manager_restriction} - than with {!Contract_storage.Counter_in_the_future}. *) - match - Signature.Public_key_hash.Map.find source vs.manager_state.managers_seen - with - | None -> Result.return_unit - | Some conflicting_oph -> - error (Manager_restriction (source, conflicting_oph)) - in + let check_manager_operation vi ~should_check_signature + (operation : _ Kind.manager operation) remaining_block_gas = + let open Lwt_tzresult_syntax in let contents_list = operation.protocol_data.contents in let* batch_state, source_pk = - check_sanity_and_find_public_key vi vs contents_list + check_sanity_and_find_public_key vi contents_list + in + let* gas_used = + check_contents_list vi batch_state contents_list remaining_block_gas in - let* batch_state = validate_contents_list vi batch_state contents_list in let*? () = if should_check_signature then Operation.check_signature source_pk vi.chain_id operation - else ok () - in - let managers_seen = - Signature.Public_key_hash.Map.add - source - oph - vs.manager_state.managers_seen - in - let remaining_block_gas = - maybe_update_remaining_block_gas vi vs batch_state + else ok_unit in - return {vs with manager_state = {managers_seen; remaining_block_gas}} + return gas_used - let rec sum_batch_gas_limit : - type kind. - Gas.Arith.integral -> - kind Kind.manager contents_list -> - Gas.Arith.integral = - fun acc contents_list -> - match contents_list with - | Single (Manager_operation {gas_limit; _}) -> Gas.Arith.add gas_limit acc - | Cons (Manager_operation {gas_limit; _}, tail) -> - sum_batch_gas_limit (Gas.Arith.add gas_limit acc) tail - - let remove_manager_operation (type manager_kind) vi vs - (operation : manager_kind Kind.manager operation) = + let check_manager_operation_conflict (type kind) vs oph + (operation : kind Kind.manager operation) = let source = match operation.protocol_data.contents with | Single (Manager_operation {source; _}) | Cons (Manager_operation {source; _}, _) -> source in + (* One-operation-per-manager-per-block restriction (1M) *) match Signature.Public_key_hash.Map.find_opt source vs.manager_state.managers_seen with - | None -> (* Nothing to do *) vs - | Some _oph -> - let managers_seen = - Signature.Public_key_hash.Map.remove - source - vs.manager_state.managers_seen - in + | None -> ok_unit + | Some oph' -> + Error (Operation_conflict {existing = oph'; new_operation = oph}) + + let wrap_check_manager_operation_conflict (type kind) + (operation : kind Kind.manager operation) = + let source = + match operation.protocol_data.contents with + | Single (Manager_operation {source; _}) + | Cons (Manager_operation {source; _}, _) -> + source + in + function + | Ok () -> ok_unit + | Error conflict -> error (Manager_restriction {source; conflict}) + + let add_manager_operation (type kind) vs oph + (operation : kind Kind.manager operation) = + let source = + match operation.protocol_data.contents with + | Single (Manager_operation {source; _}) + | Cons (Manager_operation {source; _}, _) -> + source + in + let managers_seen = + Signature.Public_key_hash.Map.add + source + oph + vs.manager_state.managers_seen + in + {vs with manager_state = {managers_seen}} + + (* Return the new [block_state] with the updated remaining gas used: + - In non-mempool modes, this value is + [block_state.remaining_block_gas], in which the gas from the + validated operation has been subtracted. + + - In [Mempool] mode, the [block_state] should remain + unchanged. Indeed, we only want each batch to not exceed the + block limit individually, without taking other operations + into account. *) + let may_update_remaining_gas_used mode (block_state : block_state) + operation_gas_used = + match mode with + | Application _ | Partial_application _ | Construction _ -> let remaining_block_gas = - match vi.mode with - | Application _ | Partial_application _ | Construction _ -> - let gas_limit = - sum_batch_gas_limit - Gas.Arith.zero - operation.protocol_data.contents - in - Gas.Arith.( - sub vs.manager_state.remaining_block_gas (fp gas_limit)) - | Mempool -> - (* The remaining block gas is never updated in [Mempool] - mode anyway (see {!maybe_update_remaining_block_gas}). *) - vs.manager_state.remaining_block_gas + Gas.Arith.(sub block_state.remaining_block_gas operation_gas_used) in - {vs with manager_state = {managers_seen; remaining_block_gas}} + {block_state with remaining_block_gas} + | Mempool -> block_state + + let remove_manager_operation (type kind) vs + (operation : kind Kind.manager operation) = + let source = + match operation.protocol_data.contents with + | Single (Manager_operation {source; _}) + | Cons (Manager_operation {source; _}, _) -> + source + in + let managers_seen = + Signature.Public_key_hash.Map.remove source vs.manager_state.managers_seen + in + {vs with manager_state = {managers_seen}} + + let validate_manager_operation ~should_check_signature info operation_state + block_state oph operation = + let open Lwt_tzresult_syntax in + let* gas_used = + check_manager_operation + info + ~should_check_signature + operation + block_state.remaining_block_gas + in + let*? () = + check_manager_operation_conflict operation_state oph operation + |> wrap_check_manager_operation_conflict operation + in + let operation_state = add_manager_operation operation_state oph operation in + let block_state = + may_update_remaining_gas_used info.mode block_state gas_used + in + return {info; operation_state; block_state} end -let init_info_and_state ctxt mode chain_id all_expected_consensus_features = +let init_validation_state ctxt mode chain_id all_expected_consensus_features + ~predecessor_level = let info = init_info ctxt mode chain_id all_expected_consensus_features in - let state = init_state ctxt in - {info; state} + let operation_state = init_operation_conflict_state ~predecessor_level in + let block_state = init_block_state info in + {info; operation_state; block_state} (* Pre-condition: Shell block headers' checks have already been done. These checks must ensure that: @@ -2104,7 +2614,7 @@ let init_info_and_state ctxt mode chain_id all_expected_consensus_features = *) let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp (block_header : Block_header.t) fitness ~is_partial = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let predecessor_round = Fitness.predecessor_round fitness in let round = Fitness.round fitness in let current_level = Level.current ctxt in @@ -2149,7 +2659,7 @@ let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp else Application application_info in let all_expected_consensus_features = - Consensus.expected_features_for_block_validation + Consensus.expected_features_for_application ctxt fitness payload_hash @@ -2157,8 +2667,14 @@ let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp ~predecessor_round ~predecessor_hash in + let predecessor_level = predecessor_level.level in return - (init_info_and_state ctxt mode chain_id all_expected_consensus_features) + (init_validation_state + ctxt + mode + chain_id + all_expected_consensus_features + ~predecessor_level) let begin_partial_application ~ancestor_context chain_id ~predecessor_level ~predecessor_timestamp (block_header : Block_header.t) fitness = @@ -2185,7 +2701,7 @@ let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp let begin_full_construction ctxt chain_id ~predecessor_level ~predecessor_round ~predecessor_timestamp ~predecessor_hash round (header_contents : Block_header.contents) = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let round_durations = Constants.round_durations ctxt in let timestamp = Timestamp.current ctxt in let*? () = @@ -2210,7 +2726,7 @@ let begin_full_construction ctxt chain_id ~predecessor_level ~predecessor_round ~round:header_contents.payload_round in let all_expected_consensus_features = - Consensus.expected_features_for_block_construction + Consensus.expected_features_for_construction ctxt round header_contents.payload_hash @@ -2218,8 +2734,9 @@ let begin_full_construction ctxt chain_id ~predecessor_level ~predecessor_round ~predecessor_round ~predecessor_hash in + let predecessor_level = predecessor_level.level in let validation_state = - init_info_and_state + init_validation_state ctxt (Construction { @@ -2232,23 +2749,29 @@ let begin_full_construction ctxt chain_id ~predecessor_level ~predecessor_round }) chain_id all_expected_consensus_features + ~predecessor_level in return validation_state let begin_partial_construction ctxt chain_id ~predecessor_level - ~predecessor_round ~predecessor_hash:_ ~grandparent_round = - let open Lwt_result_syntax in + ~predecessor_round ~grandparent_round = let all_expected_consensus_features = - Consensus.expected_features_for_mempool + Consensus.expected_features_for_partial_construction ctxt ~predecessor_level ~predecessor_round ~grandparent_round in + let predecessor_level = predecessor_level.level in let validation_state = - init_info_and_state ctxt Mempool chain_id all_expected_consensus_features + init_validation_state + ctxt + Mempool + chain_id + all_expected_consensus_features + ~predecessor_level in - return validation_state + validation_state let begin_no_predecessor_info ctxt chain_id = let all_expected_consensus_features = @@ -2256,24 +2779,239 @@ let begin_no_predecessor_info ctxt chain_id = expected_preendorsement = No_predecessor_info_cannot_validate_preendorsement; expected_endorsement = No_predecessor_info_cannot_validate_endorsement; - expected_grandparent_endorsement_for_mempool = None; + expected_grandparent_endorsement_for_partial_construction = None; } in - init_info_and_state ctxt Mempool chain_id all_expected_consensus_features + let current_level = Level.current ctxt in + let predecessor_level = + match Raw_level.pred current_level.level with + | None -> current_level.level + | Some level -> level + in + init_validation_state + ctxt + Mempool + chain_id + all_expected_consensus_features + ~predecessor_level -(** Increment [vs.op_count] for all operations, and record - non-consensus operation hashes in [vs.recorded_operations_rev]. *) -let record_operation vs ophash validation_pass_opt = - let op_count = vs.op_count + 1 in - match validation_pass_opt with - | Some n when Compare.Int.(n = Operation_repr.consensus_pass) -> - {vs with op_count} - | _ -> - { - vs with - op_count; - recorded_operations_rev = ophash :: vs.recorded_operations_rev; - } +let check_operation info ?(should_check_signature = true) (type kind) + (operation : kind operation) : unit tzresult Lwt.t = + let open Lwt_tzresult_syntax in + match operation.protocol_data.contents with + | Single (Preendorsement _) -> + let* (_voting_power : int) = + Consensus.check_preendorsement info ~should_check_signature operation + in + return_unit + | Single (Endorsement _) -> + let* (_kind : Consensus.endorsement_kind) = + Consensus.check_endorsement info ~should_check_signature operation + in + return_unit + | Single (Dal_slot_availability _) -> + Consensus.check_dal_slot_availability info operation + | Single (Proposals _) -> + Voting.check_proposals info ~should_check_signature operation + | Single (Ballot _) -> + Voting.check_ballot info ~should_check_signature operation + | Single (Activate_account _) -> + Anonymous.check_activate_account info operation + | Single (Double_preendorsement_evidence _) -> + Anonymous.check_double_preendorsement_evidence info operation + | Single (Double_endorsement_evidence _) -> + Anonymous.check_double_endorsement_evidence info operation + | Single (Double_baking_evidence _) -> + Anonymous.check_double_baking_evidence info operation + | Single (Drain_delegate _) -> + Anonymous.check_drain_delegate info ~should_check_signature operation + | Single (Seed_nonce_revelation _) -> + Anonymous.check_seed_nonce_revelation info operation + | Single (Vdf_revelation _) -> Anonymous.check_vdf_revelation info operation + | Single (Manager_operation _) -> + let remaining_gas = + Gas.Arith.fp (Constants.hard_gas_limit_per_block info.ctxt) + in + let* (_remaining_gas : Gas.Arith.fp) = + Manager.check_manager_operation + info + ~should_check_signature + operation + remaining_gas + in + return_unit + | Cons (Manager_operation _, _) -> + let remaining_gas = + Gas.Arith.fp (Constants.hard_gas_limit_per_block info.ctxt) + in + let* (_remaining_gas : Gas.Arith.fp) = + Manager.check_manager_operation + info + ~should_check_signature + operation + remaining_gas + in + return_unit + | Single (Failing_noop _) -> fail Validate_errors.Failing_noop_error + +let check_operation_conflict (type kind) operation_conflict_state oph + (operation : kind operation) = + match operation.protocol_data.contents with + | Single (Preendorsement _) -> + Consensus.check_preendorsement_conflict + operation_conflict_state + oph + operation + | Single (Endorsement _) -> + Consensus.check_endorsement_conflict + operation_conflict_state + oph + operation + | Single (Dal_slot_availability _) -> + Consensus.check_dal_slot_availability_conflict + operation_conflict_state + oph + operation + | Single (Proposals _) -> + Voting.check_proposals_conflict operation_conflict_state oph operation + | Single (Ballot _) -> + Voting.check_ballot_conflict operation_conflict_state oph operation + | Single (Activate_account _) -> + Anonymous.check_activate_account_conflict + operation_conflict_state + oph + operation + | Single (Double_preendorsement_evidence _) -> + Anonymous.check_double_preendorsement_evidence_conflict + operation_conflict_state + oph + operation + | Single (Double_endorsement_evidence _) -> + Anonymous.check_double_endorsement_evidence_conflict + operation_conflict_state + oph + operation + | Single (Double_baking_evidence _) -> + Anonymous.check_double_baking_evidence_conflict + operation_conflict_state + oph + operation + | Single (Drain_delegate _) -> + Anonymous.check_drain_delegate_conflict + operation_conflict_state + oph + operation + | Single (Seed_nonce_revelation _) -> + Anonymous.check_seed_nonce_revelation_conflict + operation_conflict_state + oph + operation + | Single (Vdf_revelation _) -> + Anonymous.check_vdf_revelation_conflict operation_conflict_state oph + | Single (Manager_operation _) -> + Manager.check_manager_operation_conflict + operation_conflict_state + oph + operation + | Cons (Manager_operation _, _) -> + Manager.check_manager_operation_conflict + operation_conflict_state + oph + operation + | Single (Failing_noop _) -> (* Nothing to do *) ok_unit + +let add_valid_operation operation_conflict_state oph (type kind) + (operation : kind operation) = + match operation.protocol_data.contents with + | Single (Preendorsement _) -> + Consensus.add_preendorsement operation_conflict_state oph operation + | Single (Endorsement consensus_content) -> + let endorsement_kind = + if + Consensus.is_normal_endorsement_assuming_valid + operation_conflict_state + consensus_content + then Consensus.Normal_endorsement 0 + else Grandparent_endorsement + in + Consensus.add_endorsement + operation_conflict_state + oph + operation + endorsement_kind + | Single (Dal_slot_availability _) -> + Consensus.add_dal_slot_availability operation_conflict_state oph operation + | Single (Proposals _) -> + Voting.add_proposals operation_conflict_state oph operation + | Single (Ballot _) -> + Voting.add_ballot operation_conflict_state oph operation + | Single (Activate_account _) -> + Anonymous.add_activate_account operation_conflict_state oph operation + | Single (Double_preendorsement_evidence _) -> + Anonymous.add_double_preendorsement_evidence + operation_conflict_state + oph + operation + | Single (Double_endorsement_evidence _) -> + Anonymous.add_double_endorsement_evidence + operation_conflict_state + oph + operation + | Single (Double_baking_evidence _) -> + Anonymous.add_double_baking_evidence + operation_conflict_state + oph + operation + | Single (Drain_delegate _) -> + Anonymous.add_drain_delegate operation_conflict_state oph operation + | Single (Seed_nonce_revelation _) -> + Anonymous.add_seed_nonce_revelation operation_conflict_state oph operation + | Single (Vdf_revelation _) -> + Anonymous.add_vdf_revelation operation_conflict_state oph + | Single (Manager_operation _) -> + Manager.add_manager_operation operation_conflict_state oph operation + | Cons (Manager_operation _, _) -> + Manager.add_manager_operation operation_conflict_state oph operation + | Single (Failing_noop _) -> (* Nothing to do *) operation_conflict_state + +(* Hypothesis: + - the [operation] has been validated and is present in [vs]; + - this function is only valid for the mempool mode. *) +let remove_operation operation_conflict_state (type kind) + (operation : kind operation) = + match operation.protocol_data.contents with + | Single (Preendorsement _) -> + Consensus.remove_preendorsement operation_conflict_state operation + | Single (Endorsement _) -> + Consensus.remove_endorsement operation_conflict_state operation + | Single (Dal_slot_availability _) -> + Consensus.remove_dal_slot_availability operation_conflict_state operation + | Single (Proposals _) -> + Voting.remove_proposals operation_conflict_state operation + | Single (Ballot _) -> Voting.remove_ballot operation_conflict_state operation + | Single (Activate_account _) -> + Anonymous.remove_activate_account operation_conflict_state operation + | Single (Double_preendorsement_evidence _) -> + Anonymous.remove_double_preendorsement_evidence + operation_conflict_state + operation + | Single (Double_endorsement_evidence _) -> + Anonymous.remove_double_endorsement_evidence + operation_conflict_state + operation + | Single (Double_baking_evidence _) -> + Anonymous.remove_double_baking_evidence operation_conflict_state operation + | Single (Drain_delegate _) -> + Anonymous.remove_drain_delegate operation_conflict_state operation + | Single (Seed_nonce_revelation _) -> + Anonymous.remove_seed_nonce_revelation operation_conflict_state operation + | Single (Vdf_revelation _) -> + Anonymous.remove_vdf_revelation operation_conflict_state + | Single (Manager_operation _) -> + Manager.remove_manager_operation operation_conflict_state operation + | Cons (Manager_operation _, _) -> + Manager.remove_manager_operation operation_conflict_state operation + | Single (Failing_noop _) -> (* Nothing to do *) operation_conflict_state let check_validation_pass_consistency vi vs validation_pass = let open Lwt_tzresult_syntax in @@ -2293,112 +3031,190 @@ let check_validation_pass_consistency vi vs validation_pass = return {vs with last_op_validation_pass = Some validation_pass} | Some _, None -> fail Validate_errors.Failing_noop_error) -let validate_operation {info; state} ?(should_check_signature = true) oph - (packed_operation : packed_operation) = +(** Increment [vs.op_count] for all operations, and record + non-consensus operation hashes in [vs.recorded_operations_rev]. *) +let record_operation vs ophash validation_pass_opt = + let op_count = vs.op_count + 1 in + match validation_pass_opt with + | Some n when Compare.Int.(n = Operation_repr.consensus_pass) -> + {vs with op_count} + | _ -> + { + vs with + op_count; + recorded_operations_rev = ophash :: vs.recorded_operations_rev; + } + +let validate_operation {info; operation_state; block_state} + ?(should_check_signature = true) oph (packed_operation : packed_operation) = let open Lwt_tzresult_syntax in - let validation_pass_opt = - Alpha_context.Operation.acceptable_pass packed_operation - in let {shell; protocol_data = Operation_data protocol_data} = packed_operation in - let* state = - check_validation_pass_consistency info state validation_pass_opt + let validation_pass_opt = + Alpha_context.Operation.acceptable_pass packed_operation + in + let* block_state = + check_validation_pass_consistency info block_state validation_pass_opt in - let state = record_operation state oph validation_pass_opt in + let block_state = record_operation block_state oph validation_pass_opt in let operation : _ Alpha_context.operation = {shell; protocol_data} in - let* state = - match (info.mode, validation_pass_opt) with - | Partial_application _, Some n - when Compare.Int.(n <> Operation_repr.consensus_pass) -> - (* Do not validate non consensus operation in [Partial_application] mode *) - return state - | Partial_application _, _ - | Mempool, _ - | Construction _, _ - | Application _, _ -> ( - match operation.protocol_data.contents with - | Single (Preendorsement _) -> - Consensus.validate_preendorsement - info - state - ~should_check_signature - operation - | Single (Endorsement _) -> - Consensus.validate_endorsement - info - state - ~should_check_signature - operation - | Single (Dal_slot_availability _) -> - Consensus.validate_dal_slot_availability - info - state - ~should_check_signature - operation - | Single (Proposals _) -> - Voting.validate_proposals - info - state - ~should_check_signature - oph - operation - | Single (Ballot _) -> - Voting.validate_ballot - info - state - ~should_check_signature - oph - operation - | Single (Activate_account _ as contents) -> - Anonymous.validate_activate_account info state oph contents - | Single (Double_preendorsement_evidence _ as contents) -> - Anonymous.validate_double_preendorsement_evidence - info - state - oph - contents - | Single (Double_endorsement_evidence _ as contents) -> - Anonymous.validate_double_endorsement_evidence - info - state - oph - contents - | Single (Double_baking_evidence _ as contents) -> - Anonymous.validate_double_baking_evidence info state oph contents - | Single (Drain_delegate _) -> - Anonymous.validate_drain_delegate - info - state - ~should_check_signature - oph - operation - | Single (Seed_nonce_revelation _ as contents) -> - Anonymous.validate_seed_nonce_revelation info state contents - | Single (Vdf_revelation _ as contents) -> - Anonymous.validate_vdf_revelation info state contents - | Single (Manager_operation {source; _}) -> - Manager.validate_manager_operation - info - state - ~should_check_signature - source + match (info.mode, validation_pass_opt) with + | Partial_application _, Some n + when Compare.Int.(n <> Operation_repr.consensus_pass) -> + (* Do not validate non-consensus operation in [Partial_application] mode *) + return {info; operation_state; block_state} + | Partial_application _, _ | Mempool, _ | Construction _, _ | Application _, _ + -> ( + match operation.protocol_data.contents with + | Single (Preendorsement _) -> + Consensus.validate_preendorsement + ~should_check_signature + info + operation_state + block_state + oph + operation + | Single (Endorsement _) -> + Consensus.validate_endorsement + ~should_check_signature + info + operation_state + block_state + oph + operation + | Single (Dal_slot_availability _) -> + let open Consensus in + let* () = check_dal_slot_availability info operation in + let*? () = + check_dal_slot_availability_conflict operation_state oph operation + |> wrap_dal_slot_availability_conflict + in + let operation_state = + add_dal_slot_availability operation_state oph operation + in + return {info; operation_state; block_state} + | Single (Proposals _) -> + let open Voting in + let* () = check_proposals info ~should_check_signature operation in + let*? () = + check_proposals_conflict operation_state oph operation + |> wrap_proposals_conflict + in + let operation_state = add_proposals operation_state oph operation in + return {info; operation_state; block_state} + | Single (Ballot _) -> + let open Voting in + let* () = check_ballot info ~should_check_signature operation in + let*? () = + check_ballot_conflict operation_state oph operation + |> wrap_ballot_conflict + in + let operation_state = add_ballot operation_state oph operation in + return {info; operation_state; block_state} + | Single (Activate_account _) -> + let open Anonymous in + let* () = check_activate_account info operation in + let*? () = + check_activate_account_conflict operation_state oph operation + |> wrap_activate_account_conflict operation + in + let operation_state = + add_activate_account operation_state oph operation + in + return {info; operation_state; block_state} + | Single (Double_preendorsement_evidence _) -> + let open Anonymous in + let* () = check_double_preendorsement_evidence info operation in + let*? () = + check_double_preendorsement_evidence_conflict + operation_state oph operation - | Cons (Manager_operation {source; _}, _) -> - Manager.validate_manager_operation - info - state - ~should_check_signature - source + |> wrap_denunciation_conflict Preendorsement + in + let operation_state = + add_double_preendorsement_evidence operation_state oph operation + in + return {info; operation_state; block_state} + | Single (Double_endorsement_evidence _) -> + let open Anonymous in + let* () = check_double_endorsement_evidence info operation in + let*? () = + check_double_endorsement_evidence_conflict + operation_state oph operation - | Single (Failing_noop _) -> fail Validate_errors.Failing_noop_error) - in - return state + |> wrap_denunciation_conflict Endorsement + in + let operation_state = + add_double_endorsement_evidence operation_state oph operation + in + return {info; operation_state; block_state} + | Single (Double_baking_evidence _) -> + let open Anonymous in + let* () = check_double_baking_evidence info operation in + let*? () = + check_double_baking_evidence_conflict operation_state oph operation + |> wrap_denunciation_conflict Block + in + let operation_state = + add_double_baking_evidence operation_state oph operation + in + return {info; operation_state; block_state} + | Single (Drain_delegate _) -> + let open Anonymous in + let* () = + check_drain_delegate info ~should_check_signature operation + in + let*? () = + check_drain_delegate_conflict operation_state oph operation + |> wrap_drain_delegate_conflict operation + in + let operation_state = + add_drain_delegate operation_state oph operation + in + return {info; operation_state; block_state} + | Single (Seed_nonce_revelation _) -> + let open Anonymous in + let* () = check_seed_nonce_revelation info operation in + let*? () = + check_seed_nonce_revelation_conflict operation_state oph operation + |> wrap_seed_nonce_revelation_conflict + in + let operation_state = + add_seed_nonce_revelation operation_state oph operation + in + return {info; operation_state; block_state} + | Single (Vdf_revelation _) -> + let open Anonymous in + let* () = check_vdf_revelation info operation in + let*? () = + check_vdf_revelation_conflict operation_state oph + |> wrap_vdf_revelation_conflict + in + let operation_state = add_vdf_revelation operation_state oph in + return {info; operation_state; block_state} + | Single (Manager_operation _) -> + Manager.validate_manager_operation + ~should_check_signature + info + operation_state + block_state + oph + operation + | Cons (Manager_operation _, _) -> + Manager.validate_manager_operation + ~should_check_signature + info + operation_state + block_state + oph + operation + | Single (Failing_noop _) -> fail Validate_errors.Failing_noop_error) let are_endorsements_required vi = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let+ first_level = First_level_of_protocol.get vi.ctxt in (* [Comment from Legacy_apply] NB: the first level is the level of the migration block. There are no endorsements for this @@ -2409,9 +3225,9 @@ let are_endorsements_required vi = in Compare.Int32.(level_position_in_protocol > 1l) -let check_endorsement_power vi vs = - let required = Constants.consensus_threshold vi.ctxt - and provided = vs.consensus_state.endorsement_power in +let check_endorsement_power vi bs = + let required = Constants.consensus_threshold vi.ctxt in + let provided = bs.endorsement_power in error_unless Compare.Int.(provided >= required) (Validate_errors.Block.Not_enough_endorsements {required; provided}) @@ -2423,7 +3239,7 @@ let finalize_validate_block_header vi vs checkable_payload_hash Option.map (fun (preendorsement_round, preendorsement_count) -> Block_header.{preendorsement_round; preendorsement_count}) - vs.consensus_state.locked_round_evidence + vs.locked_round_evidence in Block_header.finalize_validate_block_header ~block_header_contents @@ -2433,33 +3249,34 @@ let finalize_validate_block_header vi vs checkable_payload_hash ~locked_round_evidence ~consensus_threshold:(Constants.consensus_threshold vi.ctxt) -let compute_payload_hash (vs : state) +let compute_payload_hash block_state (block_header_contents : Alpha_context.Block_header.contents) predecessor = let operations_hash = - Operation_list_hash.compute (List.rev vs.recorded_operations_rev) + Operation_list_hash.compute (List.rev block_state.recorded_operations_rev) in Block_payload.hash ~predecessor block_header_contents.payload_round operations_hash -let finalize_block {info; state} = +let finalize_block {info; block_state; _} = let open Lwt_tzresult_syntax in match info.mode with | Application {fitness; predecessor_hash; block_data_contents; _} -> let* are_endorsements_required = are_endorsements_required info in let*? () = - if are_endorsements_required then check_endorsement_power info state - else ok () + if are_endorsements_required then + check_endorsement_power info block_state + else ok_unit in let block_payload_hash = - compute_payload_hash state block_data_contents predecessor_hash + compute_payload_hash block_state block_data_contents predecessor_hash in let round = Fitness.round fitness in let*? () = finalize_validate_block_header info - state + block_state (Block_header.Expected_payload_hash block_payload_hash) block_data_contents round @@ -2469,16 +3286,17 @@ let finalize_block {info; state} = | Partial_application _ -> let* are_endorsements_required = are_endorsements_required info in let*? () = - if are_endorsements_required then check_endorsement_power info state - else ok () + if are_endorsements_required then + check_endorsement_power info block_state + else ok_unit in return_unit | Construction {predecessor_round; predecessor_hash; round; block_data_contents; _} -> let block_payload_hash = - compute_payload_hash state block_data_contents predecessor_hash + compute_payload_hash block_state block_data_contents predecessor_hash in - let locked_round_evidence = state.consensus_state.locked_round_evidence in + let locked_round_evidence = block_state.locked_round_evidence in let checkable_payload_hash = match locked_round_evidence with | Some _ -> Block_header.Expected_payload_hash block_payload_hash @@ -2494,8 +3312,9 @@ let finalize_block {info; state} = in let* are_endorsements_required = are_endorsements_required info in let*? () = - if are_endorsements_required then check_endorsement_power info state - else ok () + if are_endorsements_required then + check_endorsement_power info block_state + else ok_unit in let* fitness = let locked_round = @@ -2512,7 +3331,7 @@ let finalize_block {info; state} = let*? () = finalize_validate_block_header info - state + block_state checkable_payload_hash block_data_contents round @@ -2522,8 +3341,3 @@ let finalize_block {info; state} = | Mempool -> (* Nothing to do for the mempool mode*) return_unit - -(* This function will be replaced with a generic remove_operation in - the future. *) -let remove_manager_operation {info; state} = - Manager.remove_manager_operation info state diff --git a/src/proto_alpha/lib_protocol/validate.mli b/src/proto_alpha/lib_protocol/validate.mli index 5d2bccf457c6789685a5ddc8507fe69412cd95fe..e38a68c5ef0eaee18f0504b02ec5f00d588a6677 100644 --- a/src/proto_alpha/lib_protocol/validate.mli +++ b/src/proto_alpha/lib_protocol/validate.mli @@ -23,28 +23,44 @@ (* *) (*****************************************************************************) -(** The purpose of this module is to provide, that decides quickly - whether an operation may safely be included in a block or whether a - block can be advertised through the network. +(** The purpose of this module is to provide the {!validate_operation} + function, that decides quickly whether an operation may safely be + included in a block. See the function's description for further + information. + + This module also provide functions to check the validity of a + block and the consistency of its block_header. Most elements in this module are either used or wrapped in the - {!Main} module. *) + {!Main} module. *) -(** Static information needed by {!validate_operation} or for a block - validation. +open Alpha_context +open Validate_errors - It lives in memory, not in the storage. *) +(** Static information required to validate blocks and operations. *) type info -(** State used and modified by {!validate_operation} or by a block - validation. +(** State used to register operations effects used to establish + potential conflicts. This state is serializable which allows it to + be exchanged with another source. See {Mempool_validation} *) +type operation_conflict_state - It lives in memory, not in the storage. *) -type state +(** Encoding for the [operation_conflict_state]. *) +val operation_conflict_state_encoding : operation_conflict_state Data_encoding.t -type validation_state = {info : info; state : state} +(** State used to register global block validity dependent + effects. This state is used and updated by the + [validate_operation] function and will also be used during the + [finalize_block]. For instance, it registers inter-operations + checks (e.g. total gas used in the block so far). *) +type block_state -open Alpha_context +(** Validation state *) +type validation_state = { + info : info; + operation_state : operation_conflict_state; + block_state : block_state; +} (** Initialize the {!info} and {!state} for the validation of an existing block (in preparation for its future application). *) @@ -88,9 +104,8 @@ val begin_partial_construction : Chain_id.t -> predecessor_level:Level.t -> predecessor_round:Round.t -> - predecessor_hash:Block_hash.t -> grandparent_round:Round.t -> - validation_state tzresult Lwt.t + validation_state (** Initialize the {!info} and {!state} without providing any predecessor information. This will cause any preendorsement or @@ -166,23 +181,46 @@ val validate_operation : validation_state -> ?should_check_signature:bool -> Operation_hash.t -> - Alpha_context.packed_operation -> - state tzresult Lwt.t + packed_operation -> + validation_state tzresult Lwt.t + +(** Check the operation validity, see {!validate_operation} for + more information + + Note: Should only be called in mempool mode *) +val check_operation : + info -> ?should_check_signature:bool -> 'kind operation -> unit tzresult Lwt.t + +(** Check that the operation does not conflict with other operations + already validated and included in the {!operation_conflict_state} + + Note: Should only be called in mempool mode *) +val check_operation_conflict : + operation_conflict_state -> + Operation_hash.t -> + 'kind operation -> + (unit, operation_conflict) result + +(** Add the operation in the {!operation_conflict_state}. The + operation should be validated before being added + + Note: Should only be called in mempool mode *) +val add_valid_operation : + operation_conflict_state -> + Operation_hash.t -> + 'kind operation -> + operation_conflict_state + +(** Remove the operation from the {!operation_conflict_state}. + + Hypothesis: + - the [operation] has been validated and added to + [operation_conflict_state]; + - this function is only valid for the mempool mode. *) +val remove_operation : + operation_conflict_state -> 'kind operation -> operation_conflict_state (** Check the consistency of the block_header information with the one computed (Endorsement power, payload hash, etc) while validating the block operations. Checks vary depending on the mode. *) val finalize_block : validation_state -> unit tzresult Lwt.t - -(** Remove a manager operation from the {!validate_operation_state}. - - This function is intended for a mempool: when an operation A has - already been validated, but another operation B conflicts with A - (e.g. they have the same manager) and is more desirable than A - (e.g. better fees/gas ratio), then the mempool may remove A in - order to validate B instead. - - This function will be replaced with a generic function - [remove_operation] in the future. *) -val remove_manager_operation : - validation_state -> 'a Kind.manager operation -> state diff --git a/src/proto_alpha/lib_protocol/validate_errors.ml b/src/proto_alpha/lib_protocol/validate_errors.ml index 12269b8ba96cec0e78e424c52a348873b0b164e6..c1f639499412515b7770e70653f46404ede83e08 100644 --- a/src/proto_alpha/lib_protocol/validate_errors.ml +++ b/src/proto_alpha/lib_protocol/validate_errors.ml @@ -25,6 +25,28 @@ open Alpha_context +type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + +let operation_conflict_encoding = + let open Data_encoding in + def + "operation_conflict" + ~title:"Conflict error" + ~description:"Conflict between two operations" + @@ conv + (function + | Operation_conflict {existing; new_operation} -> + (existing, new_operation)) + (fun (existing, new_operation) -> + Operation_conflict {existing; new_operation}) + (obj2 + (req "existing" Operation_hash.encoding) + (req "new_operation" Operation_hash.encoding)) + module Consensus = struct type error += Zero_frozen_deposits of Signature.Public_key_hash.t @@ -51,6 +73,7 @@ module Consensus = struct | Preendorsement | Endorsement | Grandparent_endorsement + | Dal_slot_availability let consensus_operation_kind_encoding = Data_encoding.string_enum @@ -58,12 +81,14 @@ module Consensus = struct ("Preendorsement", Preendorsement); ("Endorsement", Endorsement); ("Grandparent_endorsement", Grandparent_endorsement); + ("Dal_slot_availability", Dal_slot_availability); ] let consensus_operation_kind_pp fmt = function | Preendorsement -> Format.fprintf fmt "Preendorsement" | Endorsement -> Format.fprintf fmt "Endorsement" | Grandparent_endorsement -> Format.fprintf fmt "Grandparent endorsement" + | Dal_slot_availability -> Format.fprintf fmt "Dal_slot_availability" (** Errors for preendorsements and endorsements. *) type error += @@ -106,7 +131,10 @@ module Consensus = struct | Wrong_slot_used_for_consensus_operation of { kind : consensus_operation_kind; } - | Conflicting_consensus_operation of {kind : consensus_operation_kind} + | Conflicting_consensus_operation of { + kind : consensus_operation_kind; + conflict : operation_conflict; + } | Consensus_operation_not_allowed let () = @@ -334,16 +362,25 @@ module Consensus = struct ~id:"validate.double_inclusion_of_consensus_operation" ~title:"Double inclusion of consensus operation" ~description:"Double inclusion of consensus operation." - ~pp:(fun ppf kind -> + ~pp:(fun ppf (kind, Operation_conflict {existing; new_operation}) -> Format.fprintf ppf - "Double inclusion of %a operation" + "%a operation %a conflicts with existing %a" consensus_operation_kind_pp - kind) - Data_encoding.(obj1 (req "kind" consensus_operation_kind_encoding)) + kind + Operation_hash.pp + new_operation + Operation_hash.pp + existing) + Data_encoding.( + obj2 + (req "kind" consensus_operation_kind_encoding) + (req "conflict" operation_conflict_encoding)) (function - | Conflicting_consensus_operation {kind} -> Some kind | _ -> None) - (fun kind -> Conflicting_consensus_operation {kind}) ; + | Conflicting_consensus_operation {kind; conflict} -> + Some (kind, conflict) + | _ -> None) + (fun (kind, conflict) -> Conflicting_consensus_operation {kind; conflict}) ; register_error_kind `Branch ~id:"validate.consensus_operation_not_allowed" @@ -354,30 +391,6 @@ module Consensus = struct Data_encoding.empty (function Consensus_operation_not_allowed -> Some () | _ -> None) (fun () -> Consensus_operation_not_allowed) - - type error += - | Conflicting_dal_slot_availability of { - endorser : Signature.Public_key_hash.t; - } - - let () = - register_error_kind - `Temporary - ~id:"validate.conflicting_dal_slot_availability" - ~title:"Conflicting Dal slot availability" - ~description:"Conflicting Dal slot availability." - ~pp:(fun ppf endorser -> - Format.fprintf - ppf - "Dal slot availability for %a has already been validated for the \ - current validation state." - Signature.Public_key_hash.pp - endorser) - Data_encoding.(obj1 (req "endorser" Signature.Public_key_hash.encoding)) - (function - | Conflicting_dal_slot_availability {endorser} -> Some endorser - | _ -> None) - (fun endorser -> Conflicting_dal_slot_availability {endorser}) end module Voting = struct @@ -395,22 +408,10 @@ module Voting = struct | (* Proposals errors *) Empty_proposals | Proposals_contain_duplicate of {proposal : Protocol_hash.t} - | Too_many_proposals | Already_proposed of {proposal : Protocol_hash.t} - | Conflict_too_many_proposals of { - max_allowed : int; - count_previous_blocks : int; - count_current_block : int; - count_operation : int; - conflicting_operations : Operation_hash.t list; - } - | Conflict_already_proposed of { - proposal : Protocol_hash.t; - conflicting_operation : Operation_hash.t; - } - | Conflicting_dictator_proposals of Operation_hash.t + | Too_many_proposals of {previous_count : int; operation_count : int} + | Conflicting_proposals of operation_conflict | Testnet_dictator_multiple_proposals - | Testnet_dictator_conflicting_operation | Proposals_from_unregistered_delegate of Signature.Public_key_hash.t | (* Ballot errors *) Ballot_for_wrong_proposal of { @@ -418,8 +419,8 @@ module Voting = struct submitted : Protocol_hash.t; } | Already_submitted_a_ballot - | Conflicting_ballot of {conflicting_operation : Operation_hash.t} | Ballot_from_unregistered_delegate of Signature.Public_key_hash.t + | Conflicting_ballot of operation_conflict let () = (* Shared voting errors *) @@ -509,18 +510,6 @@ module Voting = struct (function | Proposals_contain_duplicate {proposal} -> Some proposal | _ -> None) (fun proposal -> Proposals_contain_duplicate {proposal}) ; - let description = - "The proposer exceeded the maximum number of allowed proposals." - in - register_error_kind - `Branch - ~id:"validate.operation.too_many_proposals" - ~title:"Too many proposals" - ~description - ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) - Data_encoding.empty - (function Too_many_proposals -> Some () | _ -> None) - (fun () -> Too_many_proposals) ; register_error_kind `Branch ~id:"validate.operation.already_proposed" @@ -544,105 +533,38 @@ module Voting = struct "The delegate exceeded the maximum number of allowed proposals due to, \ among others, previous Proposals operations in the current \ block/mempool." - ~pp: - (fun ppf - ( max_allowed, - count_previous_blocks, - count_current_block, - count_operation, - conflicting_operations ) -> + ~pp:(fun ppf (previous_count, operation_count) -> Format.fprintf ppf - "The delegate has submitted too many proposals (the maximum allowed \ - is %d): %d in previous blocks, %d in the considered operation, and \ - %d in the following validated operations of the current \ - block/mempool: %a." - max_allowed - count_previous_blocks - count_operation - count_current_block - (Format.pp_print_list Operation_hash.pp) - conflicting_operations) + "The delegate cannot submit too many protocol proposals: it \ + currently voted for %d and is trying to vote for %d more." + previous_count + operation_count) Data_encoding.( - obj5 - (req "max_allowed" int8) - (req "count_previous_blocks" int8) - (req "count_current_block" int8) - (req "count_operation" int8) - (req "conflicting_operations" (list Operation_hash.encoding))) + obj2 (req "previous_count" int8) (req "operation_count" int31)) (function - | Conflict_too_many_proposals - { - max_allowed; - count_previous_blocks; - count_current_block; - count_operation; - conflicting_operations; - } -> - Some - ( max_allowed, - count_previous_blocks, - count_current_block, - count_operation, - conflicting_operations ) + | Too_many_proposals {previous_count; operation_count} -> + Some (previous_count, operation_count) | _ -> None) - (fun ( max_allowed, - count_previous_blocks, - count_current_block, - count_operation, - conflicting_operations ) -> - Conflict_too_many_proposals - { - max_allowed; - count_previous_blocks; - count_current_block; - count_operation; - conflicting_operations; - }) ; + (fun (previous_count, operation_count) -> + Too_many_proposals {previous_count; operation_count}) ; register_error_kind `Temporary - ~id:"validate.operation.conflict_already_proposed" - ~title:"Conflict already proposed" - ~description: - "The delegate has already submitted one of the operation's proposals \ - in a previously validated operation of the current block or mempool." - ~pp:(fun ppf (proposal, conflicting_oph) -> - Format.fprintf - ppf - "The delegate has already proposed the protocol hash %a in the \ - previously validated operation %a of the current block or mempool." - Protocol_hash.pp - proposal - Operation_hash.pp - conflicting_oph) - Data_encoding.( - obj2 - (req "proposal" Protocol_hash.encoding) - (req "conflicting_operation" Operation_hash.encoding)) - (function - | Conflict_already_proposed {proposal; conflicting_operation} -> - Some (proposal, conflicting_operation) - | _ -> None) - (fun (proposal, conflicting_operation) -> - Conflict_already_proposed {proposal; conflicting_operation}) ; - register_error_kind - `Branch - ~id:"validate.operation.conflicting_dictator_proposals" - ~title:"Conflicting dictator proposals" + ~id:"validate.operation.conflicting_proposals" + ~title:"Conflicting proposals" ~description: "The current block/mempool already contains a testnest dictator \ proposals operation, so it cannot have any other voting operation." - ~pp:(fun ppf dictator_operation -> + ~pp:(fun ppf (Operation_conflict {existing; _}) -> Format.fprintf ppf - "The current block/mempool already contains the testnest dictator \ - proposals operation %a, so it cannot have any other voting \ - operation." + "The current block/mempool already contains a conflicting operation \ + %a." Operation_hash.pp - dictator_operation) - Data_encoding.(obj1 (req "dictator_operation" Operation_hash.encoding)) - (function Conflicting_dictator_proposals oph -> Some oph | _ -> None) - (fun oph -> Conflicting_dictator_proposals oph) ; + existing) + Data_encoding.(obj1 (req "conflict" operation_conflict_encoding)) + (function Conflicting_proposals conflict -> Some conflict | _ -> None) + (fun conflict -> Conflicting_proposals conflict) ; let description = "A testnet dictator cannot submit more than one proposal at a time." in @@ -655,19 +577,6 @@ module Voting = struct Data_encoding.empty (function Testnet_dictator_multiple_proposals -> Some () | _ -> None) (fun () -> Testnet_dictator_multiple_proposals) ; - let description = - "A testnet dictator proposals operation cannot be included in a block or \ - mempool that already contains any other voting operation." - in - register_error_kind - `Branch - ~id:"validate.operation.testnet_dictator_conflicting_operation" - ~title:"Testnet dictator conflicting operation" - ~description - ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) - Data_encoding.empty - (function Testnet_dictator_conflicting_operation -> Some () | _ -> None) - (fun () -> Testnet_dictator_conflicting_operation) ; register_error_kind `Permanent ~id:"operation.proposals_from_unregistered_delegate" @@ -721,26 +630,6 @@ module Voting = struct Data_encoding.empty (function Already_submitted_a_ballot -> Some () | _ -> None) (fun () -> Already_submitted_a_ballot) ; - register_error_kind - `Temporary - ~id:"validate.operation.conflicting_ballot" - ~title:"Conflicting ballot" - ~description: - "The delegate has already submitted a ballot in a previously validated \ - operation of the current block or mempool." - ~pp:(fun ppf conflicting_oph -> - Format.fprintf - ppf - "The delegate has already submitted a ballot in the previously \ - validated operation %a of the current block or mempool." - Operation_hash.pp - conflicting_oph) - Data_encoding.(obj1 (req "conflicting_operation" Operation_hash.encoding)) - (function - | Conflicting_ballot {conflicting_operation} -> - Some conflicting_operation - | _ -> None) - (fun conflicting_operation -> Conflicting_ballot {conflicting_operation}) ; register_error_kind `Permanent ~id:"operation.ballot_from_unregistered_delegate" @@ -754,13 +643,33 @@ module Voting = struct c) Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) (function Ballot_from_unregistered_delegate c -> Some c | _ -> None) - (fun c -> Ballot_from_unregistered_delegate c) + (fun c -> Ballot_from_unregistered_delegate c) ; + register_error_kind + `Temporary + ~id:"validate.operation.conflicting_ballot" + ~title:"Conflicting ballot" + ~description: + "The delegate has already submitted a ballot in a previously validated \ + operation of the current block or mempool." + ~pp:(fun ppf (Operation_conflict {existing; _}) -> + Format.fprintf + ppf + "The delegate has already submitted a ballot in the previously \ + validated operation %a of the current block or mempool." + Operation_hash.pp + existing) + Data_encoding.(obj1 (req "conflict" operation_conflict_encoding)) + (function Conflicting_ballot conflict -> Some conflict | _ -> None) + (fun conflict -> Conflicting_ballot conflict) end module Anonymous = struct type error += | Invalid_activation of {pkh : Ed25519.Public_key_hash.t} - | Conflicting_activation of Ed25519.Public_key_hash.t * Operation_hash.t + | Conflicting_activation of { + edpkh : Ed25519.Public_key_hash.t; + conflict : operation_conflict; + } let () = register_error_kind @@ -787,7 +696,7 @@ module Anonymous = struct ~description: "The account has already been activated by a previous operation in the \ current validation state." - ~pp:(fun ppf (edpkh, oph) -> + ~pp:(fun ppf (edpkh, Operation_conflict {existing; _}) -> Format.fprintf ppf "Invalid activation: the account %a has already been activated in \ @@ -795,14 +704,15 @@ module Anonymous = struct Ed25519.Public_key_hash.pp edpkh Operation_hash.pp - oph) + existing) Data_encoding.( obj2 - (req "account_edpkh" Ed25519.Public_key_hash.encoding) - (req "conflicting_op_hash" Operation_hash.encoding)) + (req "edpkh" Ed25519.Public_key_hash.encoding) + (req "conflict" operation_conflict_encoding)) (function - | Conflicting_activation (edpkh, oph) -> Some (edpkh, oph) | _ -> None) - (fun (edpkh, oph) -> Conflicting_activation (edpkh, oph)) + | Conflicting_activation {edpkh; conflict} -> Some (edpkh, conflict) + | _ -> None) + (fun (edpkh, conflict) -> Conflicting_activation {edpkh; conflict}) type denunciation_kind = Preendorsement | Endorsement | Block @@ -842,9 +752,7 @@ module Anonymous = struct } | Conflicting_denunciation of { kind : denunciation_kind; - delegate : Signature.Public_key_hash.t; - level : Level.t; - hash : Operation_hash.t; + conflict : operation_conflict; } | Too_early_denunciation of { kind : denunciation_kind; @@ -966,31 +874,23 @@ module Anonymous = struct ~description: "The same denunciation has already been validated in the current \ validation state." - ~pp:(fun ppf (kind, delegate, level, hash) -> + ~pp:(fun ppf (kind, Operation_conflict {existing; _}) -> Format.fprintf ppf - "Double %a evidence for the delegate %a at level %a already exists \ - in the current validation state as operation %a." + "Double %a evidence already exists in the current validation state \ + as operation %a." pp_denunciation_kind kind - Signature.Public_key_hash.pp - delegate - Level.pp - level Operation_hash.pp - hash) + existing) Data_encoding.( - obj4 + obj2 (req "denunciation_kind" denunciation_kind_encoding) - (req "delegate" Signature.Public_key_hash.encoding) - (req "level" Level.encoding) - (req "hash" Operation_hash.encoding)) + (req "conflict" operation_conflict_encoding)) (function - | Conflicting_denunciation {kind; delegate; level; hash} -> - Some (kind, delegate, level, hash) + | Conflicting_denunciation {kind; conflict} -> Some (kind, conflict) | _ -> None) - (fun (kind, delegate, level, hash) -> - Conflicting_denunciation {kind; delegate; level; hash}) ; + (fun (kind, conflict) -> Conflicting_denunciation {kind; conflict}) ; register_error_kind `Temporary ~id:"validate.operation.block.too_early_denunciation" @@ -1046,7 +946,7 @@ module Anonymous = struct (fun (kind, level, last_cycle) -> Outdated_denunciation {kind; level; last_cycle}) - type error += Conflicting_nonce_revelation + type error += Conflicting_nonce_revelation of operation_conflict let () = register_error_kind @@ -1056,13 +956,37 @@ module Anonymous = struct ~description: "A revelation for the same nonce has already been validated for the \ current validation state." - ~pp:(fun ppf () -> + ~pp:(fun ppf (Operation_conflict {existing; _}) -> Format.fprintf ppf - "This nonce was previously revealed in the current block") - Data_encoding.unit - (function Conflicting_nonce_revelation -> Some () | _ -> None) - (fun () -> Conflicting_nonce_revelation) + "This nonce revelation is conflicting with an existing revelation %a" + Operation_hash.pp + existing) + Data_encoding.(obj1 (req "conflict" operation_conflict_encoding)) + (function + | Conflicting_nonce_revelation conflict -> Some conflict | _ -> None) + (fun conflict -> Conflicting_nonce_revelation conflict) + + type error += Conflicting_vdf_revelation of operation_conflict + + let () = + register_error_kind + `Branch + ~id:"validate.operation.conflicting_vdf_revelation" + ~title:"Conflicting vdf revelation in the current validation state)." + ~description: + "A revelation for the same vdf has already been validated for the \ + current validation state." + ~pp:(fun ppf (Operation_conflict {existing; _}) -> + Format.fprintf + ppf + "This vdf revelation is conflicting with an existing revelation %a" + Operation_hash.pp + existing) + Data_encoding.(obj1 (req "conflict" operation_conflict_encoding)) + (function + | Conflicting_vdf_revelation conflict -> Some conflict | _ -> None) + (fun conflict -> Conflicting_vdf_revelation conflict) type error += | Drain_delegate_on_unregistered_delegate of Signature.Public_key_hash.t @@ -1078,7 +1002,10 @@ module Anonymous = struct destination : Signature.Public_key_hash.t; min_amount : Tez.t; } - | Conflicting_drain of {delegate : Signature.Public_key_hash.t} + | Conflicting_drain_delegate of { + delegate : Signature.Public_key_hash.t; + conflict : operation_conflict; + } let () = register_error_kind @@ -1188,25 +1115,36 @@ module Anonymous = struct {delegate; destination; min_amount}) ; register_error_kind `Branch - ~id:"validate_operation.conflicting_drain" + ~id:"validate.operation.conflicting_drain" ~title:"Conflicting drain in the current validation state)." ~description: "A manager operation or another drain operation is in conflict." - ~pp:(fun ppf delegate -> + ~pp:(fun ppf (delegate, Operation_conflict {existing; _}) -> Format.fprintf ppf - "This drain operation is conflicting with another drain operation or \ - a manager operation for delegate %a" + "This drain operation conflicts with operation %a for the delegate %a" + Operation_hash.pp + existing Signature.Public_key_hash.pp delegate) - Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) - (function Conflicting_drain {delegate} -> Some delegate | _ -> None) - (fun delegate -> Conflicting_drain {delegate}) + Data_encoding.( + obj2 + (req "delegate" Signature.Public_key_hash.encoding) + (req "conflict" operation_conflict_encoding)) + (function + | Conflicting_drain_delegate {delegate; conflict} -> + Some (delegate, conflict) + | _ -> None) + (fun (delegate, conflict) -> + Conflicting_drain_delegate {delegate; conflict}) end module Manager = struct type error += - | Manager_restriction of Signature.Public_key_hash.t * Operation_hash.t + | Manager_restriction of { + source : Signature.Public_key_hash.t; + conflict : operation_conflict; + } | Inconsistent_sources | Inconsistent_counters | Incorrect_reveal_position @@ -1224,22 +1162,22 @@ module Manager = struct ~description: "An operation with the same manager has already been validated in the \ current block." - ~pp:(fun ppf (d, hash) -> + ~pp:(fun ppf (source, Operation_conflict {existing; _}) -> Format.fprintf ppf "Manager %a already has the operation %a in the current block." Signature.Public_key_hash.pp - d + source Operation_hash.pp - hash) + existing) Data_encoding.( obj2 - (req "manager" Signature.Public_key_hash.encoding) - (req "hash" Operation_hash.encoding)) + (req "source" Signature.Public_key_hash.encoding) + (req "conflict" operation_conflict_encoding)) (function - | Manager_restriction (manager, hash) -> Some (manager, hash) + | Manager_restriction {source; conflict} -> Some (source, conflict) | _ -> None) - (fun (manager, hash) -> Manager_restriction (manager, hash)) ; + (fun (source, conflict) -> Manager_restriction {source; conflict}) ; let inconsistent_sources_description = "The operation batch includes operations from different sources." in @@ -1287,8 +1225,8 @@ module Manager = struct ~description: (Format.asprintf "Gas limit is too low to cover the initial cost of manager \ - operations: at least %a gas required." - Gas.pp_cost + operations: a minimum of %a gas units is required." + Gas.pp_cost_as_gas Michelson_v1_gas.Cost_of.manager_operation) Data_encoding.empty (function Insufficient_gas_for_manager -> Some () | _ -> None) @@ -1337,7 +1275,7 @@ module Manager = struct in register_error_kind `Permanent - ~id:"validate_operation.zk_rollup_disabled" + ~id:"validate.operation.zk_rollup_disabled" ~title:"ZK rollups are disabled" ~description:zkru_disabled_description ~pp:(fun ppf () -> Format.fprintf ppf "%s" zkru_disabled_description) diff --git a/src/proto_alpha/lib_protocol/validate_errors.mli b/src/proto_alpha/lib_protocol/validate_errors.mli index 2bd2b0be1f6ca5f1773c813b9c272f75cf2ed65f..ece107219d11b2fac662538d97d57ccbb12baedc 100644 --- a/src/proto_alpha/lib_protocol/validate_errors.mli +++ b/src/proto_alpha/lib_protocol/validate_errors.mli @@ -25,12 +25,20 @@ open Alpha_context +(** type used for conflicting operation. *) +type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + (** Errors that may arise while validating a consensus operation. *) module Consensus : sig type consensus_operation_kind = | Preendorsement | Endorsement | Grandparent_endorsement + | Dal_slot_availability (** Errors for preendorsements and endorsements. *) type error += @@ -75,9 +83,9 @@ module Consensus : sig | Wrong_slot_used_for_consensus_operation of { kind : consensus_operation_kind; } - | Conflicting_consensus_operation of {kind : consensus_operation_kind} - | Conflicting_dal_slot_availability of { - endorser : Signature.Public_key_hash.t; + | Conflicting_consensus_operation of { + kind : consensus_operation_kind; + conflict : operation_conflict; } end @@ -97,22 +105,10 @@ module Voting : sig | (* Proposals errors *) Empty_proposals | Proposals_contain_duplicate of {proposal : Protocol_hash.t} - | Too_many_proposals | Already_proposed of {proposal : Protocol_hash.t} - | Conflict_too_many_proposals of { - max_allowed : int; - count_previous_blocks : int; - count_current_block : int; - count_operation : int; - conflicting_operations : Operation_hash.t list; - } - | Conflict_already_proposed of { - proposal : Protocol_hash.t; - conflicting_operation : Operation_hash.t; - } - | Conflicting_dictator_proposals of Operation_hash.t + | Too_many_proposals of {previous_count : int; operation_count : int} + | Conflicting_proposals of operation_conflict | Testnet_dictator_multiple_proposals - | Testnet_dictator_conflicting_operation | Proposals_from_unregistered_delegate of Signature.Public_key_hash.t | (* Ballot errors *) Ballot_for_wrong_proposal of { @@ -120,8 +116,8 @@ module Voting : sig submitted : Protocol_hash.t; } | Already_submitted_a_ballot - | Conflicting_ballot of {conflicting_operation : Operation_hash.t} | Ballot_from_unregistered_delegate of Signature.Public_key_hash.t + | Conflicting_ballot of operation_conflict end (** Errors that may arise while validating an anonymous operation. *) @@ -130,7 +126,10 @@ module Anonymous : sig type error += | Invalid_activation of {pkh : Ed25519.Public_key_hash.t} - | Conflicting_activation of Ed25519.Public_key_hash.t * Operation_hash.t + | Conflicting_activation of { + edpkh : Ed25519.Public_key_hash.t; + conflict : operation_conflict; + } | Invalid_denunciation of denunciation_kind | Invalid_double_baking_evidence of { hash1 : Block_hash.t; @@ -152,9 +151,7 @@ module Anonymous : sig } | Conflicting_denunciation of { kind : denunciation_kind; - delegate : Signature.Public_key_hash.t; - level : Level.t; - hash : Operation_hash.t; + conflict : operation_conflict; } | Too_early_denunciation of { kind : denunciation_kind; @@ -166,7 +163,8 @@ module Anonymous : sig level : Raw_level.t; last_cycle : Cycle.t; } - | Conflicting_nonce_revelation + | Conflicting_nonce_revelation of operation_conflict + | Conflicting_vdf_revelation of operation_conflict | Drain_delegate_on_unregistered_delegate of Signature.Public_key_hash.t | Invalid_drain_delegate_inactive_key of { delegate : Signature.Public_key_hash.t; @@ -180,13 +178,19 @@ module Anonymous : sig destination : Signature.Public_key_hash.t; min_amount : Tez.t; } - | Conflicting_drain of {delegate : Signature.Public_key_hash.t} + | Conflicting_drain_delegate of { + delegate : Signature.Public_key_hash.t; + conflict : operation_conflict; + } end (** Errors that may arise while validating a manager operation. *) module Manager : sig type error += - | Manager_restriction of Signature.Public_key_hash.t * Operation_hash.t + | Manager_restriction of { + source : Signature.Public_key_hash.t; + conflict : operation_conflict; + } | Inconsistent_sources | Inconsistent_counters | Incorrect_reveal_position diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index 3516885a7fa5243a515a63eadfca9eef00ec7270..eb30b8387c8ab98cbc8708ff5668802bd5e30629 100644 --- a/src/proto_demo_counter/lib_protocol/main.ml +++ b/src/proto_demo_counter/lib_protocol/main.ml @@ -127,11 +127,11 @@ let apply_operation validation_state operation = >>= fun state -> match Apply.apply state operation.protocol_data with | None -> - Error_monad.fail Error.Invalid_operation + Error_monad.fail Error.Invalid_operation | Some state -> - let receipt = Receipt.create "operation applied successfully" in - State.update_state context state - >>= fun context -> return ({context; fitness}, receipt) + let receipt = Receipt.create "operation applied successfully" in + State.update_state context state + >>= fun context -> return ({context; fitness}, receipt) let finalize_block validation_state _header = let fitness = validation_state.fitness in @@ -143,39 +143,39 @@ let finalize_block validation_state _header = >>= fun state -> return ( { - Updater.message; - context; - fitness; - max_operations_ttl = 0; - last_allowed_fork_level = 0l; - }, + Updater.message; + context; + fitness; + max_operations_ttl = 0; + last_allowed_fork_level = 0l; + }, state ) let decode_json json = match Proto_params.from_json json with | exception _ -> - fail Error.Invalid_protocol_parameters + fail Error.Invalid_protocol_parameters | proto_params -> - return proto_params + return proto_params let get_init_state context : State.t tzresult Lwt.t = let protocol_params_key = ["protocol_parameters"] in Context.find context protocol_params_key >>= (function - | None -> - return Proto_params.default - | Some bytes -> ( + | None -> + return Proto_params.default + | Some bytes -> ( match Data_encoding.Binary.of_bytes_opt Data_encoding.json bytes with | None -> - fail (Error.Failed_to_parse_parameter bytes) + fail (Error.Failed_to_parse_parameter bytes) | Some json -> - decode_json json )) + decode_json json )) >>=? function | Proto_params.{init_a; init_b} -> ( - match State.create init_a init_b with - | None -> + match State.create init_a init_b with + | None -> fail Error.Invalid_protocol_parameters - | Some state -> + | Some state -> return state ) let init _chain_id context block_header = @@ -204,3 +204,47 @@ let value_of_key ~chain_id:_ ~predecessor_context:_ ~predecessor_timestamp:_ return (fun _ -> return (Demo 123)) let rpc_services = Services.rpc_services + +(* Fake mempool *) +module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = 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 +end diff --git a/src/proto_demo_noops/lib_protocol/main.ml b/src/proto_demo_noops/lib_protocol/main.ml index 81e453503235bf20da3914a2bf64fdfe9cd0464b..977cbcd8b15a812dd6fd5690a3be429295186e95 100644 --- a/src/proto_demo_noops/lib_protocol/main.ml +++ b/src/proto_demo_noops/lib_protocol/main.ml @@ -120,12 +120,12 @@ let finalize_block state _ = let fitness = state.fitness in return ( { - Updater.message = None; - context = state.context; - fitness; - max_operations_ttl = 0; - last_allowed_fork_level = 0l; - }, + Updater.message = None; + context = state.context; + fitness; + max_operations_ttl = 0; + last_allowed_fork_level = 0l; + }, () ) let init _chain_id context block_header = @@ -146,3 +146,47 @@ let value_of_key ~chain_id:_ ~predecessor_context:_ ~predecessor_timestamp:_ return (fun _ -> fail No_error) let rpc_services = RPC_directory.empty + +(* Fake mempool *) +module Mempool = struct + type t = unit + + type validation_info = unit + + type conflict_handler = + existing_operation:Operation_hash.t * operation -> + new_operation:Operation_hash.t * operation -> + [`Keep | `Replace] + + type operation_conflict = + | Operation_conflict of { + existing : Operation_hash.t; + new_operation : Operation_hash.t; + } + + type add_result = + | Added + | Replaced of {removed : Operation_hash.t} + | Unchanged + + type add_error = + | Validation_error of error trace + | Add_conflict of operation_conflict + + type merge_error = + | Incompatible_mempool + | Merge_conflict of operation_conflict + + let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = 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 +end diff --git a/tezt/tests/prevalidator.ml b/tezt/tests/prevalidator.ml index 0032b3e4312f821a38b58ea4087d3cfe581e9cc1..6fc739199ab325493952142e9526710fb37fbad6 100644 --- a/tezt/tests/prevalidator.ml +++ b/tezt/tests/prevalidator.ml @@ -877,6 +877,16 @@ module Revamped = struct in let* () = check_mempool ~applied:[oph1; oph2] client in + let signer = + if Protocol.number protocol >= 15 then Constant.bootstrap1 + (* Since protocol 15, the 1M restriction check is done + after the validation of the op (and includes the + signature checks), therefore we need a valid + signature *) + else Constant.bootstrap3 + (* By putting the wrong signature, we also ensure that the + signature is checked only after the 1M restriction check. *) + in log_step 3 "Inject another transfer from [source1] with the same fee and a correct \ @@ -887,15 +897,13 @@ module Revamped = struct let error = rex ~opts:[`Dotall] - "Fatal error:\n Command failed: Error while applying operation.*:" + "Only one manager operation per manager per block allowed" in - (* By putting the wrong signature, we also ensure that the - signature is checked only after the 1M restriction check. *) let* (`OpHash _) = Operation.Manager.( inject ~error - ~signer:Constant.bootstrap3 + ~signer [make ~source:source1 ~fee @@ transfer ~dest:Constant.bootstrap4 ()] client) in @@ -910,7 +918,7 @@ module Revamped = struct Operation.Manager.( inject ~force:true - ~signer:Constant.bootstrap3 + ~signer [make ~source:source1 ~fee @@ transfer ~dest:Constant.bootstrap5 ()] client) in @@ -945,6 +953,12 @@ module Revamped = struct let wrong_signed_branch_delayed_becomes_refused = Protocol.register_test ~__FILE__ + ~supports: + (Protocol.Until_protocol + 14 + (* Since protocol 15, the 1M restriction check is done + after the validation of the op (which includes the + signature checks) *)) ~title:"Reclassify branch_delayed operation with wrong signature" ~tags:["mempool"; "wrong"; "signature"] @@ fun protocol -> diff --git a/tezt/tests/replace_by_fees.ml b/tezt/tests/replace_by_fees.ml index d71c67ae5c8d1e58704f8b0b0578baa99533818d..7962d9b3aa5bc7edc717e1423945322ae8766501 100644 --- a/tezt/tests/replace_by_fees.ml +++ b/tezt/tests/replace_by_fees.ml @@ -346,9 +346,9 @@ let replacement_fees_below_threshold_even_if_gas_is_decreased = implemented policy doesn't allow to decrease amount of fees when replacing and operation. *) let fees_of_second_op_below_fees_of_first_one = - let op1 = {default_op with fee = 50_000; gas = 100_000} in + let op1 = {default_op with fee = 500_000; gas = 1_000_000} in (* The ratio fee/gas is more important, but fee is lower to replace *) - let op2 = {op1 with fee = op1.fee; gas = op1.gas / 100} in + let op2 = {op1 with fee = op1.fee; gas = op1.gas / 10} in replacement_test_helper ~__LOC__ ~title:"Op2's gas/fee is more important, but fees are not higher than max"