From 16987e77ea553ae6d7115a3034785d7aab90e953 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Mon, 4 Dec 2023 12:05:04 +0100 Subject: [PATCH 1/2] Envs: propagate last_finalized and last_preserved block level --- .../test/proto_test_injection/main.ml | 6 +++-- .../environment_V0.ml | 17 ++++++++----- .../environment_V0.mli | 5 +--- .../environment_V1.ml | 17 ++++++++----- .../environment_V1.mli | 5 +--- .../environment_V10.ml | 17 ++++++++----- .../environment_V10.mli | 5 +--- .../environment_V11.ml | 17 ++++++++----- .../environment_V11.mli | 5 +--- .../environment_V12.ml | 3 ++- .../environment_V2.ml | 17 ++++++++----- .../environment_V2.mli | 5 +--- .../environment_V3.ml | 17 ++++++++----- .../environment_V3.mli | 5 +--- .../environment_V4.ml | 17 ++++++++----- .../environment_V4.mli | 5 +--- .../environment_V5.ml | 17 ++++++++----- .../environment_V5.mli | 5 +--- .../environment_V6.ml | 17 ++++++++----- .../environment_V6.mli | 5 +--- .../environment_V7.ml | 17 ++++++++----- .../environment_V7.mli | 5 +--- .../environment_V8.ml | 17 ++++++++----- .../environment_V8.mli | 5 +--- .../environment_V9.ml | 17 ++++++++----- .../environment_V9.mli | 5 +--- .../environment_context.ml | 24 ++++++++++++++++++- .../environment_context.mli | 14 ++++++++++- src/lib_protocol_environment/sigs/v12.ml | 16 ++++++++----- .../sigs/v12/updater.mli | 16 ++++++++----- .../tezos_protocol_environment.ml | 3 ++- .../lib_delegate/baking_simulator.ml | 18 ++++++++++++-- .../lib_delegate/baking_simulator.ml | 20 +++++++++++++--- src/proto_alpha/lib_protocol/alpha_context.ml | 4 +++- src/proto_alpha/lib_protocol/level_storage.ml | 5 ++++ .../lib_protocol/level_storage.mli | 2 ++ src/proto_demo_counter/lib_protocol/main.ml | 9 +++++-- src/proto_demo_noops/lib_protocol/main.ml | 6 +++-- 38 files changed, 262 insertions(+), 148 deletions(-) diff --git a/src/bin_client/test/proto_test_injection/main.ml b/src/bin_client/test/proto_test_injection/main.ml index 8d6fb9fbdc77..048e13ed7827 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 5632ac2d8e56..67a697bb9b06 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 16aca09f9c6d..ba0a5eac667f 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 1f7ef70bfe31..8325d72e2a3b 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 8520815a2f34..573fbc5af688 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 365dceebd502..60b27c633f2a 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 d4f07896faf3..56a86901022d 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 9123d2de9b19..264fe7a54c2c 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 311307153f11..e959a593c288 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 6968a715d61b..2117b0d82058 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 2f86f2f934f2..63abd1a64dd9 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 ae13045d8437..2bc846a980dc 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 360e490704c9..40d9899b6e96 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 7c7e3588ace5..eccb9e0c1a03 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 ed770f9a98e8..0627db62e94d 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 07f784e22a5d..690900502bff 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 43dddd2cfc18..296a46b19f11 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 745d58c4875e..548c3bbe4a30 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 6b021941c143..389a0bb7aec8 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 ae1d240aefeb..cb7770a73a83 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 60df5f376f19..6f67bb75b6fe 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 a8c8ec9a9d4e..0c415ff5b177 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 6f6351e1a686..18cf72445cec 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 d8a363953bff..54e127f72a61 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 0e8a620135e0..488568a5e33a 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 ffe3f8a7b618..fa7a23ec2637 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 36384c991606..bc8e8d8f2e1a 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 eb88abf5525f..e5199c8a4836 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 109a0ff09ce3..f26b8cb133f5 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 e394c22b9b62..f0461c7a706c 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 2381dfed25d8..e9aa47d12a2d 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/proto_017_PtNairob/lib_delegate/baking_simulator.ml b/src/proto_017_PtNairob/lib_delegate/baking_simulator.ml index 000d7cc3c575..2907f9769146 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 7fe5c0fab8e9..ddb417f19f13 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 f8383487b87c..a99e6f2dc553 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 c8ffb1dfbf66..072ad1e9f185 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 acc1792e9d7c..bd6b45606073 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 f7aea60622f3..c01034834b2c 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 edc6829bde50..bf16332a4c27 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:_ -- GitLab From 159e8ed6c826c69d22962e6ef4b7ba5fbe4bb123 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Mon, 4 Dec 2023 12:06:19 +0100 Subject: [PATCH 2/2] Store/Shell/doc: move from lafl to lpbl --- docs/alpha/protocol_overview.rst | 12 +- docs/nairobi/protocol_overview.rst | 12 +- docs/oxford/protocol_overview.rst | 12 +- docs/shell/storage.rst | 39 +++--- docs/user/history_modes.rst | 18 ++- src/lib_shell_services/history_mode.ml | 2 +- src/lib_shell_services/store_errors.ml | 32 ++--- src/lib_store/mocked/store.ml | 59 ++++----- src/lib_store/shared/block_repr.ml | 28 ++--- src/lib_store/shared/block_repr.mli | 4 +- src/lib_store/shared/store_events.ml | 4 +- src/lib_store/store.mli | 49 ++++---- src/lib_store/unix/block_repr_unix.ml | 8 +- src/lib_store/unix/block_repr_unix.mli | 6 +- src/lib_store/unix/block_store.ml | 117 +++++++++--------- src/lib_store/unix/block_store.mli | 2 +- src/lib_store/unix/consistency.ml | 19 +-- src/lib_store/unix/reconstruction.ml | 42 +++---- src/lib_store/unix/snapshots.ml | 11 +- src/lib_store/unix/store.ml | 93 +++++++------- src/lib_store/unix/store.mli | 48 +++---- src/lib_store/unix/test/alpha_utils.ml | 3 +- src/lib_store/unix/test/test_block_store.ml | 64 +++++----- .../unix/test/test_history_mode_switch.ml | 36 +++--- src/lib_store/unix/test/test_locator.ml | 10 +- src/lib_store/unix/test/test_reconstruct.ml | 8 +- src/lib_store/unix/test/test_snapshots.ml | 2 +- src/lib_store/unix/test/test_testchain.ml | 2 +- src/lib_store/unix/test/test_utils.ml | 41 +++--- src/lib_validation/block_validation.ml | 30 +++-- src/lib_validation/block_validation.mli | 3 +- 31 files changed, 423 insertions(+), 393 deletions(-) diff --git a/docs/alpha/protocol_overview.rst b/docs/alpha/protocol_overview.rst index 8b6c2d6252f7..59820bd83c1c 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 308f349cded0..d7a536e65785 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 4a7cec97f561..8c99a0572983 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 d9c58898a5b7..d39d7a0c631a 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 211b74745759..dbb46b550135 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/lib_shell_services/history_mode.ml b/src/lib_shell_services/history_mode.ml index d8931e385a36..365abf05433a 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 3d2d3940c076..eefed9183f8d 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 89ab66d92104..8ce8b02cfc24 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 2a6bcbcae634..77e3954f6015 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 2ebc484f5807..f6685fddbc17 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 856ab68f467f..54abbced2f7f 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 430a310e6d85..5627fb08aa14 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 01386463709b..396d9b24aab7 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 b1d44ffbde1d..9eaa5832fbb2 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 62dc8a1b3964..3bdb0c30d0a3 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 04116518980d..602d7f27a012 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 b7468267d4ce..b15dc3091dbe 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 44c359344092..065ffe59e7f0 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 eecce3b04991..77c44f719827 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 1d9afa18d36d..b5a30e2d10d5 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 96827bbf0e87..d8ee80d37fcc 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 652de86d818d..02c7e79811ce 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 7b8452ea10e5..6881a4aa7521 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 87e3781ce8ca..8140364a2956 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 3cca2f2f60ba..7811726154ec 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 fff158336a36..efe0f1beec73 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 c37eb88ac417..bff2e5a861a4 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 3f9c0b08addd..aeaab34f3721 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 29cbdb73fd0b..a22805f12d85 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 6b191a03b88f..1e25a60e844f 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 05d85f76ebb5..12eb79bfebb0 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 : -- GitLab