diff --git a/docs/alpha/protocol_overview.rst b/docs/alpha/protocol_overview.rst index 8b6c2d6252f71b936b6953c6360c70905a8265db..59820bd83c1c65dc8ae1840667a0a75c60064549 100644 --- a/docs/alpha/protocol_overview.rst +++ b/docs/alpha/protocol_overview.rst @@ -43,12 +43,12 @@ protocol and the shell interact in order to ensure that the blocks being appended to the blockchain are valid. There are mainly two rules that the shell uses when receiving a new block: -- The shell does not accept a branch whose fork point is in a cycle - more than ``PRESERVED_CYCLES`` in the past. More precisely, if ``n`` - is the current cycle, :ref:`the last allowed fork point` is - the first level of cycle ``n-PRESERVED_CYCLES``. The parameter - ``PRESERVED_CYCLES`` therefore plays a central role in Tezos: any - block before the last allowed fork level is immutable. +- The shell does not accept a block whose level is below the current + :ref:`checkpoint`. The checkpoint itself is updated based + on information resulting from successful block applications by the + protocol which depends on the protocol consensus algorithm. Previously + accepted blocks with lower levels than the current checkpoint are + considered finalized and immutable. - The shell changes the head of the chain to this new block only if the block is :doc:`valid<../shell/validation>`, and it has a higher fitness than the current head; a block is diff --git a/docs/nairobi/protocol_overview.rst b/docs/nairobi/protocol_overview.rst index 308f349cded00edca413d3d52074bc99c2e2072a..d7a536e657851c63e520c848a31d92abaf44cc4d 100644 --- a/docs/nairobi/protocol_overview.rst +++ b/docs/nairobi/protocol_overview.rst @@ -79,12 +79,12 @@ protocol and the shell interact in order to ensure that the blocks being appended to the blockchain are valid. There are mainly two rules that the shell uses when receiving a new block: -- The shell does not accept a branch whose fork point is in a cycle - more than ``PRESERVED_CYCLES`` in the past. More precisely, if ``n`` - is the current cycle, :ref:`the last allowed fork point` is - the first level of cycle ``n-PRESERVED_CYCLES``. The parameter - ``PRESERVED_CYCLES`` therefore plays a central role in Tezos: any - block before the last allowed fork level is immutable. +- The shell does not accept a block whose level is below the current + :ref:`checkpoint`. The checkpoint itself is updated based on + information resulting from successful block applications by the + protocol which depends on the protocol consensus algorithm. Previously + accepted blocks with lower levels than the current checkpoint are + considered finalized and immutable. - The shell changes the head of the chain to this new block only if the block is :doc:`valid<../shell/validation>`, and it has a higher fitness than the current head; a block is diff --git a/docs/oxford/protocol_overview.rst b/docs/oxford/protocol_overview.rst index 4a7cec97f561200f6a2f591f33bd868a500bf7a3..8c99a0572983d794b752659ed7cc450a22db72e9 100644 --- a/docs/oxford/protocol_overview.rst +++ b/docs/oxford/protocol_overview.rst @@ -78,12 +78,12 @@ protocol and the shell interact in order to ensure that the blocks being appended to the blockchain are valid. There are mainly two rules that the shell uses when receiving a new block: -- The shell does not accept a branch whose fork point is in a cycle - more than ``PRESERVED_CYCLES`` in the past. More precisely, if ``n`` - is the current cycle, :ref:`the last allowed fork point` is - the first level of cycle ``n-PRESERVED_CYCLES``. The parameter - ``PRESERVED_CYCLES`` therefore plays a central role in Tezos: any - block before the last allowed fork level is immutable. +- The shell does not accept a block whose level is below the current + :ref:`checkpoint`. The checkpoint itself is updated based on + information resulting from successful block applications by the + protocol which depends on the protocol consensus algorithm. Previously + accepted blocks with lower levels than the current checkpoint are + considered finalized and immutable. - The shell changes the head of the chain to this new block only if the block is :doc:`valid<../shell/validation>`, and it has a higher fitness than the current head; a block is diff --git a/docs/shell/storage.rst b/docs/shell/storage.rst index d9c58898a5b789cf80b09084ba0618e0fe535688..d39d7a0c631a8736c0ce46c7b7f4568d6a441669 100644 --- a/docs/shell/storage.rst +++ b/docs/shell/storage.rst @@ -45,17 +45,14 @@ Both operations are explained next. Trimming ******** -.. _lafl: - -To notice when a cycle has completed, the store uses the -latest head's metadata that contains the **last allowed fork -level**. This specifies the point under which the local chain cannot be -reorganized. When a protocol validation operation returns a changed -value for this point, it means that a cycle has completed. Then, the store -retrieves all the blocks from ``(head-1).last_allowed_fork_level + 1`` -to ``head.last_allowed_fork_level``, which contain all the blocks of the -completed cycle, that cannot be reorganized anymore, and trims the -potential branches to yield a linear history. +The protocol indicates to the shell, through some metadata present in +the block application result, how much history is relevant to keep in +order to preserve useful informations. If too much history is present, +the storage layer triggers a clean-up mechanism which trims the +chain's outdated history. Only the linear history that is part of the +finalized chain will remain, discarding all the unreachable forks in +the process. The resulting sequential interval of blocks that is +returned represents a *cycle*. Pruning ******* @@ -103,15 +100,17 @@ history mode: - The *savepoint* which indicates the lowest block known by the store that possesses metadata and context. -The *checkpoint* is another variable maintained by the store, that indicates one block that -must be part of the chain. This special block may be in the future. -Setting a future checkpoint on a fresh node before bootstrapping adds -protection in case of eclipse attacks where a set of malicious peers -will advertise a wrong chain. When the store reaches the level of a -manually defined checkpoint, it will make sure that this is indeed the -expected block or will stop the bootstrap. When the checkpoint is -unspecified by the user, the store sets it to the :ref:`last allowed fork level `, each time this latter is updated. In any case, the store will maintain the following invariant: -``checkpoint ≥ head.last_allowed_fork_level``. +.. _checkpoint: + +The *checkpoint* is another variable maintained by the store, that +indicates one block that must be part of the chain. This special block +may be in the future. Setting a future checkpoint on a fresh node +before bootstrapping adds protection in case of eclipse attacks where +a set of malicious peers will advertise a wrong chain. When the store +reaches the level of a manually defined checkpoint, it will make sure +that this is indeed the expected block or it will stop the +bootstrap. When the checkpoint is unspecified by the user, the store +sets it to the value provided by the protocol consensus. While the node is running, it is possible to call the following RPCs to access the values of all these variables: diff --git a/docs/user/history_modes.rst b/docs/user/history_modes.rst index 211b74745759857a5e1b8be3c68c8e44cfb86fa8..dbb46b5501352d99f7dcf206ded6d158a3661766 100644 --- a/docs/user/history_modes.rst +++ b/docs/user/history_modes.rst @@ -91,10 +91,9 @@ details. History modes use some markers which are used to describe the state of the storage: -- *checkpoint*: the last allowed fork level of the chain (as defined - in the Tezos position paper), -- *savepoint*: the last known block which contains metadata, -- *caboose*: the last known block. +- *checkpoint*: the most recently finalized block of the chain, +- *savepoint*: the lowest level block that contains metadata, +- *caboose*: the lowest level known block. For more details about what data are stored in each mode, refer to :doc:`../shell/storage`. @@ -190,13 +189,10 @@ history. Indeed, at each new cycle, a garbage collection phase removes the ledger state and the block metadata (operation receipts, rewards updates, etc.) of blocks outside the offset of this sliding window. Depending on the network, a minimum number of cycles are -kept. These cycles correspond to the ones above the last -allowed fork level, containing blocks subjects to a potential chain -reorganization (this minimal number of cycles is currently given by -the :ref:`preserved_cycles` protocol parameter, which -on mainnet is currently set to 5 cycles). However, the -node is able to keep an additional number of cycles that is -configurable. +kept. This number of cycles corresponds to the +:ref:`preserved_cycles` protocol parameter, which on +mainnet is set to 5 cycles. However, the node is able to keep an +additional number of cycles that is configurable. By default, 1 additional cycle is kept for both ``full`` and ``rolling`` nodes. It is possible to increase this parameter to keep diff --git a/src/bin_client/test/proto_test_injection/main.ml b/src/bin_client/test/proto_test_injection/main.ml index 8d6fb9fbdc7701996988885f0e8b3eaf1d25cbfd..048e13ed7827af45443dd7a1a42097b26ec83cfc 100644 --- a/src/bin_client/test/proto_test_injection/main.ml +++ b/src/bin_client/test/proto_test_injection/main.ml @@ -150,7 +150,8 @@ let finalize_application application_state _block_header = context = application_state.context; fitness; max_operations_ttl = 0; - last_allowed_fork_level = 0l; + last_finalized_block_level = 0l; + last_preserved_block_level = 0l; }, () ) @@ -165,7 +166,8 @@ let init _chain_id ctxt block_header = context = ctxt; fitness; max_operations_ttl = 0; - last_allowed_fork_level = 0l; + last_finalized_block_level = 0l; + last_preserved_block_level = 0l; } type error += Missing_value_in_cache diff --git a/src/lib_protocol_environment/environment_V0.ml b/src/lib_protocol_environment/environment_V0.ml index 5632ac2d8e562a01f784bdd7987e5a3bf71afe4e..67a697bb9b069151175957ff91d5699c6bd4af8d 100644 --- a/src/lib_protocol_environment/environment_V0.ml +++ b/src/lib_protocol_environment/environment_V0.ml @@ -678,7 +678,7 @@ struct module Logging = Legacy_logging module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -702,7 +702,7 @@ struct Environment_protocol_T_V0.T with type context := Context.t and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult @@ -818,13 +818,18 @@ struct let finalize_block c = let open Lwt_syntax in - let+ r = finalize_block c in - wrap_error r + let* r = finalize_block c in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_error (Error e)) let init c bh = let open Lwt_syntax in - let+ r = init c bh in - wrap_error r + let* r = init c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_error (Error e)) end module Lift (P : Updater.PROTOCOL) = struct diff --git a/src/lib_protocol_environment/environment_V0.mli b/src/lib_protocol_environment/environment_V0.mli index 16aca09f9c6d6dcd80a23aa0cb506e7fbf8be42c..ba0a5eac667f11050fe9ba788db1096cc823e457 100644 --- a/src/lib_protocol_environment/environment_V0.mli +++ b/src/lib_protocol_environment/environment_V0.mli @@ -105,7 +105,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V1.ml b/src/lib_protocol_environment/environment_V1.ml index 1f7ef70bfe31253fbb0e5535eed81d56cd6f9bba..8325d72e2a3bb7fe2d5b7620f41cfa4ae148bcc1 100644 --- a/src/lib_protocol_environment/environment_V1.ml +++ b/src/lib_protocol_environment/environment_V1.ml @@ -808,7 +808,7 @@ struct module Logging = Legacy_logging module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -832,7 +832,7 @@ struct Environment_protocol_T_V0.T with type context := Context.t and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult @@ -948,13 +948,18 @@ struct let finalize_block c = let open Lwt_syntax in - let+ r = finalize_block c in - wrap_error r + let* r = finalize_block c in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_error (Error e)) let init c bh = let open Lwt_syntax in - let+ r = init c bh in - wrap_error r + let* r = init c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_error (Error e)) end module Lift (P : Updater.PROTOCOL) = struct diff --git a/src/lib_protocol_environment/environment_V1.mli b/src/lib_protocol_environment/environment_V1.mli index 8520815a2f34b8d1812fe9c38de48940a01b8c2a..573fbc5af6884c6dea965c255b3fe8a1f3c3882e 100644 --- a/src/lib_protocol_environment/environment_V1.mli +++ b/src/lib_protocol_environment/environment_V1.mli @@ -105,7 +105,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V10.ml b/src/lib_protocol_environment/environment_V10.ml index 365dceebd502fa7cb30c311426af540582e166fc..60b27c633f2a9ca36e2cb4b4d29764f8b9c818fe 100644 --- a/src/lib_protocol_environment/environment_V10.ml +++ b/src/lib_protocol_environment/environment_V10.ml @@ -1054,7 +1054,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -1078,7 +1078,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult @@ -1296,13 +1296,18 @@ struct let finalize_application state shell_header = let open Lwt_syntax in - let+ res = finalize_application state shell_header in - wrap_tzresult res + let* r = finalize_application state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let init chain_id c bh = let open Lwt_syntax in - let+ r = init chain_id c bh in - wrap_tzresult r + let* r = init chain_id c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V10.mli b/src/lib_protocol_environment/environment_V10.mli index d4f07896faf322440673c99261a88eb2e2f0e0f3..56a86901022ddcb6045dd57f19ea6796367b1719 100644 --- a/src/lib_protocol_environment/environment_V10.mli +++ b/src/lib_protocol_environment/environment_V10.mli @@ -193,7 +193,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V11.ml b/src/lib_protocol_environment/environment_V11.ml index 9123d2de9b19550c826b156a32fb8320923123c3..264fe7a54c2ce198e4f62d4badd2f36053fc1472 100644 --- a/src/lib_protocol_environment/environment_V11.ml +++ b/src/lib_protocol_environment/environment_V11.ml @@ -1065,7 +1065,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -1089,7 +1089,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult @@ -1270,13 +1270,18 @@ struct let finalize_application state shell_header = let open Lwt_syntax in - let+ res = finalize_application state shell_header in - wrap_tzresult res + let* r = finalize_application state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let init chain_id c bh = let open Lwt_syntax in - let+ r = init chain_id c bh in - wrap_tzresult r + let* r = init chain_id c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V11.mli b/src/lib_protocol_environment/environment_V11.mli index 311307153f11e28ff9111c9e30bb7f68c7bdd24e..e959a593c2887f8822bfe5db509c047022a9735d 100644 --- a/src/lib_protocol_environment/environment_V11.mli +++ b/src/lib_protocol_environment/environment_V11.mli @@ -193,7 +193,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V12.ml b/src/lib_protocol_environment/environment_V12.ml index 6968a715d61b29249b22aa0ae3d4e0c3be060ae3..2117b0d820589070ad4cdc2c99d3a0fb45689803 100644 --- a/src/lib_protocol_environment/environment_V12.ml +++ b/src/lib_protocol_environment/environment_V12.ml @@ -1070,7 +1070,8 @@ struct fitness : Fitness.t; message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_finalized_block_level : Int32.t; + last_preserved_block_level : Int32.t; } type nonrec quota = quota = {max_size : int; max_op : int option} diff --git a/src/lib_protocol_environment/environment_V2.ml b/src/lib_protocol_environment/environment_V2.ml index 2f86f2f934f2e4242e9cf49fd53b84b0922fe6b4..63abd1a64dd975cbc8abec873be67cd34f2dfa04 100644 --- a/src/lib_protocol_environment/environment_V2.ml +++ b/src/lib_protocol_environment/environment_V2.ml @@ -821,7 +821,7 @@ struct module Logging = Legacy_logging module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -845,7 +845,7 @@ struct Environment_protocol_T_V0.T with type context := Context.t and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult @@ -943,13 +943,18 @@ struct let finalize_block c = let open Lwt_syntax in - let+ r = finalize_block c in - wrap_tzresult r + let* r = finalize_block c in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let init c bh = let open Lwt_syntax in - let+ r = init c bh in - wrap_tzresult r + let* r = init c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) end module Lift (P : Updater.PROTOCOL) = struct diff --git a/src/lib_protocol_environment/environment_V2.mli b/src/lib_protocol_environment/environment_V2.mli index ae13045d843733639c84779b3bc38959327a4ffe..2bc846a980dca8296f18e39715be9bc11f07a6ed 100644 --- a/src/lib_protocol_environment/environment_V2.mli +++ b/src/lib_protocol_environment/environment_V2.mli @@ -134,7 +134,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index 360e490704c969c5a1f212b6067b2a99abd986e7..40d9899b6e967842955cbf719e1c24f898a67501 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -973,7 +973,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -997,7 +997,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type 'a tzresult := 'a Error_monad.tzresult end @@ -1184,8 +1184,11 @@ struct let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ res = finalize_block state shell_header in - wrap_tzresult res + let* r = finalize_block state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let finalize_validation state = let open Lwt_result_syntax in @@ -1212,8 +1215,10 @@ struct let init _chain_id c bh = let open Lwt_syntax in - let+ r = init c bh in - wrap_tzresult r + let* r = init c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V3.mli b/src/lib_protocol_environment/environment_V3.mli index 7c7e3588ace5ba43417930ef2401425a41d95c1c..eccb9e0c1a03fc0d5efe62c21bdd940c86270bed 100644 --- a/src/lib_protocol_environment/environment_V3.mli +++ b/src/lib_protocol_environment/environment_V3.mli @@ -143,7 +143,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V4.ml b/src/lib_protocol_environment/environment_V4.ml index ed770f9a98e8ecfafb96f56107a9c6482bb4c015..0627db62e94d0c0ebf283180fad8ab20d435f8a1 100644 --- a/src/lib_protocol_environment/environment_V4.ml +++ b/src/lib_protocol_environment/environment_V4.ml @@ -1002,7 +1002,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -1026,7 +1026,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type 'a tzresult := 'a Error_monad.tzresult end @@ -1201,8 +1201,11 @@ struct let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ res = finalize_block state shell_header in - wrap_tzresult res + let* r = finalize_block state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let finalize_validation state = let open Lwt_result_syntax in @@ -1229,8 +1232,10 @@ struct let init _chain_id c bh = let open Lwt_syntax in - let+ r = init c bh in - wrap_tzresult r + let* r = init c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V4.mli b/src/lib_protocol_environment/environment_V4.mli index 07f784e22a5d74c3a1ed68e998bcb145c61202ee..690900502bffde409155c493631231b310fd00ab 100644 --- a/src/lib_protocol_environment/environment_V4.mli +++ b/src/lib_protocol_environment/environment_V4.mli @@ -145,7 +145,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V5.ml b/src/lib_protocol_environment/environment_V5.ml index 43dddd2cfc189132d3586d3dc7dde95ed575af9a..296a46b19f113a0067c640f55fc22149b3adc45f 100644 --- a/src/lib_protocol_environment/environment_V5.ml +++ b/src/lib_protocol_environment/environment_V5.ml @@ -976,7 +976,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -1000,7 +1000,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type 'a tzresult := 'a Error_monad.tzresult end @@ -1178,8 +1178,11 @@ struct let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ res = finalize_block state shell_header in - wrap_tzresult res + let* r = finalize_block state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let finalize_validation state = let open Lwt_result_syntax in @@ -1206,8 +1209,10 @@ struct let init _chain_id c bh = let open Lwt_syntax in - let+ r = init c bh in - wrap_tzresult r + let* r = init c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V5.mli b/src/lib_protocol_environment/environment_V5.mli index 745d58c4875ed7ccf94bc0a25e5d1fea06b15a76..548c3bbe4a301e332eafdb47300a2e80a4a5b6de 100644 --- a/src/lib_protocol_environment/environment_V5.mli +++ b/src/lib_protocol_environment/environment_V5.mli @@ -158,7 +158,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V6.ml b/src/lib_protocol_environment/environment_V6.ml index 6b021941c143c7dbe69b9eea2bf7a2b8951728a8..389a0bb7aec8484140b52d5852885e30d72c1504 100644 --- a/src/lib_protocol_environment/environment_V6.ml +++ b/src/lib_protocol_environment/environment_V6.ml @@ -978,7 +978,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -1002,7 +1002,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type 'a tzresult := 'a Error_monad.tzresult end @@ -1268,8 +1268,11 @@ struct let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ res = finalize_block state shell_header in - wrap_tzresult res + let* r = finalize_block state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let finalize_validation state = let open Lwt_result_syntax in @@ -1296,8 +1299,10 @@ struct let init chain_id c bh = let open Lwt_syntax in - let+ r = init chain_id c bh in - wrap_tzresult r + let* r = init chain_id c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V6.mli b/src/lib_protocol_environment/environment_V6.mli index ae1d240aefeb1d14efdc3d075dc532577a358492..cb7770a73a837c225f44620ecd0379419e0bf0aa 100644 --- a/src/lib_protocol_environment/environment_V6.mli +++ b/src/lib_protocol_environment/environment_V6.mli @@ -159,7 +159,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V7.ml b/src/lib_protocol_environment/environment_V7.ml index 60df5f376f19938ec6d45c3f12fff351181e7d3a..6f67bb75b6fec83b133ee327a56a941fb53cfc07 100644 --- a/src/lib_protocol_environment/environment_V7.ml +++ b/src/lib_protocol_environment/environment_V7.ml @@ -987,7 +987,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -1011,7 +1011,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult @@ -1202,13 +1202,18 @@ struct let finalize_application state shell_header = let open Lwt_syntax in - let+ res = finalize_application state shell_header in - wrap_tzresult res + let* r = finalize_application state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let init chain_id c bh = let open Lwt_syntax in - let+ r = init chain_id c bh in - wrap_tzresult r + let* r = init chain_id c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V7.mli b/src/lib_protocol_environment/environment_V7.mli index a8c8ec9a9d4eed0f2d1aa9ab4e0ce04e4fc3016a..0c415ff5b177b7e53b8b1bf405be8c3f908818da 100644 --- a/src/lib_protocol_environment/environment_V7.mli +++ b/src/lib_protocol_environment/environment_V7.mli @@ -170,7 +170,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V8.ml b/src/lib_protocol_environment/environment_V8.ml index 6f6351e1a68697989be0ed01bba7a71aa8a63b1f..18cf72445cec2885a0bebb32eaacd40e632d43a6 100644 --- a/src/lib_protocol_environment/environment_V8.ml +++ b/src/lib_protocol_environment/environment_V8.ml @@ -1044,7 +1044,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -1068,7 +1068,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult @@ -1280,13 +1280,18 @@ struct let finalize_application state shell_header = let open Lwt_syntax in - let+ res = finalize_application state shell_header in - wrap_tzresult res + let* r = finalize_application state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let init chain_id c bh = let open Lwt_syntax in - let+ r = init chain_id c bh in - wrap_tzresult r + let* r = init chain_id c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V8.mli b/src/lib_protocol_environment/environment_V8.mli index d8a363953bff2169b6edc1c19251e5c1dba9ef03..54e127f72a61884a268580690e5cfaf1b88a8f11 100644 --- a/src/lib_protocol_environment/environment_V8.mli +++ b/src/lib_protocol_environment/environment_V8.mli @@ -177,7 +177,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_V9.ml b/src/lib_protocol_environment/environment_V9.ml index 0e8a620135e03538ee6ab469259a948c7091e20a..488568a5e33a3481356a5f8a80dc1d5c095f030e 100644 --- a/src/lib_protocol_environment/environment_V9.ml +++ b/src/lib_protocol_environment/environment_V9.ml @@ -1042,7 +1042,7 @@ struct end module Updater = struct - type nonrec validation_result = validation_result = { + type nonrec validation_result = legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -1066,7 +1066,7 @@ struct and type cache_value := Environment_context.Context.cache_value and type cache_key := Environment_context.Context.cache_key and type quota := quota - and type validation_result := validation_result + and type validation_result := legacy_validation_result and type rpc_context := rpc_context and type tztrace := Error_monad.tztrace and type 'a tzresult := 'a Error_monad.tzresult @@ -1280,13 +1280,18 @@ struct let finalize_application state shell_header = let open Lwt_syntax in - let+ res = finalize_application state shell_header in - wrap_tzresult res + let* r = finalize_application state shell_header in + match r with + | Ok (vr, metadata) -> + Lwt.return_ok (lift_legacy_validation_result vr, metadata) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let init chain_id c bh = let open Lwt_syntax in - let+ r = init chain_id c bh in - wrap_tzresult r + let* r = init chain_id c bh in + match r with + | Ok vr -> Lwt.return_ok (lift_legacy_validation_result vr) + | Error e -> Lwt.return (wrap_tzresult (Error e)) let set_log_message_consumer f = Logging.logging_function := Some f diff --git a/src/lib_protocol_environment/environment_V9.mli b/src/lib_protocol_environment/environment_V9.mli index ffe3f8a7b6182c51d699638620b70b6b26b8a34b..fa7a23ec2637959003a8bf1458942abf3d4e46dd 100644 --- a/src/lib_protocol_environment/environment_V9.mli +++ b/src/lib_protocol_environment/environment_V9.mli @@ -181,7 +181,4 @@ module Make (Param : sig val name : string end) () : - T - with type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context + T with type Updater.quota = quota and type Updater.rpc_context = rpc_context diff --git a/src/lib_protocol_environment/environment_context.ml b/src/lib_protocol_environment/environment_context.ml index 36384c99160680bbcf19e33b6a5e00c960dd4ac8..bc8e8d8f2e1adcac1b194fb2fcba5cc1832de860 100644 --- a/src/lib_protocol_environment/environment_context.ml +++ b/src/lib_protocol_environment/environment_context.ml @@ -769,7 +769,7 @@ module Register (C : S) = struct let ops = (module C : S with type t = 'ctxt and type tree = 'tree) end -type validation_result = { +type legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -777,6 +777,28 @@ type validation_result = { last_allowed_fork_level : Int32.t; } +type validation_result = { + context : Context.t; + fitness : Fitness.t; + message : string option; + max_operations_ttl : int; + last_finalized_block_level : Int32.t; + last_preserved_block_level : Int32.t; +} + +let lift_legacy_validation_result + (legacy_validation_result : legacy_validation_result) : validation_result = + { + context = legacy_validation_result.context; + fitness = legacy_validation_result.fitness; + message = legacy_validation_result.message; + max_operations_ttl = legacy_validation_result.max_operations_ttl; + last_finalized_block_level = + legacy_validation_result.last_allowed_fork_level; + last_preserved_block_level = + legacy_validation_result.last_allowed_fork_level; + } + type quota = {max_size : int; max_op : int option} type rpc_context = { diff --git a/src/lib_protocol_environment/environment_context.mli b/src/lib_protocol_environment/environment_context.mli index eb88abf5525f989fe625a73d7c6b0d832c7e6a97..e5199c8a48360b92eb4fbbc2a1bbb94d722b9eb1 100644 --- a/src/lib_protocol_environment/environment_context.mli +++ b/src/lib_protocol_environment/environment_context.mli @@ -221,7 +221,7 @@ module Register (C : S) : sig val ops : (C.t, C.tree) Context.ops end -type validation_result = { +type legacy_validation_result = { context : Context.t; fitness : Fitness.t; message : string option; @@ -229,6 +229,18 @@ type validation_result = { last_allowed_fork_level : Int32.t; } +type validation_result = { + context : Context.t; + fitness : Fitness.t; + message : string option; + max_operations_ttl : int; + last_finalized_block_level : Int32.t; + last_preserved_block_level : Int32.t; +} + +val lift_legacy_validation_result : + legacy_validation_result -> validation_result + type quota = {max_size : int; max_op : int option} type rpc_context = { diff --git a/src/lib_protocol_environment/sigs/v12.ml b/src/lib_protocol_environment/sigs/v12.ml index 109a0ff09ce34118fb1f6710a21b6053dd7fccef..f26b8cb133f57851fa5ea325fc20150089763a8a 100644 --- a/src/lib_protocol_environment/sigs/v12.ml +++ b/src/lib_protocol_environment/sigs/v12.ml @@ -11345,11 +11345,15 @@ type validation_result = { (** 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. *) - 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. *) + last_finalized_block_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. *) + last_preserved_block_level : Int32.t; + (** The level of the oldest block that is considered as + preserved. The shell uses it as an hint to perform + internal maintenance operations. *) } type quota = { @@ -11578,7 +11582,7 @@ module type PROTOCOL = sig context and shell header of the predecessor block. Exceptionally 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". + than the current head's "last_finalized_block_level". [mode] specifies the circumstances of validation and also carries additional information: see {!mode}. diff --git a/src/lib_protocol_environment/sigs/v12/updater.mli b/src/lib_protocol_environment/sigs/v12/updater.mli index e394c22b9b62fdc32c9d5f569f0f004beaad5cbc..f0461c7a706cc31226ab12963871eedaf495de8e 100644 --- a/src/lib_protocol_environment/sigs/v12/updater.mli +++ b/src/lib_protocol_environment/sigs/v12/updater.mli @@ -40,11 +40,15 @@ type validation_result = { (** 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. *) - 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. *) + last_finalized_block_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. *) + last_preserved_block_level : Int32.t; + (** The level of the oldest block that is considered as + preserved. The shell uses it as an hint to perform + internal maintenance operations. *) } type quota = { @@ -273,7 +277,7 @@ module type PROTOCOL = sig context and shell header of the predecessor block. Exceptionally 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". + than the current head's "last_finalized_block_level". [mode] specifies the circumstances of validation and also carries additional information: see {!mode}. diff --git a/src/lib_protocol_environment/tezos_protocol_environment.ml b/src/lib_protocol_environment/tezos_protocol_environment.ml index 2381dfed25d87c11427a0b1d0973662605b79bd4..e9aa47d12a2d7ae1dbe4ef69846c37e934124b73 100644 --- a/src/lib_protocol_environment/tezos_protocol_environment.ml +++ b/src/lib_protocol_environment/tezos_protocol_environment.ml @@ -35,7 +35,8 @@ type validation_result = Environment_context.validation_result = { fitness : Fitness.t; message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_finalized_block_level : Int32.t; + last_preserved_block_level : Int32.t; } type quota = Environment_context.quota = {max_size : int; max_op : int option} diff --git a/src/lib_shell_services/history_mode.ml b/src/lib_shell_services/history_mode.ml index d8931e385a3647e45b5179ecde758cd59025b076..365abf05433a8f4955166c18540323a5768c37b5 100644 --- a/src/lib_shell_services/history_mode.ml +++ b/src/lib_shell_services/history_mode.ml @@ -43,7 +43,7 @@ type t = (* The default_offset value defines a window of stored cycles which is suitable for baking services. It currently corresponds to 6 as we - store 1 cycle below the last allowed fork level of the current + store 1 cycle below the last preserved block level of the current head, which is set to [preserved_cycles] cycles in the past. TODO: https://gitlab.com/tezos/tezos/-/issues/1406 As this value is potentially both network and protocol specific, it diff --git a/src/lib_shell_services/store_errors.ml b/src/lib_shell_services/store_errors.ml index 3d2d3940c076b3eb236719c3c70006c93a4e8bf3..eefed9183f8d532c19eaeb00662984108ff96f29 100644 --- a/src/lib_shell_services/store_errors.ml +++ b/src/lib_shell_services/store_errors.ml @@ -284,8 +284,8 @@ type store_block_error = operations_lengths : string; operations_data_lengths : string; } - | Invalid_last_allowed_fork_level of { - last_allowed_fork_level : int32; + | Invalid_last_preserved_block_level of { + last_preserved_block_level : int32; genesis_level : int32; } @@ -347,7 +347,7 @@ type error += | Temporary_cemented_file_exists of string | Inconsistent_cemented_file of string * string | Inconsistent_cemented_store of cemented_store_inconsistency - | Missing_last_allowed_fork_level_block + | Missing_last_preserved_block | Inconsistent_block_hash of { level : Int32.t; expected_hash : Block_hash.t; @@ -632,19 +632,19 @@ let () = (fun csi -> Inconsistent_cemented_store csi) ; Error_monad.register_error_kind `Temporary - ~id:"store.missing_last_allowed_fork_level_block" - ~title:"Missing last allowed fork level block" + ~id:"store.missing_last_preserved_block" + ~title:"Missing last preserved block" ~description: - "Current head's last allowed fork level block (or its associated \ - metadata) cannot be found in the store." + "Current head's last preserved block (or its associated metadata) cannot \ + be found in the store." ~pp:(fun ppf () -> Format.fprintf ppf - "Current head's last allowed fork level block or (its associated \ - metadata) cannot be found in the store.") + "Current head's last preserved block or (its associated metadata) \ + cannot be found in the store.") Data_encoding.empty - (function Missing_last_allowed_fork_level_block -> Some () | _ -> None) - (fun () -> Missing_last_allowed_fork_level_block) ; + (function Missing_last_preserved_block -> Some () | _ -> None) + (fun () -> Missing_last_preserved_block) ; Error_monad.register_error_kind `Temporary ~id:"store.inconsistent_block_hash" @@ -745,12 +745,12 @@ let () = "inconsistent operations (%s) and operations_data (%s) lengths" operations_lengths operations_data_lengths - | Invalid_last_allowed_fork_level - {last_allowed_fork_level; genesis_level} -> + | Invalid_last_preserved_block_level + {last_preserved_block_level; genesis_level} -> Format.sprintf - "block's last allowed fork level (%ld) is below the genesis \ - level (%ld)" - last_allowed_fork_level + "block's last preserved level (%ld) is below the genesis level \ + (%ld)" + last_preserved_block_level genesis_level)) Data_encoding.( obj2 diff --git a/src/lib_store/mocked/store.ml b/src/lib_store/mocked/store.ml index 89ab66d92104923944020d67c9896419945d9ebd..8ce8b02cfc2407175cc713ee23852d3553517410 100644 --- a/src/lib_store/mocked/store.ml +++ b/src/lib_store/mocked/store.ml @@ -187,7 +187,7 @@ module Block = struct type metadata = Block_repr.metadata = { message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_preserved_block_level : Int32.t; block_metadata : Bytes.t; operations_metadata : Block_validation.operation_metadata list list; } @@ -398,7 +398,8 @@ module Block = struct timestamp = _; message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; + _; }; block_metadata; ops_metadata; @@ -448,22 +449,22 @@ module Block = struct .chain_id in let genesis_level = Block_repr.level genesis_block in - let* last_allowed_fork_level = + let* last_preserved_block_level = if is_main_chain then let* () = fail_unless - Compare.Int32.(last_allowed_fork_level >= genesis_level) + Compare.Int32.(last_preserved_block_level >= genesis_level) (Cannot_store_block ( hash, - Invalid_last_allowed_fork_level - {last_allowed_fork_level; genesis_level} )) + Invalid_last_preserved_block_level + {last_preserved_block_level; genesis_level} )) in - return last_allowed_fork_level - else if Compare.Int32.(last_allowed_fork_level < genesis_level) then - (* Hack: on the testchain, the block's lafl depends on the - lafl and is not max(genesis_level, expected_lafl) *) + return last_preserved_block_level + else if Compare.Int32.(last_preserved_block_level < genesis_level) then + (* Hack: on the testchain, the block's lpbl depends on the + lpbl and is not max(genesis_level, expected_lpbl) *) return genesis_level - else return last_allowed_fork_level + else return last_preserved_block_level in let*! b = is_known_valid chain_store hash in match b with @@ -508,7 +509,7 @@ module Block = struct { message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata = fst block_metadata; operations_metadata = (match ops_metadata with @@ -739,8 +740,8 @@ module Block = struct let max_operations_ttl metadata = Block_repr.max_operations_ttl metadata - let last_allowed_fork_level metadata = - Block_repr.last_allowed_fork_level metadata + let last_preserved_block_level metadata = + Block_repr.last_preserved_block_level metadata let block_metadata metadata = Block_repr.block_metadata metadata @@ -1161,11 +1162,11 @@ module Chain = struct in Lwt.return_some l - let may_update_checkpoint_and_target chain_store ~new_head ~new_head_lafl + let may_update_checkpoint_and_target chain_store ~new_head ~new_head_lpbl ~checkpoint ~target = let open Lwt_result_syntax in let new_checkpoint = - if Compare.Int32.(snd new_head_lafl > snd checkpoint) then new_head_lafl + if Compare.Int32.(snd new_head_lpbl > snd checkpoint) then new_head_lpbl else checkpoint in match target with @@ -1218,28 +1219,30 @@ module Chain = struct Block.get_block_metadata chain_store new_head) in let*! target = Stored_data.get chain_state.target_data in - let new_head_lafl = Block.last_allowed_fork_level new_head_metadata in + let new_head_lpbl = + Block.last_preserved_block_level new_head_metadata + in (* This write call will initialize the cementing highwatermark when it is not yet set or do nothing otherwise. *) - let*! lafl_block_opt = + let*! lpbl_block_opt = Block.locked_read_block_by_level_opt chain_store new_head - new_head_lafl + new_head_lpbl in let* new_checkpoint, new_target = - match lafl_block_opt with + match lpbl_block_opt with | None -> - (* This case may occur when importing a rolling - snapshot where the lafl block is not known. - We may use the checkpoint instead. *) + (* This case may occur when importing a rolling snapshot + where the lpbl block is not known. We may use the + checkpoint instead. *) return (checkpoint, target) - | Some lafl_block -> + | Some lpbl_block -> may_update_checkpoint_and_target chain_store ~new_head:new_head_descr - ~new_head_lafl:(Block.descriptor lafl_block) + ~new_head_lpbl:(Block.descriptor lpbl_block) ~checkpoint ~target in @@ -1366,7 +1369,7 @@ module Chain = struct let cementing_highwatermark = Option.fold ~none:0l - ~some:(fun metadata -> Block.last_allowed_fork_level metadata) + ~some:(fun metadata -> Block.last_preserved_block_level metadata) (Block_repr.metadata genesis_block) in let expect_predecessor_context = @@ -2004,10 +2007,10 @@ let rec make_pp_chain_store (chain_store : chain_store) = in Format.fprintf fmt - "%a (lafl: %ld) (max_op_ttl: %d)" + "%a (lpbl: %ld) (max_op_ttl: %d)" pp_block_descriptor (Block.descriptor block) - (Block.last_allowed_fork_level metadata) + (Block.last_preserved_block_level metadata) (Block.max_operations_ttl metadata)) current_head pp_block_descriptor diff --git a/src/lib_store/shared/block_repr.ml b/src/lib_store/shared/block_repr.ml index 2a6bcbcae6343b5952e55bfda79447c4b39dc184..77e3954f601522c144a8a47dff1eb3529c413df2 100644 --- a/src/lib_store/shared/block_repr.ml +++ b/src/lib_store/shared/block_repr.ml @@ -35,7 +35,7 @@ type contents = { type metadata = { message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_preserved_block_level : Int32.t; block_metadata : Bytes.t; operations_metadata : Block_validation.operation_metadata list list; } @@ -92,7 +92,7 @@ let create_genesis_block ~genesis context = { message = Some "Genesis"; max_operations_ttl = 0; - last_allowed_fork_level = 0l; + last_preserved_block_level = 0l; block_metadata = Bytes.create 0; operations_metadata = []; } @@ -128,31 +128,31 @@ let metadata_encoding : metadata Data_encoding.t = (fun { message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata; operations_metadata; } -> ( message, max_operations_ttl, - last_allowed_fork_level, + last_preserved_block_level, block_metadata, operations_metadata )) (fun ( message, max_operations_ttl, - last_allowed_fork_level, + last_preserved_block_level, block_metadata, operations_metadata ) -> { message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata; operations_metadata; }) (obj5 (opt "message" string) (req "max_operations_ttl" uint16) - (req "last_allowed_fork_level" int32) + (req "last_preserved_block_level" int32) (req "block_metadata" bytes) (req "operations_metadata" @@ -230,14 +230,14 @@ let with_metadata { message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata; operations_metadata; } f = f message max_operations_ttl - last_allowed_fork_level + last_preserved_block_level block_metadata operations_metadata [@@ocaml.inline] @@ -254,10 +254,10 @@ let contents_equal c1 c2 = omh2 let metadata_equal m1 m2 = - with_metadata m1 @@ fun m1 mot1 lafl1 bm1 om1 -> - with_metadata m2 @@ fun m2 mot2 lafl2 bm2 om2 -> + with_metadata m1 @@ fun m1 mot1 lpbl1 bm1 om1 -> + with_metadata m2 @@ fun m2 mot2 lpbl2 bm2 om2 -> Option.equal String.equal m1 m2 - && Int.equal mot1 mot2 && Int32.equal lafl1 lafl2 && Bytes.equal bm1 bm2 + && Int.equal mot1 mot2 && Int32.equal lpbl1 lpbl2 && Bytes.equal bm1 bm2 && List.equal (List.equal Block_validation.operation_metadata_equal) om1 om2 let equal b1 b2 = @@ -313,7 +313,7 @@ let message metadata = metadata.message let max_operations_ttl metadata = metadata.max_operations_ttl -let last_allowed_fork_level metadata = metadata.last_allowed_fork_level +let last_preserved_block_level metadata = metadata.last_preserved_block_level let block_metadata metadata = metadata.block_metadata @@ -382,7 +382,7 @@ let convert_legacy_metadata (legacy_metadata : legacy_metadata) : metadata = { message = legacy_message; max_operations_ttl = legacy_max_operations_ttl; - last_allowed_fork_level = legacy_last_allowed_fork_level; + last_preserved_block_level = legacy_last_allowed_fork_level; block_metadata = legacy_block_metadata; operations_metadata = List.map diff --git a/src/lib_store/shared/block_repr.mli b/src/lib_store/shared/block_repr.mli index 2ebc484f58079112d9e68685c2f7f9b30f18c206..f6685fddbc176a07e915a5d8491fe447ea2e3aa2 100644 --- a/src/lib_store/shared/block_repr.mli +++ b/src/lib_store/shared/block_repr.mli @@ -50,7 +50,7 @@ type contents = { type metadata = { message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_preserved_block_level : Int32.t; block_metadata : Bytes.t; operations_metadata : Block_validation.operation_metadata list list; } @@ -172,7 +172,7 @@ val message : metadata -> string option val max_operations_ttl : metadata -> int -val last_allowed_fork_level : metadata -> Int32.t +val last_preserved_block_level : metadata -> Int32.t val block_metadata : metadata -> bytes diff --git a/src/lib_store/shared/store_events.ml b/src/lib_store/shared/store_events.ml index 856ab68f467f7bdd8d95aa0f20773a4ea30231fd..54abbced2f7f355ebf55fce53f0d4b1cc18f29f8 100644 --- a/src/lib_store/shared/store_events.ml +++ b/src/lib_store/shared/store_events.ml @@ -244,9 +244,9 @@ let start_merging_stores = ~section ~level:Notice ~name:"start_merging_stores" - ~msg:"merging store up to block level {lafl}" + ~msg:"merging store up to block level {lpbl}" ~pp1:pp_int32 - ("lafl", Data_encoding.int32) + ("lpbl", Data_encoding.int32) let end_merging_stores = declare_1 diff --git a/src/lib_store/store.mli b/src/lib_store/store.mli index 430a310e6d853eaa7b08471a2840d785e1878806..5627fb08aa1409358b48b3c7ad20ec07f7701193 100644 --- a/src/lib_store/store.mli +++ b/src/lib_store/store.mli @@ -58,13 +58,14 @@ - Full : maintains every block that is part of the chain but prune the metadata for blocks that are below the following - threshold level: [last_allowed_fork_level] of the current head - - [offset] cycles. + threshold level: [last_preserved_block_level] of the current head + - [offset] cycles. - Rolling : maintains rolling windows which contain recent blocks that are part of the chain, along with their metadata. It prunes everything that is below the following threshold level: - [last_allowed_fork_level] of the current head - [offset] cycles. + [last_preserved_block_level] of the current head - [offset] + cycles. {2 Protocol store} @@ -109,17 +110,17 @@ - A check is made if this head is consistent (i.e. if it's not below the checkpoint); - - If the [last_allowed_fork_level] of the head is different from + - If the [last_preserved_block_level] of the head is different from the previous head's one, then we can establish that a cycle has been completed and we can start cementing this cycle by "triggering a merge". A merge phase consists of establishing the interval of blocks to - cement, which is trivially [last_allowed_fork_level(new_head)] to - [last_allowed_fork_level(prev_head)], but also, for Full and + cement, which is trivially [last_preserved_block_level(new_head)] + to [last_preserved_block_level(prev_head)], but also, for Full and Rolling history modes, keep some extra blocks so that we make sure to keep blocks above - max_operation_ttl(last_allowed_fork_level(checkpoint)). This is + max_operation_ttl(last_preserved_block_level(checkpoint)). This is done to make sure that we can export snapshots at the checkpoint level later on. This merging operation is asynchronous, the changes will be committed on disk only when the merge succeeds. Before @@ -199,8 +200,8 @@ type chain_store @param history_mode the history mode used throughout the store. If a directory already exists and the given [history_mode] is different, the initialization will fail. - Default: {!History_mode.default} (which should correspond to full - with 5 extra preserved cycles.) + Default: {!History_mode.default} (which should correspond to + full with 5 extra preserved cycles.) @param block_cache_limit allows to override the size of the block cache to use. The minimal value is 1. @@ -289,7 +290,7 @@ module Block : sig type metadata = Block_repr.metadata = { message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_preserved_block_level : Int32.t; block_metadata : Bytes.t; operations_metadata : Block_validation.operation_metadata list list; } @@ -565,7 +566,7 @@ module Block : sig val max_operations_ttl : metadata -> int - val last_allowed_fork_level : metadata -> int32 + val last_preserved_block_level : metadata -> int32 val block_metadata : metadata -> Bytes.t @@ -647,14 +648,14 @@ module Chain : sig - The checkpoint is updated periodically such that the following invariant holds: - [checkpoint.level >= all_head.last_allowed_fork_level] + [checkpoint.level >= all_head.last_preserved_block_level] The checkpoint will tend to designate the highest block among - all chain head's [last_allowed_fork_level] in a normal mode. This - is not always true. i.e. after a snapshot import where the - checkpoint will be set as the imported block and when the - [target] block is reached, the checkpoint will be set at this - point. *) + all chain head's [last_preserved_block_level] in a normal + mode. This is not always true. i.e. after a snapshot import + where the checkpoint will be set as the imported block and when + the [target] block is reached, the checkpoint will be set at + this point. *) val checkpoint : chain_store -> block_descriptor Lwt.t (** [target chain_store] returns the target block associated to the @@ -685,7 +686,8 @@ module Chain : sig For Full and Rolling history modes, the savepoint will be periodically updated at each store merge which happens when: - [pred(head).last_allowed_fork_level < head.last_allowed_fork_level] + [pred(head).last_preserved_block_level < + head.last_preserved_block_level] On Archive history mode: [savepoint = genesis]. *) val savepoint : chain_store -> block_descriptor Lwt.t @@ -751,19 +753,18 @@ module Chain : sig After a merge: - - The checkpoint is updated to [lafl(new_head)] if it was below + - The checkpoint is updated to [lpbl(new_head)] if it was below this level or unchanged otherwise; - The savepoint will be updated to : - min(max_op_ttl(lafl(new_head)), lafl(new_head) - - * ) or will remain 0 in - Archive mode; + min(max_op_ttl(lpbl(new_head)), lpbl(new_head) - + * ) or will remain 0 in Archive mode; - The caboose will be updated to the same value as the savepoint in Rolling mode. - Note: lafl(new_head) is the last allowed fork level of the new - head. + Note: lpbl(new_head) is the last preserved block level of the + new head. {b Warnings:} diff --git a/src/lib_store/unix/block_repr_unix.ml b/src/lib_store/unix/block_repr_unix.ml index 01386463709b6c7bd64e747a0be230217f8f074c..396d9b24aab7c092d941788ee14c0830ca91349c 100644 --- a/src/lib_store/unix/block_repr_unix.ml +++ b/src/lib_store/unix/block_repr_unix.ml @@ -54,7 +54,7 @@ let decode_block_repr encoding block_bytes = ({ message = legacy_message; max_operations_ttl = legacy_max_operations_ttl; - last_allowed_fork_level = legacy_last_allowed_fork_level; + last_preserved_block_level = legacy_last_allowed_fork_level; block_metadata = legacy_block_metadata; operations_metadata; } @@ -153,7 +153,7 @@ let raw_get_block_predecessor block_bytes = Block_hash.of_bytes_exn (Bytes.sub block_bytes predecessor_offset Block_hash.size) -let raw_get_last_allowed_fork_level block_bytes total_block_length = +let raw_get_last_preserved_block_level block_bytes total_block_length = let header_length = Bytes.get_int32_be block_bytes header_length_offset in let operations_length_offset = header_length_offset + 4 + Int32.to_int header_length @@ -182,7 +182,7 @@ let raw_get_last_allowed_fork_level block_bytes total_block_length = in if metadata_offset = total_block_length then (* Pruned *) None else - let lafl_offset = + let lpbl_offset = (* max op ttl *) 2 + @@ -194,7 +194,7 @@ let raw_get_last_allowed_fork_level block_bytes total_block_length = metadata_offset + 1 + 4 + Int32.to_int message_length else metadata_offset + 1 in - Some (Bytes.get_int32_be block_bytes lafl_offset) + Some (Bytes.get_int32_be block_bytes lpbl_offset) let fitness_length_offset = predecessor_offset + Block_hash.size + 8 (* timestamp *) + 1 diff --git a/src/lib_store/unix/block_repr_unix.mli b/src/lib_store/unix/block_repr_unix.mli index b1d44ffbde1d3297a8f7aff6373663c917d79fd7..9eaa5832fbb2173f2b405813a96dd7bd7ff49a58 100644 --- a/src/lib_store/unix/block_repr_unix.mli +++ b/src/lib_store/unix/block_repr_unix.mli @@ -73,11 +73,11 @@ val raw_get_block_level : bytes -> int32 predecessor's hash of the block contained in [block_buffer]. *) val raw_get_block_predecessor : bytes -> Block_hash.t -(** [raw_get_last_allowed_fork_level block_buffer] introspects the - last allowed fork level of the block's metadata contained in +(** [raw_get_last_preserved_block_level block_buffer] introspects the + last preserved block level of the block's metadata contained in [block_buffer] if there is any. Returns [None] if no metadata is present. *) -val raw_get_last_allowed_fork_level : bytes -> int -> int32 option +val raw_get_last_preserved_block_level : bytes -> int -> int32 option (** [raw_get_context block_buffer] introspects the context of the block contained in diff --git a/src/lib_store/unix/block_store.ml b/src/lib_store/unix/block_store.ml index 62dc8a1b396442920113e0580002176ad7e1e4bd..3bdb0c30d0a3cfd6636402c9c663065e2331ae9c 100644 --- a/src/lib_store/unix/block_store.ml +++ b/src/lib_store/unix/block_store.ml @@ -557,10 +557,10 @@ let available_savepoint block_store current_head savepoint_candidate = in return (descriptor block) -(* [preserved_block block_store current_head] returns the - preserved block candidate level. The preserved block aims to be the - one needed and maintained available to export snapshot. That is to - say, the block: lafl(head) - max_op_ttl(lafl). *) +(* [preserved_block block_store current_head] returns the preserved + block candidate level. The preserved block aims to be the one + needed and maintained available to export snapshot. That is to say, + the block: lpbl(head) - max_op_ttl(lpbl). *) let preserved_block block_store current_head = let open Lwt_result_syntax in let head_hash = Block_repr.hash current_head in @@ -570,11 +570,11 @@ let preserved_block block_store current_head = let current_head_metadata = WithExceptions.Option.get ~loc:__LOC__ current_head_metadata_o in - let head_lafl = Block_repr.last_allowed_fork_level current_head_metadata in + let head_lpbl = Block_repr.last_preserved_block_level current_head_metadata in let head_max_op_ttl = Int32.of_int (Block_repr.max_operations_ttl current_head_metadata) in - return Int32.(max 0l (sub head_lafl head_max_op_ttl)) + return Int32.(max 0l (sub head_lpbl head_max_op_ttl)) (* [infer_savepoint block_store current_head ~target_offset] returns the savepoint candidate for an history mode switch. *) @@ -879,28 +879,28 @@ let compute_new_caboose block_store history_mode ~new_savepoint return (Block_repr.descriptor min_block_to_preserve) else return new_savepoint -module BlocksLAFL = Set.Make (Int32) +module BlocksLPBL = Set.Make (Int32) (* FIXME: update doc *) (* [update_floating_stores block_store ~history_mode ~ro_store - ~rw_store ~new_store ~new_head ~new_head_lafl + ~rw_store ~new_store ~new_head ~new_head_lpbl ~lowest_bound_to_preserve_in_floating ~cementing_highwatermark] updates the [new_store] by storing the predecessors of the - [new_head_lafl] and preserving the + [new_head_lpbl] and preserving the [lowest_bound_to_preserve_in_floating]. It returns the cycles to cement from [new_head] to [cementing_highwatermark] and the savepoint and caboose candidates. *) let update_floating_stores block_store ~history_mode ~ro_store ~rw_store - ~new_store ~new_head ~new_head_lafl ~lowest_bound_to_preserve_in_floating + ~new_store ~new_head ~new_head_lpbl ~lowest_bound_to_preserve_in_floating ~cementing_highwatermark = let open Lwt_result_syntax in let*! () = Store_events.(emit start_updating_floating_stores) () in - let* lafl_block = - read_predecessor_block_by_level block_store ~head:new_head new_head_lafl + let* lpbl_block = + read_predecessor_block_by_level block_store ~head:new_head new_head_lpbl in - let final_hash, final_level = Block_repr.descriptor lafl_block in + let final_hash, final_level = Block_repr.descriptor lpbl_block in (* 1. Append to the new RO [new_store] blocks between - [lowest_bound_to_preserve_in_floating] and [lafl_block]. *) + [lowest_bound_to_preserve_in_floating] and [lpbl_block]. *) let max_nb_blocks_to_retrieve = Compare.Int.( max @@ -914,7 +914,7 @@ let update_floating_stores block_store ~history_mode ~ro_store ~rw_store (* Iterate over the store with RO first for the lookup. *) [ro_store; rw_store] in - let*! lafl_predecessors = + let*! lpbl_predecessors = try_retrieve_n_predecessors floating_stores final_hash @@ -923,8 +923,8 @@ let update_floating_stores block_store ~history_mode ~ro_store ~rw_store (* [min_level_to_preserve] is the lowest block that we want to keep in the floating stores. *) let*! min_level_to_preserve = - match lafl_predecessors with - | [] -> Lwt.return new_head_lafl + match lpbl_predecessors with + | [] -> Lwt.return new_head_lpbl | oldest_predecessor :: _ -> ( let*! o = List.find_map_s @@ -933,29 +933,29 @@ let update_floating_stores block_store ~history_mode ~ro_store ~rw_store floating_stores in match o with - | None -> Lwt.return new_head_lafl + | None -> Lwt.return new_head_lpbl | Some x -> Lwt.return (Block_repr.level x)) in - (* As blocks from [lafl_predecessors] contains older blocks first, + (* As blocks from [lpbl_predecessors] contains older blocks first, the resulting [new_store] will be correct and will contain older blocks before more recent ones. *) let* () = Floating_block_store.raw_copy_all ~src_floating_stores:floating_stores - ~block_hashes:lafl_predecessors + ~block_hashes:lpbl_predecessors ~dst_floating_store:new_store in (* 2. Retrieve ALL cycles (potentially more than one) *) (* 2.1. We write back to the new store all the blocks from - [lafl_block] to the end of the file(s). + [lpbl_block] to the end of the file(s). 2.2 At the same time, retrieve the list of cycle bounds: i.e. the interval of blocks s.t. \forall b \in - {stores}. cementing_highwatermark < b.lafl <= new_head_lafl + {stores}. cementing_highwatermark < b.lpbl <= new_head_lpbl - HYPOTHESIS: all blocks at a given level have the same lafl. *) - let visited = ref (Block_hash.Set.singleton (Block_repr.hash lafl_block)) in - let blocks_lafl = ref BlocksLAFL.empty in + HYPOTHESIS: all blocks at a given level have the same lpbl. *) + let visited = ref (Block_hash.Set.singleton (Block_repr.hash lpbl_block)) in + let blocks_lpbl = ref BlocksLPBL.empty in let*! () = Store_events.(emit start_retreiving_cycles) () in let* () = List.iter_es @@ -967,20 +967,20 @@ let update_floating_stores block_store ~history_mode ~ro_store ~rw_store if Compare.Int32.(block_level <= cementing_highwatermark) then return_unit else - let block_lafl_opt = - Block_repr_unix.raw_get_last_allowed_fork_level + let block_lpbl_opt = + Block_repr_unix.raw_get_last_preserved_block_level block_bytes total_block_length in (* Start by updating the set of cycles *) Option.iter - (fun block_lafl -> + (fun block_lpbl -> if Compare.Int32.( - cementing_highwatermark < block_lafl - && block_lafl <= new_head_lafl) - then blocks_lafl := BlocksLAFL.add block_lafl !blocks_lafl) - block_lafl_opt ; + cementing_highwatermark < block_lpbl + && block_lpbl <= new_head_lpbl) + then blocks_lpbl := BlocksLPBL.add block_lpbl !blocks_lpbl) + block_lpbl_opt ; (* Append block if its predecessor was visited and update the visited set. *) let block_predecessor = @@ -1014,24 +1014,24 @@ let update_floating_stores block_store ~history_mode ~ro_store ~rw_store let rec loop acc pred = function | [] -> tzfail (Cannot_cement_blocks `Empty) | [h] -> - assert (Compare.Int32.(h = new_head_lafl)) ; + assert (Compare.Int32.(h = new_head_lpbl)) ; return (List.rev ((Int32.succ pred, h) :: acc)) | h :: (h' :: _ as t) -> - (* lafls are monotonous and strictly increasing *) + (* lpbls are monotonous and strictly increasing *) assert (Compare.Int32.(h < h')) ; loop ((Int32.succ pred, h) :: acc) h t in let initial_pred = (* Hack to include genesis in the first cycle when the initial - cementing highwatermark is genesis's lafl *) + cementing highwatermark is genesis's lpbl *) if is_cementing_highwatermark_genesis then Int32.pred cementing_highwatermark else cementing_highwatermark in - let sorted_lafl = - List.sort Compare.Int32.compare (BlocksLAFL.elements !blocks_lafl) + let sorted_lpbl = + List.sort Compare.Int32.compare (BlocksLPBL.elements !blocks_lpbl) in - let* cycles_to_cement = loop [] initial_pred sorted_lafl in + let* cycles_to_cement = loop [] initial_pred sorted_lpbl in let* new_savepoint = compute_new_savepoint block_store @@ -1138,29 +1138,30 @@ let check_store_consistency block_store ~cementing_highwatermark = {highest_cemented_level; cementing_highwatermark})) (* We want to keep in the floating store, at least, the blocks above - (new_head.lafl - (new_head.lafl).max_op_ttl)). Important: we might + (new_head.lpbl - (new_head.lpbl).max_op_ttl)). Important: we might not have this block so it should be treated as a potential lower bound. Furethermore, we consider the current caboose as a potential - lower bound.*) + lower bound. *) let compute_lowest_bound_to_preserve_in_floating block_store ~new_head ~new_head_metadata = let open Lwt_result_syntax in - (* Safety check: is the highwatermark consistent with our highest cemented block *) - let lafl = Block_repr.last_allowed_fork_level new_head_metadata in - let* lafl_block = + (* Safety check: is the highwatermark consistent with our highest + cemented block *) + let lpbl = Block_repr.last_preserved_block_level new_head_metadata in + let* lpbl_block = trace - Missing_last_allowed_fork_level_block + Missing_last_preserved_block (read_predecessor_block_by_level block_store ~read_metadata:true ~head:new_head - lafl) + lpbl) in return (Int32.sub - lafl + lpbl (Int32.of_int - (match Block_repr.metadata lafl_block with + (match Block_repr.metadata lpbl_block with | None -> (* FIXME: this is not valid but it is a good approximation of the max_op_ttl of a block where the @@ -1202,7 +1203,7 @@ let instanciate_temporary_floating_store block_store = return (ro_store, rw_store, new_rw_store))) let create_merging_thread block_store ~history_mode ~old_ro_store ~old_rw_store - ~new_head ~new_head_lafl ~lowest_bound_to_preserve_in_floating + ~new_head ~new_head_lpbl ~lowest_bound_to_preserve_in_floating ~cementing_highwatermark = let open Lwt_result_syntax in let*! () = Store_events.(emit start_merging_thread) () in @@ -1220,7 +1221,7 @@ let create_merging_thread block_store ~history_mode ~old_ro_store ~old_rw_store ~rw_store:old_rw_store ~new_store:new_ro_store ~new_head - ~new_head_lafl + ~new_head_lpbl ~lowest_bound_to_preserve_in_floating ~cementing_highwatermark in @@ -1336,12 +1337,12 @@ let may_trigger_gc block_store history_mode ~previous_savepoint ~new_savepoint = let*! () = Store_events.(emit start_context_gc new_savepoint) in gc savepoint_hash -let split_context block_store new_head_lafl = +let split_context block_store new_head_lpbl = let open Lwt_result_syntax in match block_store.split_callback with | None -> return_unit | Some split -> - let*! () = Store_events.(emit start_context_split new_head_lafl) in + let*! () = Store_events.(emit start_context_split new_head_lpbl) in split () let merge_stores block_store ~(on_error : tztrace -> unit tzresult Lwt.t) @@ -1365,10 +1366,10 @@ let merge_stores block_store ~(on_error : tztrace -> unit tzresult Lwt.t) in (* Mark the store's status as Merging *) let* () = write_status block_store Merging in - let new_head_lafl = - Block_repr.last_allowed_fork_level new_head_metadata + let new_head_lpbl = + Block_repr.last_preserved_block_level new_head_metadata in - let*! () = Store_events.(emit start_merging_stores) new_head_lafl in + let*! () = Store_events.(emit start_merging_stores) new_head_lpbl in let* () = check_store_consistency block_store ~cementing_highwatermark in let*! previous_savepoint = Stored_data.get block_store.savepoint in let* lowest_bound_to_preserve_in_floating = @@ -1399,7 +1400,7 @@ let merge_stores block_store ~(on_error : tztrace -> unit tzresult Lwt.t) let msg = Format.asprintf "%a" pp_print_trace err in let*! () = Store_events.(emit merge_error) - (cementing_highwatermark, new_head_lafl, msg) + (cementing_highwatermark, new_head_lpbl, msg) in on_error (Merge_error :: err)) (fun () -> @@ -1410,7 +1411,7 @@ let merge_stores block_store ~(on_error : tztrace -> unit tzresult Lwt.t) ~old_ro_store ~old_rw_store ~new_head - ~new_head_lafl + ~new_head_lpbl ~lowest_bound_to_preserve_in_floating ~cementing_highwatermark in @@ -1433,7 +1434,7 @@ let merge_stores block_store ~(on_error : tztrace -> unit tzresult Lwt.t) (* Don't call the finalizer in the critical section, in case it needs to access the block store. *) - let* () = finalizer new_head_lafl in + let* () = finalizer new_head_lpbl in (* We can now trigger the context GC: if the GC is performed, this call will block until its end. *) @@ -1460,7 +1461,7 @@ let merge_stores block_store ~(on_error : tztrace -> unit tzresult Lwt.t) (Ptime.Span.to_float_s merging_time) ; return_unit in - block_store.merging_thread <- Some (new_head_lafl, merging_thread) ; + block_store.merging_thread <- Some (new_head_lpbl, merging_thread) ; (* Temporary stores in place and the merging thread was started: we can now release the hard-lock. *) return_unit) diff --git a/src/lib_store/unix/block_store.mli b/src/lib_store/unix/block_store.mli index 04116518980ddd29aeec917fe278bc7b569a6ca8..602d7f27a012c07d3aee3898804a171bc85df2e4 100644 --- a/src/lib_store/unix/block_store.mli +++ b/src/lib_store/unix/block_store.mli @@ -359,7 +359,7 @@ val register_gc_callback : val register_split_callback : block_store -> (unit -> unit tzresult Lwt.t) option -> unit -(** [split_context block_store new_head_lafl] calls the callback +(** [split_context block_store new_head_lpbl] calls the callback registered by [register_split_callback] if any. *) val split_context : t -> Int32.t -> unit tzresult Lwt.t diff --git a/src/lib_store/unix/consistency.ml b/src/lib_store/unix/consistency.ml index b7468267d4ce6ceda40d162fb7bf7f28df6e751d..b15dc3091dbef860a7aaead6cdd19e0c90e0778e 100644 --- a/src/lib_store/unix/consistency.ml +++ b/src/lib_store/unix/consistency.ml @@ -450,9 +450,9 @@ let lowest_head_predecessor_in_floating block_store ~head = let highest_cemented_block = Cemented_block_store.get_highest_cemented_level cemented_block_store in - let* head_lafl = + let* head_lpbl = match Block_repr.metadata head with - | Some m -> return m.last_allowed_fork_level + | Some m -> return m.last_preserved_block_level | None -> (*Assumption: head must have metadata *) tzfail @@ -461,8 +461,8 @@ let lowest_head_predecessor_in_floating block_store ~head = in let start = match highest_cemented_block with - | Some hcb -> max Int32.(succ hcb) head_lafl - | None -> head_lafl + | Some hcb -> max Int32.(succ hcb) head_lpbl + | None -> head_lpbl in let head_descr = Block_repr.descriptor head in let head_level = Block_repr.level head in @@ -663,9 +663,10 @@ let fix_savepoint_and_caboose ?history_mode chain_dir block_store head genesis = in return (savepoint, caboose) -(* [fix_checkpoint chain_dir block_store ~head ~savepoint] fixes the checkpoint by - setting it to the last allowed fork level of the current head. If - the metadata of this block is not available, the savepoint is used. +(* [fix_checkpoint chain_dir block_store ~head ~savepoint] fixes the + checkpoint by setting it to the last preserved block level of the + current head. If the metadata of this block is not available, the + savepoint is used. Assumptions: - head is valid, - savepoint is valid, @@ -683,13 +684,13 @@ let fix_checkpoint chain_dir block_store ~head ~savepoint = match head_metadata with | None -> return savepoint | Some head_metadata -> ( - let lafl = Block_repr.last_allowed_fork_level head_metadata in + let lpbl = Block_repr.last_preserved_block_level head_metadata in let* block = read_block_at_level ~read_metadata:false block_store ~head:(Block_repr.descriptor head) - lafl + lpbl in match block with | None -> return savepoint diff --git a/src/lib_store/unix/reconstruction.ml b/src/lib_store/unix/reconstruction.ml index 44c3593440920499b5bc0599342379cfa5c7afd7..065ffe59e7f02ec3086cf0d6b99ee8df313a668e 100644 --- a/src/lib_store/unix/reconstruction.ml +++ b/src/lib_store/unix/reconstruction.ml @@ -223,7 +223,7 @@ let apply_context context_index chain_id ~user_activated_upgrades ( validation_store.resulting_context_hash, validation_store.message, validation_store.max_operations_ttl, - validation_store.last_allowed_fork_level, + validation_store.last_preserved_block_level, fst block_metadata, ops_metadata ) @@ -244,7 +244,7 @@ let protocol_of_protocol_level chain_store protocol_level block_hash = (* Restores the block and operations metadata hash of a given block, if needed. *) let restore_block_contents chain_store block_protocol_env ~block_metadata - ~operations_metadata message max_operations_ttl last_allowed_fork_level + ~operations_metadata message max_operations_ttl last_preserved_block_level block = let operations_metadata, operations_metadata_hashes = split_operations_metadata operations_metadata @@ -265,7 +265,7 @@ let restore_block_contents chain_store block_protocol_env ~block_metadata { Block_repr.message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata; operations_metadata; } @@ -278,7 +278,7 @@ let reconstruct_genesis_operations_metadata chain_store = let* { message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata; operations_metadata; } = @@ -304,7 +304,7 @@ let reconstruct_genesis_operations_metadata chain_store = ( resulting_context_hash, message, max_operations_ttl, - last_allowed_fork_level, + last_preserved_block_level, block_metadata, operations_metadata ) @@ -333,7 +333,7 @@ let reconstruct_chunk chain_store context_index ~user_activated_upgrades let* ( _resulting_context_hash, message, max_operations_ttl, - last_allowed_fork_level, + last_preserved_block_level, block_metadata, operations_metadata ) = if Store.Block.is_genesis chain_store (Store.Block.hash block) then @@ -390,7 +390,7 @@ let reconstruct_chunk chain_store context_index ~user_activated_upgrades ~operations_metadata message max_operations_ttl - last_allowed_fork_level + last_preserved_block_level (Store.Unsafe.repr_of_block block) in loop (Int32.succ level) ((reconstructed_block, block_protocol_env) :: acc) @@ -694,7 +694,7 @@ let reconstruct_floating chain_store context_index ~user_activated_upgrades let* ( resulting_context_hash, message, max_operations_ttl, - last_allowed_fork_level, + last_preserved_block_level, block_metadata, operations_metadata ) = if @@ -783,7 +783,7 @@ let reconstruct_floating chain_store context_index ~user_activated_upgrades { message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata; operations_metadata; } -> @@ -818,7 +818,7 @@ let reconstruct_floating chain_store context_index ~user_activated_upgrades ( resulting_context_hash, message, max_operations_ttl, - last_allowed_fork_level, + last_preserved_block_level, block_metadata, operations_metadata ) in @@ -830,7 +830,7 @@ let reconstruct_floating chain_store context_index ~user_activated_upgrades ~operations_metadata message max_operations_ttl - last_allowed_fork_level + last_preserved_block_level block in let* () = @@ -869,22 +869,22 @@ let check_history_mode_compatibility chain_store savepoint genesis_block = (Reconstruction_failure Nothing_to_reconstruct) | _ as history_mode -> tzfail (Cannot_reconstruct history_mode) -let restore_constants chain_store genesis_block head_lafl_block +let restore_constants chain_store genesis_block head_lpbl_block ~cementing_highwatermark = let open Lwt_result_syntax in - (* The checkpoint is updated to the last allowed fork level of the - current head if higher than the cementing + (* The checkpoint is updated to the last preserved block level of + the current head if higher than the cementing highwatermark. Otherwise, the checkpoint is assumed to be the cementing highwatermark (this may occur after a snapshot import). Thus, we ensure that the store invariant `cementing_highwatermark <= checkpoint` is maintained. *) - let head_lafl_descr = Store.Block.descriptor head_lafl_block in + let head_lpbl_descr = Store.Block.descriptor head_lpbl_block in let checkpoint = match cementing_highwatermark with - | None -> head_lafl_descr + | None -> head_lpbl_descr | Some chw -> - if snd chw > Store.Block.level head_lafl_block then chw - else head_lafl_descr + if snd chw > Store.Block.level head_lpbl_block then chw + else head_lpbl_descr in let* () = Store.Unsafe.set_checkpoint chain_store checkpoint in let* () = Store.Unsafe.set_history_mode chain_store History_mode.Archive in @@ -1013,10 +1013,10 @@ let reconstruct ?patch_context ~store_dir ~context_dir genesis let* head_metadata = Store.Block.get_block_metadata chain_store current_head in - let* head_lafl_block = + let* head_lpbl_block = Store.Block.read_block_by_level chain_store - (Store.Block.last_allowed_fork_level head_metadata) + (Store.Block.last_preserved_block_level head_metadata) in let* cementing_highwatermark_data = Stored_data.load @@ -1057,7 +1057,7 @@ let reconstruct ?patch_context ~store_dir ~context_dir genesis restore_constants chain_store genesis_block - head_lafl_block + head_lpbl_block ~cementing_highwatermark) in (* TODO? add a global check *) diff --git a/src/lib_store/unix/snapshots.ml b/src/lib_store/unix/snapshots.ml index eecce3b04991673aa10b39e5912f5c3d5cc1bb9a..77c44f7198278cc1823e20fdb327e4acc76d6cd5 100644 --- a/src/lib_store/unix/snapshots.ml +++ b/src/lib_store/unix/snapshots.ml @@ -2400,10 +2400,10 @@ module Make_snapshot_exporter (Exporter : EXPORTER) : Snapshot_exporter = struct return (pred_block, minimum_level_needed) (* Retrieves the block to export based on given block "as hint". As - the checkpoint is provided as a default value, we must ensure that - it is valid. It may be not the case when the checkpoint was set in - the future. In this particular case, the last allowed fork level of - the current head is chosen. *) + the checkpoint is provided as a default value, we must ensure + that it is valid. It may be not the case when the checkpoint was + set in the future. In this particular case, the last preserved + block level of the current head is chosen. *) let retrieve_export_block chain_store block = let open Lwt_result_syntax in let* export_block = @@ -4389,7 +4389,8 @@ module Make_snapshot_importer (Importer : IMPORTER) : Snapshot_importer = struct ({ message = validation_store.message; max_operations_ttl = validation_store.max_operations_ttl; - last_allowed_fork_level = validation_store.last_allowed_fork_level; + last_preserved_block_level = + validation_store.last_preserved_block_level; block_metadata = fst block_metadata; operations_metadata = (match ops_metadata with diff --git a/src/lib_store/unix/store.ml b/src/lib_store/unix/store.ml index 1d9afa18d36d552bb58515cda8b854ec1de9a3c7..b5a30e2d10d5c5a63c1eb8717aca74fbdc06af3a 100644 --- a/src/lib_store/unix/store.ml +++ b/src/lib_store/unix/store.ml @@ -240,7 +240,7 @@ module Block = struct type metadata = Block_repr.metadata = { message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_preserved_block_level : Int32.t; block_metadata : Bytes.t; operations_metadata : Block_validation.operation_metadata list list; } @@ -451,7 +451,8 @@ module Block = struct timestamp = _; message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; + _; }; block_metadata; ops_metadata; @@ -501,22 +502,22 @@ module Block = struct .chain_id in let genesis_level = Block_repr.level genesis_block in - let* last_allowed_fork_level = + let* last_preserved_block_level = if is_main_chain then let* () = fail_unless - Compare.Int32.(last_allowed_fork_level >= genesis_level) + Compare.Int32.(last_preserved_block_level >= genesis_level) (Cannot_store_block ( hash, - Invalid_last_allowed_fork_level - {last_allowed_fork_level; genesis_level} )) + Invalid_last_preserved_block_level + {last_preserved_block_level; genesis_level} )) in - return last_allowed_fork_level - else if Compare.Int32.(last_allowed_fork_level < genesis_level) then - (* Hack: on the testchain, the block's lafl depends on the - lafl and is not max(genesis_level, expected_lafl) *) + return last_preserved_block_level + else if Compare.Int32.(last_preserved_block_level < genesis_level) then + (* Hack: on the testchain, the block's lpbl depends on the + lpbl and is not max(genesis_level, expected_lpbl) *) return genesis_level - else return last_allowed_fork_level + else return last_preserved_block_level in let*! b = is_known_valid chain_store hash in match b with @@ -561,7 +562,7 @@ module Block = struct { message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata = fst block_metadata; operations_metadata = (match ops_metadata with @@ -837,8 +838,8 @@ module Block = struct let max_operations_ttl metadata = Block_repr.max_operations_ttl metadata - let last_allowed_fork_level metadata = - Block_repr.last_allowed_fork_level metadata + let last_preserved_block_level metadata = + Block_repr.last_preserved_block_level metadata let block_metadata metadata = Block_repr.block_metadata metadata @@ -1298,11 +1299,11 @@ module Chain = struct chain_state.cementing_highwatermark_data (Some new_highest_cemented_level)) - let may_update_checkpoint_and_target chain_store ~new_head ~new_head_lafl + let may_update_checkpoint_and_target chain_store ~new_head ~new_head_lfbl ~checkpoint ~target = let open Lwt_result_syntax in let new_checkpoint = - if Compare.Int32.(snd new_head_lafl > snd checkpoint) then new_head_lafl + if Compare.Int32.(snd new_head_lfbl > snd checkpoint) then new_head_lfbl else checkpoint in match target with @@ -1319,7 +1320,7 @@ module Chain = struct tzfail Target_mismatch else return (new_checkpoint, Some target) - let locked_determine_cementing_highwatermark chain_store chain_state head_lafl + let locked_determine_cementing_highwatermark chain_store chain_state head_lpbl = let open Lwt_syntax in let* cementing_highwatermark = @@ -1338,10 +1339,10 @@ module Chain = struct (* If we have cemented blocks, take the highest cemented level *) Lwt.return_some hcb | None -> - (* If we don't, check that the head lafl is > caboose *) + (* If we don't, check that the head lpbl is > caboose *) let* _, caboose_level = Block_store.caboose block_store in - if Compare.Int32.(head_lafl >= caboose_level) then - Lwt.return_some head_lafl + if Compare.Int32.(head_lpbl >= caboose_level) then + Lwt.return_some head_lpbl else Lwt.return_none) let locked_may_update_cementing_highwatermark chain_state @@ -1372,13 +1373,13 @@ module Chain = struct cycle, i.e, a future savepoint. Thus, that commit will end a chunk and will be an optimal candidate for a GC call. - The call of split is triggered when the last allowed fork level - of the new head changes. This is not ensuring that the created - chunk will be ended by a commit that will be the target of a - future gc call as reorganization may occur above the last allowed - fork level. Most of the time, and as reorganization are often - short, this will lead to the optimal behaviour. *) - let may_split_context chain_store new_head_lafl previous_head = + The call of split is triggered when the last preserved block + level of the new head changes. This is not ensuring that the + created chunk will be ended by a commit that will be the target + of a future gc call as reorganization may occur above the last + preserved block level. Most of the time, and as reorganization + are often short, this will lead to the optimal behaviour. *) + let may_split_context chain_store new_head_lpbl previous_head = let open Lwt_result_syntax in match history_mode chain_store with | Archive -> return_unit @@ -1389,11 +1390,11 @@ module Chain = struct if not (Int32.equal - new_head_lafl - (Block.last_allowed_fork_level previous_head_metadata)) + new_head_lpbl + (Block.last_preserved_block_level previous_head_metadata)) then let block_store = chain_store.block_store in - Block_store.split_context block_store new_head_lafl + Block_store.split_context block_store new_head_lpbl else return_unit let set_head chain_store new_head = @@ -1443,13 +1444,15 @@ module Chain = struct Block.get_block_metadata chain_store new_head) in let*! target = Stored_data.get chain_state.target_data in - let new_head_lafl = Block.last_allowed_fork_level new_head_metadata in - let* () = may_split_context chain_store new_head_lafl previous_head in + let new_head_lpbl = + Block.last_preserved_block_level new_head_metadata + in + let* () = may_split_context chain_store new_head_lpbl previous_head in let*! cementing_highwatermark = locked_determine_cementing_highwatermark chain_store chain_state - new_head_lafl + new_head_lpbl in (* This write call will initialize the cementing highwatermark when it is not yet set or do nothing @@ -1459,24 +1462,24 @@ module Chain = struct chain_state cementing_highwatermark in - let*! lafl_block_opt = + let*! lfbl_block_opt = Block.locked_read_block_by_level_opt chain_store new_head - new_head_lafl + new_head_lpbl in let* new_checkpoint, new_target = - match lafl_block_opt with + match lfbl_block_opt with | None -> (* This case may occur when importing a rolling snapshot where the lafl block is not known. We may use the checkpoint instead. *) return (checkpoint, target) - | Some lafl_block -> + | Some lfbl_block -> may_update_checkpoint_and_target chain_store ~new_head:new_head_descr - ~new_head_lafl:(Block.descriptor lafl_block) + ~new_head_lfbl:(Block.descriptor lfbl_block) ~checkpoint ~target in @@ -1493,7 +1496,7 @@ module Chain = struct set. *) false | Some cementing_highwatermark -> - Compare.Int32.(new_head_lafl > cementing_highwatermark) + Compare.Int32.(new_head_lpbl > cementing_highwatermark) in let* new_cementing_highwatermark = if should_merge then @@ -1535,9 +1538,9 @@ module Chain = struct ~loc:__LOC__ cementing_highwatermark) in - (* The new memory highwatermark is new_head_lafl, the disk + (* The new memory highwatermark is new_head_lpbl, the disk value will be updated after the merge completion. *) - return_some new_head_lafl + return_some new_head_lpbl else return cementing_highwatermark in let*! new_checkpoint = @@ -1689,7 +1692,7 @@ module Chain = struct { Block_repr.message = Some "Genesis"; max_operations_ttl = 0; - last_allowed_fork_level = genesis_header.shell.level; + last_preserved_block_level = genesis_header.shell.level; block_metadata = Bytes.create 0; operations_metadata = []; } @@ -1705,7 +1708,7 @@ module Chain = struct let cementing_highwatermark = Option.fold ~none:0l - ~some:(fun metadata -> Block.last_allowed_fork_level metadata) + ~some:(fun metadata -> Block.last_preserved_block_level metadata) (Block_repr.metadata genesis_block) in let activation_block = genesis_descr in @@ -2864,10 +2867,10 @@ let rec make_pp_chain_store (chain_store : chain_store) = in Format.fprintf fmt - "%a (lafl: %ld) (max_op_ttl: %d)" + "%a (lpbl: %ld) (max_op_ttl: %d)" pp_block_descriptor (Block.descriptor block) - (Block.last_allowed_fork_level metadata) + (Block.last_preserved_block_level metadata) (Block.max_operations_ttl metadata)) current_head pp_block_descriptor diff --git a/src/lib_store/unix/store.mli b/src/lib_store/unix/store.mli index 96827bbf0e87b5ba87435a3a3fa1b95df2cf46b4..d8ee80d37fcce44b1348a517e94c34c319b8ecf2 100644 --- a/src/lib_store/unix/store.mli +++ b/src/lib_store/unix/store.mli @@ -58,13 +58,14 @@ - Full : maintains every block that is part of the chain but prune the metadata for blocks that are below the following - threshold level: [last_allowed_fork_level] of the current head - - [offset] cycles. + threshold level: [last_preserved_block_level] of the current head + - [offset] cycles. - Rolling : maintains rolling windows which contain recent blocks that are part of the chain, along with their metadata. It prunes everything that is below the following threshold level: - [last_allowed_fork_level] of the current head - [offset] cycles. + [last_preserved_block_level] of the current head - [offset] + cycles. {2 Protocol store} @@ -109,17 +110,17 @@ - A check is made if this head is consistent (i.e. if it's not below the checkpoint); - - If the [last_allowed_fork_level] of the head is different from + - If the [last_preserved_block_level] of the head is different from the previous head's one, then we can establish that a cycle has been completed and we can start cementing this cycle by "triggering a merge". A merge phase consists of establishing the interval of blocks to - cement, which is trivially [last_allowed_fork_level(new_head)] to - [last_allowed_fork_level(prev_head)], but also, for Full and + cement, which is trivially [last_preserved_block_level(new_head)] + to [last_preserved_block_level(prev_head)], but also, for Full and Rolling history modes, keep some extra blocks so that we make sure to keep blocks above - max_operation_ttl(last_allowed_fork_level(checkpoint)). This is + max_operation_ttl(last_preserved_block_level(checkpoint)). This is done to make sure that we can export snapshots at the checkpoint level later on. This merging operation is asynchronous, the changes will be committed on disk only when the merge succeeds. Before @@ -198,8 +199,8 @@ type chain_store @param history_mode the history mode used throughout the store. If a directory already exists and the given [history_mode] is different, the initialization will fail. - Default: {!History_mode.default} (which should correspond to full - with 5 extra preserved cycles.) + Default: {!History_mode.default} (which should correspond to + full with 5 extra preserved cycles.) @param block_cache_limit allows to override the size of the block cache to use. The minimal value is 1. @@ -288,7 +289,7 @@ module Block : sig type metadata = Block_repr.metadata = { message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_preserved_block_level : Int32.t; block_metadata : Bytes.t; operations_metadata : Block_validation.operation_metadata list list; } @@ -561,7 +562,7 @@ module Block : sig val max_operations_ttl : metadata -> int - val last_allowed_fork_level : metadata -> int32 + val last_preserved_block_level : metadata -> int32 val block_metadata : metadata -> Bytes.t @@ -642,15 +643,15 @@ module Chain : sig checkpoint's level. - The checkpoint is updated periodically such that the following - invariant holds: - [checkpoint.level >= all_head.last_allowed_fork_level] + invariant holds: [checkpoint.level >= + all_head.last_preserved_block_level] The checkpoint will tend to designate the highest block among - all chain head's [last_allowed_fork_level] in a normal mode. This - is not always true. i.e. after a snapshot import where the - checkpoint will be set as the imported block and when the - [target] block is reached, the checkpoint will be set at this - point. *) + all chain head's [last_preserved_block_level] in a normal + mode. This is not always true. i.e. after a snapshot import + where the checkpoint will be set as the imported block and when + the [target] block is reached, the checkpoint will be set at + this point. *) val checkpoint : chain_store -> block_descriptor Lwt.t (** [target chain_store] returns the target block associated to the @@ -681,7 +682,8 @@ module Chain : sig For Full and Rolling history modes, the savepoint will be periodically updated at each store merge which happens when: - [pred(head).last_allowed_fork_level < head.last_allowed_fork_level] + [pred(head).last_preserved_block_level < + head.last_preserved_block_level] On Archive history mode: [savepoint = genesis]. *) val savepoint : chain_store -> block_descriptor Lwt.t @@ -747,19 +749,19 @@ module Chain : sig After a merge: - - The checkpoint is updated to [lafl(new_head)] if it was below + - The checkpoint is updated to [lpbl(new_head)] if it was below this level or unchanged otherwise; - The savepoint will be updated to : - min(max_op_ttl(lafl(new_head)), lafl(new_head) - + min(max_op_ttl(lpbl(new_head)), lpbl(new_head) - * ) or will remain 0 in Archive mode; - The caboose will be updated to the same value as the savepoint in Rolling mode. - Note: lafl(new_head) is the last allowed fork level of the new - head. + Note: lpbl(new_head) is the last preserved block level of the + new head. {b Warnings:} diff --git a/src/lib_store/unix/test/alpha_utils.ml b/src/lib_store/unix/test/alpha_utils.ml index 652de86d818d1771a1ad3a66b75e4d76434e0236..02c7e79811ceebc39f26a0f67aaedc79ef6a49a5 100644 --- a/src/lib_store/unix/test/alpha_utils.ml +++ b/src/lib_store/unix/test/alpha_utils.ml @@ -688,7 +688,8 @@ let apply_and_store chain_store ?(synchronous_merge = true) ?policy timestamp = block_header.shell.timestamp; message = validation.Tezos_protocol_environment.message; max_operations_ttl = validation.max_operations_ttl; - last_allowed_fork_level = validation.last_allowed_fork_level; + last_finalized_block_level = validation.last_finalized_block_level; + last_preserved_block_level = validation.last_preserved_block_level; }; block_metadata = (block_header_metadata, block_metadata_hash); ops_metadata; diff --git a/src/lib_store/unix/test/test_block_store.ml b/src/lib_store/unix/test/test_block_store.ml index 7b8452ea10e5f9405072e8b3c9673131632ff83c..6881a4aa752177c5eeeb8921103f7bbfdf28d4de 100644 --- a/src/lib_store/unix/test/test_block_store.ml +++ b/src/lib_store/unix/test/test_block_store.ml @@ -142,7 +142,7 @@ let assert_cemented_bound block_store (lowest, highest) = "is 0 the lowest cemented level?" Compare.Int32.(lowest_cemented_level = lowest) ; Assert.assert_true - "is head's lafl the lowest cemented level?" + "is head's lpbl the lowest cemented level?" Compare.Int32.(highest_cemented_level = highest) let test_storing_and_access_predecessors block_store = @@ -187,18 +187,18 @@ let test_storing_and_access_predecessors block_store = in return_unit -let make_raw_block_list_with_lafl pred size ~lafl = +let make_raw_block_list_with_lpbl pred size ~lpbl = let open Lwt_syntax in let* chunk, head = make_raw_block_list ~kind:`Full pred size in - let change_lafl block = + let change_lpbl block = let metadata = WithExceptions.Option.to_exn ~none:Not_found block.Block_repr.metadata in block.Block_repr.metadata <- - Some {metadata with last_allowed_fork_level = lafl} ; + Some {metadata with last_preserved_block_level = lpbl} ; block in - Lwt.return (List.map change_lafl chunk, change_lafl head) + Lwt.return (List.map change_lpbl chunk, change_lpbl head) let make_n_consecutive_cycles pred ~cycle_length ~nb_cycles = let open Lwt_syntax in @@ -216,9 +216,9 @@ let make_n_consecutive_cycles pred ~cycle_length ~nb_cycles = if Block_hash.equal (fst pred) genesis_hash then cycle_length - 1 else cycle_length in - let lafl = max 0l (snd pred) in + let lpbl = max 0l (snd pred) in let* chunk, head = - make_raw_block_list_with_lafl pred cycle_length ~lafl + make_raw_block_list_with_lpbl pred cycle_length ~lpbl in loop (chunk :: acc) (Block_repr.descriptor head) (n - 1) in @@ -263,7 +263,7 @@ let test_simple_merge block_store = let*! () = Block_store.await_merging block_store in assert_cemented_bound block_store - (0l, Block_repr.last_allowed_fork_level head_metadata) ; + (0l, Block_repr.last_preserved_block_level head_metadata) ; return_unit let test_consecutive_concurrent_merges block_store = @@ -283,22 +283,22 @@ let test_consecutive_concurrent_merges block_store = in let cycles_to_merge = List.fold_left - (fun (acc, pred_cycle_lafl) cycle -> + (fun (acc, pred_cycle_lpbl) cycle -> let block_in_cycle = List.hd cycle |> WithExceptions.Option.get ~loc:__LOC__ in - let block_lafl = + let block_lpbl = Block_repr.metadata block_in_cycle |> WithExceptions.Option.get ~loc:__LOC__ - |> Block_repr.last_allowed_fork_level + |> Block_repr.last_preserved_block_level in - ((cycle, pred_cycle_lafl) :: acc, block_lafl)) + ((cycle, pred_cycle_lpbl) :: acc, block_lpbl)) ([], 0l) cycles |> fst |> List.rev |> List.tl |> WithExceptions.Option.get ~loc:__LOC__ in - let merge_cycle (cycle, previous_cycle_lafl) = + let merge_cycle (cycle, previous_cycle_lpbl) = let new_head = List.last_opt cycle |> WithExceptions.Option.get ~loc:__LOC__ in @@ -313,7 +313,7 @@ let test_consecutive_concurrent_merges block_store = ~history_mode:Archive ~new_head ~new_head_metadata - ~cementing_highwatermark:previous_cycle_lafl + ~cementing_highwatermark:previous_cycle_lpbl in let threads = List.map merge_cycle cycles_to_merge in let*! res = Lwt.all threads in @@ -328,7 +328,7 @@ let test_consecutive_concurrent_merges block_store = in assert_cemented_bound block_store - (0l, Block_repr.last_allowed_fork_level head_metadata) ; + (0l, Block_repr.last_preserved_block_level head_metadata) ; return_unit let test_ten_cycles_merge block_store = @@ -370,8 +370,8 @@ let test_ten_cycles_merge block_store = let test_merge_with_branches block_store = let open Lwt_result_syntax in (* make an initial chain of 2 cycles of 100 blocks with each - block's lafl pointing to the highest block of its preceding cycle. - i.e. 1st cycle's lafl = 0, 2nd cycle's lafl = 99 *) + block's lpbl pointing to the highest block of its preceding cycle. + i.e. 1st cycle's lpbl = 0, 2nd cycle's lpbl = 99 *) let*! cycles, head = make_n_initial_consecutive_cycles block_store ~cycle_length:100 ~nb_cycles:2 in @@ -391,19 +391,19 @@ let test_merge_with_branches block_store = |> WithExceptions.Option.get ~loc:__LOC__ in let*! blocks, _head = - make_raw_block_list_with_lafl - ~lafl:0l + make_raw_block_list_with_lpbl + ~lpbl:0l (Block_repr.descriptor fork_root) 50 in - (* tweek lafl's to make them coherent *) + (* tweek lpbl's to make them coherent *) List.iter (fun block -> if Compare.Int32.(Block_repr.level block > 99l) then block.metadata <- Option.map (fun metadata -> - {metadata with Block_repr.last_allowed_fork_level = 99l}) + {metadata with Block_repr.last_preserved_block_level = 99l}) block.metadata) blocks ; let* () = @@ -423,19 +423,19 @@ let test_merge_with_branches block_store = |> WithExceptions.Option.get ~loc:__LOC__ in let*! blocks, _head = - make_raw_block_list_with_lafl - ~lafl:99l + make_raw_block_list_with_lpbl + ~lpbl:99l (Block_repr.descriptor fork_root) 50 in - (* tweek lafl's to make them coherent *) + (* tweek lpbl's to make them coherent *) List.iter (fun block -> if Compare.Int32.(Block_repr.level block > 199l) then block.metadata <- Option.map (fun metadata -> - {metadata with Block_repr.last_allowed_fork_level = 199l}) + {metadata with Block_repr.last_preserved_block_level = 199l}) block.metadata) blocks ; let* () = @@ -536,14 +536,14 @@ let test_full_0_merge block_store = (* hack: invert the reading order to clear the cache *) in let expected_savepoint_level = - ((nb_cycles - 1) * cycle_length) - 1 (* lafl *) - 1 - (* lafl max_op_ttl *) + ((nb_cycles - 1) * cycle_length) - 1 (* lpbl *) - 1 + (* lpbl max_op_ttl *) in let expected_pruned_blocks, expected_preserved_blocks = List.split_n (expected_savepoint_level - 1) (* the genesis block is not counted *) all_blocks - (* First 9 cycles shouldn't have metadata except for the lafl block + (* First 9 cycles shouldn't have metadata except for the lpbl block (i.e. the last one) *) in let* () = @@ -627,15 +627,15 @@ let test_rolling_0_merge block_store = in let all_blocks = List.concat cycles in let expected_savepoint_level = - ((nb_cycles - 1) * cycle_length) - 1 (* lafl *) - 1 - (* lafl max_op_ttl *) + ((nb_cycles - 1) * cycle_length) - 1 (* lpbl *) - 1 + (* lpbl max_op_ttl *) in let expected_pruned_blocks, expected_preserved_blocks = List.split_n (expected_savepoint_level - 1) (* the genesis block is not counted *) all_blocks - (* First 9 cycles shouldn't have metadata except for the lafl block - (i.e. the last one) *) + (* First 9 cycles shouldn't have metadata except for the lpbl + block (i.e. the last one) *) in let* () = assert_absence_in_block_store block_store expected_pruned_blocks in let* () = diff --git a/src/lib_store/unix/test/test_history_mode_switch.ml b/src/lib_store/unix/test/test_history_mode_switch.ml index 87e3781ce8cadcf8547ff49bf77bcc019c6dd822..8140364a29563d8ab3a81b4f2f01b410391ff727 100644 --- a/src/lib_store/unix/test/test_history_mode_switch.ml +++ b/src/lib_store/unix/test/test_history_mode_switch.ml @@ -50,7 +50,9 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode let* current_head_metadata = Store.Block.get_block_metadata chain_store current_head in - let head_lafl = Store.Block.last_allowed_fork_level current_head_metadata in + let head_lpbl = + Store.Block.last_preserved_block_level current_head_metadata + in let max_op_ttl = Store.Block.max_operations_ttl current_head_metadata in match target_mode with | Archive when previous_mode <> Archive -> @@ -66,7 +68,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode (* We can comply to every mode *) (* The preserved_level is the level to be kept to be able to export snapshots.*) - let preserved_level = Int32.(sub head_lafl (of_int max_op_ttl)) in + let preserved_level = Int32.(sub head_lpbl (of_int max_op_ttl)) in let target_offset_window = Int32.(mul blocks_per_cycle (of_int target_offset)) in @@ -74,7 +76,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode offset. We take the succ to be on a block of the end of a cycle. *) let expected_savepoint = - Int32.(succ (sub head_lafl target_offset_window)) + Int32.(succ (sub head_lpbl target_offset_window)) in let preserved_savepoint = min preserved_level expected_savepoint in return (max 0l preserved_savepoint) @@ -86,7 +88,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode .offset in (* We are limited by the previous savepoint available *) - let preserved_level = Int32.(sub head_lafl (of_int max_op_ttl)) in + let preserved_level = Int32.(sub head_lpbl (of_int max_op_ttl)) in let target_offset_window = Int32.(mul blocks_per_cycle (of_int target_offset)) in @@ -94,7 +96,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode Int32.(mul blocks_per_cycle (of_int previous_offset)) in let expected_savepoint = - Int32.(succ (sub head_lafl target_offset_window)) + Int32.(succ (sub head_lpbl target_offset_window)) in let preserved_savepoint = min preserved_level expected_savepoint in (* The available savepoint is the savepoint available in the @@ -106,7 +108,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode 0l (min preserved_level - (succ (sub head_lafl previous_offset_window)))) + (succ (sub head_lpbl previous_offset_window)))) in return (max available_savepoint preserved_savepoint) | Rolling _ -> invalid_history_mode_switch ~previous_mode ~target_mode) @@ -118,12 +120,12 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode match previous_mode with | Archive -> (* We can comply to every mode *) - let preserved_level = Int32.(sub head_lafl (of_int max_op_ttl)) in + let preserved_level = Int32.(sub head_lpbl (of_int max_op_ttl)) in let target_offset_window = Int32.(mul blocks_per_cycle (of_int target_offset)) in let expected_savepoint = - Int32.(succ (sub head_lafl target_offset_window)) + Int32.(succ (sub head_lpbl target_offset_window)) in let preserved_savepoint = min preserved_level expected_savepoint in return (max 0l preserved_savepoint) @@ -135,7 +137,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode .offset in (* We are limited by the previous savepoint available *) - let preserved_level = Int32.(sub head_lafl (of_int max_op_ttl)) in + let preserved_level = Int32.(sub head_lpbl (of_int max_op_ttl)) in let target_offset_window = Int32.(mul blocks_per_cycle (of_int target_offset)) in @@ -143,7 +145,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode Int32.(mul blocks_per_cycle (of_int previous_offset)) in let expected_savepoint = - Int32.(succ (sub head_lafl target_offset_window)) + Int32.(succ (sub head_lpbl target_offset_window)) in let preserved_savepoint = min preserved_level expected_savepoint in let available_savepoint = @@ -152,7 +154,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode 0l (min preserved_level - (succ (sub head_lafl previous_offset_window)))) + (succ (sub head_lpbl previous_offset_window)))) in return (max available_savepoint preserved_savepoint) | Rolling offset -> @@ -163,7 +165,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode .offset in (* We are limited by the previous savepoint available *) - let preserved_level = Int32.(sub head_lafl (of_int max_op_ttl)) in + let preserved_level = Int32.(sub head_lpbl (of_int max_op_ttl)) in let target_offset_window = Int32.(mul blocks_per_cycle (of_int target_offset)) in @@ -171,7 +173,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode Int32.(mul blocks_per_cycle (of_int previous_offset)) in let expected_savepoint = - Int32.(succ (sub head_lafl target_offset_window)) + Int32.(succ (sub head_lpbl target_offset_window)) in let preserved_savepoint = min preserved_level expected_savepoint in let available_savepoint = @@ -180,7 +182,7 @@ let expected_savepoint chain_store current_head blocks_per_cycle ~previous_mode 0l (min preserved_level - (succ (sub head_lafl previous_offset_window)))) + (succ (sub head_lpbl previous_offset_window)))) in return (max available_savepoint preserved_savepoint)) @@ -202,11 +204,11 @@ let expected_caboose chain_store current_head blocks_per_cycle ~previous_mode let* current_head_metadata = Store.Block.get_block_metadata chain_store current_head in - let head_lafl = - Store.Block.last_allowed_fork_level current_head_metadata + let head_lpbl = + Store.Block.last_preserved_block_level current_head_metadata in let offset_window = - Int32.(sub head_lafl (mul blocks_per_cycle (of_int target_offset))) + Int32.(sub head_lpbl (mul blocks_per_cycle (of_int target_offset))) in let expected_caboose = (* When the offset window exceeds the savepoint, we take the diff --git a/src/lib_store/unix/test/test_locator.ml b/src/lib_store/unix/test/test_locator.ml index 3cca2f2f60ba26f7f36955923f6989741936f321..7811726154eccc2fb6ec9ce87e34394860a1aaac 100644 --- a/src/lib_store/unix/test/test_locator.ml +++ b/src/lib_store/unix/test/test_locator.ml @@ -121,7 +121,8 @@ let make_empty_chain chain_store n : Block_hash.t Lwt.t = timestamp = header.shell.timestamp; message; max_operations_ttl; - last_allowed_fork_level = 0l; + last_finalized_block_level = 0l; + last_preserved_block_level = 0l; }; block_metadata = (zero, None); ops_metadata = Block_validation.No_metadata_hash []; @@ -163,7 +164,8 @@ let make_multiple_protocol_chain (chain_store : Store.Chain.t) timestamp = Time.Protocol.epoch; message = None; max_operations_ttl = 0; - last_allowed_fork_level = 0l; + last_finalized_block_level = 0l; + last_preserved_block_level = 0l; } in let rec loop remaining_fork_points lvl (pred_header : Block_header.t) = @@ -194,13 +196,13 @@ let make_multiple_protocol_chain (chain_store : Store.Chain.t) Option.some @@ Block_metadata_hash.hash_bytes [block_metadata] in (* make some cycles *) - let last_allowed_fork_level = + let last_preserved_block_level = Int32.of_int (max 0 (20 * ((lvl - 10) / 20))) in let validation_result = { Block_validation.validation_store = - {empty_result with last_allowed_fork_level}; + {empty_result with last_preserved_block_level}; block_metadata = (zero, block_metadata_hash); ops_metadata = Block_validation.No_metadata_hash []; shell_header_hash = Block_validation.Shell_header_hash.zero; diff --git a/src/lib_store/unix/test/test_reconstruct.ml b/src/lib_store/unix/test/test_reconstruct.ml index fff158336a36861b4a102b76ac3e4162a259701d..efe0f1beec73756f7b9833035c6b33100e271aae 100644 --- a/src/lib_store/unix/test/test_reconstruct.ml +++ b/src/lib_store/unix/test/test_reconstruct.ml @@ -59,7 +59,7 @@ let check_flags descr store expected_head = History_mode.Archive ; let*! checkpoint = Store.Chain.checkpoint chain_store in let* metadata = Store.Block.get_block_metadata chain_store expected_head in - let expected_checkpoint = Store.Block.last_allowed_fork_level metadata in + let expected_checkpoint = Store.Block.last_preserved_block_level metadata in Assert.Int32.equal ~msg:("checkpoint consistency: " ^ descr) expected_checkpoint @@ -197,10 +197,10 @@ let test_from_snapshot ~descr:_ (store_dir, context_dir) store let* baked_blocks, last = Alpha_utils.bake_n chain_store nb_blocks_to_bake genesis_block in - let*! lafl = + let*! lpbl = let*! o = Store.Block.get_block_metadata_opt chain_store last in match o with - | Some m -> Lwt.return (Store.Block.last_allowed_fork_level m) + | Some m -> Lwt.return (Store.Block.last_preserved_block_level m) | None -> assert false in let*! savepoint = Store.Chain.savepoint chain_store in @@ -257,7 +257,7 @@ let test_from_snapshot ~descr:_ (store_dir, context_dir) store ~on_error:(function | [Reconstruction.(Reconstruction_failure Nothing_to_reconstruct)] as e -> - if Compare.Int32.(lafl = 0l) || snd savepoint = 0l then + if Compare.Int32.(lpbl = 0l) || snd savepoint = 0l then (* It is expected as nothing was pruned *) return_true else ( diff --git a/src/lib_store/unix/test/test_snapshots.ml b/src/lib_store/unix/test/test_snapshots.ml index c37eb88ac417a5ed6f1bc938ba57f43eacee615c..bff2e5a861a43a145d540ffcba9e8c08d1b5bf35 100644 --- a/src/lib_store/unix/test/test_snapshots.ml +++ b/src/lib_store/unix/test/test_snapshots.ml @@ -597,7 +597,7 @@ let make_tests_rolling speed = (* This test aims to check that the caboose and savepoint are well dragged when the first merge occurs, after a rolling snapshot import on a block which is not on a cycle's bound. Indeed, in such - a scenario, the merge procedure may remove blocks bellow the lafl + a scenario, the merge procedure may remove blocks bellow the lpbl without cementing them. It would result in non stored caboose (rolling issue) and savepoint (rolling and full issue). In this test, we need to increase the number of blocks per cycle to diff --git a/src/lib_store/unix/test/test_testchain.ml b/src/lib_store/unix/test/test_testchain.ml index 3f9c0b08addddda1d1b2825c9ea9a226da64f043..aeaab34f3721136646e960950222686efb514640 100644 --- a/src/lib_store/unix/test/test_testchain.ml +++ b/src/lib_store/unix/test/test_testchain.ml @@ -81,7 +81,7 @@ let fork_testchain chain_store (blocks, forked_block) = let testchain_store = Store.Chain.testchain_store testchain in let* test_blocks, head = append_blocks - ~min_lafl:genesis_header.shell.level + ~min_lpbl:genesis_header.shell.level ~should_set_head:true testchain_store ~kind:`Full diff --git a/src/lib_store/unix/test/test_utils.ml b/src/lib_store/unix/test/test_utils.ml index 29cbdb73fd0b32e4327ba80eb18be2685e6bcd24..a22805f12d85669abd44aebd929a1775f52493e6 100644 --- a/src/lib_store/unix/test/test_utils.ml +++ b/src/lib_store/unix/test/test_utils.ml @@ -46,7 +46,7 @@ let equal_metadata ?msg m1 m2 = ({ message; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata = _; operations_metadata = _; } : @@ -54,12 +54,12 @@ let equal_metadata ?msg m1 m2 = -> Format.fprintf ppf - "message: %a@.max_operations_ttl: %d@. last_allowed_fork_level: \ - %ld@." + "message: %a@.max_operations_ttl: %d@. \ + last_preserved_block_level: %ld@." (Format.pp_print_option ~none Format.pp_print_string) message max_operations_ttl - last_allowed_fork_level)) + last_preserved_block_level)) md in Assert.equal ?msg ~pp ~eq m1 m2 @@ -113,12 +113,12 @@ let check_invariants ?(expected_checkpoint = None) ?(expected_savepoint = None) let expected_checkpoint_level = match expected_checkpoint with | Some l -> snd l - | None -> Block.last_allowed_fork_level head_metadata + | None -> Block.last_preserved_block_level head_metadata in Assert.assert_true (Format.sprintf "check_invariant: checkpoint.level(%ld) < \ - head.last_allowed_fork_level(%ld)" + head.last_preserved_block_level(%ld)" (snd checkpoint) expected_checkpoint_level) Compare.Int32.(snd checkpoint >= expected_checkpoint_level) ; @@ -361,7 +361,7 @@ let wrap_simple_store_init_test ?history_mode ?(speed = `Quick) ?patch_context speed (wrap_simple_store_init ?history_mode ?patch_context ?keep_dir ?with_gc f) -let make_raw_block ?min_lafl ?(max_operations_ttl = default_max_operations_ttl) +let make_raw_block ?min_lpbl ?(max_operations_ttl = default_max_operations_ttl) ?(constants = default_protocol_constants) ?(context = Context_hash.zero) (pred_block_hash, pred_block_level) = let level = Int32.succ pred_block_level in @@ -385,7 +385,7 @@ let make_raw_block ?min_lafl ?(max_operations_ttl = default_max_operations_ttl) } in let hash = Block_header.hash header in - let last_allowed_fork_level = + let last_preserved_block_level = let current_cycle = Int32.(div (pred level) constants.blocks_per_cycle) in Int32.( mul @@ -394,10 +394,10 @@ let make_raw_block ?min_lafl ?(max_operations_ttl = default_max_operations_ttl) 0l (sub current_cycle (of_int constants.blocks_preservation_cycles)))) in - let last_allowed_fork_level = - match min_lafl with - | Some min_lafl -> Compare.Int32.max min_lafl last_allowed_fork_level - | None -> last_allowed_fork_level + let last_preserved_block_level = + match min_lpbl with + | Some min_lpbl -> Compare.Int32.max min_lpbl last_preserved_block_level + | None -> last_preserved_block_level in let operations = List.map @@ -417,7 +417,7 @@ let make_raw_block ?min_lafl ?(max_operations_ttl = default_max_operations_ttl) { Block_repr.message = Some "message"; max_operations_ttl; - last_allowed_fork_level; + last_preserved_block_level; block_metadata = Bytes.create 1; operations_metadata = List.map @@ -494,7 +494,12 @@ let store_raw_block chain_store ?resulting_context (raw_block : Block_repr.t) = timestamp = Block_repr.timestamp raw_block; message = Block_repr.message metadata; max_operations_ttl = Block_repr.max_operations_ttl metadata; - last_allowed_fork_level = Block_repr.last_allowed_fork_level metadata; + last_finalized_block_level = + (* Not yet implemented. We use the last_preserved_block_level by + default.*) + Block_repr.last_preserved_block_level metadata; + last_preserved_block_level = + Block_repr.last_preserved_block_level metadata; }; block_metadata = ( Block_repr.block_metadata metadata, @@ -536,13 +541,13 @@ let set_block_predecessor blk pred_hash = }; } -let make_raw_block_list ?min_lafl ?constants ?max_operations_ttl ?(kind = `Full) +let make_raw_block_list ?min_lpbl ?constants ?max_operations_ttl ?(kind = `Full) (pred_hash, pred_level) n = List.fold_left (fun ((pred_hash, pred_level), acc) _ -> let raw_block = make_raw_block - ?min_lafl + ?min_lpbl ?constants ?max_operations_ttl (pred_hash, pred_level) @@ -569,7 +574,7 @@ let incr_fitness b = [b] | _ -> assert false -let append_blocks ?min_lafl ?constants ?max_operations_ttl ?root ?(kind = `Full) +let append_blocks ?min_lpbl ?constants ?max_operations_ttl ?root ?(kind = `Full) ?(should_set_head = false) ?protocol_level ?set_protocol chain_store n = let open Lwt_result_syntax in let*! root = @@ -581,7 +586,7 @@ let append_blocks ?min_lafl ?constants ?max_operations_ttl ?root ?(kind = `Full) in let* root_b = Store.Block.read_block chain_store (fst root) in let*! blocks, _last = - make_raw_block_list ?min_lafl ?constants ?max_operations_ttl ~kind root n + make_raw_block_list ?min_lpbl ?constants ?max_operations_ttl ~kind root n in let proto_level = match protocol_level with diff --git a/src/lib_validation/block_validation.ml b/src/lib_validation/block_validation.ml index 6b191a03b88fd8686baea53512ba183a27595973..1e25a60e844f0b60409ebead0141680423ed5b1e 100644 --- a/src/lib_validation/block_validation.ml +++ b/src/lib_validation/block_validation.ml @@ -75,7 +75,8 @@ type validation_store = { timestamp : Time.Protocol.t; message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_finalized_block_level : Int32.t; + last_preserved_block_level : Int32.t; } let validation_store_encoding = @@ -86,31 +87,36 @@ let validation_store_encoding = timestamp; message; max_operations_ttl; - last_allowed_fork_level; + last_finalized_block_level; + last_preserved_block_level; } -> ( resulting_context_hash, timestamp, message, max_operations_ttl, - last_allowed_fork_level )) + last_finalized_block_level, + last_preserved_block_level )) (fun ( resulting_context_hash, timestamp, message, max_operations_ttl, - last_allowed_fork_level ) -> + last_finalized_block_level, + last_preserved_block_level ) -> { resulting_context_hash; timestamp; message; max_operations_ttl; - last_allowed_fork_level; + last_finalized_block_level; + last_preserved_block_level; }) - (obj5 + (obj6 (req "resulting_context_hash" Context_hash.encoding) (req "timestamp" Time.Protocol.encoding) (req "message" (option string)) (req "max_operations_ttl" int31) - (req "last_allowed_fork_level" int32)) + (req "last_finalized_block_level" int32) + (req "last_preserved_block_level" int32)) type operation_metadata = Metadata of Bytes.t | Too_large_metadata @@ -827,7 +833,10 @@ module Make (Proto : Protocol_plugin.T) = struct timestamp = block_header.shell.timestamp; message = validation_result.message; max_operations_ttl = validation_result.max_operations_ttl; - last_allowed_fork_level = validation_result.last_allowed_fork_level; + last_finalized_block_level = + validation_result.last_finalized_block_level; + last_preserved_block_level = + validation_result.last_preserved_block_level; } in return @@ -1233,7 +1242,10 @@ module Make (Proto : Protocol_plugin.T) = struct timestamp; message = validation_result.message; max_operations_ttl; - last_allowed_fork_level = validation_result.last_allowed_fork_level; + last_finalized_block_level = + validation_result.last_finalized_block_level; + last_preserved_block_level = + validation_result.last_preserved_block_level; } in let result = diff --git a/src/lib_validation/block_validation.mli b/src/lib_validation/block_validation.mli index 05d85f76ebb5696f706ba6ebb965b18fc954f64d..12eb79bfebb0bb62580207e7d9274aec89e73aa8 100644 --- a/src/lib_validation/block_validation.mli +++ b/src/lib_validation/block_validation.mli @@ -47,8 +47,9 @@ type validation_store = { timestamp : Time.Protocol.t; message : string option; max_operations_ttl : int; - last_allowed_fork_level : Int32.t; + last_finalized_block_level : Int32.t; (** Oldest block for which reorganizations can happen *) + last_preserved_block_level : Int32.t; } val may_patch_protocol : diff --git a/src/proto_017_PtNairob/lib_delegate/baking_simulator.ml b/src/proto_017_PtNairob/lib_delegate/baking_simulator.ml index 000d7cc3c575fa85898ecaa3915ebaf135f33232..2907f976914627a3e7433654fb956e232cd939c3 100644 --- a/src/proto_017_PtNairob/lib_delegate/baking_simulator.ml +++ b/src/proto_017_PtNairob/lib_delegate/baking_simulator.ml @@ -171,9 +171,23 @@ let finalize_construction inc = let** () = Protocol.finalize_validation validation_state in let** result = match application_state with - | Some application_state -> + | Some application_state -> ( Protocol.finalize_application application_state (Some inc.header) - >>=? return_some + >>= function + | Ok (vr, metadata) -> + let new_vr = + Tezos_protocol_environment. + { + context = vr.context; + fitness = vr.fitness; + message = vr.message; + max_operations_ttl = vr.max_operations_ttl; + last_finalized_block_level = vr.last_allowed_fork_level; + last_preserved_block_level = vr.last_allowed_fork_level; + } + in + return_some (new_vr, metadata) + | Error e -> Lwt.return (Error e)) | None -> return_none in return result) diff --git a/src/proto_018_Proxford/lib_delegate/baking_simulator.ml b/src/proto_018_Proxford/lib_delegate/baking_simulator.ml index 7fe5c0fab8e94b965a5039fbd98c67fd080e71e4..ddb417f19f133e8b99dad845c41a0c664cff9736 100644 --- a/src/proto_018_Proxford/lib_delegate/baking_simulator.ml +++ b/src/proto_018_Proxford/lib_delegate/baking_simulator.ml @@ -186,11 +186,25 @@ let finalize_construction inc = let** () = Protocol.finalize_validation validation_state in let** result = match application_state with - | Some application_state -> - let* result = + | Some application_state -> ( + let*! result = Protocol.finalize_application application_state (Some inc.header) in - return_some result + match result with + | Ok (vr, metadata) -> + let new_vr = + Tezos_protocol_environment. + { + context = vr.context; + fitness = vr.fitness; + message = vr.message; + max_operations_ttl = vr.max_operations_ttl; + last_finalized_block_level = vr.last_allowed_fork_level; + last_preserved_block_level = vr.last_allowed_fork_level; + } + in + return_some (new_vr, metadata) + | Error e -> Lwt.return (Error e)) | None -> return_none in return result) diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index f8383487b87c3d849846e878b85f9266d2050d12..a99e6f2dc5531e6191cc28e7ebc07b0dcf081913 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -663,7 +663,9 @@ let finalize ?commit_message:message c fitness = fitness; message; max_operations_ttl = (Raw_context.constants c).max_operations_time_to_live; - last_allowed_fork_level = + last_finalized_block_level = + Raw_level.to_int32 @@ Level.last_finalized_block_level c; + last_preserved_block_level = Raw_level.to_int32 @@ Level.last_preserved_block_level c; } diff --git a/src/proto_alpha/lib_protocol/level_storage.ml b/src/proto_alpha/lib_protocol/level_storage.ml index c8ffb1dfbf660c4d554c6eb5bba7f56d0335449d..072ad1e9f18532c969078648d9c1416ff9a246a3 100644 --- a/src/proto_alpha/lib_protocol/level_storage.ml +++ b/src/proto_alpha/lib_protocol/level_storage.ml @@ -109,6 +109,11 @@ let last_preserved_block_level c = | None -> Raw_level_repr.root | Some cycle -> (first_level_in_cycle c cycle).level +let last_finalized_block_level c = + (* Not implemented yet. We use the last_preserved_block_level by + default.*) + last_preserved_block_level c + let last_of_a_cycle ctxt level = let cycle_eras = Raw_context.cycle_eras ctxt in Level_repr.last_of_cycle ~cycle_eras level diff --git a/src/proto_alpha/lib_protocol/level_storage.mli b/src/proto_alpha/lib_protocol/level_storage.mli index acc1792e9d7ca6fced13cdd87955274e32a0b5f3..bd6b45606073cf6637c6af2f46da770fc931a1a6 100644 --- a/src/proto_alpha/lib_protocol/level_storage.mli +++ b/src/proto_alpha/lib_protocol/level_storage.mli @@ -64,6 +64,8 @@ val levels_with_commitments_in_cycle : val last_preserved_block_level : Raw_context.t -> Raw_level_repr.t +val last_finalized_block_level : Raw_context.t -> Raw_level_repr.t + (** Returns [Some cycle] if the current level represents the last level of [cycle] and [None] if the level is not the last level of a cycle. *) diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index f7aea60622f343c9db47034e37a128a34e7409f6..c01034834b2c2ab85f18347734bdbc2fce02ef00 100644 --- a/src/proto_demo_counter/lib_protocol/main.ml +++ b/src/proto_demo_counter/lib_protocol/main.ml @@ -217,7 +217,8 @@ let finalize_application application_state _shell_header = context; fitness; max_operations_ttl = 0; - last_allowed_fork_level = 0l; + last_finalized_block_level = 0l; + last_preserved_block_level = 0l; }, state ) @@ -262,7 +263,11 @@ let init _chain_id context block_header = context = init_context; fitness; max_operations_ttl = 0; - last_allowed_fork_level = block_header.level; + last_finalized_block_level = + (* Not yet implemented. We use the last_preserved_block_level by + default.*) + block_header.level; + last_preserved_block_level = block_header.level; } let compare_operations _ _ = 0 diff --git a/src/proto_demo_noops/lib_protocol/main.ml b/src/proto_demo_noops/lib_protocol/main.ml index edc6829bde5010c94ba52e30ecc0bc88c83e1a0f..bf16332a4c2756bd6ac57df32b0df13188adf3a1 100644 --- a/src/proto_demo_noops/lib_protocol/main.ml +++ b/src/proto_demo_noops/lib_protocol/main.ml @@ -150,7 +150,8 @@ let finalize_application application_state _shell_header = context = application_state.context; fitness = application_state.fitness; max_operations_ttl = 0; - last_allowed_fork_level = 0l; + last_preserved_block_level = 0l; + last_finalized_block_level = 0l ; }, () ) @@ -165,7 +166,8 @@ let init _chain_id context block_header = context; fitness; max_operations_ttl = 0; - last_allowed_fork_level = 0l; + last_finalized_block_level = 0l; + last_preserved_block_level = 0l; } let value_of_key ~chain_id:_ ~predecessor_context:_ ~predecessor_timestamp:_