From 1a03c6615c401d34fe86eb951ea7c1e1614169c5 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Thu, 11 Jan 2024 16:03:07 +0100
Subject: [PATCH 1/4] Rollup node: save context splitting level

---
 src/lib_smart_rollup/rollup_node_services.ml  | 19 ++++++++++++------
 src/lib_smart_rollup_node/node_context.ml     |  8 +++++++-
 src/lib_smart_rollup_node/node_context.mli    |  4 ++++
 .../rollup_node_daemon.ml                     | 16 ++++++++++-----
 src/lib_smart_rollup_node/rpc_directory.ml    |  8 ++++++--
 src/lib_smart_rollup_node/store_v2.ml         | 20 +++++++++++++++++++
 src/lib_smart_rollup_node/store_v2.mli        |  4 ++++
 7 files changed, 65 insertions(+), 14 deletions(-)

diff --git a/src/lib_smart_rollup/rollup_node_services.ml b/src/lib_smart_rollup/rollup_node_services.ml
index 98c54904f5f4..cf20650ccb64 100644
--- a/src/lib_smart_rollup/rollup_node_services.ml
+++ b/src/lib_smart_rollup/rollup_node_services.ml
@@ -85,7 +85,11 @@ type message_status =
       published_at_level : int32;
     }
 
-type gc_info = {last_gc_level : int32; first_available_level : int32}
+type gc_info = {
+  last_gc_level : int32;
+  first_available_level : int32;
+  last_context_split_level : int32 option;
+}
 
 module Encodings = struct
   open Data_encoding
@@ -259,11 +263,14 @@ module Encodings = struct
 
   let gc_info : gc_info Data_encoding.t =
     conv
-      (fun {last_gc_level; first_available_level} ->
-        (last_gc_level, first_available_level))
-      (fun (last_gc_level, first_available_level) ->
-        {last_gc_level; first_available_level})
-    @@ obj2 (req "last_gc_level" int32) (req "first_available_level" int32)
+      (fun {last_gc_level; first_available_level; last_context_split_level} ->
+        (last_gc_level, first_available_level, last_context_split_level))
+      (fun (last_gc_level, first_available_level, last_context_split_level) ->
+        {last_gc_level; first_available_level; last_context_split_level})
+    @@ obj3
+         (req "last_gc_level" int32)
+         (req "first_available_level" int32)
+         (opt "last_context_split_level" int32)
 end
 
 module Arg = struct
diff --git a/src/lib_smart_rollup_node/node_context.ml b/src/lib_smart_rollup_node/node_context.ml
index 5006d5b63585..c6009573c3cf 100644
--- a/src/lib_smart_rollup_node/node_context.ml
+++ b/src/lib_smart_rollup_node/node_context.ml
@@ -913,6 +913,9 @@ let get_gc_levels node_ctxt =
         first_available_level = node_ctxt.genesis_info.level;
       }
 
+let get_last_context_split_level node_ctxt =
+  Store.Last_context_split.read node_ctxt.store.last_context_split_level
+
 let save_gc_info node_ctxt ~at_level ~gc_level =
   let open Lwt_syntax in
   (* Note: Setting the `first_available_level` before GC succeeds simplifies the
@@ -929,6 +932,9 @@ let save_gc_info node_ctxt ~at_level ~gc_level =
   | Error _ -> Event.gc_levels_storage_failure ()
   | Ok () -> return_unit
 
+let save_context_split_level node_ctxt level =
+  Store.Last_context_split.write node_ctxt.store.last_context_split_level level
+
 let get_gc_level node_ctxt =
   let open Lwt_result_syntax in
   let* history_mode = Store.History_mode.read node_ctxt.store.history_mode in
@@ -950,7 +956,7 @@ let gc node_ctxt ~(level : int32) =
      called. *)
   let* gc_level = get_gc_level node_ctxt in
   let frequency = node_ctxt.config.gc_parameters.frequency_in_blocks in
-  let* {last_gc_level; first_available_level} = get_gc_levels node_ctxt in
+  let* {last_gc_level; first_available_level; _} = get_gc_levels node_ctxt in
   match gc_level with
   | None -> return_unit
   | Some gc_level
diff --git a/src/lib_smart_rollup_node/node_context.mli b/src/lib_smart_rollup_node/node_context.mli
index d941bf9bcc3d..c91d0329fc49 100644
--- a/src/lib_smart_rollup_node/node_context.mli
+++ b/src/lib_smart_rollup_node/node_context.mli
@@ -544,6 +544,10 @@ val get_gc_levels : _ t -> Store.Gc_levels.levels tzresult Lwt.t
     [level] is before the first non garbage collected level. *)
 val check_level_available : _ t -> int32 -> unit tzresult Lwt.t
 
+val get_last_context_split_level : _ t -> int32 option tzresult Lwt.t
+
+val save_context_split_level : rw -> int32 -> unit tzresult Lwt.t
+
 (** {2 Helpers} *)
 
 (** [make_kernel_logger event ?log_kernel_debug_file logs_dir] returns two
diff --git a/src/lib_smart_rollup_node/rollup_node_daemon.ml b/src/lib_smart_rollup_node/rollup_node_daemon.ml
index 346722055b46..9141cc0163ad 100644
--- a/src/lib_smart_rollup_node/rollup_node_daemon.ml
+++ b/src/lib_smart_rollup_node/rollup_node_daemon.ml
@@ -82,6 +82,16 @@ let handle_protocol_migration ~catching_up state (head : Layer1.header) =
   state.node_ctxt.current_protocol <- new_protocol ;
   return_unit
 
+let maybe_split_context node_ctxt commitment_hash head_level =
+  let open Lwt_result_syntax in
+  let* history_mode = Node_context.get_history_mode node_ctxt in
+  let commit_is_gc_candidate =
+    history_mode <> Archive && Option.is_some commitment_hash
+  in
+  when_ commit_is_gc_candidate @@ fun () ->
+  Context.split node_ctxt.context ;
+  Node_context.save_context_split_level node_ctxt head_level
+
 (* Process a L1 that we have never seen and for which we have processed the
    predecessor. *)
 let process_unseen_head ({node_ctxt; _} as state) ~catching_up ~predecessor
@@ -123,11 +133,7 @@ let process_unseen_head ({node_ctxt; _} as state) ~catching_up ~predecessor
       head
       ctxt
   in
-  let* history_mode = Node_context.get_history_mode node_ctxt in
-  let commit_is_gc_candidate =
-    history_mode <> Archive && Option.is_some commitment_hash
-  in
-  if commit_is_gc_candidate then Context.split node_ctxt.context ;
+  let* () = maybe_split_context node_ctxt commitment_hash head.level in
   let* () =
     unless (catching_up && Option.is_none commitment_hash) @@ fun () ->
     Plugin.Inbox.same_as_layer_1 node_ctxt head.hash inbox
diff --git a/src/lib_smart_rollup_node/rpc_directory.ml b/src/lib_smart_rollup_node/rpc_directory.ml
index f1b2d0f197c4..7863f6513314 100644
--- a/src/lib_smart_rollup_node/rpc_directory.ml
+++ b/src/lib_smart_rollup_node/rpc_directory.ml
@@ -176,10 +176,14 @@ let () =
   Local_directory.register0 Rollup_node_services.Local.gc_info
   @@ fun node_ctxt () () ->
   let open Lwt_result_syntax in
-  let+ {last_gc_level; first_available_level} =
+  let* {last_gc_level; first_available_level} =
     Node_context.get_gc_levels node_ctxt
+  and* last_context_split_level =
+    Node_context.get_last_context_split_level node_ctxt
   in
-  Rollup_node_services.{last_gc_level; first_available_level}
+  return
+    Rollup_node_services.
+      {last_gc_level; first_available_level; last_context_split_level}
 
 let () =
   Local_directory.register0 Rollup_node_services.Local.injection
diff --git a/src/lib_smart_rollup_node/store_v2.ml b/src/lib_smart_rollup_node/store_v2.ml
index e92cd2753ef3..d1c5f725254f 100644
--- a/src/lib_smart_rollup_node/store_v2.ml
+++ b/src/lib_smart_rollup_node/store_v2.ml
@@ -311,6 +311,14 @@ module Gc_levels = struct
   end)
 end
 
+module Last_context_split = Indexed_store.Make_singleton (struct
+  type t = int32
+
+  let name = "last_context_split_level"
+
+  let encoding = Data_encoding.int32
+end)
+
 module History_mode = Indexed_store.Make_singleton (struct
   type t = Configuration.history_mode
 
@@ -333,6 +341,7 @@ type 'a store = {
   protocols : 'a Protocols.t;
   irmin_store : 'a Irmin_store.t;
   gc_levels : 'a Gc_levels.t;
+  last_context_split_level : 'a Last_context_split.t;
   history_mode : 'a History_mode.t;
 }
 
@@ -357,6 +366,7 @@ let readonly
        protocols;
        irmin_store;
        gc_levels;
+       last_context_split_level;
        history_mode;
      } :
       _ t) : ro =
@@ -375,6 +385,8 @@ let readonly
     protocols = Protocols.readonly protocols;
     irmin_store = Irmin_store.readonly irmin_store;
     gc_levels = Gc_levels.readonly gc_levels;
+    last_context_split_level =
+      Last_context_split.readonly last_context_split_level;
     history_mode = History_mode.readonly history_mode;
   }
 
@@ -393,6 +405,7 @@ let close
        protocols = _;
        irmin_store;
        gc_levels = _;
+       last_context_split_level = _;
        history_mode = _;
      } :
       _ t) =
@@ -447,6 +460,9 @@ let load (type a) (mode : a mode) ~index_buffer_size ~l2_blocks_cache_size
   in
   let* protocols = Protocols.load mode ~path:(path "protocols") in
   let* gc_levels = Gc_levels.load mode ~path:(path "gc_levels") in
+  let* last_context_split_level =
+    Last_context_split.load mode ~path:(path "last_context_split_level")
+  in
   let* history_mode = History_mode.load mode ~path:(path "history_mode") in
   let+ irmin_store = Irmin_store.load mode (path "irmin_store") in
   {
@@ -463,6 +479,7 @@ let load (type a) (mode : a mode) ~index_buffer_size ~l2_blocks_cache_size
     protocols;
     irmin_store;
     gc_levels;
+    last_context_split_level;
     history_mode;
   }
 
@@ -558,6 +575,7 @@ let gc
        irmin_store = _;
        protocols = _;
        gc_levels = _;
+       last_context_split_level = _;
        history_mode = _;
      } :
       _ t) ~level =
@@ -590,6 +608,7 @@ let wait_gc_completion
        irmin_store = _;
        protocols = _;
        gc_levels = _;
+       last_context_split_level = _;
        history_mode = _;
      } :
       _ t) =
@@ -619,6 +638,7 @@ let is_gc_finished
        irmin_store = _;
        protocols = _;
        gc_levels = _;
+       last_context_split_level = _;
        history_mode = _;
      } :
       _ t) =
diff --git a/src/lib_smart_rollup_node/store_v2.mli b/src/lib_smart_rollup_node/store_v2.mli
index 9f0ebb9d57af..e643f896402b 100644
--- a/src/lib_smart_rollup_node/store_v2.mli
+++ b/src/lib_smart_rollup_node/store_v2.mli
@@ -124,6 +124,9 @@ module Gc_levels : sig
   include SINGLETON_STORE with type value = levels
 end
 
+(** Level at which context was last split. *)
+module Last_context_split : SINGLETON_STORE with type value := int32
+
 (** History mode of the rollup node. *)
 module History_mode :
   SINGLETON_STORE with type value := Configuration.history_mode
@@ -142,6 +145,7 @@ type +'a store = {
   protocols : 'a Protocols.t;
   irmin_store : 'a Irmin_store.t;
   gc_levels : 'a Gc_levels.t;
+  last_context_split_level : 'a Last_context_split.t;
   history_mode : 'a History_mode.t;
 }
 
-- 
GitLab


From 3ff4f49ba4d9c7824793ff33ed706887c6eafa88 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Thu, 11 Jan 2024 16:16:14 +0100
Subject: [PATCH 2/4] Rollup node: only split context every challenge window at
 most

---
 src/lib_smart_rollup_node/rollup_node_daemon.ml | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/lib_smart_rollup_node/rollup_node_daemon.ml b/src/lib_smart_rollup_node/rollup_node_daemon.ml
index 9141cc0163ad..7f091d91e6fb 100644
--- a/src/lib_smart_rollup_node/rollup_node_daemon.ml
+++ b/src/lib_smart_rollup_node/rollup_node_daemon.ml
@@ -89,8 +89,14 @@ let maybe_split_context node_ctxt commitment_hash head_level =
     history_mode <> Archive && Option.is_some commitment_hash
   in
   when_ commit_is_gc_candidate @@ fun () ->
-  Context.split node_ctxt.context ;
-  Node_context.save_context_split_level node_ctxt head_level
+  let* last = Node_context.get_last_context_split_level node_ctxt in
+  let last = Option.value last ~default:node_ctxt.genesis_info.level in
+  if Int32.(to_int @@ sub head_level last) >=
+    node_ctxt.current_protocol.constants.sc_rollup
+          .challenge_window_in_blocks then (
+    Context.split node_ctxt.context ;
+    Node_context.save_context_split_level node_ctxt head_level)
+  else return_unit
 
 (* Process a L1 that we have never seen and for which we have processed the
    predecessor. *)
-- 
GitLab


From cc78ffe5aadae3c2e1dc5d1003f928685dbfe0f8 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Mon, 15 Jan 2024 10:59:46 +0100
Subject: [PATCH 3/4] Rollup node: configuration option for context splitting
 period

---
 src/lib_smart_rollup_node/configuration.ml    | 19 +++++++++++++++----
 src/lib_smart_rollup_node/configuration.mli   |  6 +++++-
 .../rollup_node_daemon.ml                     | 11 ++++++++---
 3 files changed, 28 insertions(+), 8 deletions(-)

diff --git a/src/lib_smart_rollup_node/configuration.ml b/src/lib_smart_rollup_node/configuration.ml
index 311c711647ad..744aa06115ff 100644
--- a/src/lib_smart_rollup_node/configuration.ml
+++ b/src/lib_smart_rollup_node/configuration.ml
@@ -43,7 +43,10 @@ type batcher = {
 
 type injector = {retention_period : int; attempts : int; injection_ttl : int}
 
-type gc_parameters = {frequency_in_blocks : int32}
+type gc_parameters = {
+  frequency_in_blocks : int32;
+  context_splitting_period : int option;
+}
 
 type history_mode = Archive | Full
 
@@ -216,6 +219,7 @@ let default_gc_parameters =
     (* TODO: https://gitlab.com/tezos/tezos/-/issues/6415
      * Refine the default GC frequency parameter *)
     frequency_in_blocks = 100l;
+    context_splitting_period = None;
   }
 
 (* TODO: https://gitlab.com/tezos/tezos/-/issues/6576
@@ -377,9 +381,13 @@ let injector_encoding : injector Data_encoding.t =
 let gc_parameters_encoding : gc_parameters Data_encoding.t =
   let open Data_encoding in
   conv
-    (fun {frequency_in_blocks} -> frequency_in_blocks)
-    (fun frequency_in_blocks -> {frequency_in_blocks})
-  @@ obj1 (dft "frequency" int32 default_gc_parameters.frequency_in_blocks)
+    (fun {frequency_in_blocks; context_splitting_period} ->
+      (frequency_in_blocks, context_splitting_period))
+    (fun (frequency_in_blocks, context_splitting_period) ->
+      {frequency_in_blocks; context_splitting_period})
+  @@ obj2
+       (dft "frequency" int32 default_gc_parameters.frequency_in_blocks)
+       (opt "context_splitting_period" int31)
 
 let history_mode_encoding : history_mode Data_encoding.t =
   Data_encoding.string_enum [("archive", Archive); ("full", Full)]
@@ -712,6 +720,7 @@ module Cli = struct
             Option.value
               ~default:default_gc_parameters.frequency_in_blocks
               gc_frequency;
+          context_splitting_period = None;
         };
       history_mode;
       cors =
@@ -793,6 +802,8 @@ module Cli = struct
               Option.value
                 ~default:configuration.gc_parameters.frequency_in_blocks
                 gc_frequency;
+            context_splitting_period =
+              configuration.gc_parameters.context_splitting_period;
           };
         history_mode = Option.either history_mode configuration.history_mode;
         cors =
diff --git a/src/lib_smart_rollup_node/configuration.mli b/src/lib_smart_rollup_node/configuration.mli
index c933ea0c9c63..bbf8c96c7336 100644
--- a/src/lib_smart_rollup_node/configuration.mli
+++ b/src/lib_smart_rollup_node/configuration.mli
@@ -66,7 +66,11 @@ type injector = {
           never included is retried. *)
 }
 
-type gc_parameters = {frequency_in_blocks : int32}
+type gc_parameters = {
+  frequency_in_blocks : int32;  (** Frequency at which the GC is triggered. *)
+  context_splitting_period : int option;
+      (** Number of blocks before splitting the context. *)
+}
 
 type history_mode =
   | Archive
diff --git a/src/lib_smart_rollup_node/rollup_node_daemon.ml b/src/lib_smart_rollup_node/rollup_node_daemon.ml
index 7f091d91e6fb..d237709a1c00 100644
--- a/src/lib_smart_rollup_node/rollup_node_daemon.ml
+++ b/src/lib_smart_rollup_node/rollup_node_daemon.ml
@@ -91,9 +91,14 @@ let maybe_split_context node_ctxt commitment_hash head_level =
   when_ commit_is_gc_candidate @@ fun () ->
   let* last = Node_context.get_last_context_split_level node_ctxt in
   let last = Option.value last ~default:node_ctxt.genesis_info.level in
-  if Int32.(to_int @@ sub head_level last) >=
-    node_ctxt.current_protocol.constants.sc_rollup
-          .challenge_window_in_blocks then (
+  let splitting_period =
+    Option.value
+      node_ctxt.config.gc_parameters.context_splitting_period
+      ~default:
+        node_ctxt.current_protocol.constants.sc_rollup
+          .challenge_window_in_blocks
+  in
+  if Int32.(to_int @@ sub head_level last) >= splitting_period then (
     Context.split node_ctxt.context ;
     Node_context.save_context_split_level node_ctxt head_level)
   else return_unit
-- 
GitLab


From 4da2dcfc29dea123fa6f7b71cbcff6c3591e1d61 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Mon, 15 Jan 2024 14:59:13 +0100
Subject: [PATCH 4/4] Test: ensure context is not split more than each
 challenge window

---
 tezt/tests/sc_rollup.ml | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/tezt/tests/sc_rollup.ml b/tezt/tests/sc_rollup.ml
index dfd311f5c284..e3cbfbd8bd44 100644
--- a/tezt/tests/sc_rollup.ml
+++ b/tezt/tests/sc_rollup.ml
@@ -992,6 +992,24 @@ let test_gc variant ?(tags = []) ~challenge_window ~commitment_period
         "Commitment was published but publication info is not available \
          anymore."
   | _ -> ()) ;
+  let* context_files =
+    Process.run_and_read_stdout
+      "ls"
+      [Sc_rollup_node.data_dir sc_rollup_node ^ "/context/"]
+  in
+  let last_suffix =
+    String.split_on_char '\n' context_files
+    |> List.filter_map (fun s -> s =~* rex "store\\.(\\d+)\\.suffix")
+    |> List.rev |> List.hd
+  in
+  let nb_suffix = int_of_string last_suffix in
+  let max_nb_split =
+    match history_mode with
+    | Archive -> 0
+    | _ -> (level - origination_level + challenge_window - 1) / challenge_window
+  in
+  Check.((nb_suffix <= max_nb_split) int)
+    ~error_msg:"Expected at most %R context suffix files, instead got %L" ;
   unit
 
 (* Testing that snapshots can be exported correctly for a running node, and that
-- 
GitLab