From 23d941b6d87415d70726a5cfe1a822dea1a373e7 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 12 Sep 2022 17:37:10 +0200 Subject: [PATCH 01/12] Proto: remove label ancestor_context in Validate.begin_partial_application --- src/proto_alpha/lib_protocol/main.ml | 2 +- src/proto_alpha/lib_protocol/validate.ml | 16 ++++++++-------- src/proto_alpha/lib_protocol/validate.mli | 9 +++++++-- 3 files changed, 16 insertions(+), 11 deletions(-) diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 2f0c42c1788b..7e24584d75a6 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -198,7 +198,7 @@ let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp let*? fitness = Fitness.from_raw block_header.shell.fitness in let* validity_state = Validate.begin_partial_application - ~ancestor_context + ancestor_context chain_id ~predecessor_level ~predecessor_timestamp diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml index 4c2a0549fe43..906a8962db55 100644 --- a/src/proto_alpha/lib_protocol/validate.ml +++ b/src/proto_alpha/lib_protocol/validate.ml @@ -2612,8 +2612,8 @@ let init_validation_state ctxt mode chain_id all_expected_consensus_features 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 begin_any_application ctxt chain_id ~predecessor_level + ~predecessor_timestamp (block_header : Block_header.t) fitness ~is_partial = let open Lwt_tzresult_syntax in let predecessor_round = Fitness.predecessor_round fitness in let round = Fitness.round fitness in @@ -2676,10 +2676,10 @@ let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp all_expected_consensus_features ~predecessor_level) -let begin_partial_application ~ancestor_context chain_id ~predecessor_level - ~predecessor_timestamp (block_header : Block_header.t) fitness = - begin_application - ancestor_context +let begin_partial_application ctxt chain_id ~predecessor_level + ~predecessor_timestamp block_header fitness = + begin_any_application + ctxt chain_id ~predecessor_level ~predecessor_timestamp @@ -2688,8 +2688,8 @@ let begin_partial_application ~ancestor_context chain_id ~predecessor_level ~is_partial:true let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp - (block_header : Block_header.t) fitness = - begin_application + block_header fitness = + begin_any_application ctxt chain_id ~predecessor_level diff --git a/src/proto_alpha/lib_protocol/validate.mli b/src/proto_alpha/lib_protocol/validate.mli index e38a68c5ef0e..f9f5fe0ca1f8 100644 --- a/src/proto_alpha/lib_protocol/validate.mli +++ b/src/proto_alpha/lib_protocol/validate.mli @@ -74,9 +74,14 @@ val begin_application : validation_state tzresult Lwt.t (** Initialize the {!info} and {!state} for the partial validation of - an existing block. *) + an existing block. + + Note that the given context may be based on an ancestor + block. Indeed, we may not have access to the predecessor context + when trying to quickly assess a series of blocks in a cousin branch + (multipass validation). *) val begin_partial_application : - ancestor_context:context -> + context -> Chain_id.t -> predecessor_level:Level.t -> predecessor_timestamp:Time.t -> -- GitLab From c6179a211c07d7b74c6bf90fd87dbbbfc997b4d9 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Tue, 20 Sep 2022 18:20:26 +0200 Subject: [PATCH 02/12] Proto: rename argument should_check_signature to check_signature in Validate.check_operation and Validate.validate_operation --- src/proto_alpha/lib_plugin/RPC.ml | 2 +- src/proto_alpha/lib_plugin/mempool.ml | 2 +- .../lib_protocol/mempool_validation.ml | 4 +- src/proto_alpha/lib_protocol/validate.ml | 99 +++++++++---------- src/proto_alpha/lib_protocol/validate.mli | 8 +- 5 files changed, 54 insertions(+), 61 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 440c7215fdf8..027684ba910d 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -852,8 +852,8 @@ module Scripts = struct let oph = Operation.hash_packed packed_operation in let validity_state = Validate.begin_no_predecessor_info context chain_id in Validate.validate_operation + ~check_signature:false validity_state - ~should_check_signature:false oph packed_operation >>=? fun _validate_operation_state -> diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 74c6c924cd38..8185c9cbe564 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -877,8 +877,8 @@ let proto_validate_operation validation_state oph ~nb_successful_prechecks let open Lwt_result_syntax in let*! res = Validate.validate_operation + ~check_signature:(nb_successful_prechecks <= 0) validation_state.validity_state - ~should_check_signature:(nb_successful_prechecks <= 0) oph operation in diff --git a/src/proto_alpha/lib_protocol/mempool_validation.ml b/src/proto_alpha/lib_protocol/mempool_validation.ml index 2debf1f8e6cb..8493f18a7e13 100644 --- a/src/proto_alpha/lib_protocol/mempool_validation.ml +++ b/src/proto_alpha/lib_protocol/mempool_validation.ml @@ -100,9 +100,7 @@ let add_operation ?(check_signature = true) let open Lwt_syntax in let {shell; protocol_data = Operation_data protocol_data} = packed_op in let operation : _ Alpha_context.operation = {shell; protocol_data} in - let* validate_result = - check_operation info ~should_check_signature:check_signature operation - in + let* validate_result = check_operation ~check_signature info operation in match validate_result with | Error err -> Lwt.return_error (Validation_error err) | Ok () -> ( diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml index 906a8962db55..f59a65bd6bdc 100644 --- a/src/proto_alpha/lib_protocol/validate.ml +++ b/src/proto_alpha/lib_protocol/validate.ml @@ -706,7 +706,7 @@ module Consensus = struct (Slot.Map.find consensus_content.slot slot_map) ~error:(trace_of_error (Wrong_slot_used_for_consensus_operation {kind})) - let check_preendorsement vi ~should_check_signature + let check_preendorsement vi ~check_signature (operation : Kind.preendorsement operation) = let open Lwt_tzresult_syntax in let (Single (Preendorsement consensus_content)) = @@ -736,7 +736,7 @@ module Consensus = struct check_frozen_deposits_are_positive vi.ctxt consensus_key.delegate in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature consensus_key.consensus_pk vi.chain_id @@ -811,10 +811,10 @@ module Consensus = struct in {vs with consensus_state = {vs.consensus_state with preendorsements_seen}} - (** Validates an endorsement pointing to the grandparent block. This + (** Validate an endorsement pointing to the grandparent block. This function will only be called in [Partial_construction] mode. *) - let check_grandparent_endorsement vi ~should_check_signature expected - operation (consensus_content : consensus_content) = + let check_grandparent_endorsement vi ~check_signature expected operation + (consensus_content : consensus_content) = let open Lwt_tzresult_syntax in let kind = Grandparent_endorsement in let level = Level.from_raw vi.ctxt consensus_content.level in @@ -825,7 +825,7 @@ module Consensus = struct check_consensus_features kind expected consensus_content operation in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature consensus_key.consensus_pk vi.chain_id @@ -894,7 +894,7 @@ module Consensus = struct (** Validate an endorsement pointing to the predecessor, aka a "normal" endorsement. Only this kind of endorsement may be found during block validation or construction. *) - let check_normal_endorsement vi ~should_check_signature + let check_normal_endorsement vi ~check_signature (operation : Kind.endorsement operation) = let open Lwt_tzresult_syntax in let (Single (Endorsement consensus_content)) = @@ -921,7 +921,7 @@ module Consensus = struct check_frozen_deposits_are_positive vi.ctxt consensus_key.delegate in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature consensus_key.consensus_pk vi.chain_id @@ -966,7 +966,7 @@ module Consensus = struct in {vs with consensus_state = {vs.consensus_state with endorsements_seen}} - let check_endorsement vi ~should_check_signature + let check_endorsement vi ~check_signature (operation : Kind.endorsement operation) = let open Lwt_tzresult_syntax in let (Single (Endorsement consensus_content)) = @@ -983,7 +983,7 @@ module Consensus = struct let* () = check_grandparent_endorsement vi - ~should_check_signature + ~check_signature expected_grandparent_endorsement operation (consensus_content : consensus_content) @@ -991,7 +991,7 @@ module Consensus = struct return Grandparent_endorsement | _ -> let* voting_power = - check_normal_endorsement vi ~should_check_signature operation + check_normal_endorsement vi ~check_signature operation in return (Normal_endorsement voting_power) @@ -1147,15 +1147,13 @@ module Consensus = struct them. *) check_round kind expected consensus_content) - let validate_preendorsement ~should_check_signature info operation_state - block_state oph (operation : Kind.preendorsement operation) = + let validate_preendorsement ~check_signature info operation_state block_state + oph (operation : Kind.preendorsement operation) = let open Lwt_tzresult_syntax in let (Single (Preendorsement consensus_content)) = operation.protocol_data.contents in - let* voting_power = - check_preendorsement info ~should_check_signature operation - in + let* voting_power = check_preendorsement info ~check_signature operation in let*? () = check_construction_preendorsement_round_consistency info @@ -1178,10 +1176,10 @@ module Consensus = struct let operation_state = add_preendorsement operation_state oph operation in return {info; operation_state; block_state} - let validate_endorsement ~should_check_signature info operation_state - block_state oph operation = + let validate_endorsement ~check_signature info operation_state block_state oph + operation = let open Lwt_tzresult_syntax in - let* kind = check_endorsement info ~should_check_signature operation in + let* kind = check_endorsement info ~check_signature operation in let*? () = check_endorsement_conflict operation_state oph operation |> wrap_endorsement_conflict @@ -1360,8 +1358,8 @@ module Voting = struct @return [Error Operation.Missing_signature] or [Error Operation.Invalid_signature] if the operation is unsigned or incorrectly signed. *) - let check_proposals vi ~should_check_signature - (operation : Kind.proposals operation) = + let check_proposals vi ~check_signature (operation : Kind.proposals operation) + = let open Lwt_tzresult_syntax in let (Single (Proposals {source; period; proposals})) = operation.protocol_data.contents @@ -1382,7 +1380,7 @@ module Voting = struct let*? () = check_count ~count_in_ctxt ~proposals_length in check_already_proposed vi.ctxt source proposals in - if should_check_signature then + if check_signature then (* Retrieving the public key should not fail as it *should* be called after checking that the delegate is in the vote listings (or is a testnet dictator), which implies that it @@ -1459,8 +1457,7 @@ module Voting = struct @return [Error Operation.Missing_signature] or [Error Operation.Invalid_signature] if the operation is unsigned or incorrectly signed. *) - let check_ballot vi ~should_check_signature - (operation : Kind.ballot operation) = + let check_ballot vi ~check_signature (operation : Kind.ballot operation) = let open Lwt_tzresult_syntax in let (Single (Ballot {source; period; proposal; ballot = _})) = operation.protocol_data.contents @@ -1472,7 +1469,7 @@ module Voting = struct let* () = check_current_proposal vi.ctxt proposal in let* () = check_source_has_not_already_voted vi.ctxt source in let* () = check_in_listings vi.ctxt source in - when_ should_check_signature (fun () -> + when_ check_signature (fun () -> (* Retrieving the public key cannot fail. Indeed, we have already checked that the delegate is in the vote listings, which implies that it is a manager with a revealed key. *) @@ -1880,7 +1877,7 @@ module Anonymous = struct in {vs with anonymous_state} - let check_drain_delegate info ~should_check_signature + let check_drain_delegate info ~check_signature (operation : Kind.drain_delegate Operation.t) = let open Lwt_tzresult_syntax in let (Single (Drain_delegate {delegate; destination; consensus_key})) = @@ -1938,7 +1935,7 @@ module Anonymous = struct {delegate; destination; min_amount}) in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature active_pk.consensus_pk info.chain_id operation else ok_unit in @@ -2189,7 +2186,7 @@ module Manager = struct key. This includes the case where the key ends up not being used because the signature check is skipped in {!validate_manager_operation} called with - [~should_check_signature:false]. Indeed, the mempool may use + [~check_signature:false]. Indeed, the mempool may use this argument when it has already checked the signature of the operation in the past; but if there has been a branch reorganization since then, the key might not be revealed in @@ -2480,7 +2477,7 @@ module Manager = struct in check_contents_list vi batch_state tail remaining_gas - let check_manager_operation vi ~should_check_signature + let check_manager_operation vi ~check_signature (operation : _ Kind.manager operation) remaining_block_gas = let open Lwt_tzresult_syntax in let contents_list = operation.protocol_data.contents in @@ -2491,7 +2488,7 @@ module Manager = struct check_contents_list vi batch_state contents_list remaining_block_gas in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature source_pk vi.chain_id operation else ok_unit in @@ -2575,13 +2572,13 @@ module Manager = struct in {vs with manager_state = {managers_seen}} - let validate_manager_operation ~should_check_signature info operation_state + let validate_manager_operation ~check_signature info operation_state block_state oph operation = let open Lwt_tzresult_syntax in let* gas_used = check_manager_operation info - ~should_check_signature + ~check_signature operation block_state.remaining_block_gas in @@ -2795,26 +2792,25 @@ let begin_no_predecessor_info ctxt chain_id = all_expected_consensus_features ~predecessor_level -let check_operation info ?(should_check_signature = true) (type kind) +let check_operation ?(check_signature = true) info (type kind) (operation : kind operation) : unit tzresult Lwt.t = let open Lwt_tzresult_syntax in match operation.protocol_data.contents with | Single (Preendorsement _) -> let* (_voting_power : int) = - Consensus.check_preendorsement info ~should_check_signature operation + Consensus.check_preendorsement info ~check_signature operation in return_unit | Single (Endorsement _) -> let* (_kind : Consensus.endorsement_kind) = - Consensus.check_endorsement info ~should_check_signature operation + Consensus.check_endorsement info ~check_signature operation in return_unit | Single (Dal_slot_availability _) -> Consensus.check_dal_slot_availability info operation | Single (Proposals _) -> - Voting.check_proposals info ~should_check_signature operation - | Single (Ballot _) -> - Voting.check_ballot info ~should_check_signature operation + Voting.check_proposals info ~check_signature operation + | Single (Ballot _) -> Voting.check_ballot info ~check_signature operation | Single (Activate_account _) -> Anonymous.check_activate_account info operation | Single (Double_preendorsement_evidence _) -> @@ -2824,7 +2820,7 @@ let check_operation info ?(should_check_signature = true) (type kind) | Single (Double_baking_evidence _) -> Anonymous.check_double_baking_evidence info operation | Single (Drain_delegate _) -> - Anonymous.check_drain_delegate info ~should_check_signature operation + Anonymous.check_drain_delegate info ~check_signature operation | Single (Seed_nonce_revelation _) -> Anonymous.check_seed_nonce_revelation info operation | Single (Vdf_revelation _) -> Anonymous.check_vdf_revelation info operation @@ -2835,7 +2831,7 @@ let check_operation info ?(should_check_signature = true) (type kind) let* (_remaining_gas : Gas.Arith.fp) = Manager.check_manager_operation info - ~should_check_signature + ~check_signature operation remaining_gas in @@ -2847,7 +2843,7 @@ let check_operation info ?(should_check_signature = true) (type kind) let* (_remaining_gas : Gas.Arith.fp) = Manager.check_manager_operation info - ~should_check_signature + ~check_signature operation remaining_gas in @@ -3045,8 +3041,9 @@ let record_operation vs ophash validation_pass_opt = recorded_operations_rev = ophash :: vs.recorded_operations_rev; } -let validate_operation {info; operation_state; block_state} - ?(should_check_signature = true) oph (packed_operation : packed_operation) = +let validate_operation ?(check_signature = true) + {info; operation_state; block_state} oph + (packed_operation : packed_operation) = let open Lwt_tzresult_syntax in let {shell; protocol_data = Operation_data protocol_data} = packed_operation @@ -3069,7 +3066,7 @@ let validate_operation {info; operation_state; block_state} match operation.protocol_data.contents with | Single (Preendorsement _) -> Consensus.validate_preendorsement - ~should_check_signature + ~check_signature info operation_state block_state @@ -3077,7 +3074,7 @@ let validate_operation {info; operation_state; block_state} operation | Single (Endorsement _) -> Consensus.validate_endorsement - ~should_check_signature + ~check_signature info operation_state block_state @@ -3096,7 +3093,7 @@ let validate_operation {info; operation_state; block_state} return {info; operation_state; block_state} | Single (Proposals _) -> let open Voting in - let* () = check_proposals info ~should_check_signature operation in + let* () = check_proposals info ~check_signature operation in let*? () = check_proposals_conflict operation_state oph operation |> wrap_proposals_conflict @@ -3105,7 +3102,7 @@ let validate_operation {info; operation_state; block_state} return {info; operation_state; block_state} | Single (Ballot _) -> let open Voting in - let* () = check_ballot info ~should_check_signature operation in + let* () = check_ballot info ~check_signature operation in let*? () = check_ballot_conflict operation_state oph operation |> wrap_ballot_conflict @@ -3164,9 +3161,7 @@ let validate_operation {info; operation_state; block_state} return {info; operation_state; block_state} | Single (Drain_delegate _) -> let open Anonymous in - let* () = - check_drain_delegate info ~should_check_signature operation - in + let* () = check_drain_delegate info ~check_signature operation in let*? () = check_drain_delegate_conflict operation_state oph operation |> wrap_drain_delegate_conflict operation @@ -3197,7 +3192,7 @@ let validate_operation {info; operation_state; block_state} return {info; operation_state; block_state} | Single (Manager_operation _) -> Manager.validate_manager_operation - ~should_check_signature + ~check_signature info operation_state block_state @@ -3205,7 +3200,7 @@ let validate_operation {info; operation_state; block_state} operation | Cons (Manager_operation _, _) -> Manager.validate_manager_operation - ~should_check_signature + ~check_signature info operation_state block_state diff --git a/src/proto_alpha/lib_protocol/validate.mli b/src/proto_alpha/lib_protocol/validate.mli index f9f5fe0ca1f8..cc994a613fff 100644 --- a/src/proto_alpha/lib_protocol/validate.mli +++ b/src/proto_alpha/lib_protocol/validate.mli @@ -168,7 +168,7 @@ val begin_no_predecessor_info : context -> Chain_id.t -> validation_state validation of such an operation must ensure that its application will fully succeed. - @param should_check_signature indicates whether the signature + @param check_signature indicates whether the signature check should happen. It defaults to [true] because the signature needs to be correct for the operation to be valid. This argument exists for special cases where it is acceptable to bypass this @@ -177,14 +177,14 @@ val begin_no_predecessor_info : context -> Chain_id.t -> validation_state - The mempool may keep track of operations whose signatures have already been checked: if such an operation needs to be validated again (typically when the head block changes), then the mempool may - call [validate_operation] with [should_check_signature:false]. + call [validate_operation] with [check_signature:false]. - The [run_operation] RPC provided by the plugin explicitly excludes signature checks: see its documentation in [lib_plugin/RPC.Scripts.S.run_operation]. *) val validate_operation : + ?check_signature:bool -> validation_state -> - ?should_check_signature:bool -> Operation_hash.t -> packed_operation -> validation_state tzresult Lwt.t @@ -194,7 +194,7 @@ val validate_operation : Note: Should only be called in mempool mode *) val check_operation : - info -> ?should_check_signature:bool -> 'kind operation -> unit tzresult Lwt.t + ?check_signature:bool -> info -> 'kind operation -> unit tzresult Lwt.t (** Check that the operation does not conflict with other operations already validated and included in the {!operation_conflict_state} -- GitLab From 86833732dbc26fb31cc56bb0e781273cc5b261d8 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Wed, 21 Sep 2022 11:45:47 +0200 Subject: [PATCH 03/12] Plugin/mempool: no longer retrieve info from Partial_construction mode Instead, store the proposal_round in the filter state. This will allow us to remove the predecessor_round field from the Partial_construction mode of the application_state in the next commit. And it prepares for the full removal of the application_state from the mempool plugin (keeping only the validation_state) that will come with the environment rework. --- src/proto_alpha/lib_plugin/mempool.ml | 108 ++++++++++++-------------- 1 file changed, 51 insertions(+), 57 deletions(-) diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 8185c9cbe564..e032a99be8d4 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -208,9 +208,18 @@ module ManagerOpWeightSet = Set.Make (struct let compare = compare_manager_op_weight end) +(** Static information to store in the filter state. *) +type state_info = { + grandparent_level_start : Timestamp.t; + round_zero_duration : Period.t; + proposal_round : Round.t; + alpha_ctxt : Alpha_context.t; + (** Protocol context at the initialization of the mempool filter. + Note that it never gets updated. *) +} + type state = { - grandparent_level_start : Timestamp.t option; - round_zero_duration : Period.t option; + state_info : state_info option; prechecked_manager_op_count : int; (** Number of prechecked manager operations. Invariants: @@ -231,8 +240,7 @@ type state = { let empty : state = { - grandparent_level_start = None; - round_zero_duration = None; + state_info = None; prechecked_manager_op_count = 0; prechecked_manager_ops = Operation_hash.Map.empty; prechecked_op_weights = ManagerOpWeightSet.empty; @@ -267,13 +275,16 @@ let init config ?(validation_state : validation_state option) ~predecessor () = >>?= fun proposal_round_offset -> Period.(add proposal_level_offset proposal_round_offset) >>?= fun proposal_offset -> - return + let state_info = { - empty with grandparent_level_start = - Some Timestamp.(predecessor_timestamp - proposal_offset); - round_zero_duration = Some round_zero_duration; - }) + Timestamp.(predecessor_timestamp - proposal_offset); + round_zero_duration; + proposal_round = predecessor_round; + alpha_ctxt = ctxt; + } + in + return {empty with state_info = Some state_info}) >|= Environment.wrap_tzresult let manager_prio p = `Low p @@ -757,50 +768,37 @@ let acceptable_op ~config ~round_durations ~round_zero_duration ~proposal_level acceptable *) acceptable ~drift ~op_earliest_ts ~now_timestamp -let pre_filter_far_future_consensus_ops config - ~filter_state:({grandparent_level_start; round_zero_duration; _} : state) - ?validation_state_before +let pre_filter_far_future_consensus_ops config ~filter_state ({level = op_level; round = op_round; _} : consensus_content) : bool Lwt.t = - match - (grandparent_level_start, validation_state_before, round_zero_duration) - with - | None, _, _ | _, None, _ | _, _, None -> Lwt.return_true - | ( Some grandparent_level_start, - Some validation_state_before, - Some round_zero_duration ) -> ( - 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 *) - | Partial_construction {predecessor_round = proposal_round; _} -> ( - (let proposal_timestamp = Alpha_context.Timestamp.predecessor ctxt in - let now_timestamp = Time.System.now () |> Time.System.to_protocol in - let Level.{level; _} = Alpha_context.Level.current ctxt in - let proposal_level = - match Raw_level.pred level with - | None -> - (* mempool level is set to the successor of the - current head *) - assert false - | Some proposal_level -> proposal_level - in - let round_durations = Alpha_context.Constants.round_durations ctxt in - Lwt.return - @@ acceptable_op - ~config - ~round_durations - ~round_zero_duration - ~proposal_level - ~proposal_round - ~proposal_timestamp - ~proposal_predecessor_level_start:grandparent_level_start - ~op_level - ~op_round - ~now_timestamp) - >>= function - | Ok b -> Lwt.return b - | _ -> Lwt.return_false)) + match filter_state.state_info with + | None -> Lwt.return_true + | Some state_info -> ( + (let proposal_timestamp = Timestamp.predecessor state_info.alpha_ctxt in + let now_timestamp = Time.System.now () |> Time.System.to_protocol in + let Level.{level; _} = Level.current state_info.alpha_ctxt in + let proposal_level = + match Raw_level.pred level with + | None -> + (* mempool level is set to the successor of the current head *) + assert false + | Some proposal_level -> proposal_level + in + let round_durations = Constants.round_durations state_info.alpha_ctxt in + Lwt.return + @@ acceptable_op + ~config + ~round_durations + ~round_zero_duration:state_info.round_zero_duration + ~proposal_level + ~proposal_round:state_info.proposal_round + ~proposal_timestamp + ~proposal_predecessor_level_start:state_info.grandparent_level_start + ~op_level + ~op_round + ~now_timestamp) + >>= function + | Ok b -> Lwt.return b + | _ -> Lwt.return_false) (** A quasi infinite amount of "valid" (pre)endorsements could be sent by a committee member, one for each possible round number. @@ -835,11 +833,7 @@ let pre_filter config ~(filter_state : state) ?validation_state_before Lwt.return (`Refused [Environment.wrap_tzerror Wrong_operation]) | Single (Preendorsement consensus_content) | Single (Endorsement consensus_content) -> - pre_filter_far_future_consensus_ops - ~filter_state - config - ?validation_state_before - consensus_content + pre_filter_far_future_consensus_ops ~filter_state config consensus_content >>= fun keep -> if keep then Lwt.return @@ `Passed_prefilter consensus_prio else -- GitLab From c3795bbc1f6cb11df4702413344d3a345ba9cb35 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Thu, 8 Sep 2022 18:36:24 +0200 Subject: [PATCH 04/12] Proto: remove predecessor_round from Partial_construction in application_state --- src/proto_alpha/lib_plugin/RPC.ml | 8 +------- src/proto_alpha/lib_protocol/apply.ml | 7 +------ src/proto_alpha/lib_protocol/apply.mli | 1 - 3 files changed, 2 insertions(+), 14 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 027684ba910d..38ef501df1de 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -858,15 +858,9 @@ module Scripts = struct 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; - } + {predecessor_level; predecessor_fitness = block_header.fitness} in let application_state = Apply. diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 1b9527b40b12..beb776d85124 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1977,7 +1977,6 @@ type mode = } | Partial_construction of { predecessor_level : Raw_level.t; - predecessor_round : Round.t; predecessor_fitness : Fitness.raw; } @@ -2684,15 +2683,11 @@ 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 + let mode = Partial_construction {predecessor_level; predecessor_fitness} in return { mode; diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli index 56433919ddd3..d46680572474 100644 --- a/src/proto_alpha/lib_protocol/apply.mli +++ b/src/proto_alpha/lib_protocol/apply.mli @@ -71,7 +71,6 @@ type mode = } | 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. *) -- GitLab From 52f033239979f49286a55061e0ec104687273531 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Thu, 8 Sep 2022 19:02:19 +0200 Subject: [PATCH 05/12] Proto/main: refactor into begin_validation/application with mode argument, validate/apply_operation, and finalize_validation/application. But also keep functions that are compliant with the current proto environment: these will be removed in the next commit. --- src/proto_alpha/lib_protocol/main.ml | 475 +++++++++++++++------------ 1 file changed, 268 insertions(+), 207 deletions(-) diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 7e24584d75a6..c9a9ab303ebe 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -95,12 +95,9 @@ type validation_state = { application_state : Apply.application_state; } -let prepare_context ctxt ~level ~predecessor_timestamp ~timestamp = - Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt - let init_allowed_consensus_operations ctxt ~endorsement_level ~preendorsement_level = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let open Alpha_context in let* ctxt = Delegate.prepare_stake_distribution ctxt in let* ctxt, allowed_endorsements, allowed_preendorsements = @@ -127,247 +124,316 @@ let init_allowed_consensus_operations ctxt ~endorsement_level in return ctxt -let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~(predecessor_fitness : Fitness.t) - (block_header : Alpha_context.Block_header.t) = +(** Circumstances and relevant information for [begin_validation] and + [begin_application] below. *) +type mode = + | Application of {block_header : block_header} + | Partial_application of {block_header : block_header} + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + +let prepare_ctxt ctxt mode ~(predecessor : Block_header.shell_header) = let open Lwt_tzresult_syntax in let open Alpha_context in + let level, timestamp = + match mode with + | Application {block_header} | Partial_application {block_header} -> + (block_header.shell.level, block_header.shell.timestamp) + | Construction {timestamp; _} | Partial_construction {timestamp; _} -> + (Int32.succ predecessor.level, timestamp) + 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 + prepare ctxt ~level ~predecessor_timestamp:predecessor.timestamp ~timestamp in - let*? predecessor_level = - Alpha_context.Raw_level.of_int32 (Int32.pred block_header.shell.level) + let*? predecessor_raw_level = Raw_level.of_int32 predecessor.level in + let predecessor_level = Level.from_raw ctxt predecessor_raw_level in + (* During block (full or partial) application or full construction, + endorsements must be for [predecessor_level] and preendorsements, + if any, for the block's level. In the mempool (partial + construction), only consensus operations for [predecessor_level] + (that is, head's level) are allowed (except for grandparent + endorsements, which are handled differently). *) + let preendorsement_level = + match mode with + | Application _ | Partial_application _ | Construction _ -> + Level.current ctxt + | Partial_construction _ -> predecessor_level in - 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_timestamp - block_header - fitness + ~preendorsement_level in - 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 - return {validity_state; application_state} + return + ( ctxt, + migration_balance_updates, + migration_operation_results, + predecessor_level, + predecessor_raw_level ) -let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp - ~(predecessor_fitness : Fitness.t) - (block_header : Alpha_context.Block_header.t) = +let begin_validation ctxt chain_id mode ~predecessor = 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 + let* ( ctxt, + _migration_balance_updates, + _migration_operation_results, + predecessor_level, + _predecessor_raw_level ) = + prepare_ctxt ctxt ~predecessor mode 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 predecessor_timestamp = predecessor.timestamp in + let predecessor_fitness = predecessor.fitness in + match mode with + | Application {block_header} -> + let*? fitness = Fitness.from_raw block_header.shell.fitness in + Validate.begin_application + ctxt + chain_id + ~predecessor_level + ~predecessor_timestamp + block_header + fitness + | Partial_application {block_header} -> + let*? fitness = Fitness.from_raw block_header.shell.fitness in + Validate.begin_partial_application + ctxt + chain_id + ~predecessor_level + ~predecessor_timestamp + block_header + fitness + | Construction {predecessor_hash; timestamp; block_header_data} -> + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let*? round = + Round.round_of_timestamp + (Constants.round_durations ctxt) + ~predecessor_timestamp + ~predecessor_round + ~timestamp + in + Validate.begin_full_construction + ctxt + chain_id + ~predecessor_level + ~predecessor_round + ~predecessor_timestamp + ~predecessor_hash + round + block_header_data.contents + | Partial_construction _ -> + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let*? grandparent_round = + Fitness.predecessor_round_from_raw predecessor_fitness + in + return + (Validate.begin_partial_construction + ctxt + chain_id + ~predecessor_level + ~predecessor_round + ~grandparent_round) + +let validate_operation = Validate.validate_operation -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 finalize_validation = Validate.finalize_block + +let new_begin_application ctxt chain_id mode ~predecessor = 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 + let* ( ctxt, + migration_balance_updates, + migration_operation_results, + predecessor_level, + predecessor_raw_level ) = + prepare_ctxt ctxt ~predecessor mode 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 + let predecessor_timestamp = predecessor.timestamp in + let predecessor_fitness = predecessor.fitness in + match mode with + | Application {block_header} -> + Apply.begin_application + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results + ~predecessor_fitness + block_header + | Partial_application {block_header} -> + Apply.begin_partial_application + chain_id + ~ancestor_context:ctxt + ~migration_balance_updates + ~migration_operation_results + ~predecessor_fitness + block_header + | Construction {predecessor_hash; timestamp; block_header_data; _} -> + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + Apply.begin_full_construction + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results + ~predecessor_timestamp + ~predecessor_level + ~predecessor_round + ~predecessor:predecessor_hash + ~timestamp + block_header_data.contents + | Partial_construction _ -> + Apply.begin_partial_construction + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results + ~predecessor_level:predecessor_raw_level + ~predecessor_fitness + +let new_apply_operation = Apply.apply_operation + +let finalize_application = Apply.finalize_block + +(* Dummy block header for the predecessor, setting only the fields + which will actually be accessed by the validation or application of + blocks and operations (that is, the ones taken as arguments). + + This is a temporary function used by the updater-compliant + functions below; it will go away in the next commit. *) +let dummy_predecessor ~predecessor_timestamp ~predecessor_fitness + ~predecessor_level = + { + Block_header.level = predecessor_level; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = predecessor_timestamp; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = predecessor_fitness; + context = Context_hash.zero; + } + +(* Updater's signature compliant functions, that will be removed in + the next commit. *) + +let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness (block_header : block_header) = + let open Lwt_tzresult_syntax in + let predecessor = + dummy_predecessor ~predecessor_timestamp - ~predecessor_round - ~timestamp + ~predecessor_fitness + ~predecessor_level:(Int32.pred block_header.shell.level) in let* validity_state = - Validate.begin_full_construction - ctxt + begin_validation + predecessor_context chain_id - ~predecessor_level - ~predecessor_round - ~predecessor_timestamp - ~predecessor_hash:predecessor - round - block_header_contents + ~predecessor + (Application {block_header}) in let* application_state = - Apply.begin_full_construction - ctxt + new_begin_application + predecessor_context chain_id - ~migration_balance_updates - ~migration_operation_results - ~predecessor_timestamp - ~predecessor_level - ~predecessor_round ~predecessor - ~timestamp - block_header_contents + (Application {block_header}) in return {validity_state; application_state} -let begin_partial_construction ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor:_ ~timestamp = +let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp + ~predecessor_fitness (block_header : block_header) = 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 ~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 + let predecessor = + dummy_predecessor + ~predecessor_timestamp + ~predecessor_fitness + ~predecessor_level:(Int32.pred block_header.shell.level) in - let validity_state = - Validate.begin_partial_construction - ctxt + let* validity_state = + begin_validation + ancestor_context chain_id - ~predecessor_level - ~predecessor_round - ~grandparent_round + ~predecessor + (Partial_application {block_header}) in let* application_state = - Apply.begin_partial_construction - ctxt + new_begin_application + ancestor_context chain_id - ~migration_balance_updates - ~migration_operation_results - ~predecessor_level:predecessor_raw_level - ~predecessor_fitness + ~predecessor + (Partial_application {block_header}) 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 + ~predecessor_level ~predecessor_fitness ~predecessor:predecessor_hash ~timestamp ?(protocol_data : block_header_data option) () = + let open Lwt_tzresult_syntax in + let predecessor = + dummy_predecessor + ~predecessor_timestamp + ~predecessor_fitness + ~predecessor_level + in match protocol_data with | None -> - begin_partial_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - | Some protocol_data -> - begin_full_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~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.validate_operation validity_state oph packed_operation + let partial_construction = + Partial_construction {predecessor_hash; timestamp} + in + let* validity_state = + begin_validation + predecessor_context + chain_id + ~predecessor + partial_construction + in + let* application_state = + new_begin_application + predecessor_context + chain_id + ~predecessor + partial_construction + in + return {validity_state; application_state} + | Some block_header_data -> + let construction = + Construction {predecessor_hash; timestamp; block_header_data} + in + let* validity_state = + begin_validation predecessor_context chain_id ~predecessor construction + in + let* application_state = + new_begin_application + predecessor_context + chain_id + ~predecessor + construction + in + return {validity_state; application_state} let apply_operation (state : validation_state) (packed_operation : Alpha_context.packed_operation) = let open Lwt_result_syntax in - let* validation_state = - validate_operation state.validity_state packed_operation - in let operation_hash = Alpha_context.Operation.hash_packed packed_operation in + let* validity_state = + validate_operation state.validity_state operation_hash packed_operation + in let* application_state, operation_receipt = - Apply.apply_operation - state.application_state - operation_hash - packed_operation + new_apply_operation state.application_state operation_hash packed_operation in - return - ({validity_state = validation_state; application_state}, operation_receipt) + return ({validity_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* () = finalize_validation state.validity_state in + finalize_application state.application_state shell_header let compare_operations (oph1, op1) (oph2, op2) = Alpha_context.Operation.compare (oph1, op1) (oph2, op2) @@ -450,21 +516,16 @@ module Mempool = struct ~current_timestamp = let open Lwt_tzresult_syntax in let open Alpha_context in - let level = Int32.succ head_header.level in - let* ctxt, _migration_balance_updates, _migration_operation_results = - prepare - ~level - ~predecessor_timestamp:head_header.timestamp - ~timestamp:current_timestamp - ctxt - in - let*? raw_pred_level = Raw_level.of_int32 head_header.level in - let head_level = Level.from_raw ctxt raw_pred_level in - let* ctxt = - init_allowed_consensus_operations + let* ( ctxt, + _migration_balance_updates, + _migration_operation_results, + head_level, + _head_raw_level ) = + prepare_ctxt ctxt - ~endorsement_level:head_level - ~preendorsement_level:head_level + (Partial_construction + {predecessor_hash = head_hash; timestamp = current_timestamp}) + ~predecessor:head_header in let*? fitness = Fitness.from_raw head_header.fitness in let predecessor_round = Fitness.round fitness in -- GitLab From aa85e7d1ce78422ffbf6b3287f075b67623ad0b8 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 12 Sep 2022 18:46:14 +0200 Subject: [PATCH 06/12] Everywhere: add pipelining functions to protocol environment --- .../test/proto_test_injection/main.ml | 60 +-- src/lib_mockup/local_services.ml | 173 ++++---- .../environment_V3.ml | 207 ++++++---- .../environment_V3.mli | 1 + .../environment_V4.ml | 207 ++++++---- .../environment_V4.mli | 1 + .../environment_V5.ml | 207 ++++++---- .../environment_V5.mli | 1 + .../environment_V6.ml | 207 ++++++---- .../environment_V6.mli | 1 + .../environment_V7.ml | 148 +++---- .../environment_V7.mli | 1 + .../environment_protocol_T.ml | 163 +++++--- .../environment_protocol_T_V7.ml | 65 +-- .../environment_protocol_T_test.ml | 43 +- src/lib_protocol_environment/sigs/v7.ml | 384 +++++++++++------- .../sigs/v7/updater.mli | 384 +++++++++++------- src/lib_shell/block_directory.ml | 62 ++- src/lib_shell/prevalidation.ml | 80 ++-- src/lib_shell/prevalidation.mli | 4 +- src/lib_shell/prevalidator.ml | 1 - src/lib_shell/test/test_prevalidation_t.ml | 24 +- src/lib_store/unix/test/alpha_utils.ml | 49 ++- src/lib_validation/block_validation.ml | 104 +++-- src/lib_validation/block_validation.mli | 16 +- .../lib_delegate/baking_simulator.ml | 22 +- .../lib_delegate/baking_simulator.mli | 2 +- .../test/mockup_simulator/mockup_simulator.ml | 18 +- .../lib_delegate/baking_simulator.ml | 22 +- .../lib_delegate/baking_simulator.mli | 2 +- .../test/mockup_simulator/mockup_simulator.ml | 18 +- .../lib_delegate/baking_simulator.ml | 22 +- .../lib_delegate/baking_simulator.mli | 2 +- .../test/mockup_simulator/mockup_simulator.ml | 18 +- .../sc_rollup_benchmarks.ml | 3 +- .../lib_delegate/baking_simulator.ml | 64 ++- .../lib_delegate/baking_simulator.mli | 4 +- .../test/mockup_simulator/mockup_simulator.ml | 54 ++- src/proto_alpha/lib_plugin/mempool.ml | 26 +- src/proto_alpha/lib_protocol/main.ml | 160 +------- src/proto_alpha/lib_protocol/main.mli | 14 +- .../lib_protocol/test/helpers/block.ml | 73 ++-- .../lib_protocol/test/helpers/block.mli | 6 +- .../test/helpers/consensus_helpers.ml | 7 +- .../lib_protocol/test/helpers/incremental.ml | 170 ++++---- .../lib_protocol/test/helpers/incremental.mli | 26 +- .../test/integration/gas/test_gas_levels.ml | 36 +- .../test/pbt/test_gas_properties.ml | 3 +- .../lib_protocol/test/unit/test_gas_monad.ml | 3 +- .../test/unit/test_sc_rollup_storage.ml | 3 +- src/proto_alpha/lib_protocol/validate.ml | 2 + src/proto_alpha/lib_protocol/validate.mli | 5 + src/proto_demo_counter/lib_protocol/main.ml | 169 +++++--- src/proto_demo_noops/lib_protocol/main.ml | 64 +-- 54 files changed, 2041 insertions(+), 1570 deletions(-) diff --git a/src/bin_client/test/proto_test_injection/main.ml b/src/bin_client/test/proto_test_injection/main.ml index bb03954f4801..8e265aca551f 100644 --- a/src/bin_client/test/proto_test_injection/main.ml +++ b/src/bin_client/test/proto_test_injection/main.ml @@ -66,7 +66,9 @@ let compare_operations _ _ = 0 let acceptable_pass _ = Some 0 -type validation_state = {context : Context.t; fitness : Int64.t} +type validation_state = unit + +type application_state = {context : Context.t; fitness : Int64.t} module Fitness = struct type error += Invalid_fitness @@ -92,38 +94,48 @@ module Fitness = struct let get {fitness; _} = fitness end -let begin_application ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_fitness:_ (raw_block : block_header) = - Fitness.to_int64 raw_block.shell.fitness >>=? fun fitness -> - return {context; fitness} +type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + +let begin_validation _ctxt _chain_id _mode ~predecessor:_ = return () + +let validate_operation ?check_signature:_ _validation_state _oph _op = return () + +let finalize_validation _validation_state = return () -let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp - ~predecessor_fitness raw_block = - begin_application - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - -let begin_construction ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_level:_ - ~predecessor_fitness:pred_fitness ~predecessor:_ ~timestamp:_ - ?protocol_data:_ () = - Fitness.to_int64 pred_fitness >>=? fun pred_fitness -> - let fitness = Int64.succ pred_fitness in +let begin_application context _chain_id mode + ~(predecessor : Block_header.shell_header) = + let open Lwt_result_syntax in + let* fitness = + match mode with + | Application block_header | Partial_application block_header -> + Fitness.to_int64 block_header.shell.fitness + | Construction _ | Partial_construction _ -> + let* predecessor_fitness = Fitness.to_int64 predecessor.fitness in + return (Int64.succ predecessor_fitness) + in return {context; fitness} -let apply_operation ctxt _ = return (ctxt, ()) +let apply_operation application_state _oph _op = return (application_state, ()) -let finalize_block ctxt _block_header = - let fitness = Fitness.get ctxt in +let finalize_application application_state _block_header = + let fitness = Fitness.get application_state in let message = Some (Format.asprintf "fitness <- %Ld" fitness) in let fitness = Fitness.from_int64 fitness in return ( { Updater.message; - context = ctxt.context; + context = application_state.context; fitness; max_operations_ttl = 0; last_allowed_fork_level = 0l; diff --git a/src/lib_mockup/local_services.ml b/src/lib_mockup/local_services.ml index 10e6034650f4..228f9312457e 100644 --- a/src/lib_mockup/local_services.ml +++ b/src/lib_mockup/local_services.ml @@ -194,25 +194,48 @@ module Make (E : MENV) = struct E.Protocol.block_header_data_encoding E.protocol_data + let begin_validation_and_application ctxt chain_id mode ~predecessor ~cache = + let open Lwt_result_syntax in + let* validation_state = + E.Protocol.begin_validation ctxt chain_id mode ~predecessor ~cache + in + let* application_state = + E.Protocol.begin_application ctxt chain_id mode ~predecessor ~cache + in + return (validation_state, application_state) + + let validate_and_apply_operation (validation_state, application_state) oph op + = + let open Lwt_result_syntax in + let* validation_state = + E.Protocol.validate_operation validation_state oph op + in + let* application_state, receipt = + E.Protocol.apply_operation application_state oph op + in + return ((validation_state, application_state), receipt) + + let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = E.Protocol.finalize_validation validation_state in + E.Protocol.finalize_application application_state shell_header + let partial_construction ~cache () = - let predecessor = E.rpc_context.block_hash in - let header = E.rpc_context.block_header in + let predecessor_hash = E.rpc_context.block_hash in + let predecessor = E.rpc_context.block_header in let predecessor_context = E.rpc_context.context in let timestamp = Time.System.to_protocol @@ Tezos_base.Time.System.now () in - E.Protocol.begin_construction - ~chain_id:E.chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_level:header.level - ~predecessor_fitness:header.fitness + begin_validation_and_application + predecessor_context + E.chain_id + (Partial_construction {predecessor_hash; timestamp}) ~predecessor - ~timestamp ~cache - () let full_construction ?timestamp ~protocol_data ~cache () = - let predecessor = E.rpc_context.block_hash in - let header = E.rpc_context.block_header in + let predecessor_hash = E.rpc_context.block_hash in + let predecessor = E.rpc_context.block_header in let predecessor_context = E.rpc_context.context in let timestamp = let default () = @@ -220,17 +243,13 @@ module Make (E : MENV) = struct in Option.value_f timestamp ~default in - E.Protocol.begin_construction - ~chain_id:E.chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_level:header.level - ~predecessor_fitness:header.fitness + begin_validation_and_application + predecessor_context + E.chain_id + (Construction + {predecessor_hash; timestamp; block_header_data = protocol_data}) ~predecessor - ~protocol_data - ~timestamp ~cache - () let op_data_encoding = E.Protocol.operation_data_encoding @@ -405,7 +424,7 @@ module Make (E : MENV) = struct let set = Block_hash.Set.singleton E.rpc_context.block_hash in RPC_answer.return set)) - let simulate_operation (validation_state, preapply_result) op = + let simulate_operation (state, preapply_result) op = let open Lwt_result_syntax in match Data_encoding.Binary.to_bytes @@ -416,12 +435,12 @@ module Make (E : MENV) = struct | Ok proto -> ( let op_t = {Operation.shell = op.shell; proto} in let hash = Operation.hash op_t in - let*! r = E.Protocol.apply_operation validation_state op in + let*! r = validate_and_apply_operation state hash op in match r with | Error e -> let open Preapply_result in return - ( validation_state, + ( state, { preapply_result with refused = @@ -430,10 +449,10 @@ module Make (E : MENV) = struct (op_t, e) preapply_result.refused; } ) - | Ok (validation_state, _) -> + | Ok (state, _) -> let open Preapply_result in return - ( validation_state, + ( state, { preapply_result with applied = (hash, op_t) :: preapply_result.applied; @@ -454,23 +473,21 @@ module Make (E : MENV) = struct with_chain ~caller_name:"preapply_block" chain (fun () -> let*! r = let timestamp = o#timestamp in - let* validation_state = + let* proto_state = full_construction ~cache:`Lazy ?timestamp:o#timestamp ~protocol_data () in - let* validation_passes, validation_state, preapply_results = + let* validation_passes, proto_state, preapply_results = List.fold_left_es - (fun ( validation_passes, - validation_state, - validation_result ) + (fun (validation_passes, proto_state, validation_result) operations -> let* state, result = List.fold_left_es simulate_operation - (validation_state, Preapply_result.empty) + (proto_state, Preapply_result.empty) operations in let open Preapply_result in @@ -481,12 +498,13 @@ module Make (E : MENV) = struct ( succ validation_passes, state, p_result :: validation_result )) - (0, validation_state, []) + (0, proto_state, []) operations in - let cache_nonce = Some E.rpc_context.block_header in let* validation_result, _metadata = - E.Protocol.finalize_block validation_state cache_nonce + finalize_validation_and_application + proto_state + (Some E.rpc_context.block_header) in (* Similar to lib_shell.Prevalidation.preapply *) let operations_hash = @@ -525,6 +543,18 @@ module Make (E : MENV) = struct | Error errs -> RPC_answer.fail errs | Ok v -> RPC_answer.return v)) + let hash_protocol_operation op = + match + Data_encoding.Binary.to_bytes + E.Protocol.operation_data_encoding + op.E.Protocol.protocol_data + with + | Error _ -> + failwith "mockup preapply_operations: cannot deserialize operation" + | Ok proto -> + let op_t = {Operation.shell = op.shell; proto} in + Lwt_result.return (Operation.hash op_t) + let preapply () = let open Lwt_result_syntax in Directory.prefix @@ -540,21 +570,24 @@ module Make (E : MENV) = struct (fun ((_, chain), _block) () op_list -> with_chain ~caller_name:"preapply operations" chain (fun () -> let*! outcome = - let* state = partial_construction ~cache:`Lazy () in - let* state, acc = + let* proto_state = partial_construction ~cache:`Lazy () in + let* proto_state, acc = List.fold_left_es - (fun (state, acc) op -> - let* state, result = - E.Protocol.apply_operation state op + (fun (proto_state, acc) op -> + let* oph = hash_protocol_operation op in + let* proto_state, result = + validate_and_apply_operation proto_state oph op in - return (state, (op.protocol_data, result) :: acc)) - (state, []) + return (proto_state, (op.protocol_data, result) :: acc)) + (proto_state, []) op_list in (* A pre-application should not commit into the protocol caches. For this reason, [cache_nonce] is [None]. *) - let* _ = E.Protocol.finalize_block state None in + let* _ = + finalize_validation_and_application proto_state None + in return (List.rev acc) in match outcome with @@ -584,16 +617,16 @@ module Make (E : MENV) = struct if List.mem ~equal:equal_op op mempool_operations then return `Equal else let operations = op :: mempool_operations in - let* validation_state = partial_construction ~cache:`Lazy () in - let* validation_state, preapply_result = + let* proto_state = partial_construction ~cache:`Lazy () in + let* proto_state, preapply_result = List.fold_left_es (fun rstate (shell, protocol_data) -> simulate_operation rstate E.Protocol.{shell; protocol_data}) - (validation_state, Preapply_result.empty) + (proto_state, Preapply_result.empty) operations in if Operation_hash.Map.is_empty preapply_result.refused then - let* _ = E.Protocol.finalize_block validation_state None in + let* _ = finalize_validation_and_application proto_state None in return `Applicable else return `Refused @@ -654,13 +687,12 @@ module Make (E : MENV) = struct {E.Protocol.shell = shell_header; protocol_data = operation_data} in let*! result = - let* state = partial_construction ~cache:`Lazy () in - let* state, receipt = E.Protocol.apply_operation state op in - (* The following finalization does not have to update protocol - caches because we are not interested in block creation here. - Hence, [cache_nonce] is set to [None]. *) + let* proto_state = partial_construction ~cache:`Lazy () in + let* proto_state, receipt = + validate_and_apply_operation proto_state operation_hash op + in let* validation_result, _block_header_metadata = - E.Protocol.finalize_block state None + finalize_validation_and_application proto_state None in return (validation_result, receipt) in @@ -685,20 +717,22 @@ module Make (E : MENV) = struct with | None -> assert false | Some protocol_data -> - let header = E.rpc_context.block_header in + let predecessor = E.rpc_context.block_header in let predecessor_context = E.rpc_context.context in - let* validation_state = - E.Protocol.begin_application - ~chain_id:E.chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness - {shell = block_header.shell; protocol_data} + let mode = + E.Protocol.Application {shell = block_header.shell; protocol_data} + in + let* proto_state = + begin_validation_and_application + predecessor_context + E.chain_id + mode + ~predecessor ~cache:`Lazy in - let* validation_state, _ = + let* proto_state, _ = List.fold_left_es - (List.fold_left_es (fun (validation_state, results) op -> + (List.fold_left_es (fun (proto_state, results) op -> match Data_encoding.Binary.of_bytes op_data_encoding @@ -706,20 +740,23 @@ module Make (E : MENV) = struct with | Error _ -> failwith "Cannot parse" | Ok operation_data -> + let oph = Operation.hash op in let op = { E.Protocol.shell = op.shell; protocol_data = operation_data; } in - let* validation_state, receipt = - E.Protocol.apply_operation validation_state op + let* proto_state, receipt = + validate_and_apply_operation proto_state oph op in - return (validation_state, receipt :: results))) - (validation_state, []) + return (proto_state, receipt :: results))) + (proto_state, []) operations in - E.Protocol.finalize_block validation_state (Some block_header.shell) + finalize_validation_and_application + proto_state + (Some block_header.shell) in Directory.register Directory.empty diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index f079a8b7f1e2..3eaefcd1677c 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -98,6 +98,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1053,113 +1054,141 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_shell_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor, timestamp = + match mode with + | Application block_header | Partial_application block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness + ~predecessor_timestamp:predecessor_shell_header.timestamp + ~predecessor_level:predecessor_shell_header.level + ~predecessor_fitness:predecessor_shell_header.fitness ~predecessor ~timestamp in Context.load_cache predecessor predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_application block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_application] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - in - Lwt.return (wrap_tzresult r) + let begin_validation = begin_validation_or_application `Validation - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - in - Lwt.return (wrap_tzresult r) + let begin_application = begin_validation_or_application `Application - let apply_operation c o = + let wrap_apply_operation state operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ state = apply_operation state operation in + wrap_tzresult state + + let validate_operation ?check_signature:_ state _oph operation = + let open Lwt_result_syntax in + let* state, _operation_receipt = wrap_apply_operation state operation in + return state + + let apply_operation state _oph operation = + wrap_apply_operation state operation - let finalize_block c shell_header = + let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_block state shell_header in + wrap_tzresult res + + let finalize_validation state = + let open Lwt_result_syntax in + let dummy_shell_header = + (* A shell header is required in construction mode so that + [finalize_block] does not return an error. However, it is + only used to compute the cache nonce, which is discarded + here anyway. *) + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.epoch; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = []; + context = Context_hash.zero; + } + in + let* _ = wrap_finalize_block state (Some dummy_shell_header) in + return_unit + + let finalize_application = wrap_finalize_block let init _chain_id c bh = let open Lwt_syntax in diff --git a/src/lib_protocol_environment/environment_V3.mli b/src/lib_protocol_environment/environment_V3.mli index c67f6d016b95..ff4c37fbbfa5 100644 --- a/src/lib_protocol_environment/environment_V3.mli +++ b/src/lib_protocol_environment/environment_V3.mli @@ -121,6 +121,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_V4.ml b/src/lib_protocol_environment/environment_V4.ml index 3436a6bdeb44..efba6cdc499a 100644 --- a/src/lib_protocol_environment/environment_V4.ml +++ b/src/lib_protocol_environment/environment_V4.ml @@ -104,6 +104,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1070,113 +1071,141 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_shell_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor, timestamp = + match mode with + | Application block_header | Partial_application block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness + ~predecessor_timestamp:predecessor_shell_header.timestamp + ~predecessor_level:predecessor_shell_header.level + ~predecessor_fitness:predecessor_shell_header.fitness ~predecessor ~timestamp in Context.load_cache predecessor predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_application block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_application] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - in - Lwt.return (wrap_tzresult r) + let begin_validation = begin_validation_or_application `Validation - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - in - Lwt.return (wrap_tzresult r) + let begin_application = begin_validation_or_application `Application - let apply_operation c o = + let wrap_apply_operation state operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ state = apply_operation state operation in + wrap_tzresult state + + let validate_operation ?check_signature:_ state _oph operation = + let open Lwt_result_syntax in + let* state, _operation_receipt = wrap_apply_operation state operation in + return state + + let apply_operation state _oph operation = + wrap_apply_operation state operation - let finalize_block c shell_header = + let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_block state shell_header in + wrap_tzresult res + + let finalize_validation state = + let open Lwt_result_syntax in + let dummy_shell_header = + (* A shell header is required in construction mode so that + [finalize_block] does not return an error. However, it is + only used to compute the cache nonce, which is discarded + here anyway. *) + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.epoch; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = []; + context = Context_hash.zero; + } + in + let* _ = wrap_finalize_block state (Some dummy_shell_header) in + return_unit + + let finalize_application = wrap_finalize_block let init _chain_id c bh = let open Lwt_syntax in diff --git a/src/lib_protocol_environment/environment_V4.mli b/src/lib_protocol_environment/environment_V4.mli index 86bb09abed9b..ce50e7d43c32 100644 --- a/src/lib_protocol_environment/environment_V4.mli +++ b/src/lib_protocol_environment/environment_V4.mli @@ -123,6 +123,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_V5.ml b/src/lib_protocol_environment/environment_V5.ml index d5c46e84fe3d..2173216e754b 100644 --- a/src/lib_protocol_environment/environment_V5.ml +++ b/src/lib_protocol_environment/environment_V5.ml @@ -111,6 +111,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1047,113 +1048,141 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_shell_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor, timestamp = + match mode with + | Application block_header | Partial_application block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness + ~predecessor_timestamp:predecessor_shell_header.timestamp + ~predecessor_level:predecessor_shell_header.level + ~predecessor_fitness:predecessor_shell_header.fitness ~predecessor ~timestamp in Context.load_cache predecessor predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_application block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_application] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - in - Lwt.return (wrap_tzresult r) + let begin_validation = begin_validation_or_application `Validation - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - in - Lwt.return (wrap_tzresult r) + let begin_application = begin_validation_or_application `Application - let apply_operation c o = + let wrap_apply_operation state operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ state = apply_operation state operation in + wrap_tzresult state + + let validate_operation ?check_signature:_ state _oph operation = + let open Lwt_result_syntax in + let* state, _operation_receipt = wrap_apply_operation state operation in + return state + + let apply_operation state _oph operation = + wrap_apply_operation state operation - let finalize_block c shell_header = + let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_block state shell_header in + wrap_tzresult res + + let finalize_validation state = + let open Lwt_result_syntax in + let dummy_shell_header = + (* A shell header is required in construction mode so that + [finalize_block] does not return an error. However, it is + only used to compute the cache nonce, which is discarded + here anyway. *) + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.epoch; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = []; + context = Context_hash.zero; + } + in + let* _ = wrap_finalize_block state (Some dummy_shell_header) in + return_unit + + let finalize_application = wrap_finalize_block let init _chain_id c bh = let open Lwt_syntax in diff --git a/src/lib_protocol_environment/environment_V5.mli b/src/lib_protocol_environment/environment_V5.mli index 9f6b75249fb0..8df6da5fdad3 100644 --- a/src/lib_protocol_environment/environment_V5.mli +++ b/src/lib_protocol_environment/environment_V5.mli @@ -136,6 +136,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_V6.ml b/src/lib_protocol_environment/environment_V6.ml index 9c2e32c4cbe9..a1e8eb460a1e 100644 --- a/src/lib_protocol_environment/environment_V6.ml +++ b/src/lib_protocol_environment/environment_V6.ml @@ -117,6 +117,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1139,113 +1140,141 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_shell_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor, timestamp = + match mode with + | Application block_header | Partial_application block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness + ~predecessor_timestamp:predecessor_shell_header.timestamp + ~predecessor_level:predecessor_shell_header.level + ~predecessor_fitness:predecessor_shell_header.fitness ~predecessor ~timestamp in Context.load_cache predecessor predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_application block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_application] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - in - Lwt.return (wrap_tzresult r) + let begin_validation = begin_validation_or_application `Validation - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - in - Lwt.return (wrap_tzresult r) + let begin_application = begin_validation_or_application `Application - let apply_operation c o = + let wrap_apply_operation state operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ state = apply_operation state operation in + wrap_tzresult state + + let validate_operation ?check_signature:_ state _oph operation = + let open Lwt_result_syntax in + let* state, _operation_receipt = wrap_apply_operation state operation in + return state + + let apply_operation state _oph operation = + wrap_apply_operation state operation - let finalize_block c shell_header = + let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_block state shell_header in + wrap_tzresult res + + let finalize_validation state = + let open Lwt_result_syntax in + let dummy_shell_header = + (* A shell header is required in construction mode so that + [finalize_block] does not return an error. However, it is + only used to compute the cache nonce, which is discarded + here anyway. *) + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.epoch; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = []; + context = Context_hash.zero; + } + in + let* _ = wrap_finalize_block state (Some dummy_shell_header) in + return_unit + + let finalize_application = wrap_finalize_block let init chain_id c bh = let open Lwt_syntax in diff --git a/src/lib_protocol_environment/environment_V6.mli b/src/lib_protocol_environment/environment_V6.mli index 4127a8ae4293..5117b46be127 100644 --- a/src/lib_protocol_environment/environment_V6.mli +++ b/src/lib_protocol_environment/environment_V6.mli @@ -142,6 +142,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_V7.ml b/src/lib_protocol_environment/environment_V7.ml index 6f43324a37e8..2b9ba4429931 100644 --- a/src/lib_protocol_environment/environment_V7.ml +++ b/src/lib_protocol_environment/environment_V7.ml @@ -120,6 +120,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.application_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1102,113 +1103,70 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor_hash, timestamp = + match mode with + | Application block_header | Partial_application block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor + ~predecessor_timestamp:predecessor_header.timestamp + ~predecessor_level:predecessor_header.level + ~predecessor_fitness:predecessor_header.fitness + ~predecessor:predecessor_hash ~timestamp in - Context.load_cache predecessor predecessor_context cache value_of_key + Context.load_cache predecessor_hash predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation ctxt chain_id mode ~predecessor ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + begin_validation ctxt chain_id mode ~predecessor in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block + let validate_operation ?check_signature validation_state oph operation = + let open Lwt_syntax in + let+ validation_state = + validate_operation ?check_signature validation_state oph operation in - Lwt.return (wrap_tzresult r) + wrap_tzresult validation_state + + let finalize_validation validation_state = + let open Lwt_syntax in + let+ res = finalize_validation validation_state in + wrap_tzresult res - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = + let begin_application ctxt chain_id mode ~predecessor ~cache = let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! application_state = + begin_application ctxt chain_id ~predecessor mode in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult application_state) - let apply_operation c o = + let apply_operation application_state oph operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ application_state = + apply_operation application_state oph operation + in + wrap_tzresult application_state - let finalize_block c shell_header = + let finalize_application state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_application state shell_header in + wrap_tzresult res let init chain_id c bh = let open Lwt_syntax in @@ -1245,14 +1203,12 @@ struct let open Lwt_result_syntax in let* ctxt = load_predecessor_cache - ~chain_id - ~predecessor_context:ctxt - ~predecessor_timestamp:head_header.Block_header.timestamp - ~predecessor_level:head_header.Block_header.level - ~predecessor_fitness:head_header.Block_header.fitness - ~predecessor:head_hash - ~timestamp:current_timestamp - ~cache + ctxt + chain_id + (Partial_construction + {predecessor_hash = head_hash; timestamp = current_timestamp}) + head_header + cache in let*! r = init ctxt chain_id ~head_hash ~head_header ~current_timestamp diff --git a/src/lib_protocol_environment/environment_V7.mli b/src/lib_protocol_environment/environment_V7.mli index 86c63b663cf6..c629499392e2 100644 --- a/src/lib_protocol_environment/environment_V7.mli +++ b/src/lib_protocol_environment/environment_V7.mli @@ -144,6 +144,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.application_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_protocol_T.ml b/src/lib_protocol_environment/environment_protocol_T.ml index 5414af7f3b9f..f22f6a6da992 100644 --- a/src/lib_protocol_environment/environment_protocol_T.ml +++ b/src/lib_protocol_environment/environment_protocol_T.ml @@ -75,11 +75,93 @@ module V0toV7 and type operation = E.operation and type operation_receipt = E.operation_receipt and type validation_state = E.validation_state + and type application_state = E.validation_state and type cache_key = Context.Cache.key and type cache_value = Context.Cache.value = struct include E - let finalize_block vs _ = E.finalize_block vs + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + } + + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_application block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_application] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () + + let begin_validation = begin_validation_or_application `Validation + + let begin_application = begin_validation_or_application `Application + + let validate_operation ?check_signature:_ validation_state _oph operation = + let open Lwt_result_syntax in + let* validation_state, _operation_receipt = + apply_operation validation_state operation + in + return validation_state + + let apply_operation application_state _oph operation = + apply_operation application_state operation + + let finalize_validation validation_state = + let open Lwt_result_syntax in + let* _ = finalize_block validation_state in + return_unit + + let finalize_application application_state _shell_header = + finalize_block application_state let compare_operations (_, op) (_, op') = compare_operations op op' @@ -168,41 +250,21 @@ module type PROTOCOL = sig val environment_version : Protocol.env_version - val begin_partial_application : - chain_id:Chain_id.t -> - ancestor_context:Context.t -> - predecessor:Block_header.t -> - predecessor_hash:Block_hash.t -> + val begin_validation : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> cache:Context.source_of_cache -> - block_header -> validation_state Error_monad.tzresult Lwt.t val begin_application : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_fitness:Fitness.t -> + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> cache:Context.source_of_cache -> - block_header -> - validation_state Error_monad.tzresult Lwt.t - - val begin_construction : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_level:Int32.t -> - predecessor_fitness:Fitness.t -> - predecessor:Block_hash.t -> - timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> - cache:Context.source_of_cache -> - unit -> - validation_state Error_monad.tzresult Lwt.t - - val finalize_block : - validation_state -> - Block_header.shell_header option -> - (validation_result * block_header_metadata) tzresult Lwt.t + application_state Error_monad.tzresult Lwt.t module Mempool : sig include module type of Mempool @@ -241,40 +303,11 @@ struct let* context = Context.Cache.set_cache_layout context [] in init chain_id context header - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash:_ ~cache:_ - (raw_block : block_header) = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block - - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache:_ raw_block = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache:_ () = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - - let finalize_block c shell_header = P.finalize_block c shell_header + let begin_validation ctxt chain_id mode ~predecessor ~cache:_ = + begin_validation ctxt chain_id mode ~predecessor + + let begin_application ctxt chain_id mode ~predecessor ~cache:_ = + begin_application ctxt chain_id mode ~predecessor module Mempool = struct include Mempool diff --git a/src/lib_protocol_environment/environment_protocol_T_V7.ml b/src/lib_protocol_environment/environment_protocol_T_V7.ml index 36b72de4c7be..660db98b4a11 100644 --- a/src/lib_protocol_environment/environment_protocol_T_V7.ml +++ b/src/lib_protocol_environment/environment_protocol_T_V7.ml @@ -82,41 +82,52 @@ module type T = sig type validation_state - val begin_partial_application : - chain_id:Chain_id.t -> - ancestor_context:context -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_fitness:Fitness.t -> - block_header -> + type application_state + + type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + } + + val begin_validation : + context -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> validation_state tzresult Lwt.t - val begin_application : - chain_id:Chain_id.t -> - predecessor_context:context -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_fitness:Fitness.t -> - block_header -> + val validate_operation : + ?check_signature:bool -> + validation_state -> + Operation_hash.t -> + operation -> validation_state tzresult Lwt.t - val begin_construction : - chain_id:Chain_id.t -> - predecessor_context:context -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_level:Int32.t -> - predecessor_fitness:Fitness.t -> - predecessor:Block_hash.t -> - timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> - unit -> - validation_state tzresult Lwt.t + val finalize_validation : validation_state -> unit tzresult Lwt.t + + val begin_application : + context -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> + application_state tzresult Lwt.t val apply_operation : - validation_state -> + application_state -> + Operation_hash.t -> operation -> - (validation_state * operation_receipt) tzresult Lwt.t + (application_state * operation_receipt) tzresult Lwt.t - val finalize_block : - validation_state -> + val finalize_application : + application_state -> Block_header.shell_header option -> (validation_result * block_header_metadata) tzresult Lwt.t diff --git a/src/lib_protocol_environment/environment_protocol_T_test.ml b/src/lib_protocol_environment/environment_protocol_T_test.ml index 7b6c3a7abe85..fa6a7c5568af 100644 --- a/src/lib_protocol_environment/environment_protocol_T_test.ml +++ b/src/lib_protocol_environment/environment_protocol_T_test.ml @@ -32,9 +32,8 @@ module Mock_all_unit : with type block_header_data = unit and type operation_data = unit and type operation_receipt = unit - and type validation_state = unit = struct - type nonrec validation_state = unit - + and type validation_state = unit + and type application_state = unit = struct type block_header_data = unit type operation = { @@ -57,24 +56,36 @@ module Mock_all_unit : let init _ = assert false - let rpc_services = RPC_directory.empty + type nonrec validation_state = unit - let finalize_block _ = assert false + type nonrec application_state = unit - let apply_operation _ = assert false + type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + } - let begin_construction ~chain_id:_ ~predecessor_context:_ - ~predecessor_timestamp:_ ~predecessor_level:_ ~predecessor_fitness:_ - ~predecessor:_ ~timestamp:_ ?protocol_data:_ ~cache:_ _ = - assert false + let begin_validation _ = assert false - let begin_application ~chain_id:_ ~predecessor_context:_ - ~predecessor_timestamp:_ ~predecessor_fitness:_ ~cache:_ _ = - assert false + let validate_operation ?check_signature:_ = assert false - let begin_partial_application ~chain_id:_ ~ancestor_context:_ ~predecessor:_ - ~predecessor_hash:_ ~cache:_ _ = - assert false + let finalize_validation _ = assert false + + let begin_application _ = assert false + + let apply_operation _ = assert false + + let finalize_application _ = assert false + + let rpc_services = RPC_directory.empty let compare_operations _ = assert false diff --git a/src/lib_protocol_environment/sigs/v7.ml b/src/lib_protocol_environment/sigs/v7.ml index 34fdaf29dc62..f46ead55ec6c 100644 --- a/src/lib_protocol_environment/sigs/v7.ml +++ b/src/lib_protocol_environment/sigs/v7.ml @@ -11090,28 +11090,28 @@ type validation_result = { (** The resulting context, it will be used for the next block. *) fitness : Fitness.t; (** The effective fitness of the block (to be compared with the one - 'announced' in the block header). *) + 'announced' in the block header). *) message : string option; (** An optional informative message, akin to a 'git commit' message, - which can be attached to the [context] when it's being commited. *) + which can be attached to the [context] when it's being commited. *) max_operations_ttl : int; (** The "time-to-live" of operations for the next block: any - operation whose 'branch' is older than 'ttl' blocks in the past - cannot be included in the next block. *) + operation whose 'branch' is older than 'ttl' blocks in the past + cannot be included in the next block. *) last_allowed_fork_level : Int32.t; (** The level of the last block for which the node might consider an - alternate branch. The shell should consider as invalid any branch - whose fork point is older (has a lower level) than the - given value. *) + alternate branch. The shell should consider as invalid any branch + whose fork point is older (has a lower level) than the + given value. *) } type quota = { max_size : int; (** The maximum size (in bytes) of the serialized list of - operations. *) + operations. *) max_op : int option; (** The maximum number of operations in a block. - [None] means no limit. *) + [None] means no limit. *) } type rpc_context = { @@ -11148,11 +11148,11 @@ module type PROTOCOL = sig } (** Economic protocol-specific side information computed by the - protocol during the validation of a block. Should not include - information about the evaluation of operations which is handled - separately by {!operation_metadata}. To be used as an execution - trace by tools (client, indexer). Not necessary for - validation. *) + protocol during the validation of a block. Should not include + information about the evaluation of operations which is handled + separately by {!operation_metadata}. To be used as an execution + trace by tools (client, indexer). Not necessary for + validation. *) type block_header_metadata (** Encoding for economic protocol-specific block metadata. *) @@ -11162,8 +11162,8 @@ module type PROTOCOL = sig type operation_data (** Economic protocol-specific side information computed by the - protocol during the validation of each operation, to be used - conjointly with {!block_header_metadata}. *) + protocol during the validation of each operation, to be used + conjointly with {!block_header_metadata}. *) type operation_receipt (** A fully parsed operation. *) @@ -11189,144 +11189,224 @@ module type PROTOCOL = sig val acceptable_pass : operation -> int option (** [compare_operations (oph1,op1) (oph2,op2)] defines a total - ordering relation on valid operations. - - The following requirements must be satisfied: [oph1] is the - [Operation.hash.p1], [oph2] is [Operation.hash op2] and that - [op1] and [op2] are valid in the same context. - - [compare_operations (oph1,op1) (oph2,op2) = 0] happens only if - [Operation_hash.compare oph1 oph2 = 0], meaning [op1 = op2] only - when [op1] and [op2] are structurally identical. - - Two operations of different validation_passes are compared in the - reverse order of their [validation_pass]: the one with the - smaller [validation_pass] is compared as being the greater. - - When belonging to the same validation_pass, two operations - comparison depends on their static parameters. An abstract weight - is computed for each operation based on its static parameters. - When two operations' weights are compared as equal, - [compare_operation (oph1,op1) (oph2,op2)] is - [Operation_hash.compare oph1 oph2]. - - [compare_operations] can be used as a [compare] component of an - {!Stdlib.Map.OrderedType}, or any such collection which relies on - a total comparison function. *) + ordering relation on valid operations. + + The following requirements must be satisfied: [oph1] is the + [Operation.hash.p1], [oph2] is [Operation.hash op2] and that + [op1] and [op2] are valid in the same context. + + [compare_operations (oph1,op1) (oph2,op2) = 0] happens only if + [Operation_hash.compare oph1 oph2 = 0], meaning [op1 = op2] only + when [op1] and [op2] are structurally identical. + + Two operations of different validation_passes are compared in the + reverse order of their [validation_pass]: the one with the + smaller [validation_pass] is compared as being the greater. + + When belonging to the same validation_pass, two operations + comparison depends on their static parameters. An abstract weight + is computed for each operation based on its static parameters. + When two operations' weights are compared as equal, + [compare_operation (oph1,op1) (oph2,op2)] is + [Operation_hash.compare oph1 oph2]. + + [compare_operations] can be used as a [compare] component of an + {!Stdlib.Map.OrderedType}, or any such collection which relies on + a total comparison function. *) val compare_operations : Operation_hash.t * operation -> Operation_hash.t * operation -> int - (** A functional state that is transmitted through the steps of a - block validation sequence: it can be created by any of the - [begin_x] functions below, and its final value is produced by - {!finalize_block}. It must retain the current state of the store, - and it can also contain additional information that must be - remembered during the validation process. Said extra content must - however be immutable: validator or baker implementations are - allowed to pause, replay or backtrack throughout validation - steps. *) + (** {2 Block (and operation) validation and application} + + The following functions may be used when an existing block is + received through the network, when a new block is created, or + when operations are considered on their own e.g. in a mempool or + during an RPC call. + + Validation aims at deciding quickly whether a block or + an operation is valid, with minimal computations and without + writing anything in the storage. A block is valid if it can be + applied without failure. An operation is valid if it can be + safely included in a block without causing it to fail. + + The application of an operation updates the {!Context.t} with + regards to its semantics (e.g. updating balances after a + transaction). The application of a block updates the context + with all its operations and some additional global + effects. Isolated operations may be applied as part of an RPC + call to simulate their effects. + + Blocks and operations must always be validated before they are + applied. Indeed, the application assumes their validity as a + precondition, meaning that the application of an invalid block + might yield incorrect results instead of failing cleanly. + + Note that in protocol versions <= K, where the validation + functions do not yet exist, the validation of existing blocks is + done by trying to apply it using the [Partial_application] mode + below. Therefore, the application of a validated block may still + fail in these protocols. *) + + (** The mode indicates the circumstances in which a block and/or + operations are validated or applied, and contains specific + information. It must be provided as an argument to + [begin_validation] and [begin_application]. *) + type mode = + | Application of block_header + (** Standard validation or application of a preexisting block. *) + | Partial_application of block_header + (** Partial validation of a preexisting block. This mode is + meant to quickly reject obviously invalid alternate + branches by only performing a subset of checks. + Therefore, application of blocks or operations makes no + sense in this mode: calling [begin_application] with this + mode returns an error. *) + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + (** Construction of a new block. The main difference with the + previous modes is that we cannot provide the block header to the + [begin_] functions, since the block does not exist yet. Note that + the [begin_] functions may be called in this mode without knowing + yet which operations will be included in the future block. + + The provided [block_header_data] is not expected to be the final + value of the field of the same type in the {!block_header} of the + constructed block. Instead, it should be a protocol-specific, + good enough, "prototype" of the final value. E.g. if the + {!block_header_data} type for the current economic protocol + includes a signature, then the provided [block_header_data] + should contain a fake signature (since providing a correct + signature is not possible at this stage). *) + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + (** Minimal construction of a new virtual block, with the purpose of + being able to validate/apply operations of interest. This mode may + be used by the mempool (though the [Mempool] module below is better + suited for this) or by some RPCs + e.g. [preapply/operations]. Calling the [finalize_] functions makes + no sense in this mode. *) + + (** A functional state that is transmitted throughout the validation + of a block (or during the lifetime of a mempool or RPC). It is + created by [begin_validation] below, updated by + [validate_operation], and required by [finalize_validation]. + This state is immutable thus validator or baker implementations + are allowed to pause, replay or backtrack throughout validation + steps. *) type validation_state - (** [begin_partial_application cid ctxt] checks that a block is - well-formed in a given context. This function should run quickly, - as its main use is to reject bad blocks from the chain as early - as possible. The input [ancestor_context] is expected to result - from the application of an ancestor block of the current head - with the same economic protocol. Said ancestor block is also - required to be more recent (i.e., it has a greater level), than - the current head's "last_allowed_fork_level". - - The resulting `validation_state` will be used for multi-pass - validation. *) - val begin_partial_application : - chain_id:Chain_id.t -> - ancestor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_fitness:Fitness.t -> - block_header -> + (** Similar to {!validation_state}, but for the application process. *) + type application_state + + (** [begin_validation predecessor_context chain_id mode + ~predecessor] initializes the {!validation_state} for the + validation process of an existing or new block. + + [predecessor_context] and [predecessor] are the resulting + context and shell header of the predecessor block. Exceptionally + in {!Partial_application} mode, they may instead come from any + ancestor block that is more recent (i.e. has a greater level) + than the current head's "last_allowed_fork_level". + + [mode] specifies the circumstances of validation and also + carries additional information: see {!mode}. + + Note that for protocol versions <= K where [begin_validation] + does not exist yet, this calls the old [begin_application] by + necessity. However, in [Application] mode, this calls the old + [begin_application] in [Partial_application] mode in order to run + more quickly. This preserves the behavior of [precheck] in + [lib_validation/block_validation.ml] for old protocols. It does + mean that the application of a validated block may fail in these + protocols. *) + val begin_validation : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> validation_state tzresult Lwt.t - (** [begin_application chain_id ... bh] defines the first step in a - block validation sequence. It initializes a validation context - for validating a block, whose header is [bh]. *) - val begin_application : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_fitness:Fitness.t -> - block_header -> + (** Validate an operation. If successful, return the updated + {!validation_state}. + + [check_signature] indicates whether the signature should be + checked. It defaults to [true] because the signature needs to be + correct for the operation to be valid. This argument exists for + special cases where it is acceptable to bypass this check, + e.g. if we know that the operation has already been successfully + validated in another context. *) + val validate_operation : + ?check_signature:bool -> + validation_state -> + Operation_hash.t -> + operation -> validation_state tzresult Lwt.t - (** [begin_construction] initializes a validation context for - constructing a new block, as opposed to validating an existing - block. - - This function can be used in two modes: with and without the - optional [protocol_data] argument. With the latter, it is used by - bakers to start the process for baking a new block. Without it, - is used by the Shell's prevalidator to construct a virtual block, - which carries the contents of the pre-applied operations of the - mempool. - - When [protocol_data] is provided, it is not expected to be the - final value of the field of the same name in the {!block_header} - of the block eventually being baked. Instead, it is expected to - construct a protocol-specific, good enough, "prototype" of its - final value. For instance, if the economic protocol specifies - that its block headers include a signature, [protocol_data] must - include a (faked) signature. - - Moreover, these prototypes should not be distinguishable after - the application of [begin_construction]: the function must - produce the exact same context regardless of being passed a - prototype, or an "equivalent-but-complete" header. *) - val begin_construction : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_level:Int32.t -> - predecessor_fitness:Fitness.t -> - predecessor:Block_hash.t -> - timestamp:Time.t -> - ?protocol_data:block_header_data -> - unit -> - validation_state tzresult Lwt.t + (** Run final and global checks on the block that must come after + the validation of all its operations to establish its + validity. *) + val finalize_validation : validation_state -> unit tzresult Lwt.t - (** [apply_operation vs op] applies the input operation [op] on top - of the given {!validation_state} [vs]. It must be called after - {!begin_application} or {!begin_construction}, and before - {!finalize_block}, for each operation in a block. On a successful - application, it returns a pair consisting of the resulting - [validation_state], and the corresponding [operation_receipt]. *) - val apply_operation : - validation_state -> - operation -> - (validation_state * operation_receipt) tzresult Lwt.t + (** Initialize the {!application_state} for the application process + of an existing or new block. See {!begin_validation} for details + on the arguments. - (** [finalize_block vs] finalizes the context resulting from the - application of the contents of the block being validated. + In protocol versions > K, calling this function with the + {!Partial_application} mode returns an error. *) + val begin_application : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> + application_state tzresult Lwt.t - If there is no protocol migration, i.e., if the block being - applied is not the last block of the current economic protocol, the - resulting context can be used in the future as input for the - validation of its successor blocks. *) - val finalize_block : - validation_state -> + (** Apply an operation. If successful, return the updated + {!application_state} and the corresponding {!operation_receipt}. + + This should be called for all operations in a block, after + {!begin_application} and before + {!finalize_application}. Moreover, the operation should have + already been validated by {!validate_operation}. *) + val apply_operation : + application_state -> + Operation_hash.t -> + operation -> + (application_state * operation_receipt) tzresult Lwt.t + + (** Finalize the context resulting from the application of the + contents of the block. + + If there is no protocol migration, i.e. if the block being + applied is not the last block of the current economic protocol, + then the resulting context can be used in the future as input for + the validation and application of its successor blocks. + + In {!Construction} mode, the [Block_header.shell_header option] + argument must contain a value, which will be used to compute the + [cache_nonce]. In other modes, it can as well be [None] since it + will not be used. *) + val finalize_application : + application_state -> Block_header.shell_header option -> (validation_result * block_header_metadata) tzresult Lwt.t (** [rpc_services] provides the list of remote procedures exported - by this protocol implementation. *) + by this protocol implementation. *) val rpc_services : rpc_context RPC_directory.t (** [init chain_id ctxt hd] initializes the context, or upgrades the - context after a protocol amendment. This function receives as - arguments the [chain_id] of the current chain and the context - [ctxt] resulting from the application of the block that triggered - the amendment, as well as its header [hd]. This function should - fail if the "protocol stitching", i.e., the transition from a - valid previous protocol to the one being activated, has not been - implemented. *) + context after a protocol amendment. This function receives as + arguments the [chain_id] of the current chain and the context + [ctxt] resulting from the application of the block that triggered + the amendment, as well as its header [hd]. This function should + fail if the "protocol stitching", i.e., the transition from a + valid previous protocol to the one being activated, has not been + implemented. *) val init : Chain_id.t -> Context.t -> @@ -11334,18 +11414,18 @@ module type PROTOCOL = sig validation_result tzresult Lwt.t (** [value_of_key chain_id predecessor_context - predecessor_timestamp predecessor_level predecessor_fitness - predecessor timestamp] returns a function to build one value of - the cache from its key. - - This function is used to restore all or part of the cache, for - instance when booting a validator to preheat the cache, or when a - reorganization happens. This function should never fail, returned - errors are fatal. - - The generated function is passed to [Context.Cache.load_caches] - which will use it either immediately a cache-loading time or - on-demand, when a given cached value is accessed. *) + predecessor_timestamp predecessor_level predecessor_fitness + predecessor timestamp] returns a function to build one value of + the cache from its key. + + This function is used to restore all or part of the cache, for + instance when booting a validator to preheat the cache, or when a + reorganization happens. This function should never fail, returned + errors are fatal. + + The generated function is passed to [Context.Cache.load_caches] + which will use it either immediately a cache-loading time or + on-demand, when a given cached value is accessed. *) val value_of_key : chain_id:Chain_id.t -> predecessor_context:Context.t -> @@ -11357,7 +11437,9 @@ module type PROTOCOL = sig (Context.Cache.key -> Context.Cache.value tzresult Lwt.t) tzresult Lwt.t module Mempool : sig - (** Mempool type *) + (** Mempool type. This immutable functional state keeps track of + operations added to the mempool, and allows to detect conflicts + between them and a new candidate operation. *) type t (** Validation info type required to validate and add operations to a @@ -11490,9 +11572,9 @@ module type PROTOCOL = sig end (** [activate ctxt ph] activates an economic protocol (given by its - hash [ph]) from the context [ctxt]. The resulting context is still - a context for the current economic protocol, and the migration is - not complete until [init] in invoked. *) + hash [ph]) from the context [ctxt]. The resulting context is still + a context for the current economic protocol, and the migration is + not complete until [init] in invoked. *) val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t end # 128 "v7.in.ml" diff --git a/src/lib_protocol_environment/sigs/v7/updater.mli b/src/lib_protocol_environment/sigs/v7/updater.mli index 299685d6887d..de834f8cc434 100644 --- a/src/lib_protocol_environment/sigs/v7/updater.mli +++ b/src/lib_protocol_environment/sigs/v7/updater.mli @@ -32,28 +32,28 @@ type validation_result = { (** The resulting context, it will be used for the next block. *) fitness : Fitness.t; (** The effective fitness of the block (to be compared with the one - 'announced' in the block header). *) + 'announced' in the block header). *) message : string option; (** An optional informative message, akin to a 'git commit' message, - which can be attached to the [context] when it's being commited. *) + which can be attached to the [context] when it's being commited. *) max_operations_ttl : int; (** The "time-to-live" of operations for the next block: any - operation whose 'branch' is older than 'ttl' blocks in the past - cannot be included in the next block. *) + operation whose 'branch' is older than 'ttl' blocks in the past + cannot be included in the next block. *) last_allowed_fork_level : Int32.t; (** The level of the last block for which the node might consider an - alternate branch. The shell should consider as invalid any branch - whose fork point is older (has a lower level) than the - given value. *) + alternate branch. The shell should consider as invalid any branch + whose fork point is older (has a lower level) than the + given value. *) } type quota = { max_size : int; (** The maximum size (in bytes) of the serialized list of - operations. *) + operations. *) max_op : int option; (** The maximum number of operations in a block. - [None] means no limit. *) + [None] means no limit. *) } type rpc_context = { @@ -90,11 +90,11 @@ module type PROTOCOL = sig } (** Economic protocol-specific side information computed by the - protocol during the validation of a block. Should not include - information about the evaluation of operations which is handled - separately by {!operation_metadata}. To be used as an execution - trace by tools (client, indexer). Not necessary for - validation. *) + protocol during the validation of a block. Should not include + information about the evaluation of operations which is handled + separately by {!operation_metadata}. To be used as an execution + trace by tools (client, indexer). Not necessary for + validation. *) type block_header_metadata (** Encoding for economic protocol-specific block metadata. *) @@ -104,8 +104,8 @@ module type PROTOCOL = sig type operation_data (** Economic protocol-specific side information computed by the - protocol during the validation of each operation, to be used - conjointly with {!block_header_metadata}. *) + protocol during the validation of each operation, to be used + conjointly with {!block_header_metadata}. *) type operation_receipt (** A fully parsed operation. *) @@ -131,144 +131,224 @@ module type PROTOCOL = sig val acceptable_pass : operation -> int option (** [compare_operations (oph1,op1) (oph2,op2)] defines a total - ordering relation on valid operations. - - The following requirements must be satisfied: [oph1] is the - [Operation.hash.p1], [oph2] is [Operation.hash op2] and that - [op1] and [op2] are valid in the same context. - - [compare_operations (oph1,op1) (oph2,op2) = 0] happens only if - [Operation_hash.compare oph1 oph2 = 0], meaning [op1 = op2] only - when [op1] and [op2] are structurally identical. - - Two operations of different validation_passes are compared in the - reverse order of their [validation_pass]: the one with the - smaller [validation_pass] is compared as being the greater. - - When belonging to the same validation_pass, two operations - comparison depends on their static parameters. An abstract weight - is computed for each operation based on its static parameters. - When two operations' weights are compared as equal, - [compare_operation (oph1,op1) (oph2,op2)] is - [Operation_hash.compare oph1 oph2]. - - [compare_operations] can be used as a [compare] component of an - {!Stdlib.Map.OrderedType}, or any such collection which relies on - a total comparison function. *) + ordering relation on valid operations. + + The following requirements must be satisfied: [oph1] is the + [Operation.hash.p1], [oph2] is [Operation.hash op2] and that + [op1] and [op2] are valid in the same context. + + [compare_operations (oph1,op1) (oph2,op2) = 0] happens only if + [Operation_hash.compare oph1 oph2 = 0], meaning [op1 = op2] only + when [op1] and [op2] are structurally identical. + + Two operations of different validation_passes are compared in the + reverse order of their [validation_pass]: the one with the + smaller [validation_pass] is compared as being the greater. + + When belonging to the same validation_pass, two operations + comparison depends on their static parameters. An abstract weight + is computed for each operation based on its static parameters. + When two operations' weights are compared as equal, + [compare_operation (oph1,op1) (oph2,op2)] is + [Operation_hash.compare oph1 oph2]. + + [compare_operations] can be used as a [compare] component of an + {!Stdlib.Map.OrderedType}, or any such collection which relies on + a total comparison function. *) val compare_operations : Operation_hash.t * operation -> Operation_hash.t * operation -> int - (** A functional state that is transmitted through the steps of a - block validation sequence: it can be created by any of the - [begin_x] functions below, and its final value is produced by - {!finalize_block}. It must retain the current state of the store, - and it can also contain additional information that must be - remembered during the validation process. Said extra content must - however be immutable: validator or baker implementations are - allowed to pause, replay or backtrack throughout validation - steps. *) + (** {2 Block (and operation) validation and application} + + The following functions may be used when an existing block is + received through the network, when a new block is created, or + when operations are considered on their own e.g. in a mempool or + during an RPC call. + + Validation aims at deciding quickly whether a block or + an operation is valid, with minimal computations and without + writing anything in the storage. A block is valid if it can be + applied without failure. An operation is valid if it can be + safely included in a block without causing it to fail. + + The application of an operation updates the {!Context.t} with + regards to its semantics (e.g. updating balances after a + transaction). The application of a block updates the context + with all its operations and some additional global + effects. Isolated operations may be applied as part of an RPC + call to simulate their effects. + + Blocks and operations must always be validated before they are + applied. Indeed, the application assumes their validity as a + precondition, meaning that the application of an invalid block + might yield incorrect results instead of failing cleanly. + + Note that in protocol versions <= K, where the validation + functions do not yet exist, the validation of existing blocks is + done by trying to apply it using the [Partial_application] mode + below. Therefore, the application of a validated block may still + fail in these protocols. *) + + (** The mode indicates the circumstances in which a block and/or + operations are validated or applied, and contains specific + information. It must be provided as an argument to + [begin_validation] and [begin_application]. *) + type mode = + | Application of block_header + (** Standard validation or application of a preexisting block. *) + | Partial_application of block_header + (** Partial validation of a preexisting block. This mode is + meant to quickly reject obviously invalid alternate + branches by only performing a subset of checks. + Therefore, application of blocks or operations makes no + sense in this mode: calling [begin_application] with this + mode returns an error. *) + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + (** Construction of a new block. The main difference with the + previous modes is that we cannot provide the block header to the + [begin_] functions, since the block does not exist yet. Note that + the [begin_] functions may be called in this mode without knowing + yet which operations will be included in the future block. + + The provided [block_header_data] is not expected to be the final + value of the field of the same type in the {!block_header} of the + constructed block. Instead, it should be a protocol-specific, + good enough, "prototype" of the final value. E.g. if the + {!block_header_data} type for the current economic protocol + includes a signature, then the provided [block_header_data] + should contain a fake signature (since providing a correct + signature is not possible at this stage). *) + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + (** Minimal construction of a new virtual block, with the purpose of + being able to validate/apply operations of interest. This mode may + be used by the mempool (though the [Mempool] module below is better + suited for this) or by some RPCs + e.g. [preapply/operations]. Calling the [finalize_] functions makes + no sense in this mode. *) + + (** A functional state that is transmitted throughout the validation + of a block (or during the lifetime of a mempool or RPC). It is + created by [begin_validation] below, updated by + [validate_operation], and required by [finalize_validation]. + This state is immutable thus validator or baker implementations + are allowed to pause, replay or backtrack throughout validation + steps. *) type validation_state - (** [begin_partial_application cid ctxt] checks that a block is - well-formed in a given context. This function should run quickly, - as its main use is to reject bad blocks from the chain as early - as possible. The input [ancestor_context] is expected to result - from the application of an ancestor block of the current head - with the same economic protocol. Said ancestor block is also - required to be more recent (i.e., it has a greater level), than - the current head's "last_allowed_fork_level". - - The resulting `validation_state` will be used for multi-pass - validation. *) - val begin_partial_application : - chain_id:Chain_id.t -> - ancestor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_fitness:Fitness.t -> - block_header -> + (** Similar to {!validation_state}, but for the application process. *) + type application_state + + (** [begin_validation predecessor_context chain_id mode + ~predecessor] initializes the {!validation_state} for the + validation process of an existing or new block. + + [predecessor_context] and [predecessor] are the resulting + context and shell header of the predecessor block. Exceptionally + in {!Partial_application} mode, they may instead come from any + ancestor block that is more recent (i.e. has a greater level) + than the current head's "last_allowed_fork_level". + + [mode] specifies the circumstances of validation and also + carries additional information: see {!mode}. + + Note that for protocol versions <= K where [begin_validation] + does not exist yet, this calls the old [begin_application] by + necessity. However, in [Application] mode, this calls the old + [begin_application] in [Partial_application] mode in order to run + more quickly. This preserves the behavior of [precheck] in + [lib_validation/block_validation.ml] for old protocols. It does + mean that the application of a validated block may fail in these + protocols. *) + val begin_validation : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> validation_state tzresult Lwt.t - (** [begin_application chain_id ... bh] defines the first step in a - block validation sequence. It initializes a validation context - for validating a block, whose header is [bh]. *) - val begin_application : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_fitness:Fitness.t -> - block_header -> + (** Validate an operation. If successful, return the updated + {!validation_state}. + + [check_signature] indicates whether the signature should be + checked. It defaults to [true] because the signature needs to be + correct for the operation to be valid. This argument exists for + special cases where it is acceptable to bypass this check, + e.g. if we know that the operation has already been successfully + validated in another context. *) + val validate_operation : + ?check_signature:bool -> + validation_state -> + Operation_hash.t -> + operation -> validation_state tzresult Lwt.t - (** [begin_construction] initializes a validation context for - constructing a new block, as opposed to validating an existing - block. - - This function can be used in two modes: with and without the - optional [protocol_data] argument. With the latter, it is used by - bakers to start the process for baking a new block. Without it, - is used by the Shell's prevalidator to construct a virtual block, - which carries the contents of the pre-applied operations of the - mempool. - - When [protocol_data] is provided, it is not expected to be the - final value of the field of the same name in the {!block_header} - of the block eventually being baked. Instead, it is expected to - construct a protocol-specific, good enough, "prototype" of its - final value. For instance, if the economic protocol specifies - that its block headers include a signature, [protocol_data] must - include a (faked) signature. - - Moreover, these prototypes should not be distinguishable after - the application of [begin_construction]: the function must - produce the exact same context regardless of being passed a - prototype, or an "equivalent-but-complete" header. *) - val begin_construction : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_level:Int32.t -> - predecessor_fitness:Fitness.t -> - predecessor:Block_hash.t -> - timestamp:Time.t -> - ?protocol_data:block_header_data -> - unit -> - validation_state tzresult Lwt.t + (** Run final and global checks on the block that must come after + the validation of all its operations to establish its + validity. *) + val finalize_validation : validation_state -> unit tzresult Lwt.t - (** [apply_operation vs op] applies the input operation [op] on top - of the given {!validation_state} [vs]. It must be called after - {!begin_application} or {!begin_construction}, and before - {!finalize_block}, for each operation in a block. On a successful - application, it returns a pair consisting of the resulting - [validation_state], and the corresponding [operation_receipt]. *) - val apply_operation : - validation_state -> - operation -> - (validation_state * operation_receipt) tzresult Lwt.t + (** Initialize the {!application_state} for the application process + of an existing or new block. See {!begin_validation} for details + on the arguments. - (** [finalize_block vs] finalizes the context resulting from the - application of the contents of the block being validated. + In protocol versions > K, calling this function with the + {!Partial_application} mode returns an error. *) + val begin_application : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> + application_state tzresult Lwt.t - If there is no protocol migration, i.e., if the block being - applied is not the last block of the current economic protocol, the - resulting context can be used in the future as input for the - validation of its successor blocks. *) - val finalize_block : - validation_state -> + (** Apply an operation. If successful, return the updated + {!application_state} and the corresponding {!operation_receipt}. + + This should be called for all operations in a block, after + {!begin_application} and before + {!finalize_application}. Moreover, the operation should have + already been validated by {!validate_operation}. *) + val apply_operation : + application_state -> + Operation_hash.t -> + operation -> + (application_state * operation_receipt) tzresult Lwt.t + + (** Finalize the context resulting from the application of the + contents of the block. + + If there is no protocol migration, i.e. if the block being + applied is not the last block of the current economic protocol, + then the resulting context can be used in the future as input for + the validation and application of its successor blocks. + + In {!Construction} mode, the [Block_header.shell_header option] + argument must contain a value, which will be used to compute the + [cache_nonce]. In other modes, it can as well be [None] since it + will not be used. *) + val finalize_application : + application_state -> Block_header.shell_header option -> (validation_result * block_header_metadata) tzresult Lwt.t (** [rpc_services] provides the list of remote procedures exported - by this protocol implementation. *) + by this protocol implementation. *) val rpc_services : rpc_context RPC_directory.t (** [init chain_id ctxt hd] initializes the context, or upgrades the - context after a protocol amendment. This function receives as - arguments the [chain_id] of the current chain and the context - [ctxt] resulting from the application of the block that triggered - the amendment, as well as its header [hd]. This function should - fail if the "protocol stitching", i.e., the transition from a - valid previous protocol to the one being activated, has not been - implemented. *) + context after a protocol amendment. This function receives as + arguments the [chain_id] of the current chain and the context + [ctxt] resulting from the application of the block that triggered + the amendment, as well as its header [hd]. This function should + fail if the "protocol stitching", i.e., the transition from a + valid previous protocol to the one being activated, has not been + implemented. *) val init : Chain_id.t -> Context.t -> @@ -276,18 +356,18 @@ module type PROTOCOL = sig validation_result tzresult Lwt.t (** [value_of_key chain_id predecessor_context - predecessor_timestamp predecessor_level predecessor_fitness - predecessor timestamp] returns a function to build one value of - the cache from its key. - - This function is used to restore all or part of the cache, for - instance when booting a validator to preheat the cache, or when a - reorganization happens. This function should never fail, returned - errors are fatal. - - The generated function is passed to [Context.Cache.load_caches] - which will use it either immediately a cache-loading time or - on-demand, when a given cached value is accessed. *) + predecessor_timestamp predecessor_level predecessor_fitness + predecessor timestamp] returns a function to build one value of + the cache from its key. + + This function is used to restore all or part of the cache, for + instance when booting a validator to preheat the cache, or when a + reorganization happens. This function should never fail, returned + errors are fatal. + + The generated function is passed to [Context.Cache.load_caches] + which will use it either immediately a cache-loading time or + on-demand, when a given cached value is accessed. *) val value_of_key : chain_id:Chain_id.t -> predecessor_context:Context.t -> @@ -299,7 +379,9 @@ module type PROTOCOL = sig (Context.Cache.key -> Context.Cache.value tzresult Lwt.t) tzresult Lwt.t module Mempool : sig - (** Mempool type *) + (** Mempool type. This immutable functional state keeps track of + operations added to the mempool, and allows to detect conflicts + between them and a new candidate operation. *) type t (** Validation info type required to validate and add operations to a @@ -432,7 +514,7 @@ module type PROTOCOL = sig end (** [activate ctxt ph] activates an economic protocol (given by its - hash [ph]) from the context [ctxt]. The resulting context is still - a context for the current economic protocol, and the migration is - not complete until [init] in invoked. *) + hash [ph]) from the context [ctxt]. The resulting context is still + a context for the current economic protocol, and the migration is + not complete until [init] in invoked. *) val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t diff --git a/src/lib_shell/block_directory.ml b/src/lib_shell/block_directory.ml index eb2f7f940f1f..efc9df8367ba 100644 --- a/src/lib_shell/block_directory.ml +++ b/src/lib_shell/block_directory.ml @@ -657,29 +657,55 @@ let build_raw_rpc_directory (module Proto : Block_services.PROTO) operations) ; register0 S.Helpers.Preapply.operations (fun (chain_store, block) () ops -> let* ctxt = Store.Block.context chain_store block in - let predecessor = Store.Block.hash block in - let header = Store.Block.shell_header block in - let predecessor_context = ctxt in - let* state = - Next_proto.begin_construction - ~chain_id:(Store.Chain.chain_id chain_store) - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_level:header.level - ~predecessor_fitness:header.fitness + let chain_id = Store.Chain.chain_id chain_store in + let mode = + let predecessor_hash = Store.Block.hash block in + let timestamp = Time.System.to_protocol (Time.System.now ()) in + Next_proto.Partial_construction {predecessor_hash; timestamp} + in + let predecessor = Store.Block.shell_header block in + let* validation_state = + Next_proto.begin_validation ctxt chain_id mode ~predecessor ~cache:`Lazy + in + let* application_state = + Next_proto.begin_application + ctxt + chain_id + mode ~predecessor - ~timestamp:(Time.System.to_protocol (Time.System.now ())) ~cache:`Lazy - () in - let* _state, acc = - List.fold_left_es - (fun (state, acc) op -> - let* state, result = Next_proto.apply_operation state op in - return (state, (op.protocol_data, result) :: acc)) - (state, []) + let* hashed_ops = + List.map_es + (fun op -> + match + Data_encoding.Binary.to_bytes + Next_proto.operation_data_encoding + op.Next_proto.protocol_data + with + | Error _ -> + failwith "preapply_operations: cannot deserialize operation" + | Ok proto -> + let op_t = {Operation.shell = op.shell; proto} in + Lwt_result.return (Operation.hash op_t, op)) ops in + let* _validation_state, _application_state, acc = + List.fold_left_es + (fun (validation_state, application_state, acc) (oph, op) -> + let* validation_state = + Next_proto.validate_operation validation_state oph op + in + let* application_state, result = + Next_proto.apply_operation application_state oph op + in + return + ( validation_state, + application_state, + (op.protocol_data, result) :: acc )) + (validation_state, application_state, []) + hashed_ops + 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/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index 9a06dfdcf51d..443b6b9b6962 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -78,7 +78,6 @@ module type T = sig val create : chain_store -> - ?protocol_data:Bytes.t -> predecessor:Store.Block.t -> live_operations:Operation_hash.Set.t -> timestamp:Time.Protocol.t -> @@ -131,7 +130,8 @@ module MakeAbstract type chain_store = Chain_store.chain_store type t = { - state : Proto.validation_state; + validation_state : validation_state; + application_state : Proto.application_state; applied : (protocol_operation operation * Proto.operation_receipt) list; live_operations : Operation_hash.Set.t; } @@ -172,23 +172,10 @@ module MakeAbstract count_successful_prechecks = op.count_successful_prechecks + 1; } - let create chain_store ?protocol_data ~predecessor ~live_operations ~timestamp - () = + let create chain_store ~predecessor ~live_operations ~timestamp () = (* The prevalidation module receives input from the system byt handles protocol values. It translates timestamps here. *) let open Lwt_result_syntax in - let { - Block_header.shell = - { - fitness = predecessor_fitness; - timestamp = predecessor_timestamp; - level = predecessor_level; - _; - }; - _; - } = - Store.Block.header predecessor - in let* predecessor_context = Chain_store.context chain_store predecessor in let predecessor_hash = Store.Block.hash predecessor in let*! predecessor_context = @@ -197,32 +184,26 @@ module MakeAbstract ~predecessor_hash timestamp in - let* protocol_data = - match protocol_data with - | None -> return_none - | Some protocol_data -> ( - match - Data_encoding.Binary.of_bytes_opt - Proto.block_header_data_encoding - protocol_data - with - | None -> failwith "Invalid block header" - | Some protocol_data -> return_some protocol_data) + let chain_id = Chain_store.chain_id chain_store in + let mode = Proto.Partial_construction {predecessor_hash; timestamp} in + let predecessor = (Store.Block.header predecessor).shell in + let* validation_state = + Proto.begin_validation + predecessor_context + chain_id + mode + ~predecessor + ~cache:`Lazy in - let* state = - Proto.begin_construction - ~chain_id:(Chain_store.chain_id chain_store) - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - ~predecessor_level - ~predecessor:predecessor_hash - ~timestamp - ?protocol_data + let* application_state = + Proto.begin_application + predecessor_context + chain_id + mode + ~predecessor ~cache:`Lazy - () in - return {state; applied = []; live_operations} + return {validation_state; application_state; applied = []; live_operations} let apply_operation pv op = let open Lwt_syntax in @@ -232,12 +213,23 @@ module MakeAbstract hence the returned error. *) Lwt.return (Outdated [Endorsement_branch_not_live]) else - let+ r = protect (fun () -> Proto.apply_operation pv.state op.protocol) in + let+ r = + protect (fun () -> + let open Lwt_result_syntax in + let* validation_state = + Proto.validate_operation pv.validation_state op.hash op.protocol + in + let* application_state, receipt = + Proto.apply_operation pv.application_state op.hash op.protocol + in + return (validation_state, application_state, receipt)) + in match r with - | Ok (state, receipt) -> ( + | Ok (validation_state, application_state, receipt) -> ( let pv = { - state; + validation_state; + application_state; applied = (op, receipt) :: pv.applied; live_operations = Operation_hash.Set.add op.hash pv.live_operations; @@ -261,9 +253,9 @@ module MakeAbstract | Temporary -> Branch_delayed trace | Outdated -> Outdated trace) - let validation_state {state; _} = state + let validation_state {validation_state; _} = validation_state - let set_validation_state t state = {t with state} + let set_validation_state t validation_state = {t with validation_state} let pp_result ppf = let open Format in diff --git a/src/lib_shell/prevalidation.mli b/src/lib_shell/prevalidation.mli index 3fc0a837337e..12e20f9ddaeb 100644 --- a/src/lib_shell/prevalidation.mli +++ b/src/lib_shell/prevalidation.mli @@ -87,11 +87,9 @@ module type T = sig protocol_operation operation -> protocol_operation operation (** Creates a new prevalidation context w.r.t. the protocol associated with - the predecessor block. When [?protocol_data] is passed to this function, - it will be used to create the new block. *) + the predecessor block. *) val create : chain_store -> - ?protocol_data:Bytes.t -> predecessor:Store.Block.t -> live_operations:Operation_hash.Set.t -> timestamp:Time.Protocol.t -> diff --git a/src/lib_shell/prevalidator.ml b/src/lib_shell/prevalidator.ml index c53a8b1236f1..193a427b698f 100644 --- a/src/lib_shell/prevalidator.ml +++ b/src/lib_shell/prevalidator.ml @@ -1470,7 +1470,6 @@ module Make let chain_store = Distributed_db.chain_store chain_db in Prevalidation_t.create chain_store - ?protocol_data:None ~predecessor ~live_operations ~timestamp diff --git a/src/lib_shell/test/test_prevalidation_t.ml b/src/lib_shell/test/test_prevalidation_t.ml index 95589530f4e2..19edf742676d 100644 --- a/src/lib_shell/test/test_prevalidation_t.ml +++ b/src/lib_shell/test/test_prevalidation_t.ml @@ -34,16 +34,19 @@ module Mock_protocol : Tezos_protocol_environment.PROTOCOL with type operation_data = unit and type operation_receipt = unit - and type validation_state = unit = struct + and type validation_state = unit + and type application_state = unit = struct open Tezos_protocol_environment.Internal_for_tests include Environment_protocol_T_test.Mock_all_unit - let begin_construction ~chain_id:_ ~predecessor_context:_ - ~predecessor_timestamp:_ ~predecessor_level:_ ~predecessor_fitness:_ - ~predecessor:_ ~timestamp:_ ?protocol_data:_ ~cache:_ _ = - (* We need to override this function (so that it's not [assert false]), - because Prevalidation.create calls this function, so we need it - to work in all tests below. *) + (* We need to override these functions so that they're not [assert + false], because the tests below use [Prevalidation.create] which + calls them. *) + + let begin_validation _ctxt _chain_id _mode ~predecessor:_ ~cache:_ = + Lwt_result_syntax.return_unit + + let begin_application _ctxt _chain_id _mode ~predecessor:_ ~cache:_ = Lwt_result_syntax.return_unit end @@ -233,11 +236,12 @@ let test_apply_operation_live_operations ctxt = let (module Protocol : Tezos_protocol_environment.PROTOCOL with type operation_data = unit and type operation_receipt = unit - and type validation_state = unit) = + and type validation_state = unit + and type application_state = unit) = (module struct include Mock_protocol - let apply_operation _ _ = + let apply_operation _ _ _ = Lwt.return (if Random.State.bool rand then Ok ((), ()) else error_with "Operation doesn't apply") @@ -286,7 +290,7 @@ let test_apply_operation_applied ctxt = (module struct include Mock_protocol - let apply_operation _ _ = + let apply_operation _ _ _ = Lwt.return (if Random.State.bool rand then Ok ((), ()) else error_with "Operation doesn't apply") diff --git a/src/lib_store/unix/test/alpha_utils.ml b/src/lib_store/unix/test/alpha_utils.ml index 954a7b85cb0d..9ca1930ca7eb 100644 --- a/src/lib_store/unix/test/alpha_utils.ml +++ b/src/lib_store/unix/test/alpha_utils.ml @@ -462,6 +462,31 @@ let nb_validation_passes = List.length Main.validation_passes let empty_operations = WithExceptions.List.init ~loc:__LOC__ nb_validation_passes (fun _ -> []) +let begin_validation_and_application ctxt chain_id mode ~predecessor = + let open Lwt_result_syntax in + let* validation_state = + Main.begin_validation ctxt chain_id mode ~predecessor + in + let* application_state = + Main.begin_application ctxt chain_id mode ~predecessor + in + return (validation_state, application_state) + +let validate_and_apply_operation (validation_state, application_state) op = + let open Lwt_result_syntax in + let oph = Operation.hash_packed op in + let* validation_state = Main.validate_operation validation_state oph op in + let* application_state, receipt = + Main.apply_operation application_state oph op + in + return ((validation_state, application_state), receipt) + +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = Main.finalize_validation validation_state in + Main.finalize_application application_state shell_header + let apply ctxt chain_id ~policy ?(operations = empty_operations) pred = let open Lwt_result_syntax in let* rpc_ctxt = make_rpc_context ~chain_id ctxt pred in @@ -519,26 +544,26 @@ let apply ctxt chain_id ~policy ?(operations = empty_operations) pred = let*! r = let open Environment.Error_monad in let* vstate = - Main.begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp:(Store.Block.timestamp pred) - ~predecessor_level:(Store.Block.level pred) - ~predecessor_fitness:(Store.Block.fitness pred) - ~predecessor:(Store.Block.hash pred) - ~timestamp:shell.timestamp - ~protocol_data - () + begin_validation_and_application + predecessor_context + chain_id + (Construction + { + predecessor_hash = Store.Block.hash pred; + timestamp = shell.timestamp; + block_header_data = protocol_data; + }) + ~predecessor:(Store.Block.shell_header pred) in let* vstate = List.fold_left_es (List.fold_left_es (fun vstate op -> - let* state, _result = apply_operation vstate op in + let* state, _result = validate_and_apply_operation vstate op in return state)) vstate operations in - Main.finalize_block vstate (Some shell) + finalize_validation_and_application vstate (Some shell) in let*? r = Environment.wrap_tzresult r in return r diff --git a/src/lib_validation/block_validation.ml b/src/lib_validation/block_validation.ml index 9ff2100efdb7..d0b8d82e01ec 100644 --- a/src/lib_validation/block_validation.ml +++ b/src/lib_validation/block_validation.ml @@ -276,7 +276,8 @@ module Make (Proto : Registered_protocol.T) = struct } type preapply_state = { - state : Proto.validation_state; + validation_state : Proto.validation_state; + application_state : Proto.application_state; applied : (Proto.operation_data preapplied_operation * Proto.operation_receipt) list; live_blocks : Block_hash.Set.t; @@ -415,7 +416,7 @@ module Make (Proto : Registered_protocol.T) = struct block_hash (Unallowed_pass {operation = op_hash; pass; allowed_pass})) in - return op)) + return (op_hash, op))) operations (* FIXME: This code is used by preapply but emitting time @@ -527,20 +528,21 @@ module Make (Proto : Registered_protocol.T) = struct (invalid_block block_hash Economic_protocol_error) (let* state = (Proto.begin_application - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:predecessor_block_header.shell.timestamp - ~predecessor_fitness:predecessor_block_header.shell.fitness - ~cache - block_header [@time.duration_lwt application_beginning]) + context + chain_id + (Application block_header) + ~predecessor:predecessor_block_header.shell + ~cache [@time.duration_lwt application_beginning]) in let* state, ops_metadata = (List.fold_left_es (fun (state, acc) ops -> let* state, ops_metadata = List.fold_left_es - (fun (state, acc) op -> - let* state, op_metadata = Proto.apply_operation state op in + (fun (state, acc) (oph, op) -> + let* state, op_metadata = + Proto.apply_operation state oph op + in return (state, op_metadata :: acc)) (state, []) ops @@ -551,7 +553,7 @@ module Make (Proto : Registered_protocol.T) = struct in let ops_metadata = List.rev ops_metadata in let* validation_result, block_data = - (Proto.finalize_block + (Proto.finalize_application state (Some block_header.shell) [@time.duration_lwt block_finalization]) in @@ -787,15 +789,24 @@ module Make (Proto : Registered_protocol.T) = struct else let+ r = protect (fun () -> - Proto.apply_operation - pv.state - {shell = op.raw.shell; protocol_data = op.protocol_data}) + let operation : Proto.operation = + {shell = op.raw.shell; protocol_data = op.protocol_data} + in + let open Lwt_result_syntax in + let* validation_state = + Proto.validate_operation pv.validation_state op.hash operation + in + let* application_state, receipt = + Proto.apply_operation pv.application_state op.hash operation + in + return (validation_state, application_state, receipt)) in match r with - | Ok (state, receipt) -> ( + | Ok (validation_state, application_state, receipt) -> ( let pv = { - state; + validation_state; + application_state; applied = (op, receipt) :: pv.applied; live_blocks = pv.live_blocks; live_operations = @@ -884,20 +895,35 @@ module Make (Proto : Registered_protocol.T) = struct Lwt_result.ok @@ Context_ops.add_predecessor_ops_metadata_hash context hash in - let* state = - Proto.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:predecessor_shell_header.Block_header.timestamp - ~predecessor_fitness:predecessor_shell_header.Block_header.fitness - ~predecessor_level:predecessor_shell_header.level - ~predecessor:predecessor_hash - ~timestamp - ~protocol_data + let mode = + Proto.Construction + {predecessor_hash; timestamp; block_header_data = protocol_data} + in + let* validation_state = + Proto.begin_validation + context + chain_id + mode + ~predecessor:predecessor_shell_header + ~cache + in + let* application_state = + Proto.begin_application + context + chain_id + mode + ~predecessor:predecessor_shell_header ~cache - () in - let preapply_state = {state; applied = []; live_blocks; live_operations} in + let preapply_state = + { + validation_state; + application_state; + applied = []; + live_blocks; + live_operations; + } + in let apply_operation_with_preapply_result preapp t receipts op = let open Preapply_result in let*! r = preapply_operation t op in @@ -994,8 +1020,11 @@ module Make (Proto : Registered_protocol.T) = struct fitness = []; } in + let* () = Proto.finalize_validation preapply_state.validation_state in let* validation_result, block_header_metadata = - Proto.finalize_block preapply_state.state (Some shell_header) + Proto.finalize_application + preapply_state.application_state + (Some shell_header) in let*! validation_result = may_patch_protocol @@ -1101,27 +1130,26 @@ module Make (Proto : Registered_protocol.T) = struct in let* operations = parse_operations block_hash operations in let* state = - Proto.begin_partial_application - ~chain_id - ~ancestor_context:context - ~predecessor:predecessor_block_header - ~predecessor_hash:predecessor_block_hash + Proto.begin_validation + context + chain_id + (Application block_header) + ~predecessor:predecessor_block_header.shell ~cache - block_header in let* state = List.fold_left_es (fun state ops -> List.fold_left_es - (fun state op -> - let* state, _op_metadata = Proto.apply_operation state op in + (fun state (oph, op) -> + let* state = Proto.validate_operation state oph op in return state) state ops) state operations in - let* _validation_result, _block_data = Proto.finalize_block state None in + let* () = Proto.finalize_validation state in return_unit let precheck chain_id ~(predecessor_block_header : Block_header.t) diff --git a/src/lib_validation/block_validation.mli b/src/lib_validation/block_validation.mli index 3bce57c5b38a..6d53db17f11f 100644 --- a/src/lib_validation/block_validation.mli +++ b/src/lib_validation/block_validation.mli @@ -120,8 +120,8 @@ type apply_environment = { (** Default size limit for operation metadata *) val default_operation_metadata_size_limit : int option -(** [apply env header ops] gets the protocol [P] of the context of the predecessor - block and calls successively: +(** [apply env header ops] gets the protocol [P] of the context of the + predecessor block and calls successively: 1. [P.begin_application] 2. [P.apply] 3. [P.finalize_block] @@ -129,7 +129,9 @@ val default_operation_metadata_size_limit : int option If [simulate] is true, the context resulting from the application is not committed to disk using `Context.commit`, only the commit hash is computed, using `Context.hash`. Set to false by default. -*) + + Hypothesis: we assume that the given block has already been + validated -- E.g. by calling [precheck]. *) val apply : ?simulate:bool -> ?cached_result:apply_result * Tezos_protocol_environment.Context.t -> @@ -142,8 +144,10 @@ val apply : (** [precheck chain_id ~predecessor_block_header ~predecessor_block_hash ~predecessor_context ~cache header ops] gets the protocol [P] of the context of the predecessor block and - calls successively: 1. [P.begin_partial_application] 2. [P.apply] - 3. [P.finalize_block] *) + calls successively: + 1. [P.begin_validate] + 2. [P.validate_operation] + 3. [P.finalize_validation] *) val precheck : chain_id:Chain_id.t -> predecessor_block_header:Block_header.t -> @@ -175,6 +179,8 @@ val preapply : tzresult Lwt.t +(** Hypothesis: we assume that the given block has already been + validated -- E.g. by calling [precheck]. *) val recompute_metadata : chain_id:Chain_id.t -> predecessor_block_header:Block_header.t -> diff --git a/src/proto_012_Psithaca/lib_delegate/baking_simulator.ml b/src/proto_012_Psithaca/lib_delegate/baking_simulator.ml index 08fb0417b465..125ab0fbf45c 100644 --- a/src/proto_012_Psithaca/lib_delegate/baking_simulator.ml +++ b/src/proto_012_Psithaca/lib_delegate/baking_simulator.ml @@ -80,7 +80,7 @@ let check_context_consistency (abstract_index : Abstract_context_index.t) | true -> return_unit | false -> fail Invalid_context)) -let begin_construction ~timestamp ?protocol_data +let begin_construction ~timestamp ~protocol_data (abstract_index : Abstract_context_index.t) predecessor chain_id = protect (fun () -> let {Baking_state.shell = pred_shell; hash = pred_hash; _} = @@ -103,17 +103,17 @@ let begin_construction ~timestamp ?protocol_data Operation_list_list_hash.zero (* fake op hash *); } in - Lifted_protocol.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:pred_shell.timestamp - ~predecessor_fitness:pred_shell.fitness - ~predecessor_level:pred_shell.level - ~predecessor:pred_hash - ?protocol_data - ~timestamp + Lifted_protocol.begin_application + context + chain_id + (Construction + { + predecessor_hash = predecessor.hash; + timestamp; + block_header_data = protocol_data; + }) + ~predecessor:pred_shell ~cache:`Lazy - () >>=? fun state -> return {predecessor; context; state; rev_operations = []; header}) diff --git a/src/proto_012_Psithaca/lib_delegate/baking_simulator.mli b/src/proto_012_Psithaca/lib_delegate/baking_simulator.mli index 582fbd3e2922..eff536a60cda 100644 --- a/src/proto_012_Psithaca/lib_delegate/baking_simulator.mli +++ b/src/proto_012_Psithaca/lib_delegate/baking_simulator.mli @@ -43,7 +43,7 @@ val check_context_consistency : val begin_construction : timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> + protocol_data:block_header_data -> Abstract_context_index.t -> Baking_state.block_info -> Chain_id.t -> diff --git a/src/proto_012_Psithaca/lib_delegate/test/mockup_simulator/mockup_simulator.ml b/src/proto_012_Psithaca/lib_delegate/test/mockup_simulator/mockup_simulator.ml index 3b8acb2d6e11..289181dcb9ed 100644 --- a/src/proto_012_Psithaca/lib_delegate/test/mockup_simulator/mockup_simulator.ml +++ b/src/proto_012_Psithaca/lib_delegate/test/mockup_simulator/mockup_simulator.ml @@ -488,12 +488,11 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let predecessor_context = rpc_context.context in parse_protocol_data block_header.protocol_data >>=? fun protocol_data -> Mockup.M.Protocol.begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness + predecessor_context + chain_id + (Application {shell = block_header.shell; protocol_data}) + ~predecessor:header ~cache:`Lazy - {shell = block_header.shell; protocol_data} >>=? fun validation_state -> let i = ref 0 in List.fold_left_es @@ -507,13 +506,18 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let op = {Mockup.M.Protocol.shell = op.shell; protocol_data = operation_data} in - Mockup.M.Protocol.apply_operation validation_state op + Mockup.M.Protocol.apply_operation + validation_state + (* The operation hash argument is ignored in protocol + environment versions < V7. *) + Operation_hash.zero + op >>=? fun (validation_state, receipt) -> return (validation_state, receipt :: results))) (validation_state, []) operations >>=? fun (validation_state, _) -> - Mockup.M.Protocol.finalize_block validation_state None + Mockup.M.Protocol.finalize_application validation_state None (** Process an incoming block. If validation succeeds: - update the current head to this new block diff --git a/src/proto_013_PtJakart/lib_delegate/baking_simulator.ml b/src/proto_013_PtJakart/lib_delegate/baking_simulator.ml index 08fb0417b465..125ab0fbf45c 100644 --- a/src/proto_013_PtJakart/lib_delegate/baking_simulator.ml +++ b/src/proto_013_PtJakart/lib_delegate/baking_simulator.ml @@ -80,7 +80,7 @@ let check_context_consistency (abstract_index : Abstract_context_index.t) | true -> return_unit | false -> fail Invalid_context)) -let begin_construction ~timestamp ?protocol_data +let begin_construction ~timestamp ~protocol_data (abstract_index : Abstract_context_index.t) predecessor chain_id = protect (fun () -> let {Baking_state.shell = pred_shell; hash = pred_hash; _} = @@ -103,17 +103,17 @@ let begin_construction ~timestamp ?protocol_data Operation_list_list_hash.zero (* fake op hash *); } in - Lifted_protocol.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:pred_shell.timestamp - ~predecessor_fitness:pred_shell.fitness - ~predecessor_level:pred_shell.level - ~predecessor:pred_hash - ?protocol_data - ~timestamp + Lifted_protocol.begin_application + context + chain_id + (Construction + { + predecessor_hash = predecessor.hash; + timestamp; + block_header_data = protocol_data; + }) + ~predecessor:pred_shell ~cache:`Lazy - () >>=? fun state -> return {predecessor; context; state; rev_operations = []; header}) diff --git a/src/proto_013_PtJakart/lib_delegate/baking_simulator.mli b/src/proto_013_PtJakart/lib_delegate/baking_simulator.mli index 582fbd3e2922..eff536a60cda 100644 --- a/src/proto_013_PtJakart/lib_delegate/baking_simulator.mli +++ b/src/proto_013_PtJakart/lib_delegate/baking_simulator.mli @@ -43,7 +43,7 @@ val check_context_consistency : val begin_construction : timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> + protocol_data:block_header_data -> Abstract_context_index.t -> Baking_state.block_info -> Chain_id.t -> diff --git a/src/proto_013_PtJakart/lib_delegate/test/mockup_simulator/mockup_simulator.ml b/src/proto_013_PtJakart/lib_delegate/test/mockup_simulator/mockup_simulator.ml index 0af160aed4a3..c7b89de68398 100644 --- a/src/proto_013_PtJakart/lib_delegate/test/mockup_simulator/mockup_simulator.ml +++ b/src/proto_013_PtJakart/lib_delegate/test/mockup_simulator/mockup_simulator.ml @@ -488,12 +488,11 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let predecessor_context = rpc_context.context in parse_protocol_data block_header.protocol_data >>=? fun protocol_data -> Mockup.M.Protocol.begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness + predecessor_context + chain_id + (Application {shell = block_header.shell; protocol_data}) + ~predecessor:header ~cache:`Lazy - {shell = block_header.shell; protocol_data} >>=? fun validation_state -> let i = ref 0 in List.fold_left_es @@ -507,13 +506,18 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let op = {Mockup.M.Protocol.shell = op.shell; protocol_data = operation_data} in - Mockup.M.Protocol.apply_operation validation_state op + Mockup.M.Protocol.apply_operation + validation_state + (* The operation hash argument is ignored in protocol + environment versions < V7. *) + Operation_hash.zero + op >>=? fun (validation_state, receipt) -> return (validation_state, receipt :: results))) (validation_state, []) operations >>=? fun (validation_state, _) -> - Mockup.M.Protocol.finalize_block validation_state None + Mockup.M.Protocol.finalize_application validation_state None (** Process an incoming block. If validation succeeds: - update the current head to this new block diff --git a/src/proto_014_PtKathma/lib_delegate/baking_simulator.ml b/src/proto_014_PtKathma/lib_delegate/baking_simulator.ml index 08fb0417b465..125ab0fbf45c 100644 --- a/src/proto_014_PtKathma/lib_delegate/baking_simulator.ml +++ b/src/proto_014_PtKathma/lib_delegate/baking_simulator.ml @@ -80,7 +80,7 @@ let check_context_consistency (abstract_index : Abstract_context_index.t) | true -> return_unit | false -> fail Invalid_context)) -let begin_construction ~timestamp ?protocol_data +let begin_construction ~timestamp ~protocol_data (abstract_index : Abstract_context_index.t) predecessor chain_id = protect (fun () -> let {Baking_state.shell = pred_shell; hash = pred_hash; _} = @@ -103,17 +103,17 @@ let begin_construction ~timestamp ?protocol_data Operation_list_list_hash.zero (* fake op hash *); } in - Lifted_protocol.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:pred_shell.timestamp - ~predecessor_fitness:pred_shell.fitness - ~predecessor_level:pred_shell.level - ~predecessor:pred_hash - ?protocol_data - ~timestamp + Lifted_protocol.begin_application + context + chain_id + (Construction + { + predecessor_hash = predecessor.hash; + timestamp; + block_header_data = protocol_data; + }) + ~predecessor:pred_shell ~cache:`Lazy - () >>=? fun state -> return {predecessor; context; state; rev_operations = []; header}) diff --git a/src/proto_014_PtKathma/lib_delegate/baking_simulator.mli b/src/proto_014_PtKathma/lib_delegate/baking_simulator.mli index 582fbd3e2922..eff536a60cda 100644 --- a/src/proto_014_PtKathma/lib_delegate/baking_simulator.mli +++ b/src/proto_014_PtKathma/lib_delegate/baking_simulator.mli @@ -43,7 +43,7 @@ val check_context_consistency : val begin_construction : timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> + protocol_data:block_header_data -> Abstract_context_index.t -> Baking_state.block_info -> Chain_id.t -> diff --git a/src/proto_014_PtKathma/lib_delegate/test/mockup_simulator/mockup_simulator.ml b/src/proto_014_PtKathma/lib_delegate/test/mockup_simulator/mockup_simulator.ml index 0af160aed4a3..c7b89de68398 100644 --- a/src/proto_014_PtKathma/lib_delegate/test/mockup_simulator/mockup_simulator.ml +++ b/src/proto_014_PtKathma/lib_delegate/test/mockup_simulator/mockup_simulator.ml @@ -488,12 +488,11 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let predecessor_context = rpc_context.context in parse_protocol_data block_header.protocol_data >>=? fun protocol_data -> Mockup.M.Protocol.begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness + predecessor_context + chain_id + (Application {shell = block_header.shell; protocol_data}) + ~predecessor:header ~cache:`Lazy - {shell = block_header.shell; protocol_data} >>=? fun validation_state -> let i = ref 0 in List.fold_left_es @@ -507,13 +506,18 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let op = {Mockup.M.Protocol.shell = op.shell; protocol_data = operation_data} in - Mockup.M.Protocol.apply_operation validation_state op + Mockup.M.Protocol.apply_operation + validation_state + (* The operation hash argument is ignored in protocol + environment versions < V7. *) + Operation_hash.zero + op >>=? fun (validation_state, receipt) -> return (validation_state, receipt :: results))) (validation_state, []) operations >>=? fun (validation_state, _) -> - Mockup.M.Protocol.finalize_block validation_state None + Mockup.M.Protocol.finalize_application validation_state None (** Process an incoming block. If validation succeeds: - update the current head to this new block 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 90c24f32cdeb..30cdec2015a6 100644 --- a/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml @@ -206,8 +206,7 @@ module Sc_rollup_add_external_messages_benchmark = struct let open Lwt_result_syntax in let* block, _ = Context.init1 () in let+ b = Incremental.begin_construction block in - let state = Incremental.validation_state b in - let ctxt = state.application_state.ctxt in + let ctxt = Incremental.alpha_ctxt b in (* Necessary to originate rollups. *) let ctxt = Alpha_context.Origination_nonce.init ctxt Operation_hash.zero diff --git a/src/proto_alpha/lib_delegate/baking_simulator.ml b/src/proto_alpha/lib_delegate/baking_simulator.ml index 08fb0417b465..957768d1b412 100644 --- a/src/proto_alpha/lib_delegate/baking_simulator.ml +++ b/src/proto_alpha/lib_delegate/baking_simulator.ml @@ -31,10 +31,6 @@ type error += Failed_to_checkout_context type error += Invalid_context -let wrap_error_lwt x = x >>= fun x -> Lwt.return @@ Environment.wrap_tzresult x - -let ( >>=?? ) x k = wrap_error_lwt x >>=? k - let () = register_error_kind `Permanent @@ -58,7 +54,7 @@ let () = type incremental = { predecessor : Baking_state.block_info; context : Tezos_protocol_environment.Context.t; - state : Protocol.validation_state; + state : Protocol.validation_state * Protocol.application_state; rev_operations : Operation.packed list; header : Tezos_base.Block_header.shell_header; } @@ -80,7 +76,7 @@ let check_context_consistency (abstract_index : Abstract_context_index.t) | true -> return_unit | false -> fail Invalid_context)) -let begin_construction ~timestamp ?protocol_data +let begin_construction ~timestamp ~protocol_data (abstract_index : Abstract_context_index.t) predecessor chain_id = protect (fun () -> let {Baking_state.shell = pred_shell; hash = pred_hash; _} = @@ -103,25 +99,55 @@ let begin_construction ~timestamp ?protocol_data Operation_list_list_hash.zero (* fake op hash *); } in - Lifted_protocol.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:pred_shell.timestamp - ~predecessor_fitness:pred_shell.fitness - ~predecessor_level:pred_shell.level - ~predecessor:pred_hash - ?protocol_data - ~timestamp + let mode = + Lifted_protocol.Construction + { + predecessor_hash = predecessor.hash; + timestamp; + block_header_data = protocol_data; + } + in + Lifted_protocol.begin_validation + context + chain_id + mode + ~predecessor:pred_shell ~cache:`Lazy - () - >>=? fun state -> + >>=? fun validation_state -> + Lifted_protocol.begin_application + context + chain_id + mode + ~predecessor:pred_shell + ~cache:`Lazy + >>=? fun application_state -> + let state = (validation_state, application_state) in return {predecessor; context; state; rev_operations = []; header}) +let ( let** ) x k = + let open Lwt_result_syntax in + let*! x = x in + let*? x = Environment.wrap_tzresult x in + k x + let add_operation st (op : Operation.packed) = protect (fun () -> - Protocol.apply_operation st.state op >>=?? fun (state, receipt) -> + let validation_state, application_state = st.state in + let oph = Operation.hash_packed op in + let** validation_state = + Protocol.validate_operation validation_state oph op + in + let** application_state, receipt = + Protocol.apply_operation application_state oph op + in + let state = (validation_state, application_state) in return ({st with state; rev_operations = op :: st.rev_operations}, receipt)) let finalize_construction inc = protect (fun () -> - Protocol.finalize_block inc.state (Some inc.header) >>=?? return) + let validation_state, application_state = inc.state in + let** () = Protocol.finalize_validation validation_state in + let** result = + Protocol.finalize_application application_state (Some inc.header) + in + return result) diff --git a/src/proto_alpha/lib_delegate/baking_simulator.mli b/src/proto_alpha/lib_delegate/baking_simulator.mli index 582fbd3e2922..0d0c7ac9f4d2 100644 --- a/src/proto_alpha/lib_delegate/baking_simulator.mli +++ b/src/proto_alpha/lib_delegate/baking_simulator.mli @@ -29,7 +29,7 @@ open Alpha_context type incremental = { predecessor : Baking_state.block_info; context : Tezos_protocol_environment.Context.t; - state : validation_state; + state : validation_state * application_state; rev_operations : Operation.packed list; header : Tezos_base.Block_header.shell_header; } @@ -43,7 +43,7 @@ val check_context_consistency : val begin_construction : timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> + protocol_data:block_header_data -> Abstract_context_index.t -> Baking_state.block_info -> Chain_id.t -> diff --git a/src/proto_alpha/lib_delegate/test/mockup_simulator/mockup_simulator.ml b/src/proto_alpha/lib_delegate/test/mockup_simulator/mockup_simulator.ml index 48ba5170d77f..ca26b7547a25 100644 --- a/src/proto_alpha/lib_delegate/test/mockup_simulator/mockup_simulator.ml +++ b/src/proto_alpha/lib_delegate/test/mockup_simulator/mockup_simulator.ml @@ -481,24 +481,50 @@ let clear_mempool state = state.mempool <- mempool ; return_unit +let begin_validation_and_application ctxt chain_id mode ~predecessor ~cache = + let open Lwt_result_syntax in + let* validation_state = + Mockup.M.Protocol.begin_validation ctxt chain_id mode ~predecessor ~cache + in + let* application_state = + Mockup.M.Protocol.begin_application ctxt chain_id mode ~predecessor ~cache + in + return (validation_state, application_state) + +let validate_and_apply_operation (validation_state, application_state) oph op = + let open Lwt_result_syntax in + let* validation_state = + Mockup.M.Protocol.validate_operation validation_state oph op + in + let* application_state, receipt = + Mockup.M.Protocol.apply_operation application_state oph op + in + return ((validation_state, application_state), receipt) + +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = Mockup.M.Protocol.finalize_validation validation_state in + Mockup.M.Protocol.finalize_application application_state shell_header + (** Apply a block to the given [rpc_context]. *) let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) (operations : Operation.t list list) (block_header : Block_header.t) = - let header = rpc_context.block_header in + let predecessor = rpc_context.block_header in let predecessor_context = rpc_context.context in parse_protocol_data block_header.protocol_data >>=? fun protocol_data -> - Mockup.M.Protocol.begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness + begin_validation_and_application + predecessor_context + chain_id + (Application {shell = block_header.shell; protocol_data}) + ~predecessor ~cache:`Lazy - {shell = block_header.shell; protocol_data} - >>=? fun validation_state -> + >>=? fun state -> let i = ref 0 in List.fold_left_es - (List.fold_left_es (fun (validation_state, results) op -> + (List.fold_left_es (fun (state, results) op -> incr i ; + let oph = Operation.hash op in let operation_data = Data_encoding.Binary.of_bytes_exn Mockup.M.Protocol.operation_data_encoding @@ -507,13 +533,11 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let op = {Mockup.M.Protocol.shell = op.shell; protocol_data = operation_data} in - Mockup.M.Protocol.apply_operation validation_state op - >>=? fun (validation_state, receipt) -> - return (validation_state, receipt :: results))) - (validation_state, []) + validate_and_apply_operation state oph op >>=? fun (state, receipt) -> + return (state, receipt :: results))) + (state, []) operations - >>=? fun (validation_state, _) -> - Mockup.M.Protocol.finalize_block validation_state None + >>=? fun (state, _) -> finalize_validation_and_application state None (** Process an incoming block. If validation succeeds: - update the current head to this new block diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index e032a99be8d4..369082de7e34 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -251,7 +251,8 @@ let init config ?(validation_state : validation_state option) ~predecessor () = ignore config ; (match validation_state with | None -> return empty - | Some {application_state = {ctxt; _}; _} -> + | Some validation_state -> + let ctxt = Validate.get_initial_ctxt validation_state in let { Tezos_base.Block_header.fitness = predecessor_fitness; timestamp = predecessor_timestamp; @@ -459,7 +460,8 @@ 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.application_state.ctxt + Constants.hard_gas_limit_per_block + (Validate.get_initial_ctxt validation_state) in let max_size = managers_quota.max_size in let size = match size with None -> size_of_operation op | Some s -> s in @@ -872,12 +874,12 @@ let proto_validate_operation validation_state oph ~nb_successful_prechecks let*! res = Validate.validate_operation ~check_signature:(nb_successful_prechecks <= 0) - validation_state.validity_state + validation_state oph operation in match res with - | Ok validity_state -> return {validation_state with validity_state} + | Ok validation_state -> return validation_state | Error tztrace -> let err = Environment.wrap_tztrace tztrace in let error_classification = @@ -938,10 +940,9 @@ 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 operation_state = - Validate.remove_operation validation_state.validity_state.operation_state op + Validate.remove_operation validation_state.Validate.operation_state op in - let validity_state = {validation_state.validity_state with operation_state} in - {validation_state with validity_state} + {validation_state with operation_state} (** Call the protocol validation on a manager operation and handle potential conflicts: if either the 1M restriction is triggered or @@ -1361,11 +1362,14 @@ let rec post_filter_manager : | `Refused _ as errs -> errs) let post_filter config ~(filter_state : state) ~validation_state_before:_ - ~validation_state_after: - ({application_state = {ctxt; _}; _} : validation_state) (_op, receipt) = + ~validation_state_after (_op, receipt) = match receipt with | No_operation_metadata -> assert false (* only for multipass validator *) | Operation_metadata {contents} -> ( + let handle_manager result = + let ctxt = Validate.get_initial_ctxt validation_state_after in + Lwt.return (post_filter_manager ctxt filter_state result config) + in match contents with | Single_result (Preendorsement_result _) | Single_result (Endorsement_result _) @@ -1381,6 +1385,6 @@ let post_filter config ~(filter_state : state) ~validation_state_before:_ | Single_result Ballot_result -> Lwt.return (`Passed_postfilter filter_state) | Single_result (Manager_operation_result _) as result -> - Lwt.return (post_filter_manager ctxt filter_state result config) + handle_manager result | Cons_result (Manager_operation_result _, _) as result -> - Lwt.return (post_filter_manager ctxt filter_state result config)) + handle_manager result) diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index c9a9ab303ebe..13f68a984278 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -90,10 +90,9 @@ let rpc_services = Alpha_services.register () ; Services_registration.get_rpc_services () -type validation_state = { - validity_state : Validate.validation_state; - application_state : Apply.application_state; -} +type validation_state = Validate.validation_state + +type application_state = Apply.application_state let init_allowed_consensus_operations ctxt ~endorsement_level ~preendorsement_level = @@ -127,8 +126,8 @@ let init_allowed_consensus_operations ctxt ~endorsement_level (** Circumstances and relevant information for [begin_validation] and [begin_application] below. *) type mode = - | Application of {block_header : block_header} - | Partial_application of {block_header : block_header} + | Application of block_header + | Partial_application of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -144,7 +143,7 @@ let prepare_ctxt ctxt mode ~(predecessor : Block_header.shell_header) = let open Alpha_context in let level, timestamp = match mode with - | Application {block_header} | Partial_application {block_header} -> + | Application block_header | Partial_application block_header -> (block_header.shell.level, block_header.shell.timestamp) | Construction {timestamp; _} | Partial_construction {timestamp; _} -> (Int32.succ predecessor.level, timestamp) @@ -192,7 +191,7 @@ let begin_validation ctxt chain_id mode ~predecessor = let predecessor_timestamp = predecessor.timestamp in let predecessor_fitness = predecessor.fitness in match mode with - | Application {block_header} -> + | Application block_header -> let*? fitness = Fitness.from_raw block_header.shell.fitness in Validate.begin_application ctxt @@ -201,7 +200,7 @@ let begin_validation ctxt chain_id mode ~predecessor = ~predecessor_timestamp block_header fitness - | Partial_application {block_header} -> + | Partial_application block_header -> let*? fitness = Fitness.from_raw block_header.shell.fitness in Validate.begin_partial_application ctxt @@ -245,7 +244,7 @@ let validate_operation = Validate.validate_operation let finalize_validation = Validate.finalize_block -let new_begin_application ctxt chain_id mode ~predecessor = +let begin_application ctxt chain_id mode ~predecessor = let open Lwt_tzresult_syntax in let open Alpha_context in let* ( ctxt, @@ -258,7 +257,7 @@ let new_begin_application ctxt chain_id mode ~predecessor = let predecessor_timestamp = predecessor.timestamp in let predecessor_fitness = predecessor.fitness in match mode with - | Application {block_header} -> + | Application block_header -> Apply.begin_application ctxt chain_id @@ -266,7 +265,7 @@ let new_begin_application ctxt chain_id mode ~predecessor = ~migration_operation_results ~predecessor_fitness block_header - | Partial_application {block_header} -> + | Partial_application block_header -> Apply.begin_partial_application chain_id ~ancestor_context:ctxt @@ -296,145 +295,10 @@ let new_begin_application ctxt chain_id mode ~predecessor = ~predecessor_level:predecessor_raw_level ~predecessor_fitness -let new_apply_operation = Apply.apply_operation +let apply_operation = Apply.apply_operation let finalize_application = Apply.finalize_block -(* Dummy block header for the predecessor, setting only the fields - which will actually be accessed by the validation or application of - blocks and operations (that is, the ones taken as arguments). - - This is a temporary function used by the updater-compliant - functions below; it will go away in the next commit. *) -let dummy_predecessor ~predecessor_timestamp ~predecessor_fitness - ~predecessor_level = - { - Block_header.level = predecessor_level; - proto_level = 0; - predecessor = Block_hash.zero; - timestamp = predecessor_timestamp; - validation_passes = 0; - operations_hash = Operation_list_list_hash.zero; - fitness = predecessor_fitness; - context = Context_hash.zero; - } - -(* Updater's signature compliant functions, that will be removed in - the next commit. *) - -let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness (block_header : block_header) = - let open Lwt_tzresult_syntax in - let predecessor = - dummy_predecessor - ~predecessor_timestamp - ~predecessor_fitness - ~predecessor_level:(Int32.pred block_header.shell.level) - in - let* validity_state = - begin_validation - predecessor_context - chain_id - ~predecessor - (Application {block_header}) - in - let* application_state = - new_begin_application - predecessor_context - chain_id - ~predecessor - (Application {block_header}) - in - return {validity_state; application_state} - -let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp - ~predecessor_fitness (block_header : block_header) = - let open Lwt_tzresult_syntax in - let predecessor = - dummy_predecessor - ~predecessor_timestamp - ~predecessor_fitness - ~predecessor_level:(Int32.pred block_header.shell.level) - in - let* validity_state = - begin_validation - ancestor_context - chain_id - ~predecessor - (Partial_application {block_header}) - in - let* application_state = - new_begin_application - ancestor_context - chain_id - ~predecessor - (Partial_application {block_header}) - in - return {validity_state; application_state} - -let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor:predecessor_hash - ~timestamp ?(protocol_data : block_header_data option) () = - let open Lwt_tzresult_syntax in - let predecessor = - dummy_predecessor - ~predecessor_timestamp - ~predecessor_fitness - ~predecessor_level - in - match protocol_data with - | None -> - let partial_construction = - Partial_construction {predecessor_hash; timestamp} - in - let* validity_state = - begin_validation - predecessor_context - chain_id - ~predecessor - partial_construction - in - let* application_state = - new_begin_application - predecessor_context - chain_id - ~predecessor - partial_construction - in - return {validity_state; application_state} - | Some block_header_data -> - let construction = - Construction {predecessor_hash; timestamp; block_header_data} - in - let* validity_state = - begin_validation predecessor_context chain_id ~predecessor construction - in - let* application_state = - new_begin_application - predecessor_context - chain_id - ~predecessor - construction - in - return {validity_state; application_state} - -let apply_operation (state : validation_state) - (packed_operation : Alpha_context.packed_operation) = - let open Lwt_result_syntax in - let operation_hash = Alpha_context.Operation.hash_packed packed_operation in - let* validity_state = - validate_operation state.validity_state operation_hash packed_operation - in - let* application_state, operation_receipt = - new_apply_operation state.application_state operation_hash packed_operation - in - return ({validity_state; application_state}, operation_receipt) - -let finalize_block state shell_header = - let open Lwt_result_syntax in - let* () = finalize_validation state.validity_state in - finalize_application state.application_state shell_header - let compare_operations (oph1, op1) (oph2, op2) = Alpha_context.Operation.compare (oph1, op1) (oph2, op2) diff --git a/src/proto_alpha/lib_protocol/main.mli b/src/proto_alpha/lib_protocol/main.mli index eaab25a35f98..d6d5913c57da 100644 --- a/src/proto_alpha/lib_protocol/main.mli +++ b/src/proto_alpha/lib_protocol/main.mli @@ -25,9 +25,9 @@ (** Tezos Protocol Implementation - Protocol Signature Instance - This module is the entrypoint to the protocol for shells and other - embedders. This signature is an instance of - {{!Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL} the + This module is the entrypoint to the protocol for shells and other + embedders. This signature is an instance of + {{!Tezos_protocol_environment_sigs.V7.T.Updater.PROTOCOL} the [Updater.PROTOCOL] signature} from the {{:https://tezos.gitlab.io/shell/the_big_picture.html#the-economic-protocol-environment-and-compiler} Protocol Environment}. @@ -40,11 +40,6 @@ {{:https://tezos.gitlab.io/shell/the_big_picture.html} this overview}. *) -type validation_state = { - validity_state : Validate.validation_state; - application_state : Apply.application_state; -} - type operation_data = Alpha_context.packed_protocol_data type operation = Alpha_context.packed_operation = { @@ -60,4 +55,5 @@ include and type operation_data := operation_data and type operation_receipt = Apply_results.packed_operation_metadata and type operation := operation - and type validation_state := validation_state + and type validation_state = Validate.validation_state + and type application_state = Apply.application_state diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index 9319e69656cc..efd8480d5bc1 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -695,50 +695,68 @@ let alpha_context ?commitments ?min_proposal_quorum (********* Baking *************) -(* Note that by calling this function without [protocol_data], we force the mode - to be partial construction (by correspondingly calling [begin_construction] - without [protocol_data]). *) +let begin_validation_and_application ctxt chain_id mode ~predecessor = + let open Lwt_result_syntax in + let* validation_state = begin_validation ctxt chain_id mode ~predecessor in + let* application_state = begin_application ctxt chain_id mode ~predecessor in + return (validation_state, application_state) + let get_application_vstate (pred : t) (operations : Protocol.operation trace) = Forge.forge_header pred ~operations >>=? fun header -> Forge.sign_header header >>=? fun header -> let open Environment.Error_monad in - Main.begin_application - ~chain_id:Chain_id.zero - ~predecessor_context:pred.context - ~predecessor_fitness:pred.header.shell.fitness - ~predecessor_timestamp:pred.header.shell.timestamp - header + begin_validation_and_application + pred.context + Chain_id.zero + (Application header) + ~predecessor:pred.header.shell >|= Environment.wrap_tzresult +(* Note that by calling this function without [protocol_data], we + force the mode to be partial construction. *) let get_construction_vstate ?(policy = By_round 0) ?timestamp ?(protocol_data = None) (pred : t) = let open Protocol in dispatch_policy policy pred >>=? fun (_pkh, _ck, _round, expected_timestamp) -> let timestamp = Option.value ~default:expected_timestamp timestamp in - Main.begin_construction - ~chain_id:Chain_id.zero - ~predecessor_context:pred.context - ~predecessor_timestamp:pred.header.shell.timestamp - ~predecessor_level:pred.header.shell.level - ~predecessor_fitness:pred.header.shell.fitness - ~predecessor:pred.hash - ?protocol_data - ~timestamp - () + let mode = + match protocol_data with + | None -> Partial_construction {predecessor_hash = pred.hash; timestamp} + | Some block_header_data -> + Construction + {predecessor_hash = pred.hash; timestamp; block_header_data} + in + begin_validation_and_application + pred.context + Chain_id.zero + mode + ~predecessor:pred.header.shell >|= Environment.wrap_tzresult +let validate_and_apply_operation (validation_state, application_state) op = + let open Lwt_result_syntax in + let oph = Operation.hash_packed op in + let* validation_state = validate_operation validation_state oph op in + let* application_state, receipt = apply_operation application_state oph op in + return ((validation_state, application_state), receipt) + +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = finalize_validation validation_state in + finalize_application application_state shell_header + let apply_with_metadata ?(policy = By_round 0) ?(check_size = true) ~baking_mode header ?(operations = []) pred = let open Environment.Error_monad in ( (match baking_mode with | Application -> - Main.begin_application - ~chain_id:Chain_id.zero - ~predecessor_context:pred.context - ~predecessor_fitness:pred.header.shell.fitness - ~predecessor_timestamp:pred.header.shell.timestamp - header + begin_validation_and_application + pred.context + Chain_id.zero + (Application header) + ~predecessor:pred.header.shell >|= Environment.wrap_tzresult | Baking -> get_construction_vstate @@ -760,12 +778,13 @@ let apply_with_metadata ?(policy = By_round 0) ?(check_size = true) ~baking_mode size %d" operation_size Constants_repr.max_operation_data_length))) ; - apply_operation vstate op >|= Environment.wrap_tzresult + validate_and_apply_operation vstate op >|= Environment.wrap_tzresult >|=? fun (state, _result) -> state) vstate operations >>=? fun vstate -> - Main.finalize_block vstate (Some header.shell) >|= Environment.wrap_tzresult + finalize_validation_and_application vstate (Some header.shell) + >|= Environment.wrap_tzresult >|=? fun (validation, result) -> (validation.context, result) ) >|=? fun (context, result) -> let hash = Block_header.hash header in diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.mli b/src/proto_alpha/lib_protocol/test/helpers/block.mli index 7a381919f32c..768c698dc105 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/block.mli @@ -162,7 +162,9 @@ val alpha_context : with the given operations. It's a shortcut for [begin_application] *) val get_application_vstate : - t -> Protocol.operation list -> validation_state tzresult Lwt.t + t -> + Protocol.operation list -> + (validation_state * application_state) tzresult Lwt.t (** [get_construction_vstate ?policy ?timestamp ?protocol_data pred] @@ -176,7 +178,7 @@ val get_construction_vstate : ?timestamp:Timestamp.time -> ?protocol_data:block_header_data option -> block -> - validation_state tzresult Lwt.t + (validation_state * application_state) tzresult Lwt.t (** applies a signed header and its operations to a block and obtains a new block *) diff --git a/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml index 2b22c3df9d4d..8c6e139df83b 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml @@ -57,8 +57,11 @@ let test_consensus_operation ?construction_mode ?level ?block_payload_hash ?slot | Some (pred, protocol_data) -> (* meaning partial construction or full construction mode, depending on [protocol_data] *) - Block.get_construction_vstate ~protocol_data pred >>=? fun vstate -> - apply_operation vstate op >|= Environment.wrap_tzresult >>= assert_error + Block.get_construction_vstate ~protocol_data pred + >>=? fun (validation_state, _application_state) -> + let oph = Operation.hash_packed op in + validate_operation validation_state oph op + >|= Environment.wrap_tzresult >>= assert_error let delegate_of_first_slot b = let module V = Plugin.RPC.Validators in diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml index f3ebdd9db24a..da83665012c4 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml @@ -29,7 +29,7 @@ open Alpha_context type t = { predecessor : Block.t; - state : validation_state; + state : validation_state * application_state; rev_operations : Operation.packed list; rev_tickets : operation_receipt list; header : Block_header.t; @@ -44,13 +44,15 @@ let header {header; _} = header let rev_tickets {rev_tickets; _} = rev_tickets -let validation_state {state; _} = state +let validation_state {state = vs, _; _} = vs let level st = st.header.shell.level +let alpha_ctxt {state = _, application_state; _} = application_state.ctxt + let rpc_context st = let fitness = (header st).shell.fitness in - let result = Alpha_context.finalize st.state.application_state.ctxt fitness in + let result = Alpha_context.finalize (alpha_ctxt st) fitness in { Environment.Updater.block_hash = Block_hash.zero; block_header = {st.header.shell with fitness = result.fitness}; @@ -62,14 +64,14 @@ let rpc_ctxt = rpc_context Plugin.RPC.rpc_services -let alpha_ctxt st = st.state.application_state.ctxt - let set_alpha_ctxt st ctxt = - { - st with - state = - {st.state with application_state = {st.state.application_state with ctxt}}; - } + {st with state = (fst st.state, {(snd st.state) with ctxt})} + +let begin_validation_and_application ctxt chain_id mode ~predecessor = + let open Lwt_result_syntax in + let* validation_state = begin_validation ctxt chain_id mode ~predecessor in + let* application_state = begin_application ctxt chain_id mode ~predecessor in + return (validation_state, application_state) let begin_construction ?timestamp ?seed_nonce_hash ?(mempool_mode = false) ?(policy = Block.By_round 0) (predecessor : Block.t) = @@ -93,9 +95,15 @@ let begin_construction ?timestamp ?seed_nonce_hash ?(mempool_mode = false) ~payload_round () in - let protocol_data = - if mempool_mode then None - else Some {Block_header.contents; signature = Signature.zero} + let mode = + if mempool_mode then + Partial_construction {predecessor_hash = predecessor.hash; timestamp} + else + let block_header_data = + {Block_header.contents; signature = Signature.zero} + in + Construction + {predecessor_hash = predecessor.hash; timestamp; block_header_data} in let header = { @@ -113,16 +121,11 @@ let begin_construction ?timestamp ?seed_nonce_hash ?(mempool_mode = false) protocol_data = {contents; signature = Signature.zero}; } in - begin_construction - ~chain_id:Chain_id.zero - ~predecessor_context:predecessor.context - ~predecessor_timestamp:predecessor.header.shell.timestamp - ~predecessor_fitness:predecessor.header.shell.fitness - ~predecessor_level:predecessor.header.shell.level - ~predecessor:predecessor.hash - ~timestamp - ?protocol_data - () + begin_validation_and_application + predecessor.context + Chain_id.zero + mode + ~predecessor:predecessor.header.shell >|= fun state -> Environment.wrap_tzresult state >|? fun state -> {predecessor; state; rev_operations = []; rev_tickets = []; header; delegate} @@ -164,68 +167,77 @@ let detect_script_failure : in fun {contents} -> detect_script_failure contents -let apply_operation ?(check_size = true) st op = - (if check_size then - let operation_size = Data_encoding.Binary.length Operation.encoding op in - if operation_size > Constants_repr.max_operation_data_length then - raise - (invalid_arg - (Format.sprintf - "The operation size is %d, it exceeds the constant maximum size %d" - operation_size - Constants_repr.max_operation_data_length))) ; - apply_operation st.state op >|= Environment.wrap_tzresult +let check_operation_size ?(check_size = true) op = + if check_size then + let operation_size = Data_encoding.Binary.length Operation.encoding op in + if operation_size > Constants_repr.max_operation_data_length then + raise + (invalid_arg + (Format.sprintf + "The operation size is %d: it exceeds the constant maximum size \ + %d." + operation_size + Constants_repr.max_operation_data_length)) let validate_operation ?expect_failure ?check_size st op = - apply_operation ?check_size st op >>= fun result -> - match (expect_failure, result) with + let open Lwt_result_syntax in + check_operation_size ?check_size op ; + let validation_state, application_state = st.state in + let oph = Operation.hash_packed op in + let*! res = validate_operation validation_state oph op in + match (expect_failure, Environment.wrap_tzresult res) with | Some _, Ok _ -> failwith "Error expected while validating operation" - | Some f, Error err -> f err >|=? fun () -> st - | None, Error err -> failwith "Error %a was not expected" pp_print_trace err - | None, Ok (state, (Operation_metadata _ as metadata)) - | None, Ok (state, (No_operation_metadata as metadata)) -> - return + | Some f, Error err -> + let* () = f err in + return st + | None, Error err -> fail err + | None, Ok validation_state -> + return {st with state = (validation_state, application_state)} + +let add_operation ?expect_failure ?expect_apply_failure ?check_size st op = + let open Lwt_result_syntax in + let open Apply_results in + let* st = validate_operation ?expect_failure ?check_size st op in + match expect_failure with + | Some _ -> + (* The expected failure has already been observed in + [validate_operation]. *) + return st + | None -> ( + let validation_state, application_state = st.state in + let oph = Operation.hash_packed op in + let*! res = apply_operation application_state oph op in + let*? application_state, metadata = Environment.wrap_tzresult res in + let st = { st with - state; + state = (validation_state, application_state); rev_operations = op :: st.rev_operations; rev_tickets = metadata :: st.rev_tickets; } + in + match (expect_apply_failure, metadata) with + | None, No_operation_metadata -> return st + | None, Operation_metadata result -> + let*? () = detect_script_failure result in + return st + | Some _, No_operation_metadata -> + failwith "Error expected while adding operation" + | Some f, Operation_metadata result -> ( + match detect_script_failure result with + | Ok _ -> failwith "Error expected while adding operation" + | Error err -> + let* () = f err in + return st)) -let add_operation ?expect_failure ?expect_apply_failure ?check_size st op = - let open Apply_results in - apply_operation ?check_size st op >>= fun result -> - match (expect_failure, result) with - | Some _, Ok _ -> failwith "Error expected while adding operation" - | Some f, Error err -> f err >|=? fun () -> st - | None, result -> ( - result >>?= fun result -> - match result with - | state, (Operation_metadata result as metadata) -> - detect_script_failure result |> fun result -> - (match expect_apply_failure with - | None -> Lwt.return result - | Some f -> ( - match result with - | Ok _ -> failwith "Error expected while adding operation" - | Error e -> f e)) - >|=? fun () -> - { - st with - state; - rev_operations = op :: st.rev_operations; - rev_tickets = metadata :: st.rev_tickets; - } - | state, (No_operation_metadata as metadata) -> - return - { - st with - state; - rev_operations = op :: st.rev_operations; - rev_tickets = metadata :: st.rev_tickets; - }) +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = finalize_validation validation_state in + finalize_application application_state shell_header let finalize_block st = + let open Lwt_result_syntax in let operations = List.rev st.rev_operations in let operations_hash = Operation_list_list_hash.compute @@ -238,8 +250,10 @@ let finalize_block st = operations_hash; } in - finalize_block st.state (Some shell_header) >|= fun x -> - Environment.wrap_tzresult x >|? fun (result, _) -> + let*! res = + finalize_validation_and_application st.state (Some shell_header) + in + let*? validation_result, _ = Environment.wrap_tzresult res in let operations = List.rev st.rev_operations in let operations_hash = Operation_list_list_hash.compute @@ -253,12 +267,12 @@ let finalize_block st = st.header.shell with level = Int32.succ st.header.shell.level; operations_hash; - fitness = result.fitness; + fitness = validation_result.fitness; }; } in let hash = Block_header.hash header in - {Block.hash; header; operations; context = result.context} + return {Block.hash; header; operations; context = validation_result.context} let assert_validate_operation_fails expect_failure op block = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.mli b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli index 72541d86ccfe..dc543c0d78e7 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/incremental.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli @@ -41,14 +41,14 @@ val validation_state : incremental -> validation_state val level : incremental -> int32 (** [begin_construction ?mempool_mode predecessor] uses - [Main.begin_construction] to create a validation state on top of - [predecessor]. + {!Main.begin_validation_and_application} to create a validation and + application state on top of [predecessor] for the construction of a + new block. Optional arguments allow to override defaults: - {ul {li [?mempool_mode:bool]: set the validation state to - [partial_construction], [construction] otherwise (default).}} -*) + {ul {li [?mempool_mode:bool]: when [true], use [Partial_construction] + mode. By default, it is [false] and the mode is [Construction].}} *) val begin_construction : ?timestamp:Time.Protocol.t -> ?seed_nonce_hash:Nonce_hash.t -> @@ -81,10 +81,11 @@ val validate_operation : incremental tzresult Lwt.t (** [add_operation ?expect_failure ?expect_apply_failure ?check_size i - op] tries to apply [op] in the validation state of [i]. If the - validation of [op] succeeds, the function returns the incremental - value with a validation state updated after the application of - [op]. Otherwise raise the error from the validation of [op]. + op] tries to validate then apply [op] in the validation and + application state of [i]. If the validation of [op] succeeds, the + function returns the incremental value with a validation state + updated after the application of [op]. Otherwise raise the error + from the validation of [op]. Optional arguments allow to override defaults: @@ -110,10 +111,9 @@ val add_operation : Operation.packed -> incremental tzresult Lwt.t -(** [finalize_block i] creates a [Block.t] based on the - validation_state and the operations contained in [i]. The function - calls [Main.finalize_block] to compute a new context. -*) +(** [finalize_block i] creates a [Block.t] based on the protocol + states and the operations contained in [i]. The function calls + [Main.finalize_application] to compute a new context. *) val finalize_block : incremental -> Block.t tzresult Lwt.t (** [assert_validate_operation_fails expect_failure operation block] diff --git a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml index 1866f629aead..678a6c79844c 100644 --- a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml +++ b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml @@ -194,24 +194,42 @@ let test_set_gas_limited () = (*** Tests with blocks ***) +let begin_validation_and_application ctxt chain_id mode ~predecessor = + let open Lwt_result_syntax in + let* validation_state = begin_validation ctxt chain_id mode ~predecessor in + let* application_state = begin_application ctxt chain_id mode ~predecessor in + return (validation_state, application_state) + +let validate_and_apply_operation (validation_state, application_state) op = + let open Lwt_result_syntax in + let oph = Alpha_context.Operation.hash_packed op in + let* validation_state = validate_operation validation_state oph op in + let* application_state, receipt = apply_operation application_state oph op in + return ((validation_state, application_state), receipt) + +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = finalize_validation validation_state in + finalize_application application_state shell_header + let apply_with_gas header ?(operations = []) (pred : Block.t) = let open Alpha_context in (let open Environment.Error_monad in - begin_application - ~chain_id:Chain_id.zero - ~predecessor_context:pred.context - ~predecessor_fitness:pred.header.shell.fitness - ~predecessor_timestamp:pred.header.shell.timestamp - header + begin_validation_and_application + pred.context + Chain_id.zero + (Application header) + ~predecessor:pred.header.shell >>=? fun vstate -> List.fold_left_es (fun vstate op -> - apply_operation vstate op >|=? fun (state, _result) -> state) + validate_and_apply_operation vstate op >|=? fun (state, _result) -> state) vstate operations >>=? fun vstate -> - finalize_block vstate (Some header.shell) >|=? fun (validation, result) -> - (validation.context, result.consumed_gas)) + finalize_validation_and_application vstate (Some header.shell) + >|=? fun (validation, result) -> (validation.context, result.consumed_gas)) >|= Environment.wrap_tzresult >|=? fun (context, consumed_gas) -> let hash = Block_header.hash header in 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 77839e7b3852..7d882937ddbb 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 @@ -97,9 +97,8 @@ let context_gen : Alpha_context.t QCheck2.Gen.t = (let open Lwt_result_syntax in let* b, _contract = Context.init1 () in let+ inc = Incremental.begin_construction b in - let state = Incremental.validation_state inc in Alpha_context.Gas.set_limit - state.application_state.ctxt + (Incremental.alpha_ctxt inc) 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 e1d563b5fc3e..1ef3b1b84067 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 @@ -40,8 +40,7 @@ let ten_milligas = Gas.fp_of_milligas_int 10 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.application_state.ctxt limit + Gas.set_limit (Incremental.alpha_ctxt inc) 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 f171ae3e04ed..1846fd0353ae 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 @@ -58,8 +58,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.application_state.ctxt in + let ctxt = Incremental.alpha_ctxt inc 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.ml b/src/proto_alpha/lib_protocol/validate.ml index f59a65bd6bdc..b50fa7ef72ba 100644 --- a/src/proto_alpha/lib_protocol/validate.ml +++ b/src/proto_alpha/lib_protocol/validate.ml @@ -502,6 +502,8 @@ let init_block_state vi = endorsement_power = 0; } +let get_initial_ctxt {info; _} = info.ctxt + (** Validation of consensus operations (validation pass [0]): preendorsement, endorsement, and dal_slot_availability. *) module Consensus = struct diff --git a/src/proto_alpha/lib_protocol/validate.mli b/src/proto_alpha/lib_protocol/validate.mli index cc994a613fff..2be9798450e4 100644 --- a/src/proto_alpha/lib_protocol/validate.mli +++ b/src/proto_alpha/lib_protocol/validate.mli @@ -62,6 +62,11 @@ type validation_state = { block_state : block_state; } +(** Return the context stored in the state. Note that this is the + context at the beginning of the block / mempool: indeed, it is not + modified by [validate_operation]. *) +val get_initial_ctxt : validation_state -> context + (** Initialize the {!info} and {!state} for the validation of an existing block (in preparation for its future application). *) val begin_application : diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index eb30b8387c8a..2697c4bd776e 100644 --- a/src/proto_demo_counter/lib_protocol/main.ml +++ b/src/proto_demo_counter/lib_protocol/main.ml @@ -64,29 +64,47 @@ type operation = { type validation_state = {context : Context.t; fitness : Fitness.t} -let begin_application ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_fitness (raw_block : block_header) = - let fitness = raw_block.shell.fitness in - Logging.log Notice - "begin_application: pred_fitness = %a block_fitness = %a%!" +type application_state = validation_state + +type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + +let mode_str = function + | Application _ -> "application" + | Partial_application _ -> "partial_application" + | Construction _ -> "construction" + | Partial_construction _ -> "partial_construction" + +let validation_or_application_str = function + | `Validation -> "validation" + | `Application -> "application" + +let begin_any_application_mode validation_or_application mode context + ~(predecessor : Block_header.shell_header) (block_header : block_header) = + let fitness = block_header.shell.fitness in + Logging.log + Notice + "begin_%s (%s mode): pred_fitness = %a block_fitness = %a%!" + (validation_or_application_str validation_or_application) + (mode_str mode) Fitness.pp - predecessor_fitness + predecessor.fitness Fitness.pp fitness ; (* Note: Logging is only available for debugging purposes and should not appear in a real protocol. *) return {context; fitness} -let begin_partial_application ~chain_id ~ancestor_context - ~predecessor_timestamp ~predecessor_fitness block_header = - Logging.log Notice "begin_partial_application%!" ; - begin_application - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp - ~predecessor_fitness - block_header - (* we use here the same fitness format than proto alpha, but with higher [version_number] to allow testing migration from alpha to demo_counter. *) @@ -98,57 +116,94 @@ let int64_to_bytes i = b let fitness_from_level level = - [Bytes.of_string version_number; - Bytes.of_string "\000"; - Bytes.of_string "\000"; - Bytes.of_string "\000"; - int64_to_bytes level] - -let begin_construction ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_level ~predecessor_fitness - ~predecessor:_ ~timestamp:_ ?protocol_data () = - let fitness = fitness_from_level Int64.(succ (of_int32 predecessor_level)) in - let mode = - match protocol_data with Some _ -> "block" | None -> "mempool" - in - Logging.log Notice - "begin_construction (%s): pred_fitness = %a constructed fitness = %a%!" - mode + [ + Bytes.of_string version_number; + Bytes.of_string "\000"; + Bytes.of_string "\000"; + Bytes.of_string "\000"; + int64_to_bytes level; + ] + +let begin_any_construction_mode validation_or_application mode context + ~(predecessor : Block_header.shell_header) = + let fitness = fitness_from_level Int64.(succ (of_int32 predecessor.level)) in + Logging.log + Notice + "begin_%s (%s mode): pred_fitness = %a constructed fitness = %a%!" + (validation_or_application_str validation_or_application) + (mode_str mode) Fitness.pp - predecessor_fitness + predecessor.fitness Fitness.pp fitness ; return {context; fitness} -let apply_operation validation_state operation = - Logging.log Notice "apply_operation" ; - let {context; fitness} = validation_state in - State.get_state context - >>= fun state -> +let begin_validation_or_application validation_or_application ctxt _chain_id + mode ~predecessor = + match mode with + | Application block_header | Partial_application block_header -> + begin_any_application_mode + validation_or_application + mode + ctxt + ~predecessor + block_header + | Construction _ | Partial_construction _ -> + begin_any_construction_mode + validation_or_application + mode + ctxt + ~predecessor + +let begin_validation = begin_validation_or_application `Validation + +let begin_application = begin_validation_or_application `Application + +let apply_operation_aux application_state operation = + let {context; fitness} = application_state in + State.get_state context >>= fun state -> match Apply.apply state operation.protocol_data with - | None -> - Error_monad.fail Error.Invalid_operation + | None -> Error_monad.fail Error.Invalid_operation | Some state -> - let receipt = Receipt.create "operation applied successfully" in - State.update_state context state - >>= fun context -> return ({context; fitness}, receipt) - -let finalize_block validation_state _header = - let fitness = validation_state.fitness in - Logging.log Notice "finalize_block: fitness = %a%!" Fitness.pp fitness ; - let fitness = validation_state.fitness in + State.update_state context state >>= fun context -> + return {context; fitness} + +let validate_operation ?check_signature:_ validation_state _oph operation = + Logging.log Notice "validate_operation" ; + apply_operation_aux validation_state operation + +let apply_operation application_state _oph operation = + Logging.log Notice "apply_operation" ; + apply_operation_aux application_state operation >>=? fun application_state -> + let receipt = Receipt.create "operation applied successfully" in + return (application_state, receipt) + +let log_finalize validation_or_application validation_state = + Logging.log + Notice + "finalize_%s: fitness = %a%!" + (validation_or_application_str validation_or_application) + Fitness.pp + validation_state.fitness + +let finalize_validation validation_state = + log_finalize `Validation validation_state ; + return_unit + +let finalize_application application_state _shell_header = + log_finalize `Application application_state ; + let fitness = application_state.fitness in let message = Some (Format.asprintf "fitness <- %a" Fitness.pp fitness) in - let context = validation_state.context in - State.get_state context - >>= fun state -> + let context = application_state.context in + State.get_state context >>= fun state -> return ( { - Updater.message; - context; - fitness; - max_operations_ttl = 0; - last_allowed_fork_level = 0l; - }, + Updater.message; + context; + fitness; + max_operations_ttl = 0; + last_allowed_fork_level = 0l; + }, state ) let decode_json json = diff --git a/src/proto_demo_noops/lib_protocol/main.ml b/src/proto_demo_noops/lib_protocol/main.ml index 977cbcd8b15a..a337cd63d8e8 100644 --- a/src/proto_demo_noops/lib_protocol/main.ml +++ b/src/proto_demo_noops/lib_protocol/main.ml @@ -68,19 +68,20 @@ let compare_operations _ _ = 0 type validation_state = {context : Context.t; fitness : Fitness.t} -let begin_application ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_fitness:_ (raw_block : block_header) = - let fitness = raw_block.shell.fitness in - return {context; fitness} - -let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp - ~predecessor_fitness block_header = - begin_application - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp - ~predecessor_fitness - block_header +type application_state = validation_state + +type mode = + | Application of block_header + | Partial_application of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } let version_number = "\001" @@ -92,15 +93,19 @@ let int64_to_bytes i = let fitness_from_level level = [Bytes.of_string version_number; int64_to_bytes level] -let begin_construction ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_level ~predecessor_fitness:_ - ~predecessor:_ ~timestamp:_ ?protocol_data () = - let fitness = fitness_from_level Int64.(succ (of_int32 predecessor_level)) in - let _mode = - match protocol_data with Some _ -> "block" | None -> "mempool" +let begin_validation context _chain_id mode + ~(predecessor : Block_header.shell_header) = + let fitness = + match mode with + | Application block_header | Partial_application block_header -> + block_header.shell.fitness + | Construction _ | Partial_construction _ -> + fitness_from_level Int64.(succ (of_int32 predecessor.level)) in return {context; fitness} +let begin_application = begin_validation + type error += No_error let () = @@ -114,18 +119,21 @@ let () = (function No_error -> Some () | _ -> None) (fun () -> No_error) -let apply_operation _state _op = fail No_error +let validate_operation ?check_signature:_ _state _oph _op = fail No_error + +let apply_operation _state _oph _op = fail No_error -let finalize_block state _ = - let fitness = state.fitness in +let finalize_validation _state = return_unit + +let finalize_application application_state _shell_header = return ( { - Updater.message = None; - context = state.context; - fitness; - max_operations_ttl = 0; - last_allowed_fork_level = 0l; - }, + Updater.message = None; + context = application_state.context; + fitness = application_state.fitness; + max_operations_ttl = 0; + last_allowed_fork_level = 0l; + }, () ) let init _chain_id context block_header = -- GitLab From adf8c86959e0194d1f9296c347401d61a4a05c69 Mon Sep 17 00:00:00 2001 From: vbot Date: Wed, 21 Sep 2022 23:24:16 +0200 Subject: [PATCH 07/12] Environment: simplify and harmonize mempool mode signature --- .../test/proto_test_injection/main.ml | 3 +-- .../environment_V3.ml | 3 +-- .../environment_V4.ml | 3 +-- .../environment_V5.ml | 3 +-- .../environment_V6.ml | 3 +-- .../environment_V7.ml | 13 +++++++------ .../environment_protocol_T.ml | 10 ++++------ .../environment_protocol_T_V7.ml | 3 +-- .../environment_protocol_T_test.ml | 3 +-- src/lib_protocol_environment/sigs/v7.ml | 19 +++++++++---------- .../sigs/v7/updater.mli | 3 +-- src/proto_alpha/lib_protocol/main.ml | 10 +++++----- src/proto_demo_counter/lib_protocol/main.ml | 2 +- src/proto_demo_noops/lib_protocol/main.ml | 2 +- 14 files changed, 35 insertions(+), 45 deletions(-) diff --git a/src/bin_client/test/proto_test_injection/main.ml b/src/bin_client/test/proto_test_injection/main.ml index 8e265aca551f..8bce3f867114 100644 --- a/src/bin_client/test/proto_test_injection/main.ml +++ b/src/bin_client/test/proto_test_injection/main.ml @@ -192,8 +192,7 @@ module Mempool = struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index 3eaefcd1677c..a474148129ee 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -1233,8 +1233,7 @@ struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V4.ml b/src/lib_protocol_environment/environment_V4.ml index efba6cdc499a..699423d014e9 100644 --- a/src/lib_protocol_environment/environment_V4.ml +++ b/src/lib_protocol_environment/environment_V4.ml @@ -1250,8 +1250,7 @@ struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V5.ml b/src/lib_protocol_environment/environment_V5.ml index 2173216e754b..2d43961722e4 100644 --- a/src/lib_protocol_environment/environment_V5.ml +++ b/src/lib_protocol_environment/environment_V5.ml @@ -1227,8 +1227,7 @@ struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V6.ml b/src/lib_protocol_environment/environment_V6.ml index a1e8eb460a1e..cebc971ff85a 100644 --- a/src/lib_protocol_environment/environment_V6.ml +++ b/src/lib_protocol_environment/environment_V6.ml @@ -1319,8 +1319,7 @@ struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V7.ml b/src/lib_protocol_environment/environment_V7.ml index 2b9ba4429931..410e314b59ac 100644 --- a/src/lib_protocol_environment/environment_V7.ml +++ b/src/lib_protocol_environment/environment_V7.ml @@ -1199,20 +1199,21 @@ struct Error (Validation_error (wrap_tztrace e)) | Error (Mempool.Add_conflict c) -> Error (Add_conflict c) - let init ctxt chain_id ~head_hash ~head_header ~current_timestamp ~cache = + let init ctxt chain_id ~head_hash ~head ~cache = let open Lwt_result_syntax in let* ctxt = load_predecessor_cache ctxt chain_id (Partial_construction - {predecessor_hash = head_hash; timestamp = current_timestamp}) - head_header + { + predecessor_hash = head_hash; + timestamp = head.Block_header.timestamp; + }) + head cache in - let*! r = - init ctxt chain_id ~head_hash ~head_header ~current_timestamp - in + let*! r = init ctxt chain_id ~head_hash ~head in Lwt.return (wrap_tzresult r) end end diff --git a/src/lib_protocol_environment/environment_protocol_T.ml b/src/lib_protocol_environment/environment_protocol_T.ml index f22f6a6da992..bb3337cc4df3 100644 --- a/src/lib_protocol_environment/environment_protocol_T.ml +++ b/src/lib_protocol_environment/environment_protocol_T.ml @@ -211,8 +211,7 @@ module V0toV7 | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit @@ -273,8 +272,7 @@ module type PROTOCOL = sig Context.t -> Chain_id.t -> head_hash:Block_hash.t -> - head_header:Block_header.shell_header -> - current_timestamp:Time.Protocol.t -> + head:Block_header.shell_header -> cache:Context.source_of_cache -> (validation_info * t) tzresult Lwt.t end @@ -312,7 +310,7 @@ struct module Mempool = struct include Mempool - let init ctxt chain_id ~head_hash ~head_header ~current_timestamp ~cache:_ = - init ctxt chain_id ~head_hash ~head_header ~current_timestamp + let init ctxt chain_id ~head_hash ~head ~cache:_ = + init ctxt chain_id ~head_hash ~head end end diff --git a/src/lib_protocol_environment/environment_protocol_T_V7.ml b/src/lib_protocol_environment/environment_protocol_T_V7.ml index 660db98b4a11..9282b40f43ef 100644 --- a/src/lib_protocol_environment/environment_protocol_T_V7.ml +++ b/src/lib_protocol_environment/environment_protocol_T_V7.ml @@ -186,8 +186,7 @@ module type T = sig context -> Chain_id.t -> head_hash:Block_hash.t -> - head_header:Block_header.shell_header -> - current_timestamp:Time.Protocol.t -> + head:Block_header.shell_header -> (validation_info * t) tzresult Lwt.t val encoding : t Data_encoding.t diff --git a/src/lib_protocol_environment/environment_protocol_T_test.ml b/src/lib_protocol_environment/environment_protocol_T_test.ml index fa6a7c5568af..c8c4a4d6429c 100644 --- a/src/lib_protocol_environment/environment_protocol_T_test.ml +++ b/src/lib_protocol_environment/environment_protocol_T_test.ml @@ -146,8 +146,7 @@ module Mock_all_unit : | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/sigs/v7.ml b/src/lib_protocol_environment/sigs/v7.ml index f46ead55ec6c..6641bdc38d1a 100644 --- a/src/lib_protocol_environment/sigs/v7.ml +++ b/src/lib_protocol_environment/sigs/v7.ml @@ -2549,13 +2549,13 @@ val divexact: t -> t -> t external divisible: t -> t -> bool = "ml_z_divisible" (** [divisible a b] returns [true] if [a] is exactly divisible by [b]. - Unlike the other division functions, [b = 0] is accepted + Unlike the other division functions, [b = 0] is accepted (only 0 is considered divisible by 0). *) external congruent: t -> t -> t -> bool = "ml_z_congruent" (** [congruent a b c] returns [true] if [a] is congruent to [b] modulo [c]. - Unlike the other division functions, [c = 0] is accepted + Unlike the other division functions, [c = 0] is accepted (only equal numbers are considered equal congruent 0). *) @@ -2571,27 +2571,27 @@ external congruent: t -> t -> t -> bool = "ml_z_congruent" val logand: t -> t -> t (** Bitwise logical and. *) - + val logor: t -> t -> t (** Bitwise logical or. *) - + val logxor: t -> t -> t (** Bitwise logical exclusive or. *) val lognot: t -> t -(** Bitwise logical negation. +(** Bitwise logical negation. The identity [lognot a]=[-a-1] always hold. *) val shift_left: t -> int -> t -(** Shifts to the left. +(** Shifts to the left. Equivalent to a multiplication by a power of 2. The second argument must be nonnegative. *) val shift_right: t -> int -> t -(** Shifts to the right. - This is an arithmetic shift, +(** Shifts to the right. + This is an arithmetic shift, equivalent to a division by a power of 2 with rounding towards -oo. The second argument must be nonnegative. *) @@ -11513,8 +11513,7 @@ module type PROTOCOL = sig Context.t -> Chain_id.t -> head_hash:Block_hash.t -> - head_header:Block_header.shell_header -> - current_timestamp:Time.t -> + head:Block_header.shell_header -> (validation_info * t) tzresult Lwt.t (** Mempool encoding *) diff --git a/src/lib_protocol_environment/sigs/v7/updater.mli b/src/lib_protocol_environment/sigs/v7/updater.mli index de834f8cc434..28ecf1a1387d 100644 --- a/src/lib_protocol_environment/sigs/v7/updater.mli +++ b/src/lib_protocol_environment/sigs/v7/updater.mli @@ -455,8 +455,7 @@ module type PROTOCOL = sig Context.t -> Chain_id.t -> head_hash:Block_hash.t -> - head_header:Block_header.shell_header -> - current_timestamp:Time.t -> + head:Block_header.shell_header -> (validation_info * t) tzresult Lwt.t (** Mempool encoding *) diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 13f68a984278..668c1e189cbc 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -376,8 +376,7 @@ let value_of_key ~chain_id:_ ~predecessor_context:ctxt ~predecessor_timestamp module Mempool = struct include Mempool_validation - let init ctxt chain_id ~head_hash ~(head_header : Block_header.shell_header) - ~current_timestamp = + let init ctxt chain_id ~head_hash ~(head : Block_header.shell_header) = let open Lwt_tzresult_syntax in let open Alpha_context in let* ( ctxt, @@ -385,13 +384,14 @@ module Mempool = struct _migration_operation_results, head_level, _head_raw_level ) = + (* We use Partial_construction to factorize the [prepare_ctxt]. *) prepare_ctxt ctxt (Partial_construction - {predecessor_hash = head_hash; timestamp = current_timestamp}) - ~predecessor:head_header + {predecessor_hash = head_hash; timestamp = head.timestamp}) + ~predecessor:head in - let*? fitness = Fitness.from_raw head_header.fitness in + let*? fitness = Fitness.from_raw head.fitness in let predecessor_round = Fitness.round fitness in let grandparent_round = Fitness.predecessor_round fitness in return diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index 2697c4bd776e..f6912d06ce7c 100644 --- a/src/proto_demo_counter/lib_protocol/main.ml +++ b/src/proto_demo_counter/lib_protocol/main.ml @@ -290,7 +290,7 @@ module Mempool = struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/proto_demo_noops/lib_protocol/main.ml b/src/proto_demo_noops/lib_protocol/main.ml index a337cd63d8e8..5bb17f7fd617 100644 --- a/src/proto_demo_noops/lib_protocol/main.ml +++ b/src/proto_demo_noops/lib_protocol/main.ml @@ -185,7 +185,7 @@ module Mempool = struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit -- GitLab From 1ed2c63c4825cd9beea6edc2d67fe60fb78d76dd Mon Sep 17 00:00:00 2001 From: vbot Date: Thu, 22 Sep 2022 11:39:23 +0200 Subject: [PATCH 08/12] Tezt: adapt precheck test to the alpha's validity check semantics --- tezt/tests/precheck.ml | 43 +++++++++++++++++++++++++++--------------- 1 file changed, 28 insertions(+), 15 deletions(-) diff --git a/tezt/tests/precheck.ml b/tezt/tests/precheck.ml index 5c1fdec62765..15574700297c 100644 --- a/tezt/tests/precheck.ml +++ b/tezt/tests/precheck.ml @@ -276,12 +276,12 @@ let propagate_precheckable_bad_block = (* activation block + four blocks + the final bake *) wait_for_cluster_at_level cluster (1 + blocks_to_bake + 1) -let propagate_precheckable_bad_block_signature = +let propagate_precheckable_bad_block_payload = let blocks_to_bake = 4 in Protocol.register_test ~__FILE__ - ~title:"forge block with wrong signature" - ~tags:["precheck"; "fake_block"; "propagation"; "signature"] + ~title:"forge block with wrong payload" + ~tags:["precheck"; "fake_block"; "propagation"; "payload"] @@ fun protocol -> (* Expected topology is : N3 @@ -291,14 +291,14 @@ let propagate_precheckable_bad_block_signature = N4 *) Log.info "Setting up the node topology" ; - let n1 = Node.create [] in + let node_client = Node.create [] in let ring = Cluster.create ~name:"ring" 4 [Private_mode; Synchronisation_threshold 0] in let n2 = List.hd ring in Cluster.ring ring ; - Cluster.connect [n1] [n2] ; - let cluster = n1 :: ring in + Cluster.connect [node_client] [n2] ; + let cluster = node_client :: ring in Log.info "Starting up cluster" ; let* () = Cluster.start @@ -307,7 +307,7 @@ let propagate_precheckable_bad_block_signature = cluster in Log.info "Cluster initialized" ; - let* client = Client.(init ~endpoint:(Node n1) ()) in + let* client = Client.(init ~endpoint:(Node node_client) ()) in let* () = Client.activate_protocol ~protocol client in let bootstrap1 = Constant.bootstrap1.alias in let* () = @@ -317,8 +317,12 @@ let propagate_precheckable_bad_block_signature = let* () = Client.bake_for_and_wait ~keys:[bootstrap1] client in wait_for_cluster_at_level cluster i) in - let* op_block_header = forge_block ~client n1 ~key:bootstrap1 ~with_op:true in - let* block_header = forge_block ~client n1 ~key:bootstrap1 ~with_op:false in + let* op_block_header = + forge_block ~client node_client ~key:bootstrap1 ~with_op:true + in + let* block_header = + forge_block ~client node_client ~key:bootstrap1 ~with_op:false + in (* Put a bad context *) Log.info "Crafting a block header with a bad context hash" ; let bad_block_header = @@ -338,12 +342,12 @@ let propagate_precheckable_bad_block_signature = let unsigned_bad_block_header_hex = String.sub bad_block_header_hex 0 (String.length bad_block_header_hex - 128) in - let* bad_signature = + let* signature = Client.sign_block client unsigned_bad_block_header_hex ~delegate:bootstrap1 >>= fun s -> String.trim s |> return in let signed_bad_block_header_hex = - String.concat "" [unsigned_bad_block_header_hex; bad_signature] + String.concat "" [unsigned_bad_block_header_hex; signature] in let injection_json = `O @@ -367,9 +371,18 @@ let propagate_precheckable_bad_block_signature = else Test.fail "The block was not expected to be prechecked"); ] in - (* Wait all nodes to precheck the block but fail on validation *) + let expect_precheck_failure node = + Node.wait_for node "precheck_failure.v0" (fun _ -> Some ()) + in let precheck_waiter = - Lwt_list.iter_p wait_precheck_but_validation_fail cluster + if Protocol.(protocol <= Kathmandu) then + (* On Kathmandu and below: wait all nodes to precheck the block + but fail on validation *) + Lwt_list.iter_p wait_precheck_but_validation_fail cluster + else + (* Post Kathmandu: the precheck is not an over-approximation + anymore and cannot even be considered precheckable. *) + expect_precheck_failure node_client in let p = Client.spawn_rpc ~data:injection_json POST ["injection"; "block"] client @@ -378,7 +391,7 @@ let propagate_precheckable_bad_block_signature = let* () = Lwt.pick [ - ( Lwt_unix.sleep 30. >>= fun () -> + ( Lwt_unix.sleep 10. >>= fun () -> Test.fail "timeout while waiting for precheck" ); precheck_waiter; ] @@ -400,4 +413,4 @@ let propagate_precheckable_bad_block_signature = let register ~protocols = precheck_block protocols ; propagate_precheckable_bad_block protocols ; - propagate_precheckable_bad_block_signature protocols + propagate_precheckable_bad_block_payload protocols -- GitLab From 92823361b71a75129ba8615ffe3a035e7a81f607 Mon Sep 17 00:00:00 2001 From: vbot Date: Thu, 22 Sep 2022 16:23:29 +0200 Subject: [PATCH 09/12] Proto: forbid begin_application in partial_application --- src/proto_alpha/lib_protocol/apply.ml | 99 +------------------------- src/proto_alpha/lib_protocol/apply.mli | 23 ------ src/proto_alpha/lib_protocol/main.ml | 28 +++++--- 3 files changed, 22 insertions(+), 128 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index beb776d85124..5091a026a19f 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1958,14 +1958,6 @@ type mode = predecessor_level : Level.t; predecessor_round : Round.t; } - | Partial_application of { - block_header : Block_header.t; - fitness : Fitness.t; - payload_producer : Consensus_key.t; - block_producer : Consensus_key.t; - predecessor_level : Level.t; - predecessor_round : Round.t; - } | Full_construction of { predecessor : Block_hash.t; payload_producer : Consensus_key.t; @@ -2014,7 +2006,7 @@ let record_preendorsement ctxt (mode : mode) (content : consensus_content) : match Consensus.get_preendorsements_quorum_round ctxt with | None -> Consensus.set_preendorsements_quorum_round ctxt content.round | Some _ -> ctxt) - | Partial_application _ | Application _ | Partial_construction _ -> ctxt + | Application _ | Partial_construction _ -> ctxt in match Slot.Map.find content.slot (Consensus.allowed_preendorsements ctxt) with | None -> @@ -2174,7 +2166,7 @@ let apply_contents_list (type kind) ctxt chain_id (mode : mode) let mempool_mode = match mode with | Partial_construction _ -> true - | Full_construction _ | Application _ | Partial_application _ -> false + | Full_construction _ | Application _ -> false in match contents_list with | Single (Preendorsement consensus_content) -> @@ -2299,20 +2291,6 @@ let apply_operation application_state operation_hash operation = 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; _} -> @@ -2571,59 +2549,6 @@ let begin_application ctxt chain_id ~migration_balance_updates @ 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 = - Stake_distribution.baking_rights_owner ancestor_context current_level ~round - in - let* ctxt, _slot, 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 = Consensus_key.pkh payload_producer; - block_producer = Consensus_key.pkh 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 @@ -2948,25 +2873,5 @@ let finalize_block (application_state : application_state) shell_header_opt = finalize_with_commit_message ctxt ~cache_nonce fitness round op_count in return (result, receipt) - | Partial_application {payload_producer; 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 = payload_producer; - 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 d46680572474..3b5094d2b19e 100644 --- a/src/proto_alpha/lib_protocol/apply.mli +++ b/src/proto_alpha/lib_protocol/apply.mli @@ -52,14 +52,6 @@ type mode = predecessor_level : Level.t; predecessor_round : Round.t; } - | Partial_application of { - block_header : Block_header.t; - fitness : Fitness.t; - payload_producer : Consensus_key.t; - block_producer : Consensus_key.t; - predecessor_level : Level.t; - predecessor_round : Round.t; - } | Full_construction of { predecessor : Block_hash.t; payload_producer : Consensus_key.t; @@ -96,21 +88,6 @@ val begin_application : 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 : diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 668c1e189cbc..b7f495e54d95 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -244,6 +244,25 @@ let validate_operation = Validate.validate_operation let finalize_validation = Validate.finalize_block +type error += Cannot_apply_in_partial_application + +let () = + register_error_kind + `Permanent + ~id:"main.begin_application.cannot_apply_in_partial_application" + ~title:"cannot_apply_in_partial_application" + ~description: + "Cannot instantiate an application state using the 'Partial_application' \ + mode." + ~pp:(fun ppf () -> + Format.fprintf + ppf + "Cannot instantiate an application state using the \ + 'Partial_application' mode.") + Data_encoding.(empty) + (function Cannot_apply_in_partial_application -> Some () | _ -> None) + (fun () -> Cannot_apply_in_partial_application) + let begin_application ctxt chain_id mode ~predecessor = let open Lwt_tzresult_syntax in let open Alpha_context in @@ -265,14 +284,7 @@ let begin_application ctxt chain_id mode ~predecessor = ~migration_operation_results ~predecessor_fitness block_header - | Partial_application block_header -> - Apply.begin_partial_application - chain_id - ~ancestor_context:ctxt - ~migration_balance_updates - ~migration_operation_results - ~predecessor_fitness - block_header + | Partial_application _ -> fail Cannot_apply_in_partial_application | Construction {predecessor_hash; timestamp; block_header_data; _} -> let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in Apply.begin_full_construction -- GitLab From a49d307d7b98bb3cedd4fdad8b98ede419da99f1 Mon Sep 17 00:00:00 2001 From: vbot Date: Thu, 22 Sep 2022 16:34:43 +0200 Subject: [PATCH 10/12] Environment: remove spurious spaces --- src/lib_protocol_environment/sigs/v7/z.mli | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/lib_protocol_environment/sigs/v7/z.mli b/src/lib_protocol_environment/sigs/v7/z.mli index e04b459a7f0e..bc93f0cdcd0a 100644 --- a/src/lib_protocol_environment/sigs/v7/z.mli +++ b/src/lib_protocol_environment/sigs/v7/z.mli @@ -185,13 +185,13 @@ val divexact: t -> t -> t external divisible: t -> t -> bool = "ml_z_divisible" (** [divisible a b] returns [true] if [a] is exactly divisible by [b]. - Unlike the other division functions, [b = 0] is accepted + Unlike the other division functions, [b = 0] is accepted (only 0 is considered divisible by 0). *) external congruent: t -> t -> t -> bool = "ml_z_congruent" (** [congruent a b c] returns [true] if [a] is congruent to [b] modulo [c]. - Unlike the other division functions, [c = 0] is accepted + Unlike the other division functions, [c = 0] is accepted (only equal numbers are considered equal congruent 0). *) @@ -207,27 +207,27 @@ external congruent: t -> t -> t -> bool = "ml_z_congruent" val logand: t -> t -> t (** Bitwise logical and. *) - + val logor: t -> t -> t (** Bitwise logical or. *) - + val logxor: t -> t -> t (** Bitwise logical exclusive or. *) val lognot: t -> t -(** Bitwise logical negation. +(** Bitwise logical negation. The identity [lognot a]=[-a-1] always hold. *) val shift_left: t -> int -> t -(** Shifts to the left. +(** Shifts to the left. Equivalent to a multiplication by a power of 2. The second argument must be nonnegative. *) val shift_right: t -> int -> t -(** Shifts to the right. - This is an arithmetic shift, +(** Shifts to the right. + This is an arithmetic shift, equivalent to a division by a power of 2 with rounding towards -oo. The second argument must be nonnegative. *) -- GitLab From 8f7186a36c8ff35f360e3ff36d115e590b146908 Mon Sep 17 00:00:00 2001 From: vbot Date: Thu, 22 Sep 2022 18:44:40 +0200 Subject: [PATCH 11/12] Everywhere: rename Partial_application into Partial_validation --- .../test/proto_test_injection/main.ml | 4 +-- .../environment_V3.ml | 8 +++--- .../environment_V4.ml | 8 +++--- .../environment_V5.ml | 8 +++--- .../environment_V6.ml | 8 +++--- .../environment_V7.ml | 2 +- .../environment_protocol_T.ml | 8 +++--- .../environment_protocol_T_V7.ml | 2 +- .../environment_protocol_T_test.ml | 2 +- src/lib_protocol_environment/sigs/v7.ml | 10 +++---- .../sigs/v7/updater.mli | 10 +++---- src/proto_alpha/lib_protocol/main.ml | 26 +++++++++---------- src/proto_alpha/lib_protocol/validate.ml | 26 +++++++++---------- src/proto_alpha/lib_protocol/validate.mli | 2 +- src/proto_demo_counter/lib_protocol/main.ml | 6 ++--- src/proto_demo_noops/lib_protocol/main.ml | 4 +-- 16 files changed, 67 insertions(+), 67 deletions(-) diff --git a/src/bin_client/test/proto_test_injection/main.ml b/src/bin_client/test/proto_test_injection/main.ml index 8bce3f867114..c3f1b9fc2270 100644 --- a/src/bin_client/test/proto_test_injection/main.ml +++ b/src/bin_client/test/proto_test_injection/main.ml @@ -96,7 +96,7 @@ end type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -118,7 +118,7 @@ let begin_application context _chain_id mode let open Lwt_result_syntax in let* fitness = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> Fitness.to_int64 block_header.shell.fitness | Construction _ | Partial_construction _ -> let* predecessor_fitness = Fitness.to_int64 predecessor.fitness in diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index a474148129ee..bf67ffb22977 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -1058,7 +1058,7 @@ struct type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -1076,7 +1076,7 @@ struct let open Lwt_result_syntax in let predecessor, timestamp = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> (block_header.shell.predecessor, block_header.shell.timestamp) | Construction {predecessor_hash; timestamp; _} | Partial_construction {predecessor_hash; timestamp} -> @@ -1101,12 +1101,12 @@ struct let*! validation_state = match (validation_or_application, mode) with | `Validation, Application block_header - | _, Partial_application block_header -> + | _, Partial_validation block_header -> (* For the validation of an existing block, we always use the old [begin_partial_application], even in full [Application] mode. Indeed, this maintains the behavior of old block [precheck] (from [lib_validation/block_validation.ml]), which - relied on [Partial_application] mode to quickly assess the + relied on [Partial_validation] mode to quickly assess the viability of the block. *) begin_partial_application ~chain_id diff --git a/src/lib_protocol_environment/environment_V4.ml b/src/lib_protocol_environment/environment_V4.ml index 699423d014e9..b91c03739fa9 100644 --- a/src/lib_protocol_environment/environment_V4.ml +++ b/src/lib_protocol_environment/environment_V4.ml @@ -1075,7 +1075,7 @@ struct type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -1093,7 +1093,7 @@ struct let open Lwt_result_syntax in let predecessor, timestamp = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> (block_header.shell.predecessor, block_header.shell.timestamp) | Construction {predecessor_hash; timestamp; _} | Partial_construction {predecessor_hash; timestamp} -> @@ -1118,12 +1118,12 @@ struct let*! validation_state = match (validation_or_application, mode) with | `Validation, Application block_header - | _, Partial_application block_header -> + | _, Partial_validation block_header -> (* For the validation of an existing block, we always use the old [begin_partial_application], even in full [Application] mode. Indeed, this maintains the behavior of old block [precheck] (from [lib_validation/block_validation.ml]), which - relied on [Partial_application] mode to quickly assess the + relied on [Partial_validation] mode to quickly assess the viability of the block. *) begin_partial_application ~chain_id diff --git a/src/lib_protocol_environment/environment_V5.ml b/src/lib_protocol_environment/environment_V5.ml index 2d43961722e4..23b56ed9f0f3 100644 --- a/src/lib_protocol_environment/environment_V5.ml +++ b/src/lib_protocol_environment/environment_V5.ml @@ -1052,7 +1052,7 @@ struct type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -1070,7 +1070,7 @@ struct let open Lwt_result_syntax in let predecessor, timestamp = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> (block_header.shell.predecessor, block_header.shell.timestamp) | Construction {predecessor_hash; timestamp; _} | Partial_construction {predecessor_hash; timestamp} -> @@ -1095,12 +1095,12 @@ struct let*! validation_state = match (validation_or_application, mode) with | `Validation, Application block_header - | _, Partial_application block_header -> + | _, Partial_validation block_header -> (* For the validation of an existing block, we always use the old [begin_partial_application], even in full [Application] mode. Indeed, this maintains the behavior of old block [precheck] (from [lib_validation/block_validation.ml]), which - relied on [Partial_application] mode to quickly assess the + relied on [Partial_validation] mode to quickly assess the viability of the block. *) begin_partial_application ~chain_id diff --git a/src/lib_protocol_environment/environment_V6.ml b/src/lib_protocol_environment/environment_V6.ml index cebc971ff85a..57b2e7996054 100644 --- a/src/lib_protocol_environment/environment_V6.ml +++ b/src/lib_protocol_environment/environment_V6.ml @@ -1144,7 +1144,7 @@ struct type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -1162,7 +1162,7 @@ struct let open Lwt_result_syntax in let predecessor, timestamp = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> (block_header.shell.predecessor, block_header.shell.timestamp) | Construction {predecessor_hash; timestamp; _} | Partial_construction {predecessor_hash; timestamp} -> @@ -1187,12 +1187,12 @@ struct let*! validation_state = match (validation_or_application, mode) with | `Validation, Application block_header - | _, Partial_application block_header -> + | _, Partial_validation block_header -> (* For the validation of an existing block, we always use the old [begin_partial_application], even in full [Application] mode. Indeed, this maintains the behavior of old block [precheck] (from [lib_validation/block_validation.ml]), which - relied on [Partial_application] mode to quickly assess the + relied on [Partial_validation] mode to quickly assess the viability of the block. *) begin_partial_application ~chain_id diff --git a/src/lib_protocol_environment/environment_V7.ml b/src/lib_protocol_environment/environment_V7.ml index 410e314b59ac..d09bc8e95c85 100644 --- a/src/lib_protocol_environment/environment_V7.ml +++ b/src/lib_protocol_environment/environment_V7.ml @@ -1110,7 +1110,7 @@ struct let open Lwt_result_syntax in let predecessor_hash, timestamp = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> (block_header.shell.predecessor, block_header.shell.timestamp) | Construction {predecessor_hash; timestamp; _} | Partial_construction {predecessor_hash; timestamp} -> diff --git a/src/lib_protocol_environment/environment_protocol_T.ml b/src/lib_protocol_environment/environment_protocol_T.ml index bb3337cc4df3..f888482a8069 100644 --- a/src/lib_protocol_environment/environment_protocol_T.ml +++ b/src/lib_protocol_environment/environment_protocol_T.ml @@ -84,7 +84,7 @@ module V0toV7 type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.Protocol.t; @@ -98,13 +98,13 @@ module V0toV7 let begin_validation_or_application validation_or_application ctxt chain_id mode ~(predecessor : Block_header.shell_header) = match (validation_or_application, mode) with - | `Validation, Application block_header - | _, Partial_application block_header -> + | `Validation, Application block_header | _, Partial_validation block_header + -> (* For the validation of an existing block, we always use the old [begin_partial_application], even in full [Application] mode. Indeed, this maintains the behavior of old block [precheck] (from [lib_validation/block_validation.ml]), which - relied on [Partial_application] mode to quickly assess the + relied on [Partial_validation] mode to quickly assess the viability of the block. *) begin_partial_application ~chain_id diff --git a/src/lib_protocol_environment/environment_protocol_T_V7.ml b/src/lib_protocol_environment/environment_protocol_T_V7.ml index 9282b40f43ef..1ca58c075ef9 100644 --- a/src/lib_protocol_environment/environment_protocol_T_V7.ml +++ b/src/lib_protocol_environment/environment_protocol_T_V7.ml @@ -86,7 +86,7 @@ module type T = sig type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.Protocol.t; diff --git a/src/lib_protocol_environment/environment_protocol_T_test.ml b/src/lib_protocol_environment/environment_protocol_T_test.ml index c8c4a4d6429c..41cb6147f7b2 100644 --- a/src/lib_protocol_environment/environment_protocol_T_test.ml +++ b/src/lib_protocol_environment/environment_protocol_T_test.ml @@ -62,7 +62,7 @@ module Mock_all_unit : type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.Protocol.t; diff --git a/src/lib_protocol_environment/sigs/v7.ml b/src/lib_protocol_environment/sigs/v7.ml index 6641bdc38d1a..23234d810470 100644 --- a/src/lib_protocol_environment/sigs/v7.ml +++ b/src/lib_protocol_environment/sigs/v7.ml @@ -11243,7 +11243,7 @@ module type PROTOCOL = sig Note that in protocol versions <= K, where the validation functions do not yet exist, the validation of existing blocks is - done by trying to apply it using the [Partial_application] mode + done by trying to apply it using the [Partial_validation] mode below. Therefore, the application of a validated block may still fail in these protocols. *) @@ -11254,7 +11254,7 @@ module type PROTOCOL = sig type mode = | Application of block_header (** Standard validation or application of a preexisting block. *) - | Partial_application of block_header + | Partial_validation of block_header (** Partial validation of a preexisting block. This mode is meant to quickly reject obviously invalid alternate branches by only performing a subset of checks. @@ -11309,7 +11309,7 @@ module type PROTOCOL = sig [predecessor_context] and [predecessor] are the resulting context and shell header of the predecessor block. Exceptionally - in {!Partial_application} mode, they may instead come from any + in {!Partial_validation} mode, they may instead come from any ancestor block that is more recent (i.e. has a greater level) than the current head's "last_allowed_fork_level". @@ -11319,7 +11319,7 @@ module type PROTOCOL = sig Note that for protocol versions <= K where [begin_validation] does not exist yet, this calls the old [begin_application] by necessity. However, in [Application] mode, this calls the old - [begin_application] in [Partial_application] mode in order to run + [begin_application] in [Partial_validation] mode in order to run more quickly. This preserves the behavior of [precheck] in [lib_validation/block_validation.ml] for old protocols. It does mean that the application of a validated block may fail in these @@ -11357,7 +11357,7 @@ module type PROTOCOL = sig on the arguments. In protocol versions > K, calling this function with the - {!Partial_application} mode returns an error. *) + {!Partial_validation} mode returns an error. *) val begin_application : Context.t -> Chain_id.t -> diff --git a/src/lib_protocol_environment/sigs/v7/updater.mli b/src/lib_protocol_environment/sigs/v7/updater.mli index 28ecf1a1387d..d68ad345b025 100644 --- a/src/lib_protocol_environment/sigs/v7/updater.mli +++ b/src/lib_protocol_environment/sigs/v7/updater.mli @@ -185,7 +185,7 @@ module type PROTOCOL = sig Note that in protocol versions <= K, where the validation functions do not yet exist, the validation of existing blocks is - done by trying to apply it using the [Partial_application] mode + done by trying to apply it using the [Partial_validation] mode below. Therefore, the application of a validated block may still fail in these protocols. *) @@ -196,7 +196,7 @@ module type PROTOCOL = sig type mode = | Application of block_header (** Standard validation or application of a preexisting block. *) - | Partial_application of block_header + | Partial_validation of block_header (** Partial validation of a preexisting block. This mode is meant to quickly reject obviously invalid alternate branches by only performing a subset of checks. @@ -251,7 +251,7 @@ module type PROTOCOL = sig [predecessor_context] and [predecessor] are the resulting context and shell header of the predecessor block. Exceptionally - in {!Partial_application} mode, they may instead come from any + in {!Partial_validation} mode, they may instead come from any ancestor block that is more recent (i.e. has a greater level) than the current head's "last_allowed_fork_level". @@ -261,7 +261,7 @@ module type PROTOCOL = sig Note that for protocol versions <= K where [begin_validation] does not exist yet, this calls the old [begin_application] by necessity. However, in [Application] mode, this calls the old - [begin_application] in [Partial_application] mode in order to run + [begin_application] in [Partial_validation] mode in order to run more quickly. This preserves the behavior of [precheck] in [lib_validation/block_validation.ml] for old protocols. It does mean that the application of a validated block may fail in these @@ -299,7 +299,7 @@ module type PROTOCOL = sig on the arguments. In protocol versions > K, calling this function with the - {!Partial_application} mode returns an error. *) + {!Partial_validation} mode returns an error. *) val begin_application : Context.t -> Chain_id.t -> diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index b7f495e54d95..8ac765436a6b 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -127,7 +127,7 @@ let init_allowed_consensus_operations ctxt ~endorsement_level [begin_application] below. *) type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -143,7 +143,7 @@ let prepare_ctxt ctxt mode ~(predecessor : Block_header.shell_header) = let open Alpha_context in let level, timestamp = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> (block_header.shell.level, block_header.shell.timestamp) | Construction {timestamp; _} | Partial_construction {timestamp; _} -> (Int32.succ predecessor.level, timestamp) @@ -161,7 +161,7 @@ let prepare_ctxt ctxt mode ~(predecessor : Block_header.shell_header) = endorsements, which are handled differently). *) let preendorsement_level = match mode with - | Application _ | Partial_application _ | Construction _ -> + | Application _ | Partial_validation _ | Construction _ -> Level.current ctxt | Partial_construction _ -> predecessor_level in @@ -200,9 +200,9 @@ let begin_validation ctxt chain_id mode ~predecessor = ~predecessor_timestamp block_header fitness - | Partial_application block_header -> + | Partial_validation block_header -> let*? fitness = Fitness.from_raw block_header.shell.fitness in - Validate.begin_partial_application + Validate.begin_partial_validation ctxt chain_id ~predecessor_level @@ -244,24 +244,24 @@ let validate_operation = Validate.validate_operation let finalize_validation = Validate.finalize_block -type error += Cannot_apply_in_partial_application +type error += Cannot_apply_in_partial_validation let () = register_error_kind `Permanent - ~id:"main.begin_application.cannot_apply_in_partial_application" - ~title:"cannot_apply_in_partial_application" + ~id:"main.begin_application.cannot_apply_in_partial_validation" + ~title:"cannot_apply_in_partial_validation" ~description: - "Cannot instantiate an application state using the 'Partial_application' \ + "Cannot instantiate an application state using the 'Partial_validation' \ mode." ~pp:(fun ppf () -> Format.fprintf ppf "Cannot instantiate an application state using the \ - 'Partial_application' mode.") + 'Partial_validation' mode.") Data_encoding.(empty) - (function Cannot_apply_in_partial_application -> Some () | _ -> None) - (fun () -> Cannot_apply_in_partial_application) + (function Cannot_apply_in_partial_validation -> Some () | _ -> None) + (fun () -> Cannot_apply_in_partial_validation) let begin_application ctxt chain_id mode ~predecessor = let open Lwt_tzresult_syntax in @@ -284,7 +284,7 @@ let begin_application ctxt chain_id mode ~predecessor = ~migration_operation_results ~predecessor_fitness block_header - | Partial_application _ -> fail Cannot_apply_in_partial_application + | Partial_validation _ -> fail Cannot_apply_in_partial_validation | Construction {predecessor_hash; timestamp; block_header_data; _} -> let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in Apply.begin_full_construction diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml index b50fa7ef72ba..26cd81643ad4 100644 --- a/src/proto_alpha/lib_protocol/validate.ml +++ b/src/proto_alpha/lib_protocol/validate.ml @@ -391,8 +391,8 @@ type application_info = { - [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 + - [Partial_validation] is used to partially validate preexisting + block. Corresponds to [Partial_validation] of {!Main.validation_mode}. - [Construction] is used for the construction of a new block. @@ -406,7 +406,7 @@ type application_info = { the size of the map {!recfield:managers_seen}. *) type mode = | Application of application_info - | Partial_application of application_info + | Partial_validation of application_info | Construction of { predecessor_round : Round.t; predecessor_hash : Block_hash.t; @@ -785,7 +785,7 @@ module Consensus = struct let locked_round_evidence = match mode with | Mempool -> None - | Application _ | Partial_application _ | Construction _ -> ( + | Application _ | Partial_validation _ | Construction _ -> ( match block_state.locked_round_evidence with | None -> Some (consensus_content.round, voting_power) | Some (_stored_round, evidences) -> @@ -2340,7 +2340,7 @@ module Manager = struct let may_trace_gas_limit_too_high info = match info.mode with - | Application _ | Partial_application _ | Construction _ -> fun x -> x + | Application _ | Partial_validation _ | Construction _ -> fun x -> x | Mempool -> (* [Gas.check_limit] will only raise a "temporary" error, however when @@ -2554,7 +2554,7 @@ module Manager = struct let may_update_remaining_gas_used mode (block_state : block_state) operation_gas_used = match mode with - | Application _ | Partial_application _ | Construction _ -> + | Application _ | Partial_validation _ | Construction _ -> let remaining_block_gas = Gas.Arith.(sub block_state.remaining_block_gas operation_gas_used) in @@ -2654,7 +2654,7 @@ let begin_any_application ctxt chain_id ~predecessor_level } in let mode = - if is_partial then Partial_application application_info + if is_partial then Partial_validation application_info else Application application_info in let all_expected_consensus_features = @@ -2675,7 +2675,7 @@ let begin_any_application ctxt chain_id ~predecessor_level all_expected_consensus_features ~predecessor_level) -let begin_partial_application ctxt chain_id ~predecessor_level +let begin_partial_validation ctxt chain_id ~predecessor_level ~predecessor_timestamp block_header fitness = begin_any_application ctxt @@ -3015,7 +3015,7 @@ let check_validation_pass_consistency vi vs validation_pass = let open Lwt_tzresult_syntax in match vi.mode with | Mempool | Construction _ -> return vs - | Application _ | Partial_application _ -> ( + | Application _ | Partial_validation _ -> ( match (vs.last_op_validation_pass, validation_pass) with | None, validation_pass -> return {vs with last_op_validation_pass = validation_pass} @@ -3059,11 +3059,11 @@ let validate_operation ?(check_signature = true) let block_state = record_operation block_state oph validation_pass_opt in let operation : _ Alpha_context.operation = {shell; protocol_data} in match (info.mode, validation_pass_opt) with - | Partial_application _, Some n + | Partial_validation _, Some n when Compare.Int.(n <> Operation_repr.consensus_pass) -> - (* Do not validate non-consensus operation in [Partial_application] mode *) + (* Do not validate non-consensus operation in [Partial_validation] mode *) return {info; operation_state; block_state} - | Partial_application _, _ | Mempool, _ | Construction _, _ | Application _, _ + | Partial_validation _, _ | Mempool, _ | Construction _, _ | Application _, _ -> ( match operation.protocol_data.contents with | Single (Preendorsement _) -> @@ -3280,7 +3280,7 @@ let finalize_block {info; block_state; _} = fitness in return_unit - | Partial_application _ -> + | Partial_validation _ -> let* are_endorsements_required = are_endorsements_required info in let*? () = if are_endorsements_required then diff --git a/src/proto_alpha/lib_protocol/validate.mli b/src/proto_alpha/lib_protocol/validate.mli index 2be9798450e4..5bf2650d14f1 100644 --- a/src/proto_alpha/lib_protocol/validate.mli +++ b/src/proto_alpha/lib_protocol/validate.mli @@ -85,7 +85,7 @@ val begin_application : block. Indeed, we may not have access to the predecessor context when trying to quickly assess a series of blocks in a cousin branch (multipass validation). *) -val begin_partial_application : +val begin_partial_validation : context -> Chain_id.t -> predecessor_level:Level.t -> diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index f6912d06ce7c..07551afdf8d3 100644 --- a/src/proto_demo_counter/lib_protocol/main.ml +++ b/src/proto_demo_counter/lib_protocol/main.ml @@ -68,7 +68,7 @@ type application_state = validation_state type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -81,7 +81,7 @@ type mode = let mode_str = function | Application _ -> "application" - | Partial_application _ -> "partial_application" + | Partial_validation _ -> "partial_validation" | Construction _ -> "construction" | Partial_construction _ -> "partial_construction" @@ -141,7 +141,7 @@ let begin_any_construction_mode validation_or_application mode context let begin_validation_or_application validation_or_application ctxt _chain_id mode ~predecessor = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> begin_any_application_mode validation_or_application mode diff --git a/src/proto_demo_noops/lib_protocol/main.ml b/src/proto_demo_noops/lib_protocol/main.ml index 5bb17f7fd617..93394ecbd1d5 100644 --- a/src/proto_demo_noops/lib_protocol/main.ml +++ b/src/proto_demo_noops/lib_protocol/main.ml @@ -72,7 +72,7 @@ type application_state = validation_state type mode = | Application of block_header - | Partial_application of block_header + | Partial_validation of block_header | Construction of { predecessor_hash : Block_hash.t; timestamp : Time.t; @@ -97,7 +97,7 @@ let begin_validation context _chain_id mode ~(predecessor : Block_header.shell_header) = let fitness = match mode with - | Application block_header | Partial_application block_header -> + | Application block_header | Partial_validation block_header -> block_header.shell.fitness | Construction _ | Partial_construction _ -> fitness_from_level Int64.(succ (of_int32 predecessor.level)) -- GitLab From 9aefcfb1a98eec2664b39f83aad800993668a868 Mon Sep 17 00:00:00 2001 From: vbot Date: Thu, 22 Sep 2022 18:47:27 +0200 Subject: [PATCH 12/12] Changelog: add an entry for the environment rehaul --- docs/protocols/alpha.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/docs/protocols/alpha.rst b/docs/protocols/alpha.rst index 890f58a87eee..f9db68742f5f 100644 --- a/docs/protocols/alpha.rst +++ b/docs/protocols/alpha.rst @@ -42,6 +42,9 @@ It requires protocol environment V7, compared to V6 for Kathmandu. - Introduce a ``Bls`` module to gather both high and low level functions for BLS cryptography. (MR :gl:`!6295`) +- Introduce a new protocol API adapted to pipelined validation. + (MR :gl:`!6335`) + Consensus key ------------- -- GitLab