From fd0a7282aedaa3b7f364da7ff33651cb90a33e9f Mon Sep 17 00:00:00 2001
From: Anne-Laure <al.schmitt@protonmail.com>
Date: Wed, 20 Mar 2024 18:36:54 +0100
Subject: [PATCH 1/7] DAL: Implement a GC for old shards

Co-authored-by:  <francois.thire@nomadic-labs.com>
---
 src/bin_dal_node/configuration_file.ml        | 48 +++++++++++++++++--
 src/bin_dal_node/configuration_file.mli       |  9 ++++
 src/bin_dal_node/daemon.ml                    | 32 ++++++++++++-
 src/bin_dal_node/node_context.ml              | 18 +++++++
 src/bin_dal_node/node_context.mli             |  5 ++
 src/bin_dal_node/store.ml                     |  2 +
 src/bin_dal_node/store.mli                    |  4 ++
 src/lib_dal_node/dal_plugin.ml                |  1 +
 src/lib_dal_node/dal_plugin.mli               |  1 +
 src/lib_stdlib_unix/key_value_store.mli       |  2 +-
 .../lib_dal/dal_plugin_registration.ml        |  2 +
 .../lib_dal/dal_plugin_registration.ml        |  2 +
 .../lib_dal/dal_plugin_registration.ml        |  3 ++
 13 files changed, 124 insertions(+), 5 deletions(-)

diff --git a/src/bin_dal_node/configuration_file.ml b/src/bin_dal_node/configuration_file.ml
index 2f4306a65592..e8943f1709f7 100644
--- a/src/bin_dal_node/configuration_file.ml
+++ b/src/bin_dal_node/configuration_file.ml
@@ -25,6 +25,37 @@
 
 type neighbor = {addr : string; port : int}
 
+type history_mode = Rolling of {blocks : [`Auto | `Some of int]} | Full
+
+let history_mode_encoding =
+  let open Data_encoding in
+  union
+    [
+      case
+        ~title:"rolling"
+        ~description:""
+        (Tag 0)
+        (obj2
+           (req "kind" (Data_encoding.constant "rolling"))
+           (req "blocks" (Data_encoding.option Data_encoding.int31)))
+        (function
+          | Rolling {blocks} -> (
+              match blocks with
+              | `Auto -> Some ((), None)
+              | `Some n -> Some ((), Some n))
+          | Full -> None)
+        (function
+          | (), None -> Rolling {blocks = `Auto}
+          | (), Some n -> Rolling {blocks = `Some n});
+      case
+        ~title:"full"
+        ~description:""
+        (Tag 1)
+        (obj1 (req "kind" (Data_encoding.constant "full")))
+        (function Full -> Some () | _ -> None)
+        (fun () -> Full);
+    ]
+
 type t = {
   data_dir : string;
   rpc_addr : P2p_point.Id.t;
@@ -37,6 +68,7 @@ type t = {
   endpoint : Uri.t;
   metrics_addr : P2p_point.Id.t;
   profiles : Types.profiles;
+  history_mode : history_mode;
 }
 
 let default_data_dir = Filename.concat (Sys.getenv "HOME") ".tezos-dal-node"
@@ -68,6 +100,8 @@ let default_metrics_port =
 let default_metrics_addr =
   P2p_point.Id.of_string_exn ~default_port:default_metrics_port "0.0.0.0"
 
+let default_history_mode = Rolling {blocks = `Auto}
+
 let default =
   {
     data_dir = default_data_dir;
@@ -80,6 +114,7 @@ let default =
     network_name = default_network_name;
     endpoint = default_endpoint;
     metrics_addr = default_metrics_addr;
+    history_mode = Rolling {blocks = `Auto};
     profiles = Operator [];
   }
 
@@ -118,6 +153,7 @@ let encoding : t Data_encoding.t =
            network_name;
            endpoint;
            metrics_addr;
+           history_mode;
            profiles;
          } ->
       ( ( data_dir,
@@ -130,7 +166,7 @@ let encoding : t Data_encoding.t =
           network_name,
           endpoint,
           metrics_addr ),
-        profiles ))
+        (history_mode, profiles) ))
     (fun ( ( data_dir,
              rpc_addr,
              listen_addr,
@@ -141,7 +177,7 @@ let encoding : t Data_encoding.t =
              network_name,
              endpoint,
              metrics_addr ),
-           profiles ) ->
+           (history_mode, profiles) ) ->
       {
         data_dir;
         rpc_addr;
@@ -153,6 +189,7 @@ let encoding : t Data_encoding.t =
         network_name;
         endpoint;
         metrics_addr;
+        history_mode;
         profiles;
       })
     (merge_objs
@@ -207,7 +244,12 @@ let encoding : t Data_encoding.t =
              ~description:"The point for the DAL node metrics server"
              P2p_point.Id.encoding
              default_metrics_addr))
-       (obj1
+       (obj2
+          (dft
+             "history_mode"
+             ~description:"The history mode for the DAL node"
+             history_mode_encoding
+             default_history_mode)
           (dft
              "profiles"
              ~description:"The Octez DAL node profiles"
diff --git a/src/bin_dal_node/configuration_file.mli b/src/bin_dal_node/configuration_file.mli
index de3b2b611152..a864de69d8a1 100644
--- a/src/bin_dal_node/configuration_file.mli
+++ b/src/bin_dal_node/configuration_file.mli
@@ -25,6 +25,14 @@
 
 type neighbor = {addr : string; port : int}
 
+(** The history mode decides for how long shards are kept in the store. *)
+type history_mode =
+  | Rolling of {blocks : [`Auto | `Some of int]}
+      (** [Rolling {block = `Some n}] keeps the shards for about [n]
+          blocks. [Rolling {block = `Auto}] infers the number of
+          blocks depending on the L1 parametric constants. *)
+  | Full  (** [Full] keeps the shards forever *)
+
 type t = {
   data_dir : string;  (** The path to the DAL node data directory. *)
   rpc_addr : P2p_point.Id.t;
@@ -47,6 +55,7 @@ type t = {
       (** The TCP address of the node's server used to export metrics. *)
   profiles : Types.profiles;
       (** The profiles determining the topics of interest. *)
+  history_mode : history_mode;
 }
 
 (** [default] is the default configuration. *)
diff --git a/src/bin_dal_node/daemon.ml b/src/bin_dal_node/daemon.ml
index a97298f41673..11f8470ce081 100644
--- a/src/bin_dal_node/daemon.ml
+++ b/src/bin_dal_node/daemon.ml
@@ -404,7 +404,37 @@ module Handler = struct
                cryptobox
                head_level
                proto_parameters.attestation_lag) ;
-
+          let oldest_level =
+            Node_context.get_oldest_stored_shard_level
+              ctxt
+              ~current_level:head_level
+          in
+          let number_of_slots = proto_parameters.number_of_slots in
+          let store = Node_context.get_store ctxt in
+          let*! commitments =
+            List.filter_map_s
+              (fun slot_index ->
+                let open Lwt_syntax in
+                let* result =
+                  Slot_manager.get_commitment_by_published_level_and_index
+                    ~level:oldest_level
+                    ~slot_index
+                    store
+                in
+                match result with
+                | Error `Not_found -> return_none
+                | Error (`Decoding_failed _) ->
+                    return_none (* TODO: add a warning *)
+                | Ok commitment -> return_some commitment)
+              (Seq.ints 0 |> Stdlib.Seq.take number_of_slots |> List.of_seq)
+          in
+          (* Check cache probably *)
+          let* () =
+            List.iter_es
+              (fun commitment ->
+                Store.Shards.remove store.shard_store commitment)
+              commitments
+          in
           let process_block block_level =
             let block = `Level block_level in
             let* block_info =
diff --git a/src/bin_dal_node/node_context.ml b/src/bin_dal_node/node_context.ml
index d1b4172386f9..8bf23cad6c20 100644
--- a/src/bin_dal_node/node_context.ml
+++ b/src/bin_dal_node/node_context.ml
@@ -106,6 +106,24 @@ let update_plugin_in_ready ctxt plugin proto =
   | Ready ready_ctxt ->
       ctxt.status <- Ready {ready_ctxt with plugin; plugin_proto = proto}
 
+let get_oldest_stored_shard_level ctxt ~current_level =
+  match ctxt.config.history_mode with
+  | Full -> Int32.zero
+  | Rolling {blocks = `Some n} ->
+      Int32.(max zero (sub current_level (of_int n)))
+  | Rolling {blocks = `Auto} -> (
+      match ctxt.status with
+      | Starting -> Int32.zero
+      | Ready ready_ctxt ->
+          let n =
+            (* Let's give it 10 blocks of slack just in case
+               (finalisation period, of by one, attestation_lag,
+               ...). *)
+            ready_ctxt.proto_parameters.sc_rollup_challenge_window_in_blocks
+            + 10
+          in
+          Int32.(max zero (sub current_level (of_int n))))
+
 type error += Node_not_ready
 
 let () =
diff --git a/src/bin_dal_node/node_context.mli b/src/bin_dal_node/node_context.mli
index acafdcba0278..56e044776cda 100644
--- a/src/bin_dal_node/node_context.mli
+++ b/src/bin_dal_node/node_context.mli
@@ -126,6 +126,11 @@ val get_tezos_node_cctxt : t -> Tezos_rpc.Context.generic
 (** [get_neighbors_cctxts ctxt] returns the dal node neighbors client contexts *)
 val get_neighbors_cctxts : t -> Dal_node_client.cctxt list
 
+(** [get_oldest_stored_shard_level ctxt ~current_level] returns the oldest
+    level that should have shards stored; during [current_level], shards for
+    commitments published at this level will be removed *)
+val get_oldest_stored_shard_level : t -> current_level:int32 -> int32
+
 (** [fetch_assigned_shard_indices ctxt ~level ~pkh] fetches from L1 the shard
     indices assigned to [pkh] at [level].  It internally caches the DAL
     committee with [level] as the key with FIFO strategy. *)
diff --git a/src/bin_dal_node/store.ml b/src/bin_dal_node/store.ml
index 781b98f41db8..c1cf7314ba5e 100644
--- a/src/bin_dal_node/store.ml
+++ b/src/bin_dal_node/store.ml
@@ -145,6 +145,8 @@ module Shards = struct
   let count_values store commitment =
     KVS.count_values store file_layout commitment
 
+  let remove store commitment = KVS.remove_file store file_layout commitment
+
   let init node_store_dir shard_store_dir =
     let root_dir = Filename.concat node_store_dir shard_store_dir in
     KVS.init ~lru_size:Constants.shards_store_lru_size ~root_dir
diff --git a/src/bin_dal_node/store.mli b/src/bin_dal_node/store.mli
index e0e30bbae122..5919c87db3c8 100644
--- a/src/bin_dal_node/store.mli
+++ b/src/bin_dal_node/store.mli
@@ -61,6 +61,10 @@ module Shards : sig
   (** [count_values store commitment] returns the number of shards
       which are stored for the given commitment. *)
   val count_values : t -> commitment -> int tzresult Lwt.t
+
+  (** [remove store commitment] removes the shards associated to the given
+      commitment from the store *)
+  val remove : t -> commitment -> unit tzresult Lwt.t
 end
 
 module Shard_proofs_cache : sig
diff --git a/src/lib_dal_node/dal_plugin.ml b/src/lib_dal_node/dal_plugin.ml
index 21b459d93bf5..4fe51980a21e 100644
--- a/src/lib_dal_node/dal_plugin.ml
+++ b/src/lib_dal_node/dal_plugin.ml
@@ -40,6 +40,7 @@ type proto_parameters = {
   attestation_lag : int;
   attestation_threshold : int;
   cryptobox_parameters : Tezos_crypto_dal.Cryptobox.Verifier.parameters;
+  sc_rollup_challenge_window_in_blocks : int;
 }
 
 module type T = sig
diff --git a/src/lib_dal_node/dal_plugin.mli b/src/lib_dal_node/dal_plugin.mli
index 4a595b9a35f7..3cb323a27069 100644
--- a/src/lib_dal_node/dal_plugin.mli
+++ b/src/lib_dal_node/dal_plugin.mli
@@ -49,6 +49,7 @@ type proto_parameters = {
   attestation_lag : int;
   attestation_threshold : int;
   cryptobox_parameters : Tezos_crypto_dal.Cryptobox.Verifier.parameters;
+  sc_rollup_challenge_window_in_blocks : int;
 }
 
 module type T = sig
diff --git a/src/lib_stdlib_unix/key_value_store.mli b/src/lib_stdlib_unix/key_value_store.mli
index afb867971792..90763c3f0bbd 100644
--- a/src/lib_stdlib_unix/key_value_store.mli
+++ b/src/lib_stdlib_unix/key_value_store.mli
@@ -180,7 +180,7 @@ val values_exist :
     the store. In case of concurrent read/write, this function should
     succeed no matter what. The result of [read/write] depends on
     which function was issued first. For example if the [read] was
-    issued before the [remove_file], it will returns the corresponding
+    issued before the [remove_file], it will return the corresponding
     value that was stored, and then the file will be removed. *)
 val remove_file :
   ('file, 'key, 'value) t ->
diff --git a/src/proto_018_Proxford/lib_dal/dal_plugin_registration.ml b/src/proto_018_Proxford/lib_dal/dal_plugin_registration.ml
index 446ad369c124..479496978f69 100644
--- a/src/proto_018_Proxford/lib_dal/dal_plugin_registration.ml
+++ b/src/proto_018_Proxford/lib_dal/dal_plugin_registration.ml
@@ -56,6 +56,8 @@ module Plugin = struct
         attestation_lag;
         attestation_threshold;
         cryptobox_parameters;
+        sc_rollup_challenge_window_in_blocks =
+          parametric.sc_rollup.challenge_window_in_blocks;
       }
 
   let block_info ?chain ?block ~metadata ctxt =
diff --git a/src/proto_019_PtParisA/lib_dal/dal_plugin_registration.ml b/src/proto_019_PtParisA/lib_dal/dal_plugin_registration.ml
index bf5e1329c9d1..3df6477e64ad 100644
--- a/src/proto_019_PtParisA/lib_dal/dal_plugin_registration.ml
+++ b/src/proto_019_PtParisA/lib_dal/dal_plugin_registration.ml
@@ -58,6 +58,8 @@ module Plugin = struct
         attestation_lag;
         attestation_threshold;
         cryptobox_parameters;
+        sc_rollup_challenge_window_in_blocks =
+          parametric.sc_rollup.challenge_window_in_blocks;
       }
 
   let block_info ?chain ?block ~metadata ctxt =
diff --git a/src/proto_alpha/lib_dal/dal_plugin_registration.ml b/src/proto_alpha/lib_dal/dal_plugin_registration.ml
index bf5e1329c9d1..458757ae6269 100644
--- a/src/proto_alpha/lib_dal/dal_plugin_registration.ml
+++ b/src/proto_alpha/lib_dal/dal_plugin_registration.ml
@@ -50,6 +50,7 @@ module Plugin = struct
     } =
       parametric.dal
     in
+
     return
       {
         Dal_plugin.feature_enable;
@@ -58,6 +59,8 @@ module Plugin = struct
         attestation_lag;
         attestation_threshold;
         cryptobox_parameters;
+        sc_rollup_challenge_window_in_blocks =
+          parametric.sc_rollup.challenge_window_in_blocks;
       }
 
   let block_info ?chain ?block ~metadata ctxt =
-- 
GitLab


From 88d843a1819ef802a15f10bc17bffc81246194b4 Mon Sep 17 00:00:00 2001
From: Anne-Laure <al.schmitt@protonmail.com>
Date: Tue, 2 Apr 2024 16:16:33 +0200
Subject: [PATCH 2/7] Dal_node/Node_context: rename
 get_oldest_stored_shard_level into next_shards_level_to_gc

---
 src/bin_dal_node/daemon.ml        | 4 +---
 src/bin_dal_node/node_context.ml  | 2 +-
 src/bin_dal_node/node_context.mli | 4 ++--
 3 files changed, 4 insertions(+), 6 deletions(-)

diff --git a/src/bin_dal_node/daemon.ml b/src/bin_dal_node/daemon.ml
index 11f8470ce081..6e8ee53e9c69 100644
--- a/src/bin_dal_node/daemon.ml
+++ b/src/bin_dal_node/daemon.ml
@@ -405,9 +405,7 @@ module Handler = struct
                head_level
                proto_parameters.attestation_lag) ;
           let oldest_level =
-            Node_context.get_oldest_stored_shard_level
-              ctxt
-              ~current_level:head_level
+            Node_context.next_shards_level_to_gc ctxt ~current_level:head_level
           in
           let number_of_slots = proto_parameters.number_of_slots in
           let store = Node_context.get_store ctxt in
diff --git a/src/bin_dal_node/node_context.ml b/src/bin_dal_node/node_context.ml
index 8bf23cad6c20..5d4ffe8abc62 100644
--- a/src/bin_dal_node/node_context.ml
+++ b/src/bin_dal_node/node_context.ml
@@ -106,7 +106,7 @@ let update_plugin_in_ready ctxt plugin proto =
   | Ready ready_ctxt ->
       ctxt.status <- Ready {ready_ctxt with plugin; plugin_proto = proto}
 
-let get_oldest_stored_shard_level ctxt ~current_level =
+let next_shards_level_to_gc ctxt ~current_level =
   match ctxt.config.history_mode with
   | Full -> Int32.zero
   | Rolling {blocks = `Some n} ->
diff --git a/src/bin_dal_node/node_context.mli b/src/bin_dal_node/node_context.mli
index 56e044776cda..015d579f4d4b 100644
--- a/src/bin_dal_node/node_context.mli
+++ b/src/bin_dal_node/node_context.mli
@@ -126,10 +126,10 @@ val get_tezos_node_cctxt : t -> Tezos_rpc.Context.generic
 (** [get_neighbors_cctxts ctxt] returns the dal node neighbors client contexts *)
 val get_neighbors_cctxts : t -> Dal_node_client.cctxt list
 
-(** [get_oldest_stored_shard_level ctxt ~current_level] returns the oldest
+(** [next_shards_level_to_gc ctxt ~current_level] returns the oldest
     level that should have shards stored; during [current_level], shards for
     commitments published at this level will be removed *)
-val get_oldest_stored_shard_level : t -> current_level:int32 -> int32
+val next_shards_level_to_gc : t -> current_level:int32 -> int32
 
 (** [fetch_assigned_shard_indices ctxt ~level ~pkh] fetches from L1 the shard
     indices assigned to [pkh] at [level].  It internally caches the DAL
-- 
GitLab


From c99ad33a12d7991728b91dcccd54f6a75b5f6832 Mon Sep 17 00:00:00 2001
From: Anne-Laure <al.schmitt@protonmail.com>
Date: Tue, 2 Apr 2024 12:08:45 +0200
Subject: [PATCH 3/7] Dal_plugin: export `commitment_period_in_blocks` &
 `dal_attested_slots_validity_lag` to use them in Dal_node/Node_context

---
 src/bin_dal_node/node_context.ml                 | 16 ++++++++++------
 src/lib_dal_node/dal_plugin.ml                   |  2 ++
 src/lib_dal_node/dal_plugin.mli                  |  2 ++
 .../lib_dal/dal_plugin_registration.ml           |  3 +++
 .../lib_dal/dal_plugin_registration.ml           |  5 +++++
 .../lib_dal/dal_plugin_registration.ml           |  5 +++++
 6 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/src/bin_dal_node/node_context.ml b/src/bin_dal_node/node_context.ml
index 5d4ffe8abc62..babd3ebe7367 100644
--- a/src/bin_dal_node/node_context.ml
+++ b/src/bin_dal_node/node_context.ml
@@ -114,13 +114,17 @@ let next_shards_level_to_gc ctxt ~current_level =
   | Rolling {blocks = `Auto} -> (
       match ctxt.status with
       | Starting -> Int32.zero
-      | Ready ready_ctxt ->
+      | Ready {proto_parameters; _} ->
           let n =
-            (* Let's give it 10 blocks of slack just in case
-               (finalisation period, of by one, attestation_lag,
-               ...). *)
-            ready_ctxt.proto_parameters.sc_rollup_challenge_window_in_blocks
-            + 10
+            let needed_period =
+              proto_parameters.sc_rollup_challenge_window_in_blocks
+              + proto_parameters.commitment_period_in_blocks
+              + proto_parameters.dal_attested_slots_validity_lag
+            in
+            (* We double the period, to give some slack just in case
+               (finalisation period, off by one, attestation_lag, ...).
+               With current mainnet parameters, this total period is 3 months. *)
+            needed_period * 2
           in
           Int32.(max zero (sub current_level (of_int n))))
 
diff --git a/src/lib_dal_node/dal_plugin.ml b/src/lib_dal_node/dal_plugin.ml
index 4fe51980a21e..c5231999b1a4 100644
--- a/src/lib_dal_node/dal_plugin.ml
+++ b/src/lib_dal_node/dal_plugin.ml
@@ -41,6 +41,8 @@ type proto_parameters = {
   attestation_threshold : int;
   cryptobox_parameters : Tezos_crypto_dal.Cryptobox.Verifier.parameters;
   sc_rollup_challenge_window_in_blocks : int;
+  commitment_period_in_blocks : int;
+  dal_attested_slots_validity_lag : int;
 }
 
 module type T = sig
diff --git a/src/lib_dal_node/dal_plugin.mli b/src/lib_dal_node/dal_plugin.mli
index 3cb323a27069..ad3c48bb50a6 100644
--- a/src/lib_dal_node/dal_plugin.mli
+++ b/src/lib_dal_node/dal_plugin.mli
@@ -50,6 +50,8 @@ type proto_parameters = {
   attestation_threshold : int;
   cryptobox_parameters : Tezos_crypto_dal.Cryptobox.Verifier.parameters;
   sc_rollup_challenge_window_in_blocks : int;
+  commitment_period_in_blocks : int;
+  dal_attested_slots_validity_lag : int;
 }
 
 module type T = sig
diff --git a/src/proto_018_Proxford/lib_dal/dal_plugin_registration.ml b/src/proto_018_Proxford/lib_dal/dal_plugin_registration.ml
index 479496978f69..1618b806deaa 100644
--- a/src/proto_018_Proxford/lib_dal/dal_plugin_registration.ml
+++ b/src/proto_018_Proxford/lib_dal/dal_plugin_registration.ml
@@ -58,6 +58,9 @@ module Plugin = struct
         cryptobox_parameters;
         sc_rollup_challenge_window_in_blocks =
           parametric.sc_rollup.challenge_window_in_blocks;
+        commitment_period_in_blocks =
+          parametric.sc_rollup.commitment_period_in_blocks;
+        dal_attested_slots_validity_lag = Int.max_int;
       }
 
   let block_info ?chain ?block ~metadata ctxt =
diff --git a/src/proto_019_PtParisA/lib_dal/dal_plugin_registration.ml b/src/proto_019_PtParisA/lib_dal/dal_plugin_registration.ml
index 3df6477e64ad..ffb037f36253 100644
--- a/src/proto_019_PtParisA/lib_dal/dal_plugin_registration.ml
+++ b/src/proto_019_PtParisA/lib_dal/dal_plugin_registration.ml
@@ -60,6 +60,11 @@ module Plugin = struct
         cryptobox_parameters;
         sc_rollup_challenge_window_in_blocks =
           parametric.sc_rollup.challenge_window_in_blocks;
+        commitment_period_in_blocks =
+          parametric.sc_rollup.commitment_period_in_blocks;
+        dal_attested_slots_validity_lag =
+          parametric.sc_rollup.reveal_activation_level
+            .dal_attested_slots_validity_lag;
       }
 
   let block_info ?chain ?block ~metadata ctxt =
diff --git a/src/proto_alpha/lib_dal/dal_plugin_registration.ml b/src/proto_alpha/lib_dal/dal_plugin_registration.ml
index 458757ae6269..85d3c6c8b13c 100644
--- a/src/proto_alpha/lib_dal/dal_plugin_registration.ml
+++ b/src/proto_alpha/lib_dal/dal_plugin_registration.ml
@@ -61,6 +61,11 @@ module Plugin = struct
         cryptobox_parameters;
         sc_rollup_challenge_window_in_blocks =
           parametric.sc_rollup.challenge_window_in_blocks;
+        commitment_period_in_blocks =
+          parametric.sc_rollup.commitment_period_in_blocks;
+        dal_attested_slots_validity_lag =
+          parametric.sc_rollup.reveal_activation_level
+            .dal_attested_slots_validity_lag;
       }
 
   let block_info ?chain ?block ~metadata ctxt =
-- 
GitLab


From 2e23bed66038d26d5ff8326010aab5feb57695c5 Mon Sep 17 00:00:00 2001
From: Anne-Laure <al.schmitt@protonmail.com>
Date: Tue, 2 Apr 2024 16:18:03 +0200
Subject: [PATCH 4/7] Dal_node/Daemon: move code

---
 src/bin_dal_node/daemon.ml | 63 ++++++++++++++++++++------------------
 1 file changed, 34 insertions(+), 29 deletions(-)

diff --git a/src/bin_dal_node/daemon.ml b/src/bin_dal_node/daemon.ml
index 6e8ee53e9c69..585c6d0a6240 100644
--- a/src/bin_dal_node/daemon.ml
+++ b/src/bin_dal_node/daemon.ml
@@ -366,6 +366,39 @@ module Handler = struct
           return_unit
     else return_unit
 
+  (* This function removes the shards corresponding to the commitments at level
+     exactly [Node_context.next_shards_level_to_gc ~head_level]. In the future
+     we may want to remove the shards from all preceeding levels, not only this
+     one. Also, removing could be done more efficiently than iterating on all
+     the slots. *)
+  let remove_old_level_shards proto_parameters ctxt head_level =
+    let open Lwt_result_syntax in
+    let oldest_level =
+      Node_context.next_shards_level_to_gc ctxt ~current_level:head_level
+    in
+    let number_of_slots = Dal_plugin.(proto_parameters.number_of_slots) in
+    let store = Node_context.get_store ctxt in
+    let*! commitments =
+      List.filter_map_s
+        (fun slot_index ->
+          let open Lwt_syntax in
+          let* result =
+            Slot_manager.get_commitment_by_published_level_and_index
+              ~level:oldest_level
+              ~slot_index
+              store
+          in
+          match result with
+          | Error `Not_found -> return_none
+          | Error (`Decoding_failed _) -> return_none (* TODO: add a warning *)
+          | Ok commitment -> return_some commitment)
+        (Seq.ints 0 |> Stdlib.Seq.take number_of_slots |> List.of_seq)
+    in
+    (* Check cache probably *)
+    List.iter_es
+      (fun commitment -> Store.Shards.remove store.shard_store commitment)
+      commitments
+
   (* Monitor heads and store *finalized* published slot headers indexed by block
      hash. A slot header is considered finalized when it is in a block with at
      least two other blocks on top of it, as guaranteed by Tenderbake. Note that
@@ -404,35 +437,7 @@ module Handler = struct
                cryptobox
                head_level
                proto_parameters.attestation_lag) ;
-          let oldest_level =
-            Node_context.next_shards_level_to_gc ctxt ~current_level:head_level
-          in
-          let number_of_slots = proto_parameters.number_of_slots in
-          let store = Node_context.get_store ctxt in
-          let*! commitments =
-            List.filter_map_s
-              (fun slot_index ->
-                let open Lwt_syntax in
-                let* result =
-                  Slot_manager.get_commitment_by_published_level_and_index
-                    ~level:oldest_level
-                    ~slot_index
-                    store
-                in
-                match result with
-                | Error `Not_found -> return_none
-                | Error (`Decoding_failed _) ->
-                    return_none (* TODO: add a warning *)
-                | Ok commitment -> return_some commitment)
-              (Seq.ints 0 |> Stdlib.Seq.take number_of_slots |> List.of_seq)
-          in
-          (* Check cache probably *)
-          let* () =
-            List.iter_es
-              (fun commitment ->
-                Store.Shards.remove store.shard_store commitment)
-              commitments
-          in
+          let* () = remove_old_level_shards proto_parameters ctxt head_level in
           let process_block block_level =
             let block = `Level block_level in
             let* block_info =
-- 
GitLab


From 42b365c00f53f6e1701500a71643a0d166b73c90 Mon Sep 17 00:00:00 2001
From: Anne-Laure <al.schmitt@protonmail.com>
Date: Tue, 2 Apr 2024 15:04:50 +0200
Subject: [PATCH 5/7] Dal_node/Daemon: remove_old_level_shards emit an event
 instead of a warning

---
 src/bin_dal_node/daemon.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/bin_dal_node/daemon.ml b/src/bin_dal_node/daemon.ml
index 585c6d0a6240..8536443940a9 100644
--- a/src/bin_dal_node/daemon.ml
+++ b/src/bin_dal_node/daemon.ml
@@ -390,7 +390,11 @@ module Handler = struct
           in
           match result with
           | Error `Not_found -> return_none
-          | Error (`Decoding_failed _) -> return_none (* TODO: add a warning *)
+          | Error (`Decoding_failed _) ->
+              let*! () =
+                Event.(emit decoding_data_failed Types.Store.Commitment)
+              in
+              return_none
           | Ok commitment -> return_some commitment)
         (Seq.ints 0 |> Stdlib.Seq.take number_of_slots |> List.of_seq)
     in
-- 
GitLab


From 7efb73d8d84b4174600818800d1fe3548fad0a99 Mon Sep 17 00:00:00 2001
From: Anne-Laure <al.schmitt@protonmail.com>
Date: Tue, 2 Apr 2024 16:23:02 +0200
Subject: [PATCH 6/7] Dal_node/Daemon: add TODO

---
 src/bin_dal_node/daemon.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/bin_dal_node/daemon.ml b/src/bin_dal_node/daemon.ml
index 8536443940a9..d28d20692411 100644
--- a/src/bin_dal_node/daemon.ml
+++ b/src/bin_dal_node/daemon.ml
@@ -398,7 +398,9 @@ module Handler = struct
           | Ok commitment -> return_some commitment)
         (Seq.ints 0 |> Stdlib.Seq.take number_of_slots |> List.of_seq)
     in
-    (* Check cache probably *)
+    (* TODO: https://gitlab.com/tezos/tezos/-/issues/7124
+       In case of republication of the same commitment, the shards are removed
+       too early *)
     List.iter_es
       (fun commitment -> Store.Shards.remove store.shard_store commitment)
       commitments
-- 
GitLab


From a157766475e4fcddbab1db64e2fe0d1c618ff3b8 Mon Sep 17 00:00:00 2001
From: Anne-Laure <al.schmitt@protonmail.com>
Date: Tue, 2 Apr 2024 16:23:25 +0200
Subject: [PATCH 7/7] Dal_node/Daemon: use List instead of Seq

---
 src/bin_dal_node/daemon.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/bin_dal_node/daemon.ml b/src/bin_dal_node/daemon.ml
index d28d20692411..c3b84a5f7fa2 100644
--- a/src/bin_dal_node/daemon.ml
+++ b/src/bin_dal_node/daemon.ml
@@ -396,7 +396,7 @@ module Handler = struct
               in
               return_none
           | Ok commitment -> return_some commitment)
-        (Seq.ints 0 |> Stdlib.Seq.take number_of_slots |> List.of_seq)
+        (WithExceptions.List.init ~loc:__LOC__ number_of_slots Fun.id)
     in
     (* TODO: https://gitlab.com/tezos/tezos/-/issues/7124
        In case of republication of the same commitment, the shards are removed
-- 
GitLab