diff --git a/src/lib_shell/block_directory.ml b/src/lib_shell/block_directory.ml index b39c4bfa0a869ee7d1d1fe674a556c2516050f4a..168d479dcc47edfad0c710c28dd28f72ef7461f5 100644 --- a/src/lib_shell/block_directory.ml +++ b/src/lib_shell/block_directory.ml @@ -666,7 +666,7 @@ let build_raw_rpc_directory (module Proto : Block_services.PROTO) ~cache:`Lazy () in - let* state, acc = + let* _state, acc = List.fold_left_es (fun (state, acc) op -> let* state, result = Next_proto.apply_operation state op in @@ -674,9 +674,6 @@ let build_raw_rpc_directory (module Proto : Block_services.PROTO) (state, []) ops in - (* A pre application must not commit into the protocol caches. - Hence, we set [cache_nonce] to None. *) - let* _ = Next_proto.finalize_block state None in return (List.rev acc)) ; register1 S.Helpers.complete (fun (chain_store, block) prefix () () -> let* ctxt = Store.Block.context chain_store block in diff --git a/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml index de3d0f7670b9f671462fad2218dcac8e446bd834..90c24f32cdeb5ddbbb9dc479dee113966685ce7d 100644 --- a/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml @@ -207,7 +207,7 @@ module Sc_rollup_add_external_messages_benchmark = struct let* block, _ = Context.init1 () in let+ b = Incremental.begin_construction block in let state = Incremental.validation_state b in - let ctxt = state.ctxt in + let ctxt = state.application_state.ctxt in (* Necessary to originate rollups. *) let ctxt = Alpha_context.Origination_nonce.init ctxt Operation_hash.zero diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index bf0c8e836267627b38c811241c1ac8b06ef8832e..976aab814a247b1877e7040486d8897d1eba01d2 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -839,37 +839,49 @@ module Scripts = struct Return the unchanged operation protocol data, and the operation receipt ie. metadata containing balance updates, consumed gas, application success or failure, etc. *) - let run_operation_service ctxt () - ({shell; protocol_data = Operation_data protocol_data}, chain_id) = - (match protocol_data.contents with - | Single (Preendorsement _) - | Single (Endorsement _) - | Single (Dal_slot_availability _) -> + let run_operation_service rpc_ctxt () (packed_operation, chain_id) = + let {Services_registration.context; block_header; _} = rpc_ctxt in + (match packed_operation.protocol_data with + | Operation_data {contents = Single (Preendorsement _); _} + | Operation_data {contents = Single (Endorsement _); _} + | Operation_data {contents = Single (Dal_slot_availability _); _} -> error Run_operation_does_not_support_consensus_operations | _ -> ok ()) >>?= fun () -> - let operation : _ operation = {shell; protocol_data} in - let oph = Operation.hash operation in - let validate_operation_info, validate_operation_state = - Validate_operation.begin_no_predecessor_info ctxt chain_id - in - Validate_operation.validate_operation - validate_operation_info - validate_operation_state + let oph = Operation.hash_packed packed_operation in + let validity_state = Validate.begin_no_predecessor_info context chain_id in + Validate.validate_operation + validity_state ~should_check_signature:false oph - operation - >>=? fun (_validate_operation_state, op_validated_stamp) -> - Apply.apply_operation - ctxt - chain_id - (Apply.Partial_construction {predecessor_level = None}) - ~payload_producer:Signature.Public_key_hash.zero - op_validated_stamp - oph - operation + packed_operation + >>=? fun _validate_operation_state -> + Raw_level.of_int32 block_header.level >>?= fun predecessor_level -> + Alpha_context.Fitness.round_from_raw block_header.fitness + >>?= fun predecessor_round -> + let application_mode = + Apply.Partial_construction + { + predecessor_level; + predecessor_round; + predecessor_fitness = block_header.fitness; + } + in + let application_state = + Apply. + { + ctxt = context; + chain_id; + mode = application_mode; + op_count = 0; + migration_balance_updates = []; + liquidity_baking_toggle_ema = Liquidity_baking.Toggle_EMA.zero; + implicit_operations_results = []; + } + in + Apply.apply_operation application_state oph packed_operation >|=? fun (_ctxt, op_metadata) -> - (Operation_data protocol_data, Apply_results.Operation_metadata op_metadata) + (packed_operation.protocol_data, op_metadata) (* @@ -886,14 +898,16 @@ module Scripts = struct time of the operation. *) - let simulate_operation_service ctxt + let simulate_operation_service rpc_ctxt (_simulate_query : < successor_level : bool >) (blocks_before_activation, op, chain_id, time_in_blocks) = + let {Services_registration.context; _} = rpc_ctxt in Cache.Admin.future_cache_expectation - ctxt + context ~time_in_blocks ?blocks_before_activation - >>=? fun ctxt -> run_operation_service ctxt () (op, chain_id) + >>=? fun context -> + run_operation_service {rpc_ctxt with context} () (op, chain_id) let default_from_context ctxt get = function | None -> get ctxt @@ -1462,8 +1476,11 @@ module Scripts = struct (* TODO: https://gitlab.com/tezos/tezos/-/issues/3364 Should [run_operation] be registered at successor level? *) - Registration.register0 ~chunked:true S.run_operation run_operation_service ; - Registration.register0_successor_level + Registration.register0_fullctxt + ~chunked:true + S.run_operation + run_operation_service ; + Registration.register0_fullctxt_successor_level ~chunked:true S.simulate_operation simulate_operation_service ; diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 18c6543f8b0e8b73913e843b2034ae98ab697036..dc2a8978d8f515953274c91b70615904c9fc0594 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -180,7 +180,7 @@ type manager_op = Manager_op : 'kind Kind.manager operation -> manager_op type manager_op_info = { manager_op : manager_op; (** Used when we want to remove the operation with - {!Validate_operation.remove_manager_operation}. *) + {!Validate.remove_manager_operation}. *) fee : Tez.t; gas_limit : Fixed_point_repr.integral_tag Gas.Arith.t; (** Both [fee] and [gas_limit] are used to determine whether a new @@ -243,7 +243,7 @@ let init config ?(validation_state : validation_state option) ~predecessor () = ignore config ; (match validation_state with | None -> return empty - | Some {ctxt; _} -> + | Some {application_state = {ctxt; _}; _} -> let { Tezos_base.Block_header.fitness = predecessor_fitness; timestamp = predecessor_timestamp; @@ -448,7 +448,7 @@ let size_of_operation op = let weight_and_resources_manager_operation ~validation_state ?size ~fee ~gas op = let hard_gas_limit_per_block = - Constants.hard_gas_limit_per_block validation_state.ctxt + Constants.hard_gas_limit_per_block validation_state.application_state.ctxt in let max_size = managers_quota.max_size in let size = match size with None -> size_of_operation op | Some s -> s in @@ -768,8 +768,8 @@ let pre_filter_far_future_consensus_ops config | ( Some grandparent_level_start, Some validation_state_before, Some round_zero_duration ) -> ( - let ctxt : t = validation_state_before.ctxt in - match validation_state_before.mode with + let ctxt : t = validation_state_before.application_state.ctxt in + match validation_state_before.application_state.mode with | Application _ | Partial_application _ | Full_construction _ -> assert false (* Prefilter is always applied in mempool mode aka Partial_construction *) @@ -859,7 +859,7 @@ let pre_filter config ~(filter_state : state) ?validation_state_before | Single (Manager_operation _) as op -> prefilter_manager_op op | Cons (Manager_operation _, _) as op -> prefilter_manager_op op -(** Call the protocol's {!Validate_operation.validate_operation} and +(** Call the protocol's {!Validate.validate_operation} and return either: - the updated {!validation_state} when the validation is @@ -871,20 +871,20 @@ let pre_filter config ~(filter_state : state) ?validation_state_before The signature check is skipped when the operation has previously been validated successfully, ie. [nb_successful_prechecks > 0]. *) let proto_validate_operation validation_state oph ~nb_successful_prechecks - (operation : 'kind operation) : + (operation : packed_operation) : (validation_state, error trace * error_classification) result Lwt.t = let open Lwt_result_syntax in let*! res = - Validate_operation.validate_operation - validation_state.validate_operation_info - validation_state.validate_operation_state + Validate.validate_operation + validation_state.validity_state ~should_check_signature:(nb_successful_prechecks <= 0) oph operation in match res with - | Ok (validate_operation_state, (_ : Validate_operation.stamp)) -> - return {validation_state with validate_operation_state} + | Ok state -> + let validity_state = {validation_state.validity_state with state} in + return {validation_state with validity_state} | Error tztrace -> let err = Environment.wrap_tztrace tztrace in let error_classification = @@ -896,7 +896,7 @@ let proto_validate_operation validation_state oph ~nb_successful_prechecks in fail (err, error_classification) -(** Call the protocol's {!Validate_operation.validate_operation} on a +(** Call the protocol's {!Validate.validate_operation} on a manager operation and return: - [`Success] containing the updated [validation_state] when the @@ -926,7 +926,7 @@ let proto_validate_manager_operation validation_state oph validation_state oph ~nb_successful_prechecks - operation + (Operation.pack operation) in match res with | Ok validation_state -> return (`Success validation_state) @@ -941,13 +941,11 @@ let proto_validate_manager_operation validation_state oph (** Remove a manager operation from the protocol's [validation_state]. *) let remove_from_validation_state validation_state (Manager_op op) = - let validate_operation_state = - Validate_operation.remove_manager_operation - validation_state.validate_operation_info - validation_state.validate_operation_state - op + let state = + Validate.remove_manager_operation validation_state.validity_state op in - {validation_state with validate_operation_state} + let validity_state = {validation_state.validity_state with state} in + {validation_state with validity_state} (** Call the protocol validation on a manager operation and handle potential conflicts: if either the 1M restriction is triggered or @@ -1215,7 +1213,7 @@ let precheck_manager config filter_state validation_state oph err) -> Lwt.return err -(** Call the protocol's {!Validate_operation.validate_operation}. If +(** Call the protocol's {!Validate.validate_operation}. If successful, return the updated [validation_state], the unchanged [filter_state], and no operation replacement. Otherwise, return the classification associated with the protocol error. Note that when @@ -1239,13 +1237,13 @@ let precheck_non_manager filter_state validation_state oph error_classification) ) -> Lwt.return error_classification -(* Now that [precheck] uses {!Validate_operation.validate_operation} +(* Now that [precheck] uses {!Validate.validate_operation} for every kind of operation, it must never return [`Undecided]. Indeed, this would cause the prevalidator to call {!Apply.apply_operation}, which relies on updates to the alpha context to detect incompatible operations, whereas [validate_operation] only updates the - {!Validate_operation.validate_operation_state}. Therefore, it would + {!Validate.validate_operation_state}. Therefore, it would be possible for the mempool to accept conflicting operations. *) let precheck : config -> @@ -1265,8 +1263,9 @@ let precheck : ~filter_state ~validation_state oph - {shell = shell_header; protocol_data = Operation_data protocol_data} + operation ~nb_successful_prechecks -> + let {protocol_data = Operation_data protocol_data; _} = operation in let call_precheck_manager (protocol_data : _ Kind.manager protocol_data) = precheck_manager config @@ -1274,7 +1273,7 @@ let precheck : validation_state oph ~nb_successful_prechecks - {shell = shell_header; protocol_data} + {shell = operation.shell; protocol_data} in match protocol_data.contents with | Single (Manager_operation _) -> call_precheck_manager protocol_data @@ -1285,7 +1284,7 @@ let precheck : validation_state oph ~nb_successful_prechecks - {shell = shell_header; protocol_data} + operation open Apply_results @@ -1359,7 +1358,8 @@ let rec post_filter_manager : | `Refused _ as errs -> errs) let post_filter config ~(filter_state : state) ~validation_state_before:_ - ~validation_state_after:({ctxt; _} : validation_state) (_op, receipt) = + ~validation_state_after: + ({application_state = {ctxt; _}; _} : validation_state) (_op, receipt) = match receipt with | No_operation_metadata -> assert false (* only for multipass validator *) | Operation_metadata {contents} -> ( diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index 1d5c3f61c63db0c84b806714d6c6f4780f265ad4..dc04c08f8dd2341ad85f2bf6562ac1a3a54821db 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -232,7 +232,7 @@ "Baking", "Validate_errors", "Amendment", - "Validate_operation", + "Validate", "Apply", "Services_registration", diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 1aed19be761840a4372ff588ca59bdb0c28d725d..498b96eb94a36f0a1b65b7529599269d23de3e13 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -1127,74 +1127,6 @@ module Internal_for_tests : sig val to_raw : context -> Raw_context.t end -(** This module re-exports definitions from {!Cache_repr}. *) -module Cache : sig - type size = int - - type index = int - - module Admin : sig - type key - - type value - - val pp : Format.formatter -> context -> unit - - val sync : context -> cache_nonce:Bytes.t -> context Lwt.t - - val future_cache_expectation : - ?blocks_before_activation:int32 -> - context -> - time_in_blocks:int -> - context tzresult Lwt.t - - val cache_size : context -> cache_index:int -> size option - - val cache_size_limit : context -> cache_index:int -> size option - - val value_of_key : - context -> Context.Cache.key -> Context.Cache.value tzresult Lwt.t - end - - type namespace = private string - - val create_namespace : string -> namespace - - type identifier = string - - module type CLIENT = sig - type cached_value - - val cache_index : index - - val namespace : namespace - - val value_of_identifier : - context -> identifier -> cached_value tzresult Lwt.t - end - - module type INTERFACE = sig - type cached_value - - val update : - context -> identifier -> (cached_value * size) option -> context tzresult - - val find : context -> identifier -> cached_value option tzresult Lwt.t - - val list_identifiers : context -> (string * int) list - - val identifier_rank : context -> string -> int option - - val size : context -> int - - val size_limit : context -> int - end - - val register_exn : - (module CLIENT with type cached_value = 'a) -> - (module INTERFACE with type cached_value = 'a) -end - (** This module re-exports definitions from {!Level_repr} and {!Level_storage}. *) module Level : sig @@ -3806,6 +3738,79 @@ module Block_header : sig unit tzresult end +(** This module re-exports definitions from {!Cache_repr}. *) +module Cache : sig + type size = int + + type index = int + + type cache_nonce + + module Admin : sig + type key + + type value + + val pp : Format.formatter -> context -> unit + + val sync : context -> cache_nonce -> context Lwt.t + + val future_cache_expectation : + ?blocks_before_activation:int32 -> + context -> + time_in_blocks:int -> + context tzresult Lwt.t + + val cache_size : context -> cache_index:int -> size option + + val cache_size_limit : context -> cache_index:int -> size option + + val value_of_key : + context -> Context.Cache.key -> Context.Cache.value tzresult Lwt.t + end + + type namespace = private string + + val create_namespace : string -> namespace + + type identifier = string + + module type CLIENT = sig + type cached_value + + val cache_index : index + + val namespace : namespace + + val value_of_identifier : + context -> identifier -> cached_value tzresult Lwt.t + end + + module type INTERFACE = sig + type cached_value + + val update : + context -> identifier -> (cached_value * size) option -> context tzresult + + val find : context -> identifier -> cached_value option tzresult Lwt.t + + val list_identifiers : context -> (string * int) list + + val identifier_rank : context -> string -> int option + + val size : context -> int + + val size_limit : context -> int + end + + val register_exn : + (module CLIENT with type cached_value = 'a) -> + (module INTERFACE with type cached_value = 'a) + + val cache_nonce_from_block_header : + Block_header.shell_header -> Block_header.contents -> cache_nonce +end + (** This module re-exports definitions from {!Lazy_storage_kind}. *) module Kind : sig type preendorsement_consensus_kind = Preendorsement_consensus_kind diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 43cbd7fea9c25744aec038862b42b08d35c61918..3a6d1f93f1e97a7f3add842b1bf9c6b4e6d63b43 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1222,8 +1222,7 @@ let apply_manager_operation : proof ~agreed:previous_message_result ~rejected:message_result_hash - ~max_proof_size: - (Alpha_context.Constants.tx_rollup_rejection_max_proof_size ctxt) + ~max_proof_size:(Constants.tx_rollup_rejection_max_proof_size ctxt) >>=? fun ctxt -> (* Proof is correct, removing *) Tx_rollup_commitment.reject_commitment ctxt tx_rollup state level @@ -1761,21 +1760,20 @@ let rec mark_skipped : mark_skipped ~payload_producer level rest ) (** Return balance updates for fees, and an updated context that - accounts for: + accounts for: - fees spending, - counter incrementation, - consumption of each operation's [gas_limit] from the available - block gas. - - The {!type:Validate_operation.stamp} argument enforces that the - operation has already been validated by {!Validate_operation}. The - latter is responsible for ensuring that the operation is solvable, - i.e. its fees can be taken, i.e. [take_fees] cannot return an - error. *) -let take_fees ctxt (_ : Validate_operation.stamp) contents_list = + block gas. + + The operation should already have been validated by + {!Validate.validate_operation}. The latter is responsible for ensuring that + the operation is solvable, i.e. its fees can be taken, i.e. + [take_fees] cannot return an error. *) +let take_fees ctxt contents_list = let open Lwt_tzresult_syntax in let rec take_fees_rec : type kind. @@ -1891,16 +1889,48 @@ let mark_backtracked results = in traverse_apply_results results -type apply_mode = - | Application (** Both partial and normal *) - | Full_construction - | Partial_construction of {predecessor_level : Level.t option} - (** This mode is intended to be used by a mempool. In this case, - [predecessor_level] has a value and is used to identify - grandparent endorsements (see [record_endorsement] - below). However, the [option] allows this mode to be hijacked in - other situations with no access to the predecessor level, - e.g. during an RPC call. *) +type mode = + | Application of { + block_header : Block_header.t; + fitness : Fitness.t; + payload_producer : public_key_hash; + block_producer : public_key_hash; + predecessor_level : Level.t; + predecessor_round : Round.t; + } + | Partial_application of { + block_header : Block_header.t; + fitness : Fitness.t; + payload_producer : public_key_hash; + block_producer : public_key_hash; + predecessor_level : Level.t; + predecessor_round : Round.t; + } + | Full_construction of { + predecessor : Block_hash.t; + payload_producer : public_key_hash; + block_producer : public_key_hash; + block_data_contents : Block_header.contents; + round : Round.t; + predecessor_level : Level.t; + predecessor_round : Round.t; + } + | Partial_construction of { + predecessor_level : Raw_level.t; + predecessor_round : Round.t; + predecessor_fitness : Fitness.raw; + } + +type application_state = { + ctxt : t; + chain_id : Chain_id.t; + mode : mode; + op_count : int; + migration_balance_updates : Receipt.balance_updates; + liquidity_baking_toggle_ema : Liquidity_baking.Toggle_EMA.t; + implicit_operations_results : + Apply_results.packed_successful_manager_operation_result list; +} let record_operation (type kind) ctxt hash (operation : kind operation) : context = @@ -1916,17 +1946,16 @@ let record_operation (type kind) ctxt hash (operation : kind operation) : | Cons (Manager_operation _, _) -> record_non_consensus_operation_hash ctxt hash -let record_preendorsement ctxt (apply_mode : apply_mode) - (_ : Validate_operation.stamp) (content : consensus_content) : +let record_preendorsement ctxt (mode : mode) (content : consensus_content) : (context * Kind.preendorsement contents_result_list) tzresult = let open Tzresult_syntax in let ctxt = - match apply_mode with - | Full_construction -> ( + match mode with + | Full_construction _ -> ( match Consensus.get_preendorsements_quorum_round ctxt with | None -> Consensus.set_preendorsements_quorum_round ctxt content.round | Some _ -> ctxt) - | Application | Partial_construction _ -> ctxt + | Partial_application _ | Application _ | Partial_construction _ -> ctxt in match Slot.Map.find content.slot (Consensus.allowed_preendorsements ctxt) with | None -> @@ -1946,21 +1975,20 @@ let record_preendorsement ctxt (apply_mode : apply_mode) (Preendorsement_result {balance_updates = []; delegate; preendorsement_power}) ) -let is_grandparent_endorsement apply_mode content = - match apply_mode with - | Partial_construction {predecessor_level = Some predecessor_level} -> - Raw_level.(succ content.level = predecessor_level.Level.level) +let is_grandparent_endorsement mode content = + match mode with + | Partial_construction {predecessor_level; _} -> + Raw_level.(succ content.level = predecessor_level) | _ -> false -let record_endorsement ctxt (apply_mode : apply_mode) - (_ : Validate_operation.stamp) (content : consensus_content) : +let record_endorsement ctxt (mode : mode) (content : consensus_content) : (context * Kind.endorsement contents_result_list) tzresult Lwt.t = let open Lwt_tzresult_syntax in let mk_endorsement_result delegate endorsement_power = Single_result (Endorsement_result {balance_updates = []; delegate; endorsement_power}) in - if is_grandparent_endorsement apply_mode content then + if is_grandparent_endorsement mode content then let level = Level.from_raw ctxt content.level in let* ctxt, (_delegate_pk, delegate) = Stake_distribution.slot_owner ctxt level content.slot @@ -1992,12 +2020,10 @@ let apply_manager_contents_list ctxt ~payload_producer chain_id Lazy_storage.cleanup_temporaries ctxt >|= fun ctxt -> (ctxt, results) let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode - op_validated_stamp contents_list = + contents_list = let open Lwt_tzresult_syntax in let ctxt = if mempool_mode then Gas.reset_block_gas ctxt else ctxt in - let* ctxt, fees_updated_contents_list = - take_fees ctxt op_validated_stamp contents_list - in + let* ctxt, fees_updated_contents_list = take_fees ctxt contents_list in let*! ctxt, contents_result_list = apply_manager_contents_list ctxt @@ -2070,20 +2096,19 @@ let punish_double_baking ctxt (bh1 : Block_header.t) ~payload_producer = ~payload_producer (fun balance_updates -> Double_baking_evidence_result balance_updates) -let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) - ~payload_producer op_validated_stamp (contents_list : kind contents_list) : +let apply_contents_list (type kind) ctxt chain_id (mode : mode) + ~payload_producer (contents_list : kind contents_list) : (context * kind contents_result_list) tzresult Lwt.t = let mempool_mode = - match apply_mode with + match mode with | Partial_construction _ -> true - | Full_construction | Application -> false + | Full_construction _ | Application _ | Partial_application _ -> false in match contents_list with | Single (Preendorsement consensus_content) -> - record_preendorsement ctxt apply_mode op_validated_stamp consensus_content - |> Lwt.return + record_preendorsement ctxt mode consensus_content |> Lwt.return | Single (Endorsement consensus_content) -> - record_endorsement ctxt apply_mode op_validated_stamp consensus_content + record_endorsement ctxt mode consensus_content | Single (Dal_slot_availability (endorser, slot_availability)) -> (* DAL/FIXME https://gitlab.com/tezos/tezos/-/issues/3115 @@ -2144,7 +2169,6 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) ~payload_producer chain_id ~mempool_mode - op_validated_stamp contents_list | Cons (Manager_operation _, _) -> apply_manager_operations @@ -2152,24 +2176,58 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) ~payload_producer chain_id ~mempool_mode - op_validated_stamp contents_list -let apply_operation ctxt chain_id (apply_mode : apply_mode) ~payload_producer - op_validated_stamp hash operation = - let ctxt = Origination_nonce.init ctxt hash in - let ctxt = record_operation ctxt hash operation in - apply_contents_list - ctxt - chain_id - apply_mode - ~payload_producer - op_validated_stamp - operation.protocol_data.contents - >|=? fun (ctxt, result) -> - let ctxt = Gas.set_unlimited ctxt in - let ctxt = Origination_nonce.unset ctxt in - (ctxt, {contents = result}) +let apply_operation application_state operation_hash operation = + let open Lwt_tzresult_syntax in + let apply_operation application_state packed_operation ~payload_producer = + let {shell; protocol_data = Operation_data unpacked_protocol_data} = + packed_operation + in + let operation : _ Operation.t = + {shell; protocol_data = unpacked_protocol_data} + in + let ctxt = Origination_nonce.init application_state.ctxt operation_hash in + let ctxt = record_operation ctxt operation_hash operation in + let* ctxt, result = + apply_contents_list + ctxt + application_state.chain_id + application_state.mode + ~payload_producer + operation.protocol_data.contents + in + let ctxt = Gas.set_unlimited ctxt in + let ctxt = Origination_nonce.unset ctxt in + let op_count = succ application_state.op_count in + return + ( {application_state with ctxt; op_count}, + Operation_metadata {contents = result} ) + in + match application_state.mode with + | Partial_application {payload_producer; _} -> ( + match Operation.acceptable_pass operation with + | None -> + (* Only occurs with Failing_noop *) + fail Validate_errors.Failing_noop_error + | Some n -> + if + (* Multipass validation only considers operations in + consensus pass. *) + Compare.Int.(n = Operation_repr.consensus_pass) + then apply_operation application_state operation ~payload_producer + else + let op_count = application_state.op_count + 1 in + return ({application_state with op_count}, No_operation_metadata)) + | Application {payload_producer; _} -> + apply_operation application_state operation ~payload_producer + | Full_construction {payload_producer; _} -> + apply_operation application_state operation ~payload_producer + | Partial_construction _ -> + apply_operation + application_state + operation + ~payload_producer:Signature.Public_key_hash.zero let may_start_new_cycle ctxt = match Level.dawn_of_a_new_cycle ctxt with @@ -2180,29 +2238,6 @@ let may_start_new_cycle ctxt = Bootstrap.cycle_end ctxt last_cycle >|=? fun ctxt -> (ctxt, balance_updates, deactivated) -let init_allowed_consensus_operations ctxt ~endorsement_level - ~preendorsement_level = - Delegate.prepare_stake_distribution ctxt >>=? fun ctxt -> - (if Level.(endorsement_level = preendorsement_level) then - Baking.endorsing_rights_by_first_slot ctxt endorsement_level - >>=? fun (ctxt, slots) -> - let consensus_operations = slots in - return (ctxt, consensus_operations, consensus_operations) - else - Baking.endorsing_rights_by_first_slot ctxt endorsement_level - >>=? fun (ctxt, endorsements_slots) -> - let endorsements = endorsements_slots in - Baking.endorsing_rights_by_first_slot ctxt preendorsement_level - >>=? fun (ctxt, preendorsements_slots) -> - let preendorsements = preendorsements_slots in - return (ctxt, endorsements, preendorsements)) - >>=? fun (ctxt, allowed_endorsements, allowed_preendorsements) -> - return - (Consensus.initialize_consensus_operation - ctxt - ~allowed_endorsements - ~allowed_preendorsements) - let apply_liquidity_baking_subsidy ctxt ~toggle_vote = Liquidity_baking.on_subsidy_allowed ctxt @@ -2357,126 +2392,6 @@ let apply_liquidity_baking_subsidy ctxt ~toggle_vote = let ctxt = Gas.set_unlimited backtracking_ctxt in Ok (ctxt, [])) -type 'a full_construction = { - ctxt : t; - protocol_data : 'a; - payload_producer : Signature.public_key_hash; - block_producer : Signature.public_key_hash; - round : Round.t; - implicit_operations_results : packed_successful_manager_operation_result list; - liquidity_baking_toggle_ema : Liquidity_baking.Toggle_EMA.t; -} - -let begin_full_construction ctxt ~predecessor_timestamp ~predecessor_level - ~predecessor_round ~round protocol_data = - let round_durations = Constants.round_durations ctxt in - let timestamp = Timestamp.current ctxt in - Block_header.check_timestamp - round_durations - ~timestamp - ~round - ~predecessor_timestamp - ~predecessor_round - >>?= fun () -> - let current_level = Level.current ctxt in - Stake_distribution.baking_rights_owner ctxt current_level ~round - >>=? fun (ctxt, _slot, (_block_producer_pk, block_producer)) -> - Delegate.frozen_deposits ctxt block_producer >>=? fun frozen_deposits -> - fail_unless - Tez.(frozen_deposits.current_amount > zero) - (Zero_frozen_deposits block_producer) - >>=? fun () -> - Stake_distribution.baking_rights_owner - ctxt - current_level - ~round:protocol_data.Block_header.payload_round - >>=? fun (ctxt, _slot, (_payload_producer_pk, payload_producer)) -> - init_allowed_consensus_operations - ctxt - ~endorsement_level:predecessor_level - ~preendorsement_level:current_level - >>=? fun ctxt -> - let toggle_vote = protocol_data.liquidity_baking_toggle_vote in - apply_liquidity_baking_subsidy ctxt ~toggle_vote - >|=? fun ( ctxt, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema ) -> - { - ctxt; - protocol_data; - payload_producer; - block_producer; - round; - implicit_operations_results = liquidity_baking_operations_results; - liquidity_baking_toggle_ema; - } - -let begin_partial_construction ctxt ~predecessor_level ~toggle_vote = - (* In the mempool, only consensus operations for [predecessor_level] - (that is, head's level) are allowed, contrary to block validation - where endorsements are for the previous level and - preendorsements, if any, for the block's level. *) - init_allowed_consensus_operations - ctxt - ~endorsement_level:predecessor_level - ~preendorsement_level:predecessor_level - >>=? fun ctxt -> apply_liquidity_baking_subsidy ctxt ~toggle_vote - -let begin_application ctxt chain_id (block_header : Block_header.t) fitness - ~predecessor_timestamp ~predecessor_level ~predecessor_round = - let round = Fitness.round fitness in - let current_level = Level.current ctxt in - Stake_distribution.baking_rights_owner ctxt current_level ~round - >>=? fun (ctxt, _slot, (block_producer_pk, block_producer)) -> - let timestamp = block_header.shell.timestamp in - Block_header.begin_validate_block_header - ~block_header - ~chain_id - ~predecessor_timestamp - ~predecessor_round - ~fitness - ~timestamp - ~delegate_pk:block_producer_pk - ~round_durations:(Constants.round_durations ctxt) - ~proof_of_work_threshold:(Constants.proof_of_work_threshold ctxt) - ~expected_commitment:current_level.expected_commitment - >>?= fun () -> - Delegate.frozen_deposits ctxt block_producer >>=? fun frozen_deposits -> - fail_unless - Tez.(frozen_deposits.current_amount > zero) - (Zero_frozen_deposits block_producer) - >>=? fun () -> - Stake_distribution.baking_rights_owner - ctxt - current_level - ~round:block_header.protocol_data.contents.payload_round - >>=? fun (ctxt, _slot, (payload_producer_pk, _payload_producer)) -> - init_allowed_consensus_operations - ctxt - ~endorsement_level:predecessor_level - ~preendorsement_level:current_level - >>=? fun ctxt -> - let toggle_vote = - block_header.Block_header.protocol_data.contents - .liquidity_baking_toggle_vote - in - apply_liquidity_baking_subsidy ctxt ~toggle_vote - >|=? fun ( ctxt, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema ) -> - ( ctxt, - payload_producer_pk, - block_producer, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema ) - -type finalize_application_mode = - | Finalize_full_construction of { - level : Raw_level.t; - predecessor_round : Round.t; - } - | Finalize_application of Fitness.t - let compute_payload_hash (ctxt : context) ~(predecessor : Block_hash.t) ~(payload_round : Round.t) : Block_payload_hash.t = let non_consensus_operations = non_consensus_operations ctxt in @@ -2491,65 +2406,6 @@ let are_endorsements_required ctxt ~level = let level_position_in_protocol = Raw_level.diff level first_level in Compare.Int32.(level_position_in_protocol > 1l) -let check_minimum_endorsements ~endorsing_power ~minimum = - error_when - Compare.Int.(endorsing_power < minimum) - (Not_enough_endorsements {required = minimum; provided = endorsing_power}) - -let finalize_application_check_validity ctxt (mode : finalize_application_mode) - protocol_data ~round ~predecessor ~endorsing_power ~consensus_threshold - ~required_endorsements = - (if required_endorsements then - check_minimum_endorsements ~endorsing_power ~minimum:consensus_threshold - else Result.return_unit) - >>?= fun () -> - let block_payload_hash = - compute_payload_hash - ctxt - ~predecessor - ~payload_round:protocol_data.Block_header.payload_round - in - let locked_round_evidence = - Option.map - (fun (preendorsement_round, preendorsement_count) -> - Block_header.{preendorsement_round; preendorsement_count}) - (Consensus.locked_round_evidence ctxt) - in - (match mode with - | Finalize_application fitness -> ok fitness - | Finalize_full_construction {level; predecessor_round} -> - let locked_round = - match locked_round_evidence with - | None -> None - | Some {preendorsement_round; _} -> Some preendorsement_round - in - Fitness.create ~level ~round ~predecessor_round ~locked_round) - >>?= fun fitness -> - let checkable_payload_hash : Block_header.checkable_payload_hash = - match mode with - | Finalize_application _ -> Expected_payload_hash block_payload_hash - | Finalize_full_construction _ -> ( - match locked_round_evidence with - | Some _ -> Expected_payload_hash block_payload_hash - | None -> - (* In full construction, when there is no locked round - evidence (and thus no preendorsements), the baker cannot - know the payload hash before selecting the operations. We - may dismiss checking the initially given - payload_hash. However, to be valid, the baker must patch - the resulting block header with the actual payload - hash. *) - No_check) - in - Block_header.finalize_validate_block_header - ~block_header_contents:protocol_data - ~round - ~fitness - ~checkable_payload_hash - ~locked_round_evidence - ~consensus_threshold - >>?= fun () -> return (fitness, block_payload_hash) - let record_endorsing_participation ctxt = let validators = Consensus.allowed_endorsements ctxt in Slot.Map.fold_es @@ -2567,71 +2423,263 @@ let record_endorsing_participation ctxt = validators ctxt -let finalize_application ctxt (mode : finalize_application_mode) protocol_data - ~payload_producer ~block_producer liquidity_baking_toggle_ema - implicit_operations_results ~round ~predecessor ~migration_balance_updates = - (* Then we finalize the consensus. *) +let begin_application ctxt chain_id ~migration_balance_updates + ~migration_operation_results ~(predecessor_fitness : Fitness.raw) + (block_header : Block_header.t) : application_state tzresult Lwt.t = + let open Lwt_tzresult_syntax in + let*? fitness = Fitness.from_raw block_header.shell.fitness in + let level = block_header.shell.level in + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let*? predecessor_level = Raw_level.of_int32 (Int32.pred level) in + let predecessor_level = Level.from_raw ctxt predecessor_level in + let round = Fitness.round fitness in + let current_level = Level.current ctxt in + let* ctxt, _slot, (_block_producer_pk, block_producer) = + Stake_distribution.baking_rights_owner ctxt current_level ~round + in + let* ctxt, _slot, (payload_producer, _payload_producer) = + Stake_distribution.baking_rights_owner + ctxt + current_level + ~round:block_header.protocol_data.contents.payload_round + in + let toggle_vote = + block_header.Block_header.protocol_data.contents + .liquidity_baking_toggle_vote + in + let* ctxt, liquidity_baking_operations_results, liquidity_baking_toggle_ema = + apply_liquidity_baking_subsidy ctxt ~toggle_vote + in + let mode = + Application + { + block_header; + fitness; + predecessor_round; + predecessor_level; + payload_producer = Signature.Public_key.hash payload_producer; + block_producer; + } + in + return + { + mode; + chain_id; + ctxt; + op_count = 0; + migration_balance_updates; + liquidity_baking_toggle_ema; + implicit_operations_results = + Apply_results.pack_migration_operation_results + migration_operation_results + @ liquidity_baking_operations_results; + } + +let begin_partial_application ~ancestor_context chain_id + ~migration_balance_updates ~migration_operation_results + ~(predecessor_fitness : Fitness.raw) (block_header : Block_header.t) = + let open Lwt_tzresult_syntax in + let*? fitness = Fitness.from_raw block_header.shell.fitness in + let level = block_header.shell.level in + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let*? predecessor_level = Raw_level.of_int32 (Int32.pred level) in + let predecessor_level = Level.(from_raw ancestor_context predecessor_level) in + (* Note: we don't have access to the predecessor context. *) + let round = Fitness.round fitness in + let current_level = Level.current ancestor_context in + let* ctxt, _slot, (_block_producer_pk, block_producer) = + Stake_distribution.baking_rights_owner ancestor_context current_level ~round + in + let* ctxt, _slot, (payload_producer_pk, _payload_producer) = + Stake_distribution.baking_rights_owner + ctxt + current_level + ~round:block_header.protocol_data.contents.payload_round + in + let toggle_vote = + block_header.Block_header.protocol_data.contents + .liquidity_baking_toggle_vote + in + let* ctxt, liquidity_baking_operations_results, liquidity_baking_toggle_ema = + apply_liquidity_baking_subsidy ctxt ~toggle_vote + in + let mode = + Partial_application + { + block_header; + fitness; + predecessor_level; + predecessor_round; + payload_producer = Signature.Public_key.hash payload_producer_pk; + block_producer; + } + in + return + { + mode; + chain_id; + ctxt; + op_count = 0; + migration_balance_updates; + liquidity_baking_toggle_ema; + implicit_operations_results = + Apply_results.pack_migration_operation_results + migration_operation_results + @ liquidity_baking_operations_results; + } + +let begin_full_construction ctxt chain_id ~migration_balance_updates + ~migration_operation_results ~predecessor_timestamp ~predecessor_level + ~predecessor_round ~predecessor ~timestamp + (block_data_contents : Block_header.contents) = + let open Lwt_tzresult_syntax in + let round_durations = Constants.round_durations ctxt in + let*? round = + Round.round_of_timestamp + round_durations + ~predecessor_timestamp + ~predecessor_round + ~timestamp + in + (* The endorsement/preendorsement validation rules for construction are the + same as for application. *) + let current_level = Level.current ctxt in + let* ctxt, _slot, (_block_producer_pk, block_producer) = + Stake_distribution.baking_rights_owner ctxt current_level ~round + in + let* ctxt, _slot, (_payload_producer_pk, payload_producer) = + Stake_distribution.baking_rights_owner + ctxt + current_level + ~round:block_data_contents.payload_round + in + let toggle_vote = block_data_contents.liquidity_baking_toggle_vote in + let* ctxt, liquidity_baking_operations_results, liquidity_baking_toggle_ema = + apply_liquidity_baking_subsidy ctxt ~toggle_vote + in + let mode = + Full_construction + { + predecessor; + payload_producer; + block_producer; + round; + block_data_contents; + predecessor_round; + predecessor_level; + } + in + return + { + mode; + chain_id; + ctxt; + op_count = 0; + migration_balance_updates; + liquidity_baking_toggle_ema; + implicit_operations_results = + Apply_results.pack_migration_operation_results + migration_operation_results + @ liquidity_baking_operations_results; + } + +let begin_partial_construction ctxt chain_id ~migration_balance_updates + ~migration_operation_results ~predecessor_level + ~(predecessor_fitness : Fitness.raw) : application_state tzresult Lwt.t = + let open Lwt_tzresult_syntax in + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let toggle_vote = Liquidity_baking.LB_pass in + let* ctxt, liquidity_baking_operations_results, liquidity_baking_toggle_ema = + apply_liquidity_baking_subsidy ctxt ~toggle_vote + in + let mode = + Partial_construction + {predecessor_level; predecessor_round; predecessor_fitness} + in + return + { + mode; + chain_id; + ctxt; + op_count = 0; + migration_balance_updates; + liquidity_baking_toggle_ema; + implicit_operations_results = + Apply_results.pack_migration_operation_results + migration_operation_results + @ liquidity_baking_operations_results; + } + +let finalize_application ctxt block_data_contents ~round ~predecessor + ~liquidity_baking_toggle_ema ~implicit_operations_results + ~migration_balance_updates ~block_producer ~payload_producer = + let open Lwt_result_syntax in let level = Level.current ctxt in - let block_endorsing_power = Consensus.current_endorsement_power ctxt in - let consensus_threshold = Constants.consensus_threshold ctxt in - are_endorsements_required ctxt ~level:level.level - >>=? fun required_endorsements -> - finalize_application_check_validity - ctxt - mode - protocol_data - ~round - ~predecessor - ~endorsing_power:block_endorsing_power - ~consensus_threshold - ~required_endorsements - >>=? fun (fitness, block_payload_hash) -> + let endorsing_power = Consensus.current_endorsement_power ctxt in + let* required_endorsements = + are_endorsements_required ctxt ~level:level.level + in + let block_payload_hash = + compute_payload_hash + ctxt + ~predecessor + ~payload_round:block_data_contents.Block_header.payload_round + in (* from this point nothing should fail *) (* We mark the endorsement branch as the grand parent branch when accessible. This will not be present before the first two blocks of tenderbake. *) - (match Consensus.endorsement_branch ctxt with - | Some predecessor_branch -> - Consensus.store_grand_parent_branch ctxt predecessor_branch >>= return - | None -> return ctxt) - >>=? fun ctxt -> + let level = Level.current ctxt in + let*! ctxt = + match Consensus.endorsement_branch ctxt with + | Some predecessor_branch -> + Consensus.store_grand_parent_branch ctxt predecessor_branch + | None -> Lwt.return ctxt + in (* We mark the current payload hash as the predecessor one => this will only be accessed by the successor block now. *) - Consensus.store_endorsement_branch ctxt (predecessor, block_payload_hash) - >>= fun ctxt -> - Round.update ctxt round >>=? fun ctxt -> + let*! ctxt = + Consensus.store_endorsement_branch ctxt (predecessor, block_payload_hash) + in + let* ctxt = Round.update ctxt round in (* end of level *) - (match protocol_data.Block_header.seed_nonce_hash with - | None -> return ctxt - | Some nonce_hash -> - Nonce.record_hash ctxt {nonce_hash; delegate = block_producer}) - >>=? fun ctxt -> - (if required_endorsements then - record_endorsing_participation ctxt >>=? fun ctxt -> - Baking.bonus_baking_reward ctxt ~endorsing_power:block_endorsing_power - >>?= fun rewards_bonus -> return (ctxt, Some rewards_bonus) - else return (ctxt, None)) - >>=? fun (ctxt, reward_bonus) -> + let* ctxt = + match block_data_contents.Block_header.seed_nonce_hash with + | None -> return ctxt + | Some nonce_hash -> + Nonce.record_hash ctxt {nonce_hash; delegate = block_producer} + in + let* ctxt, reward_bonus = + if required_endorsements then + let* ctxt = record_endorsing_participation ctxt in + let*? rewards_bonus = Baking.bonus_baking_reward ctxt ~endorsing_power in + return (ctxt, Some rewards_bonus) + else return (ctxt, None) + in let baking_reward = Constants.baking_reward_fixed_portion ctxt in - Delegate.record_baking_activity_and_pay_rewards_and_fees - ctxt - ~payload_producer - ~block_producer - ~baking_reward - ~reward_bonus - >>=? fun (ctxt, baking_receipts) -> + let* ctxt, baking_receipts = + Delegate.record_baking_activity_and_pay_rewards_and_fees + ctxt + ~payload_producer + ~block_producer + ~baking_reward + ~reward_bonus + in (* if end of nonce revelation period, compute seed *) - (if Level.may_compute_randao ctxt then Seed.compute_randao ctxt - else return ctxt) - >>=? fun ctxt -> - (if Level.may_snapshot_stake_distribution ctxt then - Stake_distribution.snapshot ctxt - else return ctxt) - >>=? fun ctxt -> - may_start_new_cycle ctxt - >>=? fun (ctxt, cycle_end_balance_updates, deactivated) -> - Amendment.may_start_new_voting_period ctxt >>=? fun ctxt -> - Dal_apply.dal_finalisation ctxt >>=? fun (ctxt, dal_slot_availability) -> + let* ctxt = + if Level.may_compute_randao ctxt then Seed.compute_randao ctxt + else return ctxt + in + let* ctxt = + if Level.may_snapshot_stake_distribution ctxt then + Stake_distribution.snapshot ctxt + else return ctxt + in + let* ctxt, cycle_end_balance_updates, deactivated = + may_start_new_cycle ctxt + in + let* ctxt = Amendment.may_start_new_voting_period ctxt in + let* ctxt, dal_slot_availability = Dal_apply.dal_finalisation ctxt in let balance_updates = migration_balance_updates @ baking_receipts @ cycle_end_balance_updates in @@ -2640,7 +2688,7 @@ let finalize_application ctxt (mode : finalize_application_mode) protocol_data (Gas.Arith.fp @@ Constants.hard_gas_limit_per_block ctxt) (Gas.block_level ctxt) in - Voting_period.get_rpc_current_info ctxt >|=? fun voting_period_info -> + let+ voting_period_info = Voting_period.get_rpc_current_info ctxt in let receipt = Apply_results. { @@ -2648,7 +2696,7 @@ let finalize_application ctxt (mode : finalize_application_mode) protocol_data baker = block_producer; level_info = level; voting_period_info; - nonce_hash = protocol_data.seed_nonce_hash; + nonce_hash = block_data_contents.seed_nonce_hash; consumed_gas; deactivated; balance_updates; @@ -2657,6 +2705,178 @@ let finalize_application ctxt (mode : finalize_application_mode) protocol_data dal_slot_availability; } in - (ctxt, fitness, receipt) + (ctxt, receipt) + +type error += Missing_shell_header + +let () = + register_error_kind + `Permanent + ~id:"apply.missing_shell_header" + ~title:"Missing shell_header during finalisation of a block" + ~description: + "During finalisation of a block header in Application mode or Full \ + construction mode, a shell header should be provided so that a cache \ + nonce can be computed." + ~pp:(fun ppf () -> + Format.fprintf + ppf + "No shell header provided during the finalisation of a block.") + Data_encoding.unit + (function Missing_shell_header -> Some () | _ -> None) + (fun () -> Missing_shell_header) + +let finalize_with_commit_message ctxt ~cache_nonce fitness round op_count = + let open Lwt_syntax in + let* ctxt = Cache.Admin.sync ctxt cache_nonce in + let raw_level = Raw_level.to_int32 (Level.current ctxt).level in + let commit_message = + Format.asprintf + "lvl %ld, fit:%a, round %a, %d ops" + raw_level + Fitness.pp + fitness + Round.pp + round + op_count + in + let validation_result = + finalize ~commit_message ctxt (Fitness.to_raw fitness) + in + return validation_result + +let finalize_block (application_state : application_state) shell_header_opt = + let open Lwt_tzresult_syntax in + let { + ctxt; + liquidity_baking_toggle_ema; + implicit_operations_results; + migration_balance_updates; + op_count; + _; + } = + application_state + in + match application_state.mode with + | Full_construction + { + predecessor; + predecessor_level = _; + block_data_contents; + predecessor_round; + block_producer; + payload_producer; + round; + } -> + let*? (shell_header : Block_header.shell_header) = + Option.value_e + shell_header_opt + ~error:(Error_monad.trace_of_error Missing_shell_header) + in + let cache_nonce = + Cache.cache_nonce_from_block_header shell_header block_data_contents + in + let locked_round_evidence = + Option.map + (fun (preendorsement_round, preendorsement_count) -> + Block_header.{preendorsement_round; preendorsement_count}) + (Consensus.locked_round_evidence ctxt) + in + let locked_round = + match locked_round_evidence with + | None -> None + | Some {preendorsement_round; _} -> Some preendorsement_round + in + let level = (Level.current ctxt).level in + let*? fitness = + Fitness.create ~level ~round ~predecessor_round ~locked_round + in + let* ctxt, receipt = + finalize_application + ctxt + block_data_contents + ~round + ~predecessor + ~liquidity_baking_toggle_ema + ~implicit_operations_results + ~migration_balance_updates + ~block_producer + ~payload_producer + in + let*! result = + finalize_with_commit_message ctxt ~cache_nonce fitness round op_count + in + return (result, receipt) + | Partial_construction {predecessor_fitness; _} -> + let* voting_period_info = Voting_period.get_rpc_current_info ctxt in + let level_info = Level.current ctxt in + let result = finalize ctxt predecessor_fitness in + return + ( result, + Apply_results. + { + proposer = Signature.Public_key_hash.zero; + baker = Signature.Public_key_hash.zero; + level_info; + voting_period_info; + nonce_hash = None; + consumed_gas = Gas.Arith.zero; + deactivated = []; + balance_updates = migration_balance_updates; + liquidity_baking_toggle_ema; + implicit_operations_results; + dal_slot_availability = None; + } ) + | Application + { + fitness; + block_header = {shell; protocol_data}; + payload_producer; + block_producer; + _; + } -> + let round = Fitness.round fitness in + let cache_nonce = + Cache.cache_nonce_from_block_header shell protocol_data.contents + in + let* ctxt, receipt = + finalize_application + ctxt + protocol_data.contents + ~round + ~predecessor:shell.predecessor + ~liquidity_baking_toggle_ema + ~implicit_operations_results + ~migration_balance_updates + ~block_producer + ~payload_producer + in + let*! result = + finalize_with_commit_message ctxt ~cache_nonce fitness round op_count + in + return (result, receipt) + | Partial_application {block_producer; fitness; _} -> + let* voting_period_info = Voting_period.get_rpc_current_info ctxt in + let level_info = Level.current ctxt in + let ctxt = finalize ctxt (Fitness.to_raw fitness) in + return + ( ctxt, + Apply_results. + { + proposer = Signature.Public_key_hash.zero; + (* We cannot retrieve the proposer as it requires the + frozen deposit that might not be available depending on + the context given to the partial application. *) + baker = block_producer; + level_info; + voting_period_info; + nonce_hash = None; + consumed_gas = Gas.Arith.zero; + deactivated = []; + balance_updates = migration_balance_updates; + liquidity_baking_toggle_ema; + implicit_operations_results; + dal_slot_availability = None; + } ) let value_of_key ctxt k = Cache.Admin.value_of_key ctxt k diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli index fbd99dc7f5308e6c9d3f93928b17dbe3b495558d..c497016baf8dbe2bb8d06d52bd4379755271e451 100644 --- a/src/proto_alpha/lib_protocol/apply.mli +++ b/src/proto_alpha/lib_protocol/apply.mli @@ -26,7 +26,7 @@ (** This module supports advancing the ledger state by applying [operation]s. - Each operation application takes and returns an [Alpha_context.t], representing + Each operation application takes and returns an [application_state], representing the old and new state, respectively. The [Main] module provides wrappers for the functionality in this module, @@ -34,82 +34,120 @@ *) open Alpha_context -open Apply_results -open Apply_internal_results type error += - | Internal_operation_replay of packed_internal_operation + | Internal_operation_replay of + Apply_internal_results.packed_internal_operation | Tx_rollup_feature_disabled | Tx_rollup_invalid_transaction_ticket_amount | Sc_rollup_feature_disabled | Empty_transaction of Contract.t -val begin_partial_construction : - context -> - predecessor_level:Level.t -> - toggle_vote:Liquidity_baking_repr.liquidity_baking_toggle_vote -> - (t - * packed_successful_manager_operation_result list - * Liquidity_baking.Toggle_EMA.t) - tzresult - Lwt.t - -type 'a full_construction = { +type mode = + | Application of { + block_header : Block_header.t; + fitness : Fitness.t; + payload_producer : public_key_hash; + block_producer : public_key_hash; + predecessor_level : Level.t; + predecessor_round : Round.t; + } + | Partial_application of { + block_header : Block_header.t; + fitness : Fitness.t; + payload_producer : public_key_hash; + block_producer : public_key_hash; + predecessor_level : Level.t; + predecessor_round : Round.t; + } + | Full_construction of { + predecessor : Block_hash.t; + payload_producer : public_key_hash; + block_producer : public_key_hash; + block_data_contents : Block_header.contents; + round : Round.t; + predecessor_level : Level.t; + predecessor_round : Round.t; + } + | Partial_construction of { + predecessor_level : Raw_level.t; + predecessor_round : Round.t; + predecessor_fitness : Fitness.raw; + } (** This mode is mainly intended to be used by a mempool. *) + +type application_state = { ctxt : context; - protocol_data : 'a; - payload_producer : Signature.public_key_hash; - block_producer : Signature.public_key_hash; - round : Round.t; - implicit_operations_results : packed_successful_manager_operation_result list; + chain_id : Chain_id.t; + mode : mode; + op_count : int; + migration_balance_updates : Receipt.balance_updates; liquidity_baking_toggle_ema : Liquidity_baking.Toggle_EMA.t; + implicit_operations_results : + Apply_results.packed_successful_manager_operation_result list; } +(** Initialize an {!application_state} for the application of an + existing block. *) +val begin_application : + context -> + Chain_id.t -> + migration_balance_updates:Receipt.balance_updates -> + migration_operation_results:Migration.origination_result list -> + predecessor_fitness:Fitness.raw -> + Block_header.t -> + application_state tzresult Lwt.t + +(** Initialize an {!application_state} for the partial application of + an existing block. In this mode, an old [ancestor_context] can + provided. This [ancestor_context] must be above the + [last_allowed_fork_level] of the chain so that consensus + operations may be validated. In this mode, only consensus + operations will be applied. *) +val begin_partial_application : + ancestor_context:context -> + Chain_id.t -> + migration_balance_updates:Receipt.balance_updates -> + migration_operation_results:Migration.origination_result list -> + predecessor_fitness:Fitness.raw -> + Block_header.t -> + application_state tzresult Lwt.t + +(** Initialize an {!application_state} for the construction of a + fresh block. *) val begin_full_construction : context -> + Chain_id.t -> + migration_balance_updates:Receipt.balance_updates -> + migration_operation_results:Migration.origination_result list -> predecessor_timestamp:Time.t -> predecessor_level:Level.t -> predecessor_round:Round.t -> - round:Round.t -> + predecessor:Block_hash.t -> + timestamp:Time.t -> Block_header.contents -> - Block_header.contents full_construction tzresult Lwt.t + application_state tzresult Lwt.t -val begin_application : +(** Initialize an {!application_state} for the partial construction of + a block. This is similar to construction but less information is + required as this will not yield a final valid block. *) +val begin_partial_construction : context -> Chain_id.t -> - Block_header.t -> - Fitness.t -> - predecessor_timestamp:Time.t -> - predecessor_level:Level.t -> - predecessor_round:Round.t -> - (t - * Signature.public_key - * Signature.public_key_hash - * packed_successful_manager_operation_result list - * Liquidity_baking.Toggle_EMA.t) - tzresult - Lwt.t - -type apply_mode = - | Application (** Both partial and normal *) - | Full_construction (** For a baker *) - | Partial_construction of {predecessor_level : Level.t option} - (** This mode is mainly intended to be used by a mempool, in which - case the [predecessor_level] should be provided. However, an RPC - might use it with [None]. *) + migration_balance_updates:Receipt.balance_updates -> + migration_operation_results:Migration.origination_result list -> + predecessor_level:Raw_level.t -> + predecessor_fitness:Fitness.raw -> + application_state tzresult Lwt.t (** Apply an operation, i.e. update the given context in accordance with the operation's semantic (or return an error if the operation is not applicable). - The {!type:Validate_operation.stamp} argument enforces that an - operation needs to be validated by {!Validate_operation} before it - can be applied. - For non-manager operations, the application of a validated - operation should always fully succeed. + operation should always fully succeed. For manager operations, the application has two stages. The first - stage consists in updating the context to: + stage consists in updating the context to: - take the fees; @@ -118,61 +156,34 @@ type apply_mode = - decrease of the available block gas by operation's [gas_limit]. These updates are mandatory. In particular, taking the fees is - critically important. The {!Validate_operation} module (from which - we get the {!Validate_opoeration.stamp} as explained above) is - responsible for ensuring that the operation is solvable, i.e. that - fees can be taken, i.e. that the first stage of manager operation - application cannot fail. If this stage fails nevertheless, the - function returns an error. + critically important. The {!Validate} module is responsible for + ensuring that the operation is solvable, i.e. that fees can be + taken, i.e. that the first stage of manager operation application + cannot fail. If this stage fails nevertheless, the function returns + an error. The second stage of this function (still in the case of a manager - operation) consists in applying all the other effects, in - accordance with the semantic of the operation's kind. + operation) consists in applying all the other effects, in + accordance with the semantic of the operation's kind. An error may happen during this second phase: in that case, the - function returns the context obtained at the end of the first - stage, and metadata that contain the error. This means that the - operation has no other effects than those described above during - the first phase. *) + function returns the context obtained at the end of the first + stage, and metadata that contain the error. This means that the + operation has no other effects than those described above during + the first phase. *) val apply_operation : - context -> - Chain_id.t -> - apply_mode -> - payload_producer:public_key_hash -> - Validate_operation.stamp -> + application_state -> Operation_hash.t -> - 'a operation -> - (context * 'a operation_metadata) tzresult Lwt.t + packed_operation -> + (application_state * Apply_results.packed_operation_metadata) tzresult Lwt.t -type finalize_application_mode = - | Finalize_full_construction of { - level : Raw_level.t; - predecessor_round : Round.t; - } - | Finalize_application of Fitness.t - -val finalize_application : - context -> - finalize_application_mode -> - Block_header.contents -> - payload_producer:public_key_hash -> - block_producer:public_key_hash -> - Liquidity_baking.Toggle_EMA.t -> - packed_successful_manager_operation_result list -> - round:Round.t -> - predecessor:Block_hash.t -> - migration_balance_updates:Receipt.balance_updates -> - (context * Fitness.t * block_metadata, error trace) result Lwt.t +(** Finalize the application of a block depending on its mode. *) +val finalize_block : + application_state -> + Block_header.shell_header option -> + (Updater.validation_result * Apply_results.block_metadata) tzresult Lwt.t (** [value_of_key ctxt k] builds a value identified by key [k] so that it can be put into the cache. *) val value_of_key : context -> Context.Cache.key -> Context.Cache.value tzresult Lwt.t - -(** Check if endorsements are required for a given level. *) -val are_endorsements_required : - context -> level:Raw_level.t -> bool tzresult Lwt.t - -(** Check if a block's endorsing power is at least the minim required. *) -val check_minimum_endorsements : - endorsing_power:int -> minimum:int -> unit tzresult diff --git a/src/proto_alpha/lib_protocol/cache_repr.ml b/src/proto_alpha/lib_protocol/cache_repr.ml index 603e3e82848c49419d7aac0fd1c6d05218073602..2850ff2c9c521ca381353b23d61cad67f4b9960a 100644 --- a/src/proto_alpha/lib_protocol/cache_repr.ml +++ b/src/proto_alpha/lib_protocol/cache_repr.ml @@ -61,6 +61,8 @@ type identifier = string type namespace = string +type cache_nonce = Bytes.t + let compare_namespace = Compare.String.compare type internal_identifier = {namespace : namespace; id : identifier} @@ -289,3 +291,30 @@ let register_exn (type cvalue) let identifier_rank ctxt id = Admin.key_rank ctxt (mk ~id) end) + +let cache_nonce_from_block_header (shell : Block_header.shell_header) contents : + cache_nonce = + let open Block_header_repr in + let shell : Block_header.shell_header = + { + level = 0l; + proto_level = 0; + predecessor = shell.predecessor; + timestamp = Time.of_seconds 0L; + validation_passes = 0; + operations_hash = shell.operations_hash; + fitness = []; + context = Context_hash.zero; + } + in + let contents = + { + contents with + payload_hash = Block_payload_hash.zero; + proof_of_work_nonce = + Bytes.make Constants_repr.proof_of_work_nonce_size '0'; + } + in + let protocol_data = {signature = Signature.zero; contents} in + let x = {shell; protocol_data} in + Block_hash.to_bytes (hash x) diff --git a/src/proto_alpha/lib_protocol/cache_repr.mli b/src/proto_alpha/lib_protocol/cache_repr.mli index f96ffdfc9d3b9815a33b3411a17ae8dcfe1e633c..2d026d423601875fdccd1a25c20e7b9c5de29ba0 100644 --- a/src/proto_alpha/lib_protocol/cache_repr.mli +++ b/src/proto_alpha/lib_protocol/cache_repr.mli @@ -56,6 +56,10 @@ type size = int (** Index type to index caches. *) type index = int +(** Type used to identifies the block that introduced new cache + entries *) +type cache_nonce + (** The following module acts on the whole cache, not on a specific @@ -64,7 +68,7 @@ type index = int with respect to the chain. This module is typically used by low-level layers of the protocol and by the shell. - *) +*) module Admin : sig (** A key uniquely identifies a cached [value] in some subcache. *) type key @@ -75,7 +79,7 @@ module Admin : sig (** [pp fmt ctxt] is a pretty printer for the [cache] of [ctxt]. *) val pp : Format.formatter -> Raw_context.t -> unit - (** [sync ctxt ~cache_nonce] updates the context with the domain of + (** [sync ctxt cache_nonce] updates the context with the domain of the cache computed so far. Such function is expected to be called at the end of the validation of a block, when there is no more accesses to the cache. @@ -87,7 +91,7 @@ module Admin : sig consequently influences the context hash of the very same block. Such nonce cannot be determined by the shell and its computation is delegated to the economic protocol. *) - val sync : Raw_context.t -> cache_nonce:Bytes.t -> Raw_context.t Lwt.t + val sync : Raw_context.t -> cache_nonce -> Raw_context.t Lwt.t (** {3 Cache helpers for RPCs} *) @@ -125,7 +129,7 @@ module Admin : sig val cache_size_limit : Raw_context.t -> cache_index:int -> size option (** [value_of_key ctxt k] interprets the functions introduced by - [register] to construct a cacheable value for a key [k]. + [register] to construct a cacheable value for a key [k]. [value_of_key] is a maintenance operation: it is typically run when a node reboots. For this reason, this operation is not @@ -233,3 +237,8 @@ end val register_exn : (module CLIENT with type cached_value = 'a) -> (module INTERFACE with type cached_value = 'a) + +(** [cache_nonce_from_block_header shell_header contents] computes a + {!cache_nonce} from the [shell_header] and its [contents]. *) +val cache_nonce_from_block_header : + Block_header_repr.shell_header -> Block_header_repr.contents -> cache_nonce diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index b7bcc6fd8e912c6b5d6eb48f8137a5234da2f4ac..c9b2bfe301fa24fe8741363a311d6e15edd6fd3a 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -241,7 +241,7 @@ Baking Validate_errors Amendment - Validate_operation + Validate Apply Services_registration Constants_services @@ -500,7 +500,7 @@ baking.ml baking.mli validate_errors.ml validate_errors.mli amendment.ml amendment.mli - validate_operation.ml validate_operation.mli + validate.ml validate.mli apply.ml apply.mli services_registration.ml services_registration.mli constants_services.ml constants_services.mli @@ -739,7 +739,7 @@ baking.ml baking.mli validate_errors.ml validate_errors.mli amendment.ml amendment.mli - validate_operation.ml validate_operation.mli + validate.ml validate.mli apply.ml apply.mli services_registration.ml services_registration.mli constants_services.ml constants_services.mli @@ -983,7 +983,7 @@ baking.ml baking.mli validate_errors.ml validate_errors.mli amendment.ml amendment.mli - validate_operation.ml validate_operation.mli + validate.ml validate.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/main.ml b/src/proto_alpha/lib_protocol/main.ml index d282f9701fd69b114987da0c8c358d584791fba4..7ae483137744d311d7c7e6d7dc3da8893eed6dc4 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -90,600 +90,289 @@ let rpc_services = Alpha_services.register () ; Services_registration.get_rpc_services () -type validation_mode = - | Application of { - block_header : Alpha_context.Block_header.t; - fitness : Alpha_context.Fitness.t; - payload_producer : Alpha_context.public_key_hash; - block_producer : Alpha_context.public_key_hash; - predecessor_round : Alpha_context.Round.t; - predecessor_level : Alpha_context.Level.t; - } - | Partial_application of { - block_header : Alpha_context.Block_header.t; - fitness : Alpha_context.Fitness.t; - payload_producer : Alpha_context.public_key_hash; - block_producer : Alpha_context.public_key_hash; - predecessor_level : Alpha_context.Level.t; - predecessor_round : Alpha_context.Round.t; - } - (* Mempool only *) - | Partial_construction of { - predecessor : Block_hash.t; - predecessor_fitness : Fitness.t; - predecessor_level : Alpha_context.Level.t; - predecessor_round : Alpha_context.Round.t; - } - (* Baker only *) - | Full_construction of { - predecessor : Block_hash.t; - payload_producer : Alpha_context.public_key_hash; - block_producer : Alpha_context.public_key_hash; - protocol_data_contents : Alpha_context.Block_header.contents; - level : Int32.t; - round : Alpha_context.Round.t; - predecessor_level : Alpha_context.Level.t; - predecessor_round : Alpha_context.Round.t; - } - type validation_state = { - mode : validation_mode; - chain_id : Chain_id.t; - ctxt : Alpha_context.t; - op_count : int; - migration_balance_updates : Alpha_context.Receipt.balance_updates; - liquidity_baking_toggle_ema : Alpha_context.Liquidity_baking.Toggle_EMA.t; - implicit_operations_results : - Apply_results.packed_successful_manager_operation_result list; - validate_operation_info : Validate_operation.validate_operation_info; - validate_operation_state : Validate_operation.validate_operation_state; + validity_state : Validate.validation_state; + application_state : Apply.application_state; } -let begin_partial_application ~chain_id ~ancestor_context:ctxt - ~predecessor_timestamp ~(predecessor_fitness : Fitness.t) - (block_header : Alpha_context.Block_header.t) = - (* Note: we don't have access to the predecessor context. *) - let level = block_header.shell.level in - let timestamp = block_header.shell.timestamp in - Alpha_context.Fitness.from_raw block_header.shell.fitness >>?= fun fitness -> - Alpha_context.Fitness.round_from_raw predecessor_fitness - >>?= fun predecessor_round -> +let prepare_context ctxt ~level ~predecessor_timestamp ~timestamp = Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt - >>=? fun (ctxt, migration_balance_updates, migration_operation_results) -> - Alpha_context.Raw_level.of_int32 (Int32.pred level) - >>?= fun predecessor_level -> - let predecessor_level = - Alpha_context.Level.(from_raw ctxt predecessor_level) + +let init_allowed_consensus_operations ctxt ~endorsement_level + ~preendorsement_level = + let open Lwt_result_syntax in + let open Alpha_context in + let* ctxt = Delegate.prepare_stake_distribution ctxt in + let* ctxt, allowed_endorsements, allowed_preendorsements = + if Level.(endorsement_level = preendorsement_level) then + let* ctxt, slots = + Baking.endorsing_rights_by_first_slot ctxt endorsement_level + in + let consensus_operations = slots in + return (ctxt, consensus_operations, consensus_operations) + else + let* ctxt, endorsements = + Baking.endorsing_rights_by_first_slot ctxt endorsement_level + in + let* ctxt, preendorsements = + Baking.endorsing_rights_by_first_slot ctxt preendorsement_level + in + return (ctxt, endorsements, preendorsements) in - Apply.begin_application - ctxt - chain_id - block_header - fitness - ~predecessor_timestamp - ~predecessor_level - ~predecessor_round - >>=? fun ( ctxt, - payload_producer_pk, - block_producer, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema ) -> - let mode = - Partial_application - { - block_header; - fitness; - predecessor_level; - predecessor_round; - payload_producer = Signature.Public_key.hash payload_producer_pk; - block_producer; - } + let ctxt = + Consensus.initialize_consensus_operation + ctxt + ~allowed_endorsements + ~allowed_preendorsements + in + return ctxt + +let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp + ~(predecessor_fitness : Fitness.t) + (block_header : Alpha_context.Block_header.t) = + let open Lwt_tzresult_syntax in + let open Alpha_context in + let* ctxt, migration_balance_updates, migration_operation_results = + prepare_context + predecessor_context + ~level:block_header.shell.level + ~predecessor_timestamp + ~timestamp:block_header.shell.timestamp + in + let*? predecessor_level = + Alpha_context.Raw_level.of_int32 (Int32.pred block_header.shell.level) in - let validate_operation_info, validate_operation_state = - Validate_operation.begin_block_validation + let predecessor_level = Alpha_context.Level.from_raw ctxt predecessor_level in + let current_level = Level.current ctxt in + let* ctxt = + init_allowed_consensus_operations + ctxt + ~endorsement_level:predecessor_level + ~preendorsement_level:current_level + in + let*? fitness = Alpha_context.Fitness.from_raw block_header.shell.fitness in + let* validity_state = + Validate.begin_application ctxt chain_id ~predecessor_level - ~predecessor_round - ~predecessor_hash:block_header.shell.predecessor + ~predecessor_timestamp + block_header fitness - block_header.protocol_data.contents.payload_hash in - return - { - mode; - chain_id; - ctxt; - op_count = 0; - migration_balance_updates; - liquidity_baking_toggle_ema; - implicit_operations_results = - Apply_results.pack_migration_operation_results - migration_operation_results - @ liquidity_baking_operations_results; - validate_operation_info; - validate_operation_state; - } - -(* During applications the valid consensus operations are: - * Endorsements on previous block with the right round, level, payload_hash (of the predecessor block) - * Preendorsements on current level, previous round, and the payload_hash of the current block - Those endorsements justify that the previous block was finalized. - Those preendorsements justify the locked_round part of the fitness of the current block - *) -let begin_application ~chain_id ~predecessor_context:ctxt ~predecessor_timestamp - ~predecessor_fitness (block_header : Alpha_context.Block_header.t) = - let level = block_header.shell.level in - let timestamp = block_header.shell.timestamp in - Alpha_context.Fitness.from_raw block_header.shell.fitness >>?= fun fitness -> - Alpha_context.Fitness.round_from_raw predecessor_fitness - >>?= fun predecessor_round -> - Alpha_context.Raw_level.of_int32 (Int32.pred level) - >>?= fun predecessor_level -> - Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt - >>=? fun (ctxt, migration_balance_updates, migration_operation_results) -> - let predecessor_level = Alpha_context.Level.from_raw ctxt predecessor_level in - Apply.begin_application - ctxt - chain_id - block_header - fitness - ~predecessor_timestamp - ~predecessor_level - ~predecessor_round - >>=? fun ( ctxt, - payload_producer, - block_producer, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema ) -> - let mode = - Application - { - block_header; - fitness; - predecessor_round; - predecessor_level; - payload_producer = Signature.Public_key.hash payload_producer; - block_producer; - } + let* application_state = + Apply.begin_application + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results + ~predecessor_fitness + (block_header : Alpha_context.Block_header.t) in - let validate_operation_info, validate_operation_state = - Validate_operation.begin_block_validation + return {validity_state; application_state} + +let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp + ~(predecessor_fitness : Fitness.t) + (block_header : Alpha_context.Block_header.t) = + let open Lwt_tzresult_syntax in + let open Alpha_context in + let* ancestor_context, migration_balance_updates, migration_operation_results + = + prepare_context + ancestor_context + ~level:block_header.shell.level + ~predecessor_timestamp + ~timestamp:block_header.shell.timestamp + in + let*? predecessor_level = + Raw_level.of_int32 (Int32.pred block_header.shell.level) + in + let predecessor_level = Level.from_raw ancestor_context predecessor_level in + let current_level = Level.current ancestor_context in + let* ancestor_context = + init_allowed_consensus_operations + ancestor_context + ~endorsement_level:predecessor_level + ~preendorsement_level:current_level + in + let*? fitness = Fitness.from_raw block_header.shell.fitness in + let* validity_state = + Validate.begin_partial_application + ~ancestor_context + chain_id + ~predecessor_level + ~predecessor_timestamp + block_header + fitness + in + let* application_state = + Apply.begin_partial_application + chain_id + ~ancestor_context + ~migration_balance_updates + ~migration_operation_results + ~predecessor_fitness + block_header + in + return {validity_state; application_state} + +let begin_full_construction ~chain_id ~predecessor_context + ~predecessor_timestamp ~predecessor_level ~(predecessor_fitness : Fitness.t) + ~predecessor ~timestamp + (block_header_contents : Alpha_context.Block_header.contents) = + let open Lwt_tzresult_syntax in + let open Alpha_context in + let level = Int32.succ predecessor_level in + let* ctxt, migration_balance_updates, migration_operation_results = + prepare_context ~level ~predecessor_timestamp ~timestamp predecessor_context + in + let*? predecessor_level = Raw_level.of_int32 predecessor_level in + let predecessor_level = Level.from_raw ctxt predecessor_level in + let current_level = Level.current ctxt in + let* ctxt = + init_allowed_consensus_operations + ctxt + ~endorsement_level:predecessor_level + ~preendorsement_level:current_level + in + let round_durations = Constants.round_durations ctxt in + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let*? round = + Round.round_of_timestamp + round_durations + ~predecessor_timestamp + ~predecessor_round + ~timestamp + in + let* validity_state = + Validate.begin_full_construction ctxt chain_id ~predecessor_level ~predecessor_round - ~predecessor_hash:block_header.shell.predecessor - fitness - block_header.protocol_data.contents.payload_hash + ~predecessor_timestamp + ~predecessor_hash:predecessor + round + block_header_contents in - return - { - mode; - chain_id; - ctxt; - op_count = 0; - migration_balance_updates; - liquidity_baking_toggle_ema; - implicit_operations_results = - Apply_results.pack_migration_operation_results - migration_operation_results - @ liquidity_baking_operations_results; - validate_operation_info; - validate_operation_state; - } - -let begin_construction ~chain_id ~predecessor_context:ctxt + let* application_state = + Apply.begin_full_construction + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results + ~predecessor_timestamp + ~predecessor_level + ~predecessor_round + ~predecessor + ~timestamp + block_header_contents + in + return {validity_state; application_state} + +let begin_partial_construction ~chain_id ~predecessor_context ~predecessor_timestamp ~predecessor_level ~predecessor_fitness ~predecessor - ~timestamp ?(protocol_data : block_header_data option) () = + ~timestamp = + let open Lwt_tzresult_syntax in + let open Alpha_context in let level = Int32.succ predecessor_level in - Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt - >>=? fun (ctxt, migration_balance_updates, migration_operation_results) -> - Alpha_context.Raw_level.of_int32 predecessor_level - >>?= fun predecessor_level -> - let predecessor_level = - Alpha_context.Level.(from_raw ctxt predecessor_level) + let* ctxt, migration_balance_updates, migration_operation_results = + prepare ~level ~predecessor_timestamp ~timestamp predecessor_context + in + let*? predecessor_raw_level = Raw_level.of_int32 predecessor_level in + let predecessor_level = Level.from_raw ctxt predecessor_raw_level in + (* In the mempool, only consensus operations for [predecessor_level] + (that is, head's level) are allowed, contrary to block validation + where endorsements are for the previous level and + preendorsements, if any, for the block's level. *) + let* ctxt = + init_allowed_consensus_operations + ctxt + ~endorsement_level:predecessor_level + ~preendorsement_level:predecessor_level + in + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let*? grandparent_round = + Alpha_context.Fitness.predecessor_round_from_raw predecessor_fitness in - (match protocol_data with + let* validity_state = + Validate.begin_partial_construction + ctxt + chain_id + ~predecessor_level + ~predecessor_round + ~predecessor_hash:predecessor + ~grandparent_round + in + let* application_state = + Apply.begin_partial_construction + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results + ~predecessor_level:predecessor_raw_level + ~predecessor_fitness + in + return {validity_state; application_state} + +(* Updater's signature compliant function *) +let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp + ~predecessor_level ~(predecessor_fitness : Fitness.t) ~predecessor + ~timestamp ?(protocol_data : block_header_data option) () = + match protocol_data with | None -> - Alpha_context.Fitness.round_from_raw predecessor_fitness - >>?= fun predecessor_round -> - let toggle_vote = Alpha_context.Liquidity_baking.LB_pass in - Apply.begin_partial_construction ctxt ~predecessor_level ~toggle_vote - >>=? fun ( ctxt, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema ) -> - let mode = - Partial_construction - { - predecessor; - predecessor_fitness; - predecessor_level; - predecessor_round; - } - in - Alpha_context.Fitness.predecessor_round_from_raw predecessor_fitness - >>?= fun grandparent_round -> - let validate_operation_info, validate_operation_state = - Validate_operation.begin_mempool - ctxt - chain_id - ~predecessor_level - ~predecessor_round - ~predecessor_hash:predecessor - ~grandparent_round - in - return - ( mode, - ctxt, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema, - validate_operation_info, - validate_operation_state ) - | Some proto_header -> - Alpha_context.Fitness.round_from_raw predecessor_fitness - >>?= fun predecessor_round -> - let round_durations = Alpha_context.Constants.round_durations ctxt in - Alpha_context.Round.round_of_timestamp - round_durations + begin_partial_construction + ~chain_id + ~predecessor_context ~predecessor_timestamp - ~predecessor_round + ~predecessor_level + ~predecessor_fitness + ~predecessor ~timestamp - >>?= fun round -> - (* The endorsement/preendorsement validation rules for construction are the - same as for application. *) - Apply.begin_full_construction - ctxt + | Some protocol_data -> + begin_full_construction + ~chain_id + ~predecessor_context ~predecessor_timestamp - ~predecessor_round ~predecessor_level - ~round - proto_header.contents - >>=? fun { - ctxt; - protocol_data = protocol_data_contents; - payload_producer; - block_producer; - round; - liquidity_baking_toggle_ema; - implicit_operations_results = - liquidity_baking_operations_results; - } -> - let mode = - Full_construction - { - predecessor; - payload_producer; - block_producer; - level; - round; - protocol_data_contents; - predecessor_round; - predecessor_level; - } - in - let validate_operation_info, validate_operation_state = - Validate_operation.begin_block_construction - ctxt - chain_id - ~predecessor_level - ~predecessor_round - ~predecessor_hash:predecessor - round - proto_header.contents.payload_hash - in - return - ( mode, - ctxt, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema, - validate_operation_info, - validate_operation_state )) - >|=? fun ( mode, - ctxt, - liquidity_baking_operations_results, - liquidity_baking_toggle_ema, - validate_operation_info, - validate_operation_state ) -> - { - mode; - chain_id; - ctxt; - op_count = 0; - migration_balance_updates; - liquidity_baking_toggle_ema; - implicit_operations_results = - Apply_results.pack_migration_operation_results migration_operation_results - @ liquidity_baking_operations_results; - validate_operation_info; - validate_operation_state; - } - -let apply_operation_with_mode mode ctxt chain_id data op_count operation - ~payload_producer = - let {shell; protocol_data = Operation_data protocol_data} = operation in + ~predecessor_fitness + ~predecessor + ~timestamp + protocol_data.contents + +let validate_operation validity_state + (packed_operation : Alpha_context.packed_operation) = + let {shell; protocol_data = Operation_data protocol_data} = + packed_operation + in let operation : _ Alpha_context.operation = {shell; protocol_data} in let oph = Alpha_context.Operation.hash operation in - Validate_operation.validate_operation - data.validate_operation_info - data.validate_operation_state - oph - operation - >>=? fun (validate_operation_state, op_validated_stamp) -> - Apply.apply_operation - ctxt - chain_id - mode - ~payload_producer - op_validated_stamp - oph - operation - >|=? fun (ctxt, result) -> - let op_count = op_count + 1 in - ( {data with ctxt; op_count; validate_operation_state}, - Operation_metadata result ) - -let apply_operation ({mode; chain_id; ctxt; op_count; _} as data) - (operation : Alpha_context.packed_operation) = - match mode with - | Partial_application {payload_producer; _} -> ( - match acceptable_pass operation with - | None -> - (* Only occurs with Failing_noop *) - fail Validate_errors.Failing_noop_error - | Some n -> - (* Multipass validation only considers operations in - consensus pass. *) - if Compare.Int.(n = Operation_repr.consensus_pass) then - apply_operation_with_mode - Apply.Application - ctxt - chain_id - data - op_count - operation - ~payload_producer - else - let op_count = op_count + 1 in - return ({data with ctxt; op_count}, No_operation_metadata)) - | Application {payload_producer; _} -> - apply_operation_with_mode - Apply.Application - ctxt - chain_id - data - op_count - operation - ~payload_producer - | Partial_construction {predecessor_level; _} -> - apply_operation_with_mode - (Apply.Partial_construction {predecessor_level = Some predecessor_level}) - ctxt - chain_id - data - op_count - operation - ~payload_producer:Signature.Public_key_hash.zero - | Full_construction {payload_producer; _} -> - apply_operation_with_mode - Apply.Full_construction - ctxt - chain_id - data - op_count - operation - ~payload_producer - -let cache_nonce_from_block_header shell contents = - let open Alpha_context.Block_header in - let shell = - Block_header. - { - level = 0l; - proto_level = 0; - predecessor = shell.predecessor; - timestamp = Time.of_seconds 0L; - validation_passes = 0; - operations_hash = shell.operations_hash; - fitness = []; - context = Context_hash.zero; - } - in - let contents = - { - contents with - payload_hash = Block_payload_hash.zero; - proof_of_work_nonce = - Bytes.make Constants_repr.proof_of_work_nonce_size '0'; - } - in - let protocol_data = {signature = Signature.zero; contents} in - let x = {shell; protocol_data} in - Block_hash.to_bytes (hash x) - -let finalize_block_application ctxt round ~cache_nonce finalize_application_mode - protocol_data payload_producer block_producer liquidity_baking_toggle_ema - implicit_operations_results predecessor migration_balance_updates op_count = - Apply.finalize_application - ctxt - finalize_application_mode - protocol_data - ~payload_producer - ~block_producer - liquidity_baking_toggle_ema - implicit_operations_results - ~round - ~predecessor - ~migration_balance_updates - >>=? fun (ctxt, fitness, receipt) -> - Alpha_context.Cache.Admin.sync ctxt ~cache_nonce >>= fun ctxt -> - let level = Alpha_context.Level.current ctxt in - let raw_level = Alpha_context.Raw_level.to_int32 level.level in - let commit_message = - Format.asprintf - "lvl %ld, fit:%a, round %a, %d ops" - raw_level - Alpha_context.Fitness.pp - fitness - Alpha_context.Round.pp - round - op_count + Validate.validate_operation validity_state oph packed_operation + +let apply_operation (state : validation_state) + (packed_operation : Alpha_context.packed_operation) = + let open Lwt_result_syntax in + let* validate_state = + validate_operation state.validity_state packed_operation in - let validation_result = - Alpha_context.finalize - ~commit_message - ctxt - (Alpha_context.Fitness.to_raw fitness) + let operation_hash = Alpha_context.Operation.hash_packed packed_operation in + let* application_state, operation_receipt = + Apply.apply_operation + state.application_state + operation_hash + packed_operation in - return (validation_result, receipt) - -type error += Missing_shell_header - -let () = - register_error_kind - `Permanent - ~id:"main.missing_shell_header" - ~title:"Missing shell_header during finalisation of a block" - ~description: - "During finalisation of a block header in Application mode or Full \ - construction mode, a shell header should be provided so that a cache \ - nonce can be computed." - ~pp:(fun ppf () -> - Format.fprintf - ppf - "No shell header provided during the finalisation of a block.") - Data_encoding.unit - (function Missing_shell_header -> Some () | _ -> None) - (fun () -> Missing_shell_header) - -let finalize_block - { - mode; - ctxt; - op_count; - migration_balance_updates; - liquidity_baking_toggle_ema; - implicit_operations_results; - _; - } shell_header = - match mode with - | Partial_construction {predecessor_fitness; _} -> - Alpha_context.Voting_period.get_rpc_current_info ctxt - >>=? fun voting_period_info -> - let level_info = Alpha_context.Level.current ctxt in - let fitness = predecessor_fitness in - let ctxt = Alpha_context.finalize ctxt fitness in - return - ( ctxt, - Apply_results. - { - proposer = Signature.Public_key_hash.zero; - baker = Signature.Public_key_hash.zero; - level_info; - voting_period_info; - nonce_hash = None; - consumed_gas = Alpha_context.Gas.Arith.zero; - deactivated = []; - balance_updates = migration_balance_updates; - liquidity_baking_toggle_ema; - implicit_operations_results; - dal_slot_availability = None; - } ) - | Partial_application {fitness; block_producer; _} -> - (* For partial application we do not completely check the block validity. - Validating the endorsements is sufficient for a good precheck *) - let level = Alpha_context.Level.current ctxt in - let included_endorsements = - Alpha_context.Consensus.current_endorsement_power ctxt - in - let minimum = Alpha_context.Constants.consensus_threshold ctxt in - Apply.are_endorsements_required ctxt ~level:level.level - >>=? fun endorsements_required -> - (if endorsements_required then - Apply.check_minimum_endorsements - ~endorsing_power:included_endorsements - ~minimum - else Result.return_unit) - >>?= fun () -> - Alpha_context.Voting_period.get_rpc_current_info ctxt - >|=? fun voting_period_info -> - let level_info = Alpha_context.Level.current ctxt in - let ctxt = - Alpha_context.finalize ctxt (Alpha_context.Fitness.to_raw fitness) - in - ( ctxt, - Apply_results. - { - proposer = Signature.Public_key_hash.zero; - (* We cannot retrieve the proposer as it requires the - frozen deposit that might not be available depending on - the context given to the partial application. *) - baker = block_producer; - level_info; - voting_period_info; - nonce_hash = None; - consumed_gas = Alpha_context.Gas.Arith.zero; - deactivated = []; - balance_updates = migration_balance_updates; - liquidity_baking_toggle_ema; - implicit_operations_results; - dal_slot_availability = None; - } ) - | Application - { - payload_producer; - fitness; - block_producer; - block_header = {protocol_data = {contents = protocol_data; _}; shell}; - _; - } -> - let round = Alpha_context.Fitness.round fitness in - let cache_nonce = cache_nonce_from_block_header shell protocol_data in - finalize_block_application - ctxt - ~cache_nonce - round - (Finalize_application fitness) - protocol_data - payload_producer - block_producer - liquidity_baking_toggle_ema - implicit_operations_results - shell.predecessor - migration_balance_updates - op_count - | Full_construction - { - predecessor; - predecessor_round; - protocol_data_contents; - round; - level; - payload_producer; - block_producer; - _; - } -> - Option.value_e - shell_header - ~error:(Error_monad.trace_of_error Missing_shell_header) - >>?= fun shell_header -> - let cache_nonce = - cache_nonce_from_block_header shell_header protocol_data_contents - in - Alpha_context.Raw_level.of_int32 level >>?= fun level -> - finalize_block_application - ctxt - round - ~cache_nonce - (Finalize_full_construction {level; predecessor_round}) - protocol_data_contents - payload_producer - block_producer - liquidity_baking_toggle_ema - implicit_operations_results - predecessor - migration_balance_updates - op_count + return + ( { + validity_state = {state.validity_state with state = validate_state}; + application_state; + }, + operation_receipt ) + +let finalize_block state shell_header = + let open Lwt_result_syntax in + let* () = Validate.finalize_block state.validity_state in + Apply.finalize_block state.application_state shell_header let compare_operations (oph1, op1) (oph2, op2) = Alpha_context.Operation.compare (oph1, op1) (oph2, op2) @@ -736,18 +425,19 @@ let init chain_id ctxt block_header = Alpha_context.prepare_first_block chain_id ~typecheck ~level ~timestamp ctxt >>=? fun ctxt -> let cache_nonce = - cache_nonce_from_block_header + Alpha_context.Cache.cache_nonce_from_block_header block_header - { - payload_hash = Block_payload_hash.zero; - payload_round = Alpha_context.Round.zero; - liquidity_baking_toggle_vote = Alpha_context.Liquidity_baking.LB_pass; - seed_nonce_hash = None; - proof_of_work_nonce = - Bytes.make Constants_repr.proof_of_work_nonce_size '0'; - } + ({ + payload_hash = Block_payload_hash.zero; + payload_round = Alpha_context.Round.zero; + liquidity_baking_toggle_vote = Alpha_context.Liquidity_baking.LB_pass; + seed_nonce_hash = None; + proof_of_work_nonce = + Bytes.make Constants_repr.proof_of_work_nonce_size '0'; + } + : Alpha_context.Block_header.contents) in - Alpha_context.Cache.Admin.sync ctxt ~cache_nonce >>= fun ctxt -> + Alpha_context.Cache.Admin.sync ctxt cache_nonce >>= fun ctxt -> return (Alpha_context.finalize ctxt (Alpha_context.Fitness.to_raw init_fitness)) diff --git a/src/proto_alpha/lib_protocol/main.mli b/src/proto_alpha/lib_protocol/main.mli index 007a5ef2580394a32f64ab720f5804fb74381993..eaab25a35f98f0f9eb0a61cf179319c54487bfd2 100644 --- a/src/proto_alpha/lib_protocol/main.mli +++ b/src/proto_alpha/lib_protocol/main.mli @@ -40,75 +40,9 @@ {{:https://tezos.gitlab.io/shell/the_big_picture.html} this overview}. *) -(** [validation_mode] permits to differenciate [!type:validation_state] - values. - - There are four validation modes: - - [Application] - - [Partial_application] - - [Partial_construction] - - [Full_construction] - - For the meaning and typical uses of each mode, refer to the - comments attached to the corresponding type constructors below. -*) -type validation_mode = - | Application of { - block_header : Alpha_context.Block_header.t; - fitness : Alpha_context.Fitness.t; - payload_producer : Alpha_context.public_key_hash; - block_producer : Alpha_context.public_key_hash; - predecessor_round : Alpha_context.Round.t; - predecessor_level : Alpha_context.Level.t; - } - (** Full Validation of a block. See - {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_application}**) - | Partial_application of { - block_header : Alpha_context.Block_header.t; - fitness : Alpha_context.Fitness.t; - payload_producer : Alpha_context.public_key_hash; - block_producer : Alpha_context.public_key_hash; - predecessor_level : Alpha_context.Level.t; - predecessor_round : Alpha_context.Round.t; - } - (** [Partial_application] is used in pre-checking of blocks - not all checks - are done. Special case of [Application] to allow quick rejection of bad - blocks. See - {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_partial_application} - *) - | Partial_construction of { - predecessor : Block_hash.t; - predecessor_fitness : Fitness.t; - predecessor_level : Alpha_context.Level.t; - predecessor_round : Alpha_context.Round.t; - } - (** Shell/mempool-only construction of a virtual block. See - {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_construction} *) - | Full_construction of { - predecessor : Block_hash.t; - payload_producer : Alpha_context.public_key_hash; - block_producer : Alpha_context.public_key_hash; - protocol_data_contents : Alpha_context.Block_header.contents; - level : Int32.t; - round : Alpha_context.Round.t; - predecessor_level : Alpha_context.Level.t; - predecessor_round : Alpha_context.Round.t; - } - (** Baker-only block construction for baking in. See - {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_construction} - *) - type validation_state = { - mode : validation_mode; - chain_id : Chain_id.t; - ctxt : Alpha_context.t; - op_count : int; - migration_balance_updates : Alpha_context.Receipt.balance_updates; - liquidity_baking_toggle_ema : Alpha_context.Liquidity_baking.Toggle_EMA.t; - implicit_operations_results : - Apply_results.packed_successful_manager_operation_result list; - validate_operation_info : Validate_operation.validate_operation_info; - validate_operation_state : Validate_operation.validate_operation_state; + validity_state : Validate.validation_state; + application_state : Apply.application_state; } type operation_data = Alpha_context.packed_protocol_data diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml index 794101fd9535b9e3da4bfedf81e7b275a3a60b26..ce877fef08c7cd828cb3ceb733ac9d04cd8a199d 100644 --- a/src/proto_alpha/lib_protocol/raw_context.ml +++ b/src/proto_alpha/lib_protocol/raw_context.ml @@ -1257,7 +1257,7 @@ module Cache = struct let update c k v = Context.Cache.update (context c) k v |> update_context c - let sync c ~cache_nonce = + let sync c cache_nonce = Context.Cache.sync (context c) ~cache_nonce >>= fun ctxt -> Lwt.return (update_context c ctxt) diff --git a/src/proto_alpha/lib_protocol/raw_context.mli b/src/proto_alpha/lib_protocol/raw_context.mli index feec6955288d30a967fbf81c199ced4444e29c25..f5d85c760b6aaf96db46d4e15972554f0de1063e 100644 --- a/src/proto_alpha/lib_protocol/raw_context.mli +++ b/src/proto_alpha/lib_protocol/raw_context.mli @@ -215,14 +215,18 @@ val map_temporary_lazy_storage_ids_s : (Lazy_storage_kind.Temp_ids.t -> (t * Lazy_storage_kind.Temp_ids.t) Lwt.t) -> t Lwt.t -module Cache : - Context.CACHE - with type t := t - and type size := int - and type index := int - and type identifier := string - and type key = Context.Cache.key - and type value = Context.Cache.value +module Cache : sig + include + Context.CACHE + with type t := t + and type size := int + and type index := int + and type identifier := string + and type key = Context.Cache.key + and type value = Context.Cache.value + + val sync : t -> bytes -> t Lwt.t +end (* Hashes of non-consensus operations are stored so that, when finalizing the block, we can compute the block's payload hash. *) diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml index 32c831150200a22027dbd504fb47a4cdd3aa25c5..3d7ca909ee79924cc528606b0f7f931d1ad9c68b 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml @@ -50,7 +50,7 @@ let level st = st.header.shell.level let rpc_context st = let fitness = (header st).shell.fitness in - let result = Alpha_context.finalize st.state.ctxt fitness in + let result = Alpha_context.finalize st.state.application_state.ctxt fitness in { Environment.Updater.block_hash = Block_hash.zero; block_header = {st.header.shell with fitness = result.fitness}; @@ -62,9 +62,14 @@ let rpc_ctxt = rpc_context Plugin.RPC.rpc_services -let alpha_ctxt st = st.state.ctxt +let alpha_ctxt st = st.state.application_state.ctxt -let set_alpha_ctxt st ctxt = {st with state = {st.state with ctxt}} +let set_alpha_ctxt st ctxt = + { + st with + state = + {st.state with application_state = {st.state.application_state with ctxt}}; + } let begin_construction ?timestamp ?seed_nonce_hash ?(mempool_mode = false) ?(policy = Block.By_round 0) (predecessor : Block.t) = diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml index c6b4f7efcf1d9eb7536355b595e2e26b446377e3..88e2267d7f9d135af56fe1bda7215c229b5acfc6 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml @@ -218,7 +218,7 @@ let test_rewards_block_and_payload_producer () = let fee = Tez.one in Op.transaction (B b1) ~fee baker_b1_contract baker_b1_contract Tez.zero >>=? fun tx -> - Block.bake ~policy:(By_round 0) ~operations:(tx :: endos) b1 >>=? fun b2 -> + Block.bake ~policy:(By_round 0) ~operations:(endos @ [tx]) b1 >>=? fun b2 -> Context.get_baker (B b1) ~round:0 >>=? fun baker_b2 -> get_contract_for_pkh contracts baker_b2 >>=? fun baker_b2_contract -> Context.Contract.balance (B b2) baker_b2_contract >>=? fun bal -> @@ -262,7 +262,7 @@ let test_rewards_block_and_payload_producer () = ~payload_round:(Some Round.zero) ~locked_round:(Some Round.zero) ~policy:(By_account baker_b2') - ~operations:((tx :: preendos) @ endos) + ~operations:(preendos @ endos @ [tx]) b1 >>=? fun b2' -> (* [baker_b2], as payload producer, gets the block reward and the fees *) diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml index 0c6a76f98f7b28826628dd757ddaf6223cd93240..afae5660e2a364e320dc5dc1423ab585085b33d8 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_baking.ml @@ -246,7 +246,7 @@ let test_payload_producer_gets_evidence_rewards () = ~payload_round:(Some Round.zero) ~locked_round:(Some Round.zero) ~policy:(By_account baker1) - ~operations:(db_evidence :: preendos) + ~operations:(preendos @ [db_evidence]) b1 >>=? fun b' -> (* the frozen deposits of the double-signer [baker1] are slashed *) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_gas_properties.ml b/src/proto_alpha/lib_protocol/test/pbt/test_gas_properties.ml index 70b61fbfe932aaf4e091bd62b834d3565847071b..77839e7b385258f4c2ffffdde0ce07504eedb0ea 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_gas_properties.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_gas_properties.ml @@ -99,7 +99,7 @@ let context_gen : Alpha_context.t QCheck2.Gen.t = let+ inc = Incremental.begin_construction b in let state = Incremental.validation_state inc in Alpha_context.Gas.set_limit - state.ctxt + state.application_state.ctxt Alpha_context.Gas.Arith.(fp (integral_of_int_exn 100_000_000))) |> function | Ok a -> a diff --git a/src/proto_alpha/lib_protocol/test/unit/test_gas_monad.ml b/src/proto_alpha/lib_protocol/test/unit/test_gas_monad.ml index f51113e7151e2842b84a4dae2d936da022101f18..e1d563b5fc3ef714b8e95ee8916a242ea0da86c3 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_gas_monad.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_gas_monad.ml @@ -41,7 +41,7 @@ let new_context ~limit = Context.init1 () >>=? fun (b, _contract) -> Incremental.begin_construction b >|=? fun inc -> let state = Incremental.validation_state inc in - Gas.set_limit state.ctxt limit + Gas.set_limit state.application_state.ctxt limit let assert_gas_exhaustion ~loc ctxt gas_monad = match GM.run ctxt gas_monad with diff --git a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml index 9a94409b214fe114624098b7a6e1c67b63599bc4..f171ae3e04eda278f97cb8c47d65b4933e039308 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml @@ -59,7 +59,7 @@ let new_context_with_stakers nb_stakers = in let+ inc = Incremental.begin_construction b in let state = Incremental.validation_state inc in - let ctxt = state.ctxt in + let ctxt = state.application_state.ctxt in (* Necessary to originate rollups. *) let ctxt = Alpha_context.Origination_nonce.init ctxt Operation_hash.zero in let ctxt = Alpha_context.Internal_for_tests.to_raw ctxt in diff --git a/src/proto_alpha/lib_protocol/validate_operation.ml b/src/proto_alpha/lib_protocol/validate.ml similarity index 82% rename from src/proto_alpha/lib_protocol/validate_operation.ml rename to src/proto_alpha/lib_protocol/validate.ml index 6c9a67ade92a297528a7f97e548a0046fd08d6f6..67b498846abfec6b26e842d4311fdbbb8150fd4c 100644 --- a/src/proto_alpha/lib_protocol/validate_operation.ml +++ b/src/proto_alpha/lib_protocol/validate.ml @@ -25,17 +25,14 @@ open Alpha_context -(** {2 Definition and initialization of [validate_operation_info] and - [validate_operation_state]} +(** {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 in mempool mode; they are never put in the - storage. *) + 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 and mempool, we - compute them once and for all at the beginning of the - block/mempool. + 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 @@ -182,7 +179,7 @@ end) These fields are used to enforce that we do not validate the same operation multiple times. - Note that as part of {!validate_operation_state}, these maps live + Note that as part of {!state}, these maps live in memory. They are not explicitly bounded here, however: - In block validation mode, they are bounded by the number of @@ -227,7 +224,7 @@ type manager_state = { (1M). The operation hash lets us indicate the conflicting operation in the {!Manager_restriction} error. - Note that as part of {!validate_operation_state}, this map + Note that as part of {!state}, this map lives in memory. It is not explicitly bounded here, however: - In block validation mode, it is bounded by the number of @@ -246,22 +243,50 @@ let init_manager_state ctxt = remaining_block_gas = Gas.Arith.fp (Constants.hard_gas_limit_per_block ctxt); } +(** Mode-dependent information needed in final checks. *) +type application_info = { + fitness : Fitness.t; + block_producer : public_key_hash; + payload_producer : public_key_hash; + predecessor_hash : Block_hash.t; + block_data_contents : Block_header.contents; +} + (** Circumstances in which operations are validated: - - [Block]: covers both the (full or partial) validation of a - preexisting block, and the construction of a new block. Corresponds - to [Application], [Partial_application], and [Full_construction] of - {!Main.validation_mode}. + - [Application] is used for the validation of preexisting block. + Corresponds to [Application] of {!Main.validation_mode}. + + - [Partial_application] is used to partially validate preexisting + block. Corresponds to [Partial_application] of + {!Main.validation_mode}. - - [Mempool]: is used by the mempool (either directly or through - the plugin). Corresponds to [Partial_construction] of - {!Main.validation_mode}. + - [Construction] is used for the construction of a new block. + Corresponds to [Full_construction] of {!Main.validation_mode}. + + - [Mempool] is used by the mempool (either directly or through the + plugin). Corresponds to [Partial_construction] of + {!Main.validation_mode}. If you add a new mode, please make sure that it has a way to bound - the size of the map {!recfield:managers_seen}. *) -type mode = Block | Mempool + the size of the map {!recfield:managers_seen}. *) +type mode = + | Application of application_info + | Partial_application of application_info + | Construction of { + predecessor_round : Round.t; + predecessor_hash : Block_hash.t; + round : Round.t; + block_data_contents : Block_header.contents; + block_producer : public_key_hash; + payload_producer : public_key_hash; + } + | Mempool -type validate_operation_info = { +(** {2 Definition and initialization of [info] and + [state]} *) + +type info = { ctxt : t; (** The context at the beginning of the block or mempool. *) mode : mode; chain_id : Chain_id.t; (** Needed for signature checks. *) @@ -270,36 +295,43 @@ type validate_operation_info = { manager_info : manager_info; } -type validate_operation_state = { +type state = { consensus_state : consensus_state; voting_state : voting_state; anonymous_state : anonymous_state; manager_state : manager_state; + op_count : int; + recorded_operations_rev : Operation_hash.t list; + last_op_validation_pass : int option; } -let init_validate_operation_info ctxt mode chain_id - all_expected_consensus_characteritics = +type validation_state = {info : info; state : state} + +let init_info ctxt mode chain_id all_expected_consensus_characteristics = { ctxt; mode; chain_id; current_level = Level.current ctxt; consensus_info = - init_consensus_info ctxt all_expected_consensus_characteritics; + init_consensus_info ctxt all_expected_consensus_characteristics; manager_info = init_manager_info ctxt; } -let init_validate_operation_state ctxt = +let init_info ctxt mode chain_id all_expected_consensus_characteristics = + init_info ctxt mode chain_id all_expected_consensus_characteristics + +let init_state ctxt = { consensus_state = empty_consensus_state; voting_state = empty_voting_state; anonymous_state = empty_anonymous_state; manager_state = init_manager_state ctxt; + op_count = 0; + recorded_operations_rev = []; + last_op_validation_pass = None; } -(* See mli file. *) -type stamp = Operation_validated_stamp - (** Validation of consensus operations (validation pass [0]): preendorsement, endorsement, and dal_slot_availability. *) module Consensus = struct @@ -1596,7 +1628,7 @@ module Manager = struct let check_gas_limit_and_consume_from_block_gas vi ~remaining_block_gas ~gas_limit = (match vi.mode with - | Block -> fun res -> res + | Application _ | Partial_application _ | Construction _ -> fun res -> res | Mempool -> (* [Gas.check_limit_and_consume_from_block_gas] will only raise a "temporary" error, however when @@ -1839,7 +1871,7 @@ module Manager = struct contents_list] if [contents_list] were an ordinary [list]. *) let rec validate_contents_list : type kind. - validate_operation_info -> + info -> batch_state -> kind Kind.manager contents_list -> batch_state tzresult Lwt.t = @@ -1852,7 +1884,7 @@ module Manager = struct validate_contents_list vi batch_state tail (** Return the new value that [remaining_block_gas] should have in - [validate_operation_state] after the validation of a manager + [state] after the validation of a manager operation: - In [Block] (ie. block validation or block full construction) @@ -1860,12 +1892,13 @@ module Manager = struct the gas from the validated operation has been subtracted. - In [Mempool] mode, the [remaining_block_gas] in - [validate_operation_state] should remain unchanged. Indeed, we + [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 - | Block -> batch_state.remaining_block_gas + | Application _ | Partial_application _ | Construction _ -> + batch_state.remaining_block_gas | Mempool -> vs.manager_state.remaining_block_gas let validate_manager_operation vi vs ~should_check_signature source oph @@ -1941,7 +1974,7 @@ module Manager = struct in let remaining_block_gas = match vi.mode with - | Block -> + | Application _ | Partial_application _ | Construction _ -> let gas_limit = sum_batch_gas_limit Gas.Arith.zero @@ -1958,18 +1991,63 @@ module Manager = struct end let init_info_and_state ctxt mode chain_id all_expected_consensus_features = - let vi = - init_validate_operation_info + let info = init_info ctxt mode chain_id all_expected_consensus_features in + let state = init_state ctxt in + {info; state} + +(* Pre-condition: Shell block headers' checks have already been done. + These checks must ensure that: + - the block header level is the succ of the predecessor block level + - the timestamp of the predecessor is lower than the current block's + - the fitness of the block is greater than its predecessor's + - the number of operations by validation passes does not exceed the quota + established by the protocol + - the size of an operation does not exceed [max_operation_data_length] +*) +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 predecessor_round = Fitness.predecessor_round fitness in + let round = Fitness.round fitness in + let current_level = Level.current ctxt in + let* ctxt, _slot, (block_producer_pk, block_producer) = + Stake_distribution.baking_rights_owner ctxt current_level ~round + in + let*? () = + Block_header.begin_validate_block_header + ~block_header + ~chain_id + ~predecessor_timestamp + ~predecessor_round + ~fitness + ~timestamp:block_header.shell.timestamp + ~delegate_pk:block_producer_pk + ~round_durations:(Constants.round_durations ctxt) + ~proof_of_work_threshold:(Constants.proof_of_work_threshold ctxt) + ~expected_commitment:current_level.expected_commitment + in + let* () = Consensus.check_frozen_deposits_are_positive ctxt block_producer in + let* ctxt, _slot, (_payload_producer_pk, payload_producer) = + Stake_distribution.baking_rights_owner ctxt - mode - chain_id - all_expected_consensus_features + current_level + ~round:block_header.protocol_data.contents.payload_round + in + let payload_hash = block_header.protocol_data.contents.payload_hash in + let predecessor_hash = block_header.shell.predecessor in + let application_info = + { + fitness; + block_producer; + payload_producer; + predecessor_hash; + block_data_contents = block_header.protocol_data.contents; + } + in + let mode = + if is_partial then Partial_application application_info + else Application application_info in - let vs = init_validate_operation_state ctxt in - (vi, vs) - -let begin_block_validation ctxt chain_id ~predecessor_level ~predecessor_round - ~predecessor_hash fitness payload_hash = let all_expected_consensus_features = Consensus.expected_features_for_block_validation ctxt @@ -1979,23 +2057,85 @@ let begin_block_validation ctxt chain_id ~predecessor_level ~predecessor_round ~predecessor_round ~predecessor_hash in - init_info_and_state ctxt Block chain_id all_expected_consensus_features - -let begin_block_construction ctxt chain_id ~predecessor_level ~predecessor_round - ~predecessor_hash round payload_hash = + return + (init_info_and_state ctxt mode chain_id all_expected_consensus_features) + +let begin_partial_application ~ancestor_context chain_id ~predecessor_level + ~predecessor_timestamp (block_header : Block_header.t) fitness = + begin_application + ancestor_context + chain_id + ~predecessor_level + ~predecessor_timestamp + block_header + fitness + ~is_partial:true + +let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp + (block_header : Block_header.t) fitness = + begin_application + ctxt + chain_id + ~predecessor_level + ~predecessor_timestamp + block_header + fitness + ~is_partial:false + +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 round_durations = Constants.round_durations ctxt in + let timestamp = Timestamp.current ctxt in + let*? () = + Block_header.check_timestamp + round_durations + ~timestamp + ~round + ~predecessor_timestamp + ~predecessor_round + in + let current_level = Level.current ctxt in + let* ctxt, _slot, (_block_producer_pk, block_producer) = + Stake_distribution.baking_rights_owner ctxt current_level ~round + in + let* () = Consensus.check_frozen_deposits_are_positive ctxt block_producer in + let* ctxt, _slot, (_payload_producer_pk, payload_producer) = + Stake_distribution.baking_rights_owner + ctxt + current_level + ~round:header_contents.payload_round + in let all_expected_consensus_features = Consensus.expected_features_for_block_construction ctxt round - payload_hash + header_contents.payload_hash ~predecessor_level ~predecessor_round ~predecessor_hash in - init_info_and_state ctxt Block chain_id all_expected_consensus_features + let validation_state = + init_info_and_state + ctxt + (Construction + { + predecessor_round; + predecessor_hash; + round; + block_data_contents = header_contents; + block_producer; + payload_producer; + }) + chain_id + all_expected_consensus_features + in + return validation_state -let begin_mempool ctxt chain_id ~predecessor_level ~predecessor_round - ~predecessor_hash:_ ~grandparent_round = +let begin_partial_construction ctxt chain_id ~predecessor_level + ~predecessor_round ~predecessor_hash:_ ~grandparent_round = + let open Lwt_result_syntax in let all_expected_consensus_features = Consensus.expected_features_for_mempool ctxt @@ -2003,7 +2143,10 @@ let begin_mempool ctxt chain_id ~predecessor_level ~predecessor_round ~predecessor_round ~grandparent_round in - init_info_and_state ctxt Mempool chain_id all_expected_consensus_features + let validation_state = + init_info_and_state ctxt Mempool chain_id all_expected_consensus_features + in + return validation_state let begin_no_predecessor_info ctxt chain_id = let all_expected_consensus_features = @@ -2016,62 +2159,262 @@ let begin_no_predecessor_info ctxt chain_id = in init_info_and_state ctxt Mempool chain_id all_expected_consensus_features -let validate_operation (vi : validate_operation_info) - (vs : validate_operation_state) ?(should_check_signature = true) oph - (type kind) (operation : kind 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 check_validation_pass_consistency vi vs validation_pass = let open Lwt_tzresult_syntax in - let* vs = - match operation.protocol_data.contents with - | Single (Preendorsement _) -> - Consensus.validate_preendorsement - vi - vs - ~should_check_signature - operation - | Single (Endorsement _) -> - Consensus.validate_endorsement vi vs ~should_check_signature operation - | Single (Dal_slot_availability _) -> - Consensus.validate_dal_slot_availability - vi - vs - ~should_check_signature - operation - | Single (Proposals _) -> - Voting.validate_proposals vi vs ~should_check_signature oph operation - | Single (Ballot _) -> - Voting.validate_ballot vi vs ~should_check_signature oph operation - | Single (Activate_account _ as contents) -> - Anonymous.validate_activate_account vi vs oph contents - | Single (Double_preendorsement_evidence _ as contents) -> - Anonymous.validate_double_preendorsement_evidence vi vs oph contents - | Single (Double_endorsement_evidence _ as contents) -> - Anonymous.validate_double_endorsement_evidence vi vs oph contents - | Single (Double_baking_evidence _ as contents) -> - Anonymous.validate_double_baking_evidence vi vs oph contents - | Single (Seed_nonce_revelation _ as contents) -> - Anonymous.validate_seed_nonce_revelation vi vs contents - | Single (Vdf_revelation _ as contents) -> - Anonymous.validate_vdf_revelation vi vs contents - | Single (Manager_operation {source; _}) -> - Manager.validate_manager_operation - vi - vs - ~should_check_signature - source - oph - operation - | Cons (Manager_operation {source; _}, _) -> - Manager.validate_manager_operation - vi - vs - ~should_check_signature - source - oph - operation - | Single (Failing_noop _) -> fail Validate_errors.Failing_noop_error + match vi.mode with + | Mempool | Construction _ -> return vs + | Application _ | Partial_application _ -> ( + match (vs.last_op_validation_pass, validation_pass) with + | None, validation_pass -> + return {vs with last_op_validation_pass = validation_pass} + | Some previous_vp, Some validation_pass -> + let* () = + fail_unless + Compare.Int.(previous_vp <= validation_pass) + (Validate_errors.Block.Inconsistent_validation_passes_in_block + {expected = previous_vp; provided = validation_pass}) + in + 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) = + let open Lwt_tzresult_syntax in + let validation_pass_opt = + Alpha_context.Operation.acceptable_pass packed_operation in - return (vs, Operation_validated_stamp) + let {shell; protocol_data = Operation_data protocol_data} = + packed_operation + in + let* state = + check_validation_pass_consistency info state validation_pass_opt + in + let state = record_operation 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 (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 + oph + operation + | Cons (Manager_operation {source; _}, _) -> + Manager.validate_manager_operation + info + state + ~should_check_signature + source + oph + operation + | Single (Failing_noop _) -> fail Validate_errors.Failing_noop_error) + in + return state + +let are_endorsements_required vi = + let open Lwt_result_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 + block. Therefore the block at the next level cannot contain + endorsements. *) + let level_position_in_protocol = + Raw_level.diff vi.current_level.level first_level + 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 + error_unless + Compare.Int.(provided >= required) + (Validate_errors.Block.Not_enough_endorsements {required; provided}) + +let finalize_validate_block_header vi vs checkable_payload_hash + (block_header_contents : Alpha_context.Block_header.contents) round fitness + = + let locked_round_evidence = + Option.map + (fun (preendorsement_round, preendorsement_count) -> + Block_header.{preendorsement_round; preendorsement_count}) + vs.consensus_state.locked_round_evidence + in + Block_header.finalize_validate_block_header + ~block_header_contents + ~round + ~fitness + ~checkable_payload_hash + ~locked_round_evidence + ~consensus_threshold:(Constants.consensus_threshold vi.ctxt) + +let compute_payload_hash (vs : state) + (block_header_contents : Alpha_context.Block_header.contents) predecessor = + let operations_hash = + Operation_list_hash.compute (List.rev vs.recorded_operations_rev) + in + Block_payload.hash + ~predecessor + block_header_contents.payload_round + operations_hash + +let finalize_block {info; 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 () + in + let block_payload_hash = + compute_payload_hash state block_data_contents predecessor_hash + in + let round = Fitness.round fitness in + let*? () = + finalize_validate_block_header + info + state + (Block_header.Expected_payload_hash block_payload_hash) + block_data_contents + round + fitness + in + return_unit + | Partial_application _ -> + let* are_endorsements_required = are_endorsements_required info in + let*? () = + if are_endorsements_required then check_endorsement_power info state + else ok () + 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 + in + let locked_round_evidence = state.consensus_state.locked_round_evidence in + let checkable_payload_hash = + match locked_round_evidence with + | Some _ -> Block_header.Expected_payload_hash block_payload_hash + | None -> + (* In full construction, when there is no locked round + evidence (and thus no preendorsements), the baker cannot + know the payload hash before selecting the operations. We + may dismiss checking the initially given + payload_hash. However, to be valid, the baker must patch + the resulting block header with the actual payload + hash. *) + Block_header.No_check + in + let* are_endorsements_required = are_endorsements_required info in + let*? () = + if are_endorsements_required then check_endorsement_power info state + else ok () + in + let* fitness = + let locked_round = + match locked_round_evidence with + | None -> None + | Some (preendorsement_round, _power) -> Some preendorsement_round + in + let level = (Level.current info.ctxt).level in + let*? fitness = + Fitness.create ~level ~round ~predecessor_round ~locked_round + in + return fitness + in + let*? () = + finalize_validate_block_header + info + state + checkable_payload_hash + block_data_contents + round + fitness + in + return_unit + | 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 = Manager.remove_manager_operation +let remove_manager_operation {info; state} = + Manager.remove_manager_operation info state diff --git a/src/proto_alpha/lib_protocol/validate_operation.mli b/src/proto_alpha/lib_protocol/validate.mli similarity index 71% rename from src/proto_alpha/lib_protocol/validate_operation.mli rename to src/proto_alpha/lib_protocol/validate.mli index b67b913eb5b069fbbd41a5358dddc0c3cdc7b74d..5d2bccf457c6789685a5ddc8507fe69412cd95fe 100644 --- a/src/proto_alpha/lib_protocol/validate_operation.mli +++ b/src/proto_alpha/lib_protocol/validate.mli @@ -23,100 +23,101 @@ (* *) (*****************************************************************************) -(** 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. +(** 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. Most elements in this module are either used or wrapped in the - {!Main} module. *) + {!Main} module. *) -(** Static information needed in {!validate_operation}. +(** Static information needed by {!validate_operation} or for a block + validation. It lives in memory, not in the storage. *) -type validate_operation_info +type info -(** State used and modified by {!validate_operation}. +(** State used and modified by {!validate_operation} or by a block + validation. It lives in memory, not in the storage. *) -type validate_operation_state +type state + +type validation_state = {info : info; state : state} open Alpha_context -(** Initialize the {!validate_operation_info} and - {!validate_operation_state} for the validation of an existing block - (in preparation for its future application). *) -val begin_block_validation : +(** Initialize the {!info} and {!state} for the validation of an + existing block (in preparation for its future application). *) +val begin_application : context -> Chain_id.t -> predecessor_level:Level.t -> - predecessor_round:Round.t -> - predecessor_hash:Block_hash.t -> + predecessor_timestamp:Time.t -> + Block_header.t -> + Fitness.t -> + validation_state tzresult Lwt.t + +(** Initialize the {!info} and {!state} for the partial validation of + an existing block. *) +val begin_partial_application : + ancestor_context:context -> + Chain_id.t -> + predecessor_level:Level.t -> + predecessor_timestamp:Time.t -> + Block_header.t -> Fitness.t -> - Block_payload_hash.t -> - validate_operation_info * validate_operation_state + validation_state tzresult Lwt.t -(** Initialize the {!validate_operation_info} and - {!validate_operation_state} for the construction of a fresh - block. *) -val begin_block_construction : +(** Initialize the {!info} and {!state} for the full + construction of a fresh block. *) +val begin_full_construction : context -> Chain_id.t -> predecessor_level:Level.t -> predecessor_round:Round.t -> + predecessor_timestamp:Time.t -> predecessor_hash:Block_hash.t -> Round.t -> - Block_payload_hash.t -> - validate_operation_info * validate_operation_state + Block_header.contents -> + validation_state tzresult Lwt.t -(** Initialize the {!validate_operation_info} and - {!validate_operation_state} for a mempool. *) -val begin_mempool : +(** Initialize the {!info} and {!state} for the partial + construction use mainly to implement the mempool. *) +val begin_partial_construction : context -> Chain_id.t -> predecessor_level:Level.t -> predecessor_round:Round.t -> predecessor_hash:Block_hash.t -> grandparent_round:Round.t -> - validate_operation_info * validate_operation_state - -(** Initialize the {!validate_operation_info} and - {!validate_operation_state} without providing any predecessor - information. This will cause any preendorsement or endorsement - operation to fail, since we lack the information needed to validate - it. *) -val begin_no_predecessor_info : - context -> Chain_id.t -> validate_operation_info * validate_operation_state + validation_state tzresult Lwt.t -(** A receipt to guarantee that an operation is always validated - before it is applied. - - Indeed, some functions in {!Apply} require a value of this type, - which may only be created by calling {!validate_operation} (or a - function in {!TMP_for_plugin}). *) -type stamp +(** Initialize the {!info} and {!state} without providing any + predecessor information. This will cause any preendorsement or + endorsement operation to fail, since we lack the information needed + to validate it. *) +val begin_no_predecessor_info : context -> Chain_id.t -> validation_state (** Check the validity of the given operation; return an updated - {!validate_operation_state}, and a {!stamp} attesting that the - operation has been validated. + {!state}. An operation is valid if it may be included in a block without causing the block's application to fail. The purpose of this function is to decide validity quickly, that is, without trying to actually apply the operation (ie. compute modifications to the - context: see {!Apply.apply_operation}) and see whether it causes an - error. + context: see {!Apply.apply_operation}) and see whether it causes + an error. An operation's validity may be checked in different situations: when we receive a block from a peer or we are constructing a fresh block, we validate each operation in the block right before trying to apply it; when a mempool receives an operation, it validates it - to decide whether the operation should be propagated (note that for - now, this only holds for manager operations, since - [validate_operation] is not impleted yet for other operations: see - below). See {!type:mode}. + to decide whether the operation should be propagated (note that + for now, this only holds for manager operations, since + [validate_operation] is not implemented yet for other operations: + see below). See {!type:mode}. - The [validate_operation_info] contains every information we need + The [info] contains every information we need about the status of the chain to validate an operation, notably the context (of type {!Alpha_context.t}) at the end of the previous block. This context is never updated by the validation of @@ -129,7 +130,7 @@ type stamp [Error Manager_restriction] if another operation by the same manager has already been validated in the same block or mempool. In order to track this kind of operation incompatibilities, we use a - [validate_operation_state] with minimal information that gets + [state] with minimal information that gets updated during validation. For a manager operation, validity is solvability, ie. it must be @@ -162,12 +163,16 @@ type stamp excludes signature checks: see its documentation in [lib_plugin/RPC.Scripts.S.run_operation]. *) val validate_operation : - validate_operation_info -> - validate_operation_state -> + validation_state -> ?should_check_signature:bool -> Operation_hash.t -> - 'kind operation -> - (validate_operation_state * stamp) tzresult Lwt.t + Alpha_context.packed_operation -> + state tzresult Lwt.t + +(** 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}. @@ -180,7 +185,4 @@ val validate_operation : This function will be replaced with a generic function [remove_operation] in the future. *) val remove_manager_operation : - validate_operation_info -> - validate_operation_state -> - 'a Kind.manager operation -> - validate_operation_state + 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 eb7e00753be8eb4f407a8b23eed5b55dea0e4293..fba200ec512967003ed6539dcf2a3c225887a9e2 100644 --- a/src/proto_alpha/lib_protocol/validate_errors.ml +++ b/src/proto_alpha/lib_protocol/validate_errors.ml @@ -425,7 +425,7 @@ module Voting = struct (* Shared voting errors *) register_error_kind `Temporary - ~id:"validate_operation.wrong_voting_period_index" + ~id:"validate.operation.wrong_voting_period_index" ~title:"Wrong voting period index" ~description: "The voting operation contains a voting period index different from \ @@ -447,7 +447,7 @@ module Voting = struct Wrong_voting_period_index {expected; provided}) ; register_error_kind `Temporary - ~id:"validate_operation.wrong_voting_period_kind" + ~id:"validate.operation.wrong_voting_period_kind" ~title:"Wrong voting period kind" ~description: "The voting operation is incompatible the current voting period kind." @@ -474,7 +474,7 @@ module Voting = struct let description = "The delegate is not in the vote listings." in register_error_kind `Temporary - ~id:"validate_operation.source_not_in_vote_listings" + ~id:"validate.operation.source_not_in_vote_listings" ~title:"Source not in vote listings" ~description ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) @@ -486,7 +486,7 @@ module Voting = struct let description = "Proposal list cannot be empty." in register_error_kind `Permanent - ~id:"validate_operation.empty_proposals" + ~id:"validate.operation.empty_proposals" ~title:"Empty proposals" ~description ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) @@ -495,7 +495,7 @@ module Voting = struct (fun () -> Empty_proposals) ; register_error_kind `Permanent - ~id:"validate_operation.proposals_contain_duplicate" + ~id:"validate.operation.proposals_contain_duplicate" ~title:"Proposals contain duplicate" ~description:"The list of proposals contains a duplicate element." ~pp:(fun ppf proposal -> @@ -514,7 +514,7 @@ module Voting = struct in register_error_kind `Branch - ~id:"validate_operation.too_many_proposals" + ~id:"validate.operation.too_many_proposals" ~title:"Too many proposals" ~description ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) @@ -523,7 +523,7 @@ module Voting = struct (fun () -> Too_many_proposals) ; register_error_kind `Branch - ~id:"validate_operation.already_proposed" + ~id:"validate.operation.already_proposed" ~title:"Already proposed" ~description: "The delegate has already submitted one of the operation's proposals." @@ -538,7 +538,7 @@ module Voting = struct (fun proposal -> Already_proposed {proposal}) ; register_error_kind `Temporary - ~id:"validate_operation.conflict_too_many_proposals" + ~id:"validate.operation.conflict_too_many_proposals" ~title:"Conflict too many proposals" ~description: "The delegate exceeded the maximum number of allowed proposals due to, \ @@ -601,7 +601,7 @@ module Voting = struct }) ; register_error_kind `Temporary - ~id:"validate_operation.conflict_already_proposed" + ~id:"validate.operation.conflict_already_proposed" ~title:"Conflict already proposed" ~description: "The delegate has already submitted one of the operation's proposals \ @@ -627,7 +627,7 @@ module Voting = struct Conflict_already_proposed {proposal; conflicting_operation}) ; register_error_kind `Branch - ~id:"validate_operation.conflicting_dictator_proposals" + ~id:"validate.operation.conflicting_dictator_proposals" ~title:"Conflicting dictator proposals" ~description: "The current block/mempool already contains a testnest dictator \ @@ -648,7 +648,7 @@ module Voting = struct in register_error_kind `Permanent - ~id:"validate_operation.testnet_dictator_multiple_proposals" + ~id:"validate.operation.testnet_dictator_multiple_proposals" ~title:"Testnet dictator multiple proposals" ~description ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) @@ -661,7 +661,7 @@ module Voting = struct in register_error_kind `Branch - ~id:"validate_operation.testnet_dictator_conflicting_operation" + ~id:"validate.operation.testnet_dictator_conflicting_operation" ~title:"Testnet dictator conflicting operation" ~description ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) @@ -687,7 +687,7 @@ module Voting = struct (* Ballot errors *) register_error_kind `Branch - ~id:"validate_operation.ballot_for_wrong_proposal" + ~id:"validate.operation.ballot_for_wrong_proposal" ~title:"Ballot for wrong proposal" ~description:"Ballot provided for a proposal that is not the current one." ~pp:(fun ppf (current, submitted) -> @@ -714,7 +714,7 @@ module Voting = struct in register_error_kind `Branch - ~id:"validate_operation.already_submitted_a_ballot" + ~id:"validate.operation.already_submitted_a_ballot" ~title:"Already submitted a ballot" ~description ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) @@ -723,7 +723,7 @@ module Voting = struct (fun () -> Already_submitted_a_ballot) ; register_error_kind `Temporary - ~id:"validate_operation.conflicting_ballot" + ~id:"validate.operation.conflicting_ballot" ~title:"Conflicting ballot" ~description: "The delegate has already submitted a ballot in a previously validated \ @@ -765,7 +765,7 @@ module Anonymous = struct let () = register_error_kind `Permanent - ~id:"validate_operation.invalid_activation" + ~id:"validate.operation.invalid_activation" ~title:"Invalid activation" ~description: "The given key and secret do not correspond to any existing \ @@ -782,7 +782,7 @@ module Anonymous = struct (fun pkh -> Invalid_activation {pkh}) ; register_error_kind `Branch - ~id:"validate_operation.conflicting_activation" + ~id:"validate.operation.conflicting_activation" ~title:"Account already activated in current validation_state" ~description: "The account has already been activated by a previous operation in the \ @@ -895,7 +895,7 @@ module Anonymous = struct {hash1; level1; round1; hash2; level2; round2}) ; register_error_kind `Permanent - ~id:"validate_operation.block.invalid_denunciation" + ~id:"validate.operation.block.invalid_denunciation" ~title:"Invalid denunciation" ~description:"A denunciation is malformed" ~pp:(fun ppf kind -> @@ -909,7 +909,7 @@ module Anonymous = struct (fun kind -> Invalid_denunciation kind) ; register_error_kind `Permanent - ~id:"validate_operation.block.inconsistent_denunciation" + ~id:"validate.operation.block.inconsistent_denunciation" ~title:"Inconsistent denunciation" ~description: "A denunciation operation is inconsistent (two distinct delegates)" @@ -936,7 +936,7 @@ module Anonymous = struct Inconsistent_denunciation {kind; delegate1; delegate2}) ; register_error_kind `Branch - ~id:"validate_operation.already_denounced" + ~id:"validate.operation.already_denounced" ~title:"Already denounced" ~description:"The same denunciation has already been validated." ~pp:(fun ppf (kind, delegate, level) -> @@ -961,7 +961,7 @@ module Anonymous = struct (fun (kind, delegate, level) -> Already_denounced {kind; delegate; level}) ; register_error_kind `Branch - ~id:"validate_operation.conflicting_denunciation" + ~id:"validate.operation.conflicting_denunciation" ~title:"Conflicting denunciation in current validation state" ~description: "The same denunciation has already been validated in the current \ @@ -993,7 +993,7 @@ module Anonymous = struct Conflicting_denunciation {kind; delegate; level; hash}) ; register_error_kind `Temporary - ~id:"validate_operation.block.too_early_denunciation" + ~id:"validate.operation.block.too_early_denunciation" ~title:"Too early denunciation" ~description:"A denunciation is too far in the future" ~pp:(fun ppf (kind, level, current) -> @@ -1020,7 +1020,7 @@ module Anonymous = struct Too_early_denunciation {kind; level; current}) ; register_error_kind `Permanent - ~id:"validate_operation.block.outdated_denunciation" + ~id:"validate.operation.block.outdated_denunciation" ~title:"Outdated denunciation" ~description:"A denunciation is outdated." ~pp:(fun ppf (kind, level, last_cycle) -> @@ -1051,7 +1051,7 @@ module Anonymous = struct let () = register_error_kind `Branch - ~id:"validate_operation.conflicting_nonce_revelation" + ~id:"validate.operation.conflicting_nonce_revelation" ~title:"Conflicting nonce revelation in the current validation state)." ~description: "A revelation for the same nonce has already been validated for the \ @@ -1080,7 +1080,7 @@ module Manager = struct let () = register_error_kind `Temporary - ~id:"validate_operation.manager_restriction" + ~id:"validate.operation.manager_restriction" ~title:"Manager restriction" ~description: "An operation with the same manager has already been validated in the \ @@ -1106,7 +1106,7 @@ module Manager = struct in register_error_kind `Permanent - ~id:"validate_operation.inconsistent_sources" + ~id:"validate.operation.inconsistent_sources" ~title:"Inconsistent sources in operation batch" ~description:inconsistent_sources_description ~pp:(fun ppf () -> @@ -1120,7 +1120,7 @@ module Manager = struct in register_error_kind `Permanent - ~id:"validate_operation.inconsistent_counters" + ~id:"validate.operation.inconsistent_counters" ~title:"Inconsistent counters in operation" ~description:inconsistent_counters_description ~pp:(fun ppf () -> @@ -1134,7 +1134,7 @@ module Manager = struct in register_error_kind `Permanent - ~id:"validate_operation.incorrect_reveal_position" + ~id:"validate.operation.incorrect_reveal_position" ~title:"Incorrect reveal position" ~description:incorrect_reveal_description ~pp:(fun ppf () -> Format.fprintf ppf "%s" incorrect_reveal_description) @@ -1143,7 +1143,7 @@ module Manager = struct (fun () -> Incorrect_reveal_position) ; register_error_kind `Permanent - ~id:"validate_operation.insufficient_gas_for_manager" + ~id:"validate.operation.insufficient_gas_for_manager" ~title:"Not enough gas for initial manager cost" ~description: (Format.asprintf @@ -1161,7 +1161,7 @@ module Manager = struct in register_error_kind `Permanent - ~id:"validate_operation.gas_quota_exceeded_init_deserialize" + ~id:"validate.operation.gas_quota_exceeded_init_deserialize" ~title:"Not enough gas for initial deserialization of script expressions" ~description:gas_deserialize_description ~pp:(fun ppf () -> Format.fprintf ppf "%s" gas_deserialize_description) @@ -1170,7 +1170,7 @@ module Manager = struct (fun () -> Gas_quota_exceeded_init_deserialize) ; register_error_kind `Permanent - ~id:"validate_operation.tx_rollup_is_disabled" + ~id:"validate.operation.tx_rollup_is_disabled" ~title:"Tx rollup is disabled" ~description:"Cannot originate a tx rollup as it is disabled." ~pp:(fun ppf () -> @@ -1186,7 +1186,7 @@ module Manager = struct in register_error_kind `Permanent - ~id:"validate_operation.sc_rollup_disabled" + ~id:"validate.operation.sc_rollup_disabled" ~title:"Smart contract rollups are disabled" ~description:scoru_disabled_description ~pp:(fun ppf () -> Format.fprintf ppf "%s" scoru_disabled_description) @@ -1213,10 +1213,62 @@ let () = let description = "A failing_noop operation can never be validated." in register_error_kind `Permanent - ~id:"validate_operation.failing_noop_error" + ~id:"validate.operation.failing_noop_error" ~title:"Failing_noop error" ~description ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) Data_encoding.empty (function Failing_noop_error -> Some () | _ -> None) (fun () -> Failing_noop_error) + +module Block = struct + type error += + | Not_enough_endorsements of {required : int; provided : int} + | Inconsistent_validation_passes_in_block of { + expected : int; + provided : int; + } + + let () = + register_error_kind + `Permanent + ~id:"validate.block.not_enough_endorsements" + ~title:"Not enough endorsements" + ~description: + "The block being validated does not include the required minimum \ + number of endorsements." + ~pp:(fun ppf (required, provided) -> + Format.fprintf + ppf + "Wrong number of endorsements (%i), at least %i are expected" + provided + required) + Data_encoding.(obj2 (req "required" int31) (req "provided" int31)) + (function + | Not_enough_endorsements {required; provided} -> + Some (required, provided) + | _ -> None) + (fun (required, provided) -> Not_enough_endorsements {required; provided}) ; + register_error_kind + `Permanent + ~id:"validate.block.inconsistent_validation_passes_in_block" + ~title:"Inconsistent validation passes in block" + ~description: + "Validation of operation should be ordered by their validation passes \ + in a block." + ~pp:(fun ppf (expected, provided) -> + Format.fprintf + ppf + "Validation of operation should be ordered by their validation \ + passes in a block. Got an operation with validation pass: %d while \ + the last validated operation had the validation pass %d." + provided + expected) + Data_encoding.(obj2 (req "expected" int31) (req "provided" int31)) + (function + | Inconsistent_validation_passes_in_block {expected; provided} -> + Some (expected, provided) + | _ -> None) + (fun (expected, provided) -> + Inconsistent_validation_passes_in_block {expected; provided}) +end diff --git a/src/proto_alpha/lib_protocol/validate_errors.mli b/src/proto_alpha/lib_protocol/validate_errors.mli index d83d9fdb111f44937cb792019a30d590cea58ed7..f642f618e0354fece609e3381192301170b82d14 100644 --- a/src/proto_alpha/lib_protocol/validate_errors.mli +++ b/src/proto_alpha/lib_protocol/validate_errors.mli @@ -184,3 +184,12 @@ module Manager : sig end type error += Failing_noop_error + +module Block : sig + type error += + | Not_enough_endorsements of {required : int; provided : int} + | Inconsistent_validation_passes_in_block of { + expected : int; + provided : int; + } +end