From a5451b18008b0a1f9c777ea7eb139a5c024f106f Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:27:12 +0100
Subject: [PATCH 01/12] Rollup node/Layer1: create Layer1 structure without
 connecting

---
 src/lib_crawler/layer_1.ml           | 27 ++++++++++++++++++++++++++-
 src/lib_crawler/layer_1.mli          | 15 +++++++++++++++
 src/lib_smart_rollup_node/layer1.ml  | 16 ++++++++++++++++
 src/lib_smart_rollup_node/layer1.mli | 10 ++++++++++
 4 files changed, 67 insertions(+), 1 deletion(-)

diff --git a/src/lib_crawler/layer_1.ml b/src/lib_crawler/layer_1.ml
index 90af5ff06abf..d4f767c5ff14 100644
--- a/src/lib_crawler/layer_1.ml
+++ b/src/lib_crawler/layer_1.ml
@@ -141,6 +141,18 @@ let rec connect ~name ?(count = 0) ~delay ~protocols cctxt =
       let* () = Layer1_event.cannot_connect ~name ~count e in
       connect ~name ~delay ~protocols ~count:(count + 1) cctxt
 
+let create ~name ~reconnection_delay ?protocols (cctxt : #Client_context.full) =
+  let heads, _push = Lwt_stream.create () in
+  {
+    name;
+    cctxt = (cctxt :> Client_context.full);
+    heads;
+    stopper = (fun () -> ());
+    reconnection_delay;
+    protocols;
+    running = false;
+  }
+
 let start ~name ~reconnection_delay ?protocols (cctxt : #Client_context.full) =
   let open Lwt_syntax in
   let* () = Layer1_event.starting ~name in
@@ -167,7 +179,20 @@ let reconnect l1_ctxt =
       ~protocols:l1_ctxt.protocols
       l1_ctxt.cctxt
   in
-  return {l1_ctxt with heads; stopper}
+  return {l1_ctxt with heads; stopper; running = true}
+
+let connect l1_ctxt =
+  let open Lwt_result_syntax in
+  if l1_ctxt.running then failwith "Layer_1.connect: Already connected"
+  else
+    let*! heads, stopper =
+      connect
+        ~name:l1_ctxt.name
+        ~delay:l1_ctxt.reconnection_delay
+        ~protocols:l1_ctxt.protocols
+        l1_ctxt.cctxt
+    in
+    return {l1_ctxt with heads; stopper; running = true}
 
 let shutdown state =
   state.stopper () ;
diff --git a/src/lib_crawler/layer_1.mli b/src/lib_crawler/layer_1.mli
index a14f797084cb..f4cfde06cfd2 100644
--- a/src/lib_crawler/layer_1.mli
+++ b/src/lib_crawler/layer_1.mli
@@ -49,6 +49,21 @@ val start :
   #Client_context.full ->
   t Lwt.t
 
+(** [create ~name ~reconnection_delay ?protocols cctxt] creates a Layer 1
+    context without connecting to a Tezos node. Use {!connect} to connect to
+    start monitoring heads. If [protocols] is provided, only heads of these
+    protocols will be monitored. *)
+val create :
+  name:string ->
+  reconnection_delay:float ->
+  ?protocols:Protocol_hash.t list ->
+  #Client_context.full ->
+  t
+
+(** Connect a Layer 1 context created with {!create} to the L1 node for
+    monitoring.  *)
+val connect : t -> t tzresult Lwt.t
+
 (** [shutdown t] properly shuts the layer 1 down. *)
 val shutdown : t -> unit Lwt.t
 
diff --git a/src/lib_smart_rollup_node/layer1.ml b/src/lib_smart_rollup_node/layer1.ml
index 7a3a1157e17e..58e96724b3a2 100644
--- a/src/lib_smart_rollup_node/layer1.ml
+++ b/src/lib_smart_rollup_node/layer1.ml
@@ -128,6 +128,22 @@ let start ~name ~reconnection_delay ~l1_blocks_cache_size ?protocols
   let cctxt = (cctxt :> Client_context.full) in
   return {l1; cctxt; blocks_cache; headers_cache; prefetch_blocks}
 
+let create ~name ~reconnection_delay ~l1_blocks_cache_size ?protocols
+    ?(prefetch_blocks = l1_blocks_cache_size) cctxt =
+  let open Result_syntax in
+  let* () =
+    if prefetch_blocks > l1_blocks_cache_size then
+      error_with
+        "Blocks to prefetch must be less than the cache size: %d"
+        l1_blocks_cache_size
+    else Ok ()
+  in
+  let l1 = create ~name ~reconnection_delay ?protocols cctxt in
+  let blocks_cache = Blocks_cache.create l1_blocks_cache_size in
+  let headers_cache = Blocks_cache.create l1_blocks_cache_size in
+  let cctxt = (cctxt :> Client_context.full) in
+  return {l1; cctxt; blocks_cache; headers_cache; prefetch_blocks}
+
 let shutdown {l1; _} = shutdown l1
 
 let cache_shell_header {headers_cache; _} hash header =
diff --git a/src/lib_smart_rollup_node/layer1.mli b/src/lib_smart_rollup_node/layer1.mli
index 2f1a9671c1b2..92f314f3858b 100644
--- a/src/lib_smart_rollup_node/layer1.mli
+++ b/src/lib_smart_rollup_node/layer1.mli
@@ -77,6 +77,16 @@ val start :
   #Client_context.full ->
   t tzresult Lwt.t
 
+(** Same as {!start} but does not start monitoring L1 blocks. *)
+val create :
+  name:string ->
+  reconnection_delay:float ->
+  l1_blocks_cache_size:int ->
+  ?protocols:Protocol_hash.t trace ->
+  ?prefetch_blocks:int ->
+  #Client_context.full ->
+  t tzresult
+
 (** [shutdown t] properly shuts the layer 1 down. *)
 val shutdown : t -> unit Lwt.t
 
-- 
GitLab


From 99edb8e691fa8aec7a5ec3405366b7fd740423c9 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:27:50 +0100
Subject: [PATCH 02/12] Rollup node: create Node_context for context
 reconstruction in snapshots

---
 src/lib_smart_rollup_node/node_context.ml     |   2 +
 src/lib_smart_rollup_node/node_context.mli    |   4 +-
 .../node_context_loader.ml                    | 100 ++++++++++++++++++
 .../node_context_loader.mli                   |  14 +++
 4 files changed, 119 insertions(+), 1 deletion(-)

diff --git a/src/lib_smart_rollup_node/node_context.ml b/src/lib_smart_rollup_node/node_context.ml
index 281781993bf0..2d113c5e7565 100644
--- a/src/lib_smart_rollup_node/node_context.ml
+++ b/src/lib_smart_rollup_node/node_context.ml
@@ -70,6 +70,8 @@ module Node_store = struct
         save_when_rw Full
     | Some Full, Some Archive ->
         failwith "Cannot transform a full rollup node into an archive one."
+
+  let of_store store = store
 end
 
 type debug_logger = string -> unit Lwt.t
diff --git a/src/lib_smart_rollup_node/node_context.mli b/src/lib_smart_rollup_node/node_context.mli
index c91d0329fc49..efb72cd699b8 100644
--- a/src/lib_smart_rollup_node/node_context.mli
+++ b/src/lib_smart_rollup_node/node_context.mli
@@ -27,7 +27,7 @@
 
 (** This module describes the execution context of the node. *)
 
-type lcc = {commitment : Commitment.Hash.t; level : int32}
+type lcc = Store.Lcc.lcc = {commitment : Commitment.Hash.t; level : int32}
 
 type genesis_info = Metadata.genesis_info = {
   level : int32;
@@ -61,6 +61,8 @@ module Node_store : sig
     'a store ->
     Configuration.history_mode option ->
     unit tzresult Lwt.t
+
+  val of_store : 'a Store.t -> 'a store
 end
 
 type debug_logger = string -> unit Lwt.t
diff --git a/src/lib_smart_rollup_node/node_context_loader.ml b/src/lib_smart_rollup_node/node_context_loader.ml
index 886b23391801..a3eaef540385 100644
--- a/src/lib_smart_rollup_node/node_context_loader.ml
+++ b/src/lib_smart_rollup_node/node_context_loader.ml
@@ -203,6 +203,106 @@ let close ({cctxt; store; context; l1_ctxt; finaliser; _} as node_ctxt) =
   let*! () = unlock node_ctxt in
   return_unit
 
+module For_snapshots = struct
+  let create_node_context cctxt current_protocol store context ~data_dir =
+    let open Lwt_result_syntax in
+    let loser_mode = Loser_mode.no_failures in
+    let l1_blocks_cache_size = Configuration.default_l1_blocks_cache_size in
+    let l2_blocks_cache_size = Configuration.default_l2_blocks_cache_size in
+    let index_buffer_size = Configuration.default_index_buffer_size in
+    let irmin_cache_size = Configuration.default_irmin_cache_size in
+    let l1_rpc_timeout = Configuration.default_l1_rpc_timeout in
+    let* metadata = Metadata.read_metadata_file ~dir:data_dir in
+    let*? metadata =
+      match metadata with
+      | None -> error_with "Missing metadata file for snapshot node context"
+      | Some m -> Ok m
+    in
+    let mode = Configuration.Observer in
+    let*? operators =
+      Purpose.make_operator
+        ~needed_purposes:(Configuration.purposes_of_mode mode)
+        []
+    in
+    let config =
+      Configuration.
+        {
+          sc_rollup_address = metadata.rollup_address;
+          boot_sector_file = None;
+          operators;
+          rpc_addr = Configuration.default_rpc_addr;
+          rpc_port = Configuration.default_rpc_port;
+          metrics_addr = None;
+          reconnection_delay = 1.;
+          fee_parameters = Configuration.default_fee_parameters;
+          mode;
+          loser_mode;
+          dal_node_endpoint = None;
+          dac_observer_endpoint = None;
+          dac_timeout = None;
+          batcher = Configuration.default_batcher;
+          injector = Configuration.default_injector;
+          l1_blocks_cache_size;
+          l2_blocks_cache_size;
+          index_buffer_size = Some index_buffer_size;
+          irmin_cache_size = Some irmin_cache_size;
+          prefetch_blocks = None;
+          log_kernel_debug = false;
+          no_degraded = false;
+          gc_parameters = Configuration.default_gc_parameters;
+          history_mode = None;
+          cors = Resto_cohttp.Cors.default;
+          l1_rpc_timeout;
+          pre_images_endpoint = None;
+        }
+    in
+    let*? l1_ctxt =
+      Layer1.create
+        ~name:"smart_rollup_node.snapshot"
+        ~reconnection_delay:config.reconnection_delay
+        ~l1_blocks_cache_size
+        cctxt
+    in
+    let* lcc = Store.Lcc.read store.Store.lcc in
+    let lcc =
+      match lcc with
+      | Some lcc -> lcc
+      | None ->
+          {
+            commitment = metadata.genesis_info.commitment_hash;
+            level = metadata.genesis_info.level;
+          }
+    in
+    let* lpc = Store.Lpc.read store.Store.lpc in
+    let*! lockfile =
+      Lwt_unix.openfile (Filename.temp_file "lock" "") [] 0o644
+    in
+    let global_block_watcher = Lwt_watcher.create_input () in
+    return
+      {
+        config;
+        cctxt = (cctxt :> Client_context.full);
+        dal_cctxt = None;
+        dac_client = None;
+        data_dir;
+        l1_ctxt;
+        genesis_info = metadata.genesis_info;
+        lcc = Reference.new_ lcc;
+        lpc = Reference.new_ lpc;
+        private_info = Reference.new_ None;
+        kind = metadata.kind;
+        injector_retention_period = 0;
+        block_finality_time = 2;
+        lockfile;
+        store = Node_context.Node_store.of_store store;
+        context;
+        kernel_debug_logger = (fun _ -> Lwt.return_unit);
+        finaliser = Lwt.return;
+        current_protocol;
+        global_block_watcher;
+      }
+end
+
 module Internal_for_tests = struct
   let create_node_context cctxt (current_protocol : current_protocol) ~data_dir
       kind =
diff --git a/src/lib_smart_rollup_node/node_context_loader.mli b/src/lib_smart_rollup_node/node_context_loader.mli
index f3800aefe477..01e2354a4e67 100644
--- a/src/lib_smart_rollup_node/node_context_loader.mli
+++ b/src/lib_smart_rollup_node/node_context_loader.mli
@@ -52,6 +52,20 @@ val init :
 (** Closes the store, context and Layer 1 monitor. *)
 val close : _ t -> unit tzresult Lwt.t
 
+module For_snapshots : sig
+  (** [create_node_context cctxt protocol store context ~data_dir] creates a
+      node context which does not monitor the L1 chain but which can be used to
+      reconstruct the context from historical data. This function is used by the
+      {!Snapshots} module. *)
+  val create_node_context :
+    #Client_context.full ->
+    current_protocol ->
+    ([< `Read | `Write > `Read] as 'a) Store.t ->
+    'a Context.t ->
+    data_dir:string ->
+    'a t tzresult Lwt.t
+end
+
 (**/**)
 
 module Internal_for_tests : sig
-- 
GitLab


From 58a23c80567202d65097a254c29c89e5cfe711c2 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:23:18 +0100
Subject: [PATCH 03/12] Rollup node/Snapshots: file copy utilities for
 snapshots

---
 src/lib_smart_rollup_node/snapshot_utils.ml  | 37 ++++++++++++++++++++
 src/lib_smart_rollup_node/snapshot_utils.mli |  7 ++++
 2 files changed, 44 insertions(+)

diff --git a/src/lib_smart_rollup_node/snapshot_utils.ml b/src/lib_smart_rollup_node/snapshot_utils.ml
index 5c671e4ac620..e09f8d637283 100644
--- a/src/lib_smart_rollup_node/snapshot_utils.ml
+++ b/src/lib_smart_rollup_node/snapshot_utils.ml
@@ -237,6 +237,43 @@ let rec create_dir ?(perm = 0o755) dir =
            time. *)
         ())
 
+let copy_file ~src ~dst =
+  let in_chan = open_in src in
+  let out_chan = open_out dst in
+  try
+    let buffer_size = 64 * 1024 in
+    let buf = Bytes.create buffer_size in
+    let rec copy () =
+      let read_bytes = input in_chan buf 0 buffer_size in
+      output out_chan buf 0 read_bytes ;
+      if read_bytes > 0 then copy ()
+    in
+    copy () ;
+    flush out_chan ;
+    close_in in_chan ;
+    close_out out_chan
+  with e ->
+    close_in in_chan ;
+    close_out out_chan ;
+    raise e
+
+(* TODO: https://gitlab.com/tezos/tezos/-/issues/6857
+   Use Lwt_utils_unix.copy_dir instead when file descriptors issue is fixed. *)
+let copy_dir ?(perm = 0o755) src dst =
+  create_dir ~perm dst ;
+  let files =
+    list_files src ~include_file:(fun ~relative_path:_ -> true)
+    @@ fun ~full_path ~relative_path ->
+    let dst_file = Filename.concat dst relative_path in
+    (full_path, dst_file)
+  in
+  Stream.iter
+    (fun (src, dst) ->
+      let dst_dir = Filename.dirname dst in
+      create_dir ~perm dst_dir ;
+      copy_file ~src ~dst)
+    files
+
 let extract (module Reader : READER) (module Writer : WRITER) metadata_check
     ~snapshot_file ~dest =
   let open Lwt_result_syntax in
diff --git a/src/lib_smart_rollup_node/snapshot_utils.mli b/src/lib_smart_rollup_node/snapshot_utils.mli
index f38787acc026..193c8ab055eb 100644
--- a/src/lib_smart_rollup_node/snapshot_utils.mli
+++ b/src/lib_smart_rollup_node/snapshot_utils.mli
@@ -72,3 +72,10 @@ val compress : snapshot_file:string -> string
 (** [read_metadata reader ~snapshot_file] reads the metadata from the snapshot
     file without extracting it. *)
 val read_metadata : reader -> snapshot_file:string -> snapshot_metadata
+
+(** [copy_file ~src ~dst] copies the file [src] to [dst]. *)
+val copy_file : src:string -> dst:string -> unit
+
+(** [copy_dir ?perm src dst] copies the content of directory [src] in the
+    directory [dst] (created with [perm], [0o755] by default). *)
+val copy_dir : ?perm:int -> string -> string -> unit
-- 
GitLab


From df49866468a9d66a5980ec4a581f72e90ca36ced Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:24:04 +0100
Subject: [PATCH 04/12] Rollup node/Snapshots: fix progress bar reporter

Low level "display" must be finalized to display another progress bar.
---
 src/lib_smart_rollup_node/progress_bar.ml | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/src/lib_smart_rollup_node/progress_bar.ml b/src/lib_smart_rollup_node/progress_bar.ml
index 9c81a74907b2..d1054e7da223 100644
--- a/src/lib_smart_rollup_node/progress_bar.ml
+++ b/src/lib_smart_rollup_node/progress_bar.ml
@@ -65,13 +65,18 @@ module Lwt = struct
         ()
     in
     let display = Display.start ~config (Multi.line line) in
-    let [report] = Display.reporters display in
-    let* () = flush () in
-    let report n =
-      report n ;
-      flush ()
-    in
-    f report
+    Lwt.finalize
+      (fun () ->
+        let [report] = Display.reporters display in
+        let* () = flush () in
+        let report n =
+          report n ;
+          flush ()
+        in
+        f report)
+      (fun () ->
+        Display.finalise display ;
+        Lwt.return_unit)
 
   let with_reporter_no_tty {when_no_tty; _} f =
     let open Lwt_syntax in
-- 
GitLab


From 00e2281c1eb44597d45b4198559bb3844c381a16 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Fri, 17 Nov 2023 10:53:46 +0100
Subject: [PATCH 05/12] Rollup node/Interpreter: process_head does not need
 block headers

---
 src/lib_smart_rollup_node/interpreter.ml        | 12 +++---------
 src/lib_smart_rollup_node/interpreter.mli       |  4 ++--
 src/lib_smart_rollup_node/rollup_node_daemon.ml |  8 ++++----
 3 files changed, 9 insertions(+), 15 deletions(-)

diff --git a/src/lib_smart_rollup_node/interpreter.ml b/src/lib_smart_rollup_node/interpreter.ml
index 8dd07e3ca179..44c97463c3bf 100644
--- a/src/lib_smart_rollup_node/interpreter.ml
+++ b/src/lib_smart_rollup_node/interpreter.ml
@@ -96,17 +96,11 @@ let transition_pvm (module Plugin : Protocol_plugin_sig.PARTIAL) node_ctxt ctxt
 (** [process_head plugin node_ctxt ctxt ~predecessor head inbox_and_messages] runs the PVM for the given
     head. *)
 let process_head plugin (node_ctxt : _ Node_context.t) ctxt
-    ~(predecessor : Layer1.header) (head : Layer1.header) inbox_and_messages =
+    ~(predecessor : Layer1.head) (head : Layer1.head) inbox_and_messages =
   let open Lwt_result_syntax in
   let first_inbox_level = node_ctxt.genesis_info.level |> Int32.succ in
-  if head.Layer1.level >= first_inbox_level then
-    transition_pvm
-      plugin
-      node_ctxt
-      ctxt
-      (Layer1.head_of_header predecessor)
-      (Layer1.head_of_header head)
-      inbox_and_messages
+  if head.level >= first_inbox_level then
+    transition_pvm plugin node_ctxt ctxt predecessor head inbox_and_messages
   else if head.Layer1.level = node_ctxt.genesis_info.level then
     let* ctxt, state = genesis_state plugin head.hash node_ctxt ctxt in
     let*! ctxt = Context.PVMState.set ctxt state in
diff --git a/src/lib_smart_rollup_node/interpreter.mli b/src/lib_smart_rollup_node/interpreter.mli
index dc9880ca433e..0d9cbbd9889e 100644
--- a/src/lib_smart_rollup_node/interpreter.mli
+++ b/src/lib_smart_rollup_node/interpreter.mli
@@ -35,8 +35,8 @@ val process_head :
   (module Protocol_plugin_sig.PARTIAL) ->
   Node_context.rw ->
   'a Context.t ->
-  predecessor:Layer1.header ->
-  Layer1.header ->
+  predecessor:Layer1.head ->
+  Layer1.head ->
   Octez_smart_rollup.Inbox.t * string list ->
   ('a Context.t * int * int64 * Z.t) tzresult Lwt.t
 
diff --git a/src/lib_smart_rollup_node/rollup_node_daemon.ml b/src/lib_smart_rollup_node/rollup_node_daemon.ml
index 0fcee533571a..62ae192a23ab 100644
--- a/src/lib_smart_rollup_node/rollup_node_daemon.ml
+++ b/src/lib_smart_rollup_node/rollup_node_daemon.ml
@@ -137,8 +137,8 @@ let process_unseen_head ({node_ctxt; _} as state) ~catching_up ~predecessor
       (module Plugin)
       node_ctxt
       rollup_ctxt
-      ~predecessor
-      head
+      ~predecessor:(Layer1.head_of_header predecessor)
+      (Layer1.head_of_header head)
       (inbox, messages)
   in
   let*! context_hash = Context.commit ctxt in
@@ -598,8 +598,8 @@ module Internal_for_tests = struct
         (module Plugin)
         node_ctxt
         ctxt
-        ~predecessor
-        head
+        ~predecessor:(Layer1.head_of_header predecessor)
+        (Layer1.head_of_header head)
         (inbox, messages)
     in
     let*! context_hash = Context.commit ctxt in
-- 
GitLab


From f6b0c6e4c2700040c8c78ee4bbcc612a126285c5 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Thu, 18 Jan 2024 11:01:08 +0100
Subject: [PATCH 06/12] Rollup node/Context: export context snapshot in single
 commit store

---
 etherlink/bin_node/lib_dev/evm_context.ml  | 5 +----
 etherlink/bin_node/lib_prod/evm_context.ml | 5 +----
 src/lib_layer2_store/context.ml            | 4 ++++
 src/lib_layer2_store/context.mli           | 4 ++++
 src/lib_layer2_store/context_sigs.ml       | 5 +++++
 src/lib_layer2_store/irmin_context.ml      | 2 +-
 src/lib_layer2_store/irmin_context.mli     | 2 +-
 7 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/etherlink/bin_node/lib_dev/evm_context.ml b/etherlink/bin_node/lib_dev/evm_context.ml
index 671a34b27234..6c6504804a50 100644
--- a/etherlink/bin_node/lib_dev/evm_context.ml
+++ b/etherlink/bin_node/lib_dev/evm_context.ml
@@ -197,14 +197,11 @@ let init_from_rollup_node ~data_dir ~rollup_node_data_dir =
   let* rollup_node_index =
     Irmin_context.load ~cache_size:100_000 Read_only rollup_node_context_dir
   in
-  let*! rollup_node_context =
-    Irmin_context.checkout_exn rollup_node_index checkpoint
-  in
   let evm_context_dir = store_path ~data_dir in
   let*! () = Lwt_utils_unix.create_dir evm_context_dir in
   let* () =
     Irmin_context.export_snapshot
-      rollup_node_context
+      rollup_node_index
       checkpoint
       ~path:evm_context_dir
   in
diff --git a/etherlink/bin_node/lib_prod/evm_context.ml b/etherlink/bin_node/lib_prod/evm_context.ml
index 34775fdb3a4a..79460617e932 100644
--- a/etherlink/bin_node/lib_prod/evm_context.ml
+++ b/etherlink/bin_node/lib_prod/evm_context.ml
@@ -197,14 +197,11 @@ let init_from_rollup_node ~data_dir ~rollup_node_data_dir =
   let* rollup_node_index =
     Irmin_context.load ~cache_size:100_000 Read_only rollup_node_context_dir
   in
-  let*! rollup_node_context =
-    Irmin_context.checkout_exn rollup_node_index checkpoint
-  in
   let evm_context_dir = store_path ~data_dir in
   let*! () = Lwt_utils_unix.create_dir evm_context_dir in
   let* () =
     Irmin_context.export_snapshot
-      rollup_node_context
+      rollup_node_index
       checkpoint
       ~path:evm_context_dir
   in
diff --git a/src/lib_layer2_store/context.ml b/src/lib_layer2_store/context.ml
index 2087a5bbc0a2..6afdc8fee4a6 100644
--- a/src/lib_layer2_store/context.ml
+++ b/src/lib_layer2_store/context.ml
@@ -127,6 +127,10 @@ let wait_gc_completion
       [> `Write] t) =
   Pvm_Context_Impl.wait_gc_completion index
 
+let export_snapshot (type a)
+    (Context {pvm_context_impl = (module Pvm_Context_Impl); index; _} : a t) =
+  Pvm_Context_Impl.export_snapshot index
+
 type pvmstate =
   | PVMState : {
       pvm_context_impl : ('repo, 'tree) pvm_context_impl;
diff --git a/src/lib_layer2_store/context.mli b/src/lib_layer2_store/context.mli
index 62ea1a22d85a..396f1c53a008 100644
--- a/src/lib_layer2_store/context.mli
+++ b/src/lib_layer2_store/context.mli
@@ -120,6 +120,10 @@ val gc :
     GC run is currently ongoing. *)
 val wait_gc_completion : [`Read | `Write] t -> unit Lwt.t
 
+(** [export_snapshot index context_hash ~path] exports the context corresponding
+    to [context_hash], if found in [index], into the given folder path. *)
+val export_snapshot : _ t -> hash -> path:string -> unit tzresult Lwt.t
+
 (* Pvm_state that embeds the context_module embedded associated to pvm
    protocol_plugins *)
 type pvmstate =
diff --git a/src/lib_layer2_store/context_sigs.ml b/src/lib_layer2_store/context_sigs.ml
index 484bebe51601..88e3527a8c6a 100644
--- a/src/lib_layer2_store/context_sigs.ml
+++ b/src/lib_layer2_store/context_sigs.ml
@@ -134,6 +134,11 @@ module type S = sig
     GC run is currently ongoing. *)
   val wait_gc_completion : [> `Write] index -> unit Lwt.t
 
+  (** [export_snapshot index context_hash ~path] exports the context
+      corresponding to [context_hash], if found in [index], into the given
+      folder path. *)
+  val export_snapshot : _ index -> hash -> path:string -> unit tzresult Lwt.t
+
   (** State of the PVM that this rollup node deals with *)
   module PVMState : sig
     (** The value of a PVM state *)
diff --git a/src/lib_layer2_store/irmin_context.ml b/src/lib_layer2_store/irmin_context.ml
index 4c4ba7aa835d..4c1a19823dd7 100644
--- a/src/lib_layer2_store/irmin_context.ml
+++ b/src/lib_layer2_store/irmin_context.ml
@@ -195,7 +195,7 @@ let is_gc_finished index = IStore.Gc.is_finished index.repo
 
 let index context = context.index
 
-let export_snapshot {index = {path = _; repo}; _} context_hash ~path =
+let export_snapshot {path = _; repo} context_hash ~path =
   let open Lwt_result_syntax in
   let*! commit_opt =
     IStore.Commit.of_hash repo (hash_to_istore_hash context_hash)
diff --git a/src/lib_layer2_store/irmin_context.mli b/src/lib_layer2_store/irmin_context.mli
index 1342030d7d95..9d64083ad564 100644
--- a/src/lib_layer2_store/irmin_context.mli
+++ b/src/lib_layer2_store/irmin_context.mli
@@ -133,7 +133,7 @@ val wait_gc_completion : [> `Write] index -> unit Lwt.t
 
     Note: there is no associated [import_snapshot] function as the import
     consist in copying the exported Irmin store. *)
-val export_snapshot : _ t -> hash -> path:string -> unit tzresult Lwt.t
+val export_snapshot : _ index -> hash -> path:string -> unit tzresult Lwt.t
 
 (** Module for generating and verifying proofs for a context *)
 module Proof (Hash : sig
-- 
GitLab


From 3e5082e90db86d6d236d70d2b733c5191ec5a878 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:33:48 +0100
Subject: [PATCH 07/12] Rollup node/Snapshots: export compact snapshot

These snapshot have a single commit in the context for the first
level available in the rollup node. They are ~10x more compact than
snapshots with the full context once compressed.
---
 src/lib_smart_rollup_node/snapshots.ml  | 111 ++++++++++++++++++++++--
 src/lib_smart_rollup_node/snapshots.mli |  13 +++
 2 files changed, 115 insertions(+), 9 deletions(-)

diff --git a/src/lib_smart_rollup_node/snapshots.ml b/src/lib_smart_rollup_node/snapshots.ml
index 32c28d662d72..c1ecc2347fdb 100644
--- a/src/lib_smart_rollup_node/snapshots.ml
+++ b/src/lib_smart_rollup_node/snapshots.ml
@@ -432,18 +432,22 @@ let operator_local_file_regexp =
 
 let snapshotable_files_regexp =
   Re.Str.regexp
-    "^\\(storage/.*\\|context/.*\\|wasm_2_0_0/.*\\|arith/.*\\|context/.*\\|metadata$\\)"
+    "^\\(storage/.*\\|context/.*\\|wasm_2_0_0/.*\\|arith/.*\\|riscv/.*\\|context/.*\\|metadata$\\)"
 
-let export ~no_checks ~compression ~data_dir ~dest ~filename =
+let with_locks ~data_dir f =
+  Format.eprintf "Acquiring GC lock@." ;
+  (* Take GC lock first in order to not prevent progression of rollup node. *)
+  Utils.with_lockfile (Node_context.gc_lockfile_path ~data_dir) @@ fun () ->
+  Format.eprintf "Acquiring process lock@." ;
+  Utils.with_lockfile (Node_context.processing_lockfile_path ~data_dir) f
+
+let export_dir metadata ~take_locks ~compression ~data_dir ~dest ~filename =
   let open Lwt_result_syntax in
   let* snapshot_file =
-    Format.eprintf "Acquiring GC lock@." ;
-    (* Take GC lock first in order to not prevent progression of rollup node. *)
-    Utils.with_lockfile (Node_context.gc_lockfile_path ~data_dir) @@ fun () ->
-    Format.eprintf "Acquiring process lock@." ;
-    Utils.with_lockfile (Node_context.processing_lockfile_path ~data_dir)
-    @@ fun () ->
-    let* metadata = pre_export_checks_and_get_snapshot_metadata ~data_dir in
+    let with_locks =
+      if take_locks then with_locks ~data_dir else fun f -> f ()
+    in
+    with_locks @@ fun () ->
     let dest_file_name =
       match filename with
       | Some f ->
@@ -500,9 +504,98 @@ let export ~no_checks ~compression ~data_dir ~dest ~filename =
     | No | On_the_fly -> snapshot_file
     | After -> compress ~snapshot_file
   in
+  return snapshot_file
+
+let export ~no_checks ~compression ~data_dir ~dest ~filename =
+  let open Lwt_result_syntax in
+  let* metadata = pre_export_checks_and_get_snapshot_metadata ~data_dir in
+  let* snapshot_file =
+    export_dir metadata ~take_locks:true ~compression ~data_dir ~dest ~filename
+  in
   let* () = unless no_checks @@ fun () -> post_export_checks ~snapshot_file in
   return snapshot_file
 
+let export_compact ~compression ~data_dir ~dest ~filename =
+  let open Lwt_result_syntax in
+  let* snapshot_metadata =
+    pre_export_checks_and_get_snapshot_metadata ~data_dir
+  in
+  Lwt_utils_unix.with_tempdir "snapshot_temp_" @@ fun tmp_dir ->
+  let tmp_context_dir = Configuration.default_context_dir tmp_dir in
+  let tmp_store_dir = Configuration.default_storage_dir tmp_dir in
+  let*! () = Lwt_utils_unix.create_dir tmp_context_dir in
+  let*! () = Lwt_utils_unix.create_dir tmp_store_dir in
+  let store_dir = Configuration.default_storage_dir data_dir in
+  let context_dir = Configuration.default_context_dir data_dir in
+  let* store =
+    Store.load Read_only ~index_buffer_size:0 ~l2_blocks_cache_size:1 store_dir
+  in
+  let* metadata = Metadata.read_metadata_file ~dir:data_dir in
+  let*? metadata =
+    match metadata with
+    | None -> error_with "No rollup node metadata in %S." data_dir
+    | Some m -> Ok m
+  in
+  let* head = get_head store in
+  let level = head.Sc_rollup_block.header.level in
+  let* (module Plugin) =
+    Protocol_plugins.proto_plugin_for_level_with_store store level
+  in
+  let (module C) = Plugin.Pvm.context metadata.kind in
+  let* context = Context.load (module C) ~cache_size:1 Read_only context_dir in
+  let* first_level = first_available_level ~data_dir store in
+  let* first_block_hash =
+    Store.Levels_to_hashes.find store.levels_to_hashes first_level
+  in
+  let first_block_hash =
+    WithExceptions.Option.get first_block_hash ~loc:__LOC__
+  in
+  let* first_block = Store.L2_blocks.read store.l2_blocks first_block_hash in
+  let _, first_block = WithExceptions.Option.get first_block ~loc:__LOC__ in
+  Format.eprintf "Exporting context snapshot with first level %ld@." first_level ;
+  let* () =
+    Context.export_snapshot
+      context
+      (Smart_rollup_context_hash.to_context_hash first_block.context)
+      ~path:tmp_context_dir
+  in
+  let ( // ) = Filename.concat in
+  let copy_dir a =
+    let dir = data_dir // a in
+    if Sys.file_exists dir && Sys.is_directory dir then
+      copy_dir dir (tmp_dir // a)
+  in
+  let copy_file a =
+    let path = data_dir // a in
+    if Sys.file_exists path then copy_file ~src:path ~dst:(tmp_dir // a)
+  in
+  Format.eprintf "Acquiring process lock@." ;
+  let* () =
+    Utils.with_lockfile (Node_context.processing_lockfile_path ~data_dir)
+    @@ fun () ->
+    Format.eprintf "Copying data@." ;
+    Snapshot_utils.copy_dir store_dir tmp_store_dir ;
+    copy_file "metadata" ;
+    return_unit
+  in
+  copy_dir "wasm_2_0_0" ;
+  copy_dir "arith" ;
+  copy_dir "riscv" ;
+  let compression =
+    match compression with
+    | After ->
+        (* We've already copied data *)
+        On_the_fly
+    | _ -> compression
+  in
+  export_dir
+    snapshot_metadata
+    ~take_locks:false
+    ~compression
+    ~data_dir:tmp_dir
+    ~dest
+    ~filename
+
 let pre_import_checks cctxt ~no_checks ~data_dir snapshot_metadata =
   let open Lwt_result_syntax in
   let store_dir = Configuration.default_storage_dir data_dir in
diff --git a/src/lib_smart_rollup_node/snapshots.mli b/src/lib_smart_rollup_node/snapshots.mli
index 7b6eb1ad2470..4efe9877ea23 100644
--- a/src/lib_smart_rollup_node/snapshots.mli
+++ b/src/lib_smart_rollup_node/snapshots.mli
@@ -31,6 +31,19 @@ val export :
   filename:string option ->
   string tzresult Lwt.t
 
+(** [export_compact ~compression ~data_dir ~dest ~filename] creates a tar
+    gzipped archive with name [filename] (or a generated name) in [dest] (or the
+    current directory) containing a snapshot of the data of the rollup node with
+    data directory [data_dir]. The difference with {!export} is that the
+    snapshot contains a single commit for the context (which must be
+    reconstructed on import) but is significantly smaller. *)
+val export_compact :
+  compression:compression ->
+  data_dir:string ->
+  dest:string option ->
+  filename:string option ->
+  string tzresult Lwt.t
+
 (** [import ~no_checks ~force cctxt ~data_dir ~snapshot_file] imports the
     snapshot at path [snapshot_file] into the data directory [data_dir]. If
     [no_checks] is [true], the integrity of the imported data is not checked at
-- 
GitLab


From d62e4169644d418d67697c85d53bebe976acfaa2 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:35:01 +0100
Subject: [PATCH 08/12] Rollup node/Snapshots: import of compact snapshots
 reconstruct context

---
 src/lib_smart_rollup_node/snapshots.ml | 124 +++++++++++++++++++++++++
 1 file changed, 124 insertions(+)

diff --git a/src/lib_smart_rollup_node/snapshots.ml b/src/lib_smart_rollup_node/snapshots.ml
index c1ecc2347fdb..69add3ae0650 100644
--- a/src/lib_smart_rollup_node/snapshots.ml
+++ b/src/lib_smart_rollup_node/snapshots.ml
@@ -347,6 +347,129 @@ let check_lcc metadata cctxt (store : _ Store.t) (head : Sc_rollup_block.t)
              Commitment.Hash.pp
              lcc.commitment
 
+let hash_level_of_l2_block (b : Sc_rollup_block.t) =
+  Layer1.{hash = b.header.block_hash; level = b.header.level}
+
+let reconstruct_level_context rollup_ctxt ~predecessor
+    (node_ctxt : _ Node_context.t) level =
+  let open Lwt_result_syntax in
+  let* block = Node_context.get_l2_block_by_level node_ctxt level in
+  let* inbox = Node_context.get_inbox node_ctxt block.header.inbox_hash
+  and* messages = Messages.get node_ctxt block.header.inbox_witness in
+  let* (module Plugin) =
+    Protocol_plugins.proto_plugin_for_level node_ctxt level
+  in
+  let* ctxt, _num_messages, _num_ticks, _initial_tick =
+    Interpreter.process_head
+      (module Plugin)
+      node_ctxt
+      rollup_ctxt
+      ~predecessor:(hash_level_of_l2_block predecessor)
+      (hash_level_of_l2_block block)
+      (inbox, messages)
+  in
+  let*! context_hash = Context.commit ctxt in
+  assert (
+    Smart_rollup_context_hash.(
+      of_context_hash context_hash = block.header.context)) ;
+  return (block, ctxt)
+
+let reconstruct_context_from_first_available_level
+    (node_ctxt : _ Node_context.t) (head : Sc_rollup_block.t) =
+  let open Lwt_result_syntax in
+  let* {first_available_level = first_level; _} =
+    Node_context.get_gc_levels node_ctxt
+  in
+  let total = Int32.sub head.header.level first_level in
+  let progress_bar =
+    Progress_bar.progress_bar
+      ~counter:`Int
+      ~message:"Reconstructing context"
+      ~color:(Terminal.Color.rgb 219 146 21)
+      (Int32.to_int total)
+  in
+  Progress_bar.Lwt.with_reporter progress_bar @@ fun count_progress ->
+  let* first_block = Node_context.get_l2_block_by_level node_ctxt first_level in
+  let* first_ctxt =
+    Node_context.checkout_context node_ctxt first_block.header.block_hash
+  in
+  let rec reconstruct_chain_from (block : Sc_rollup_block.t) rollup_ctxt =
+    if block.header.level >= head.header.level then return_unit
+    else
+      let level = Int32.succ block.header.level in
+      let* block, rollup_ctxt =
+        reconstruct_level_context rollup_ctxt ~predecessor:block node_ctxt level
+      in
+      let*! () = count_progress 1 in
+      reconstruct_chain_from block rollup_ctxt
+  in
+  reconstruct_chain_from first_block first_ctxt
+
+let maybe_reconstruct_context cctxt ~data_dir =
+  let open Lwt_result_syntax in
+  let store_dir = Configuration.default_storage_dir data_dir in
+  let context_dir = Configuration.default_context_dir data_dir in
+  let* () = check_store_version store_dir in
+  let* store =
+    Store.load
+      Read_write
+      ~index_buffer_size:1000
+      ~l2_blocks_cache_size:100
+      store_dir
+  in
+  let* head = get_head store in
+  let* (module Plugin) =
+    Protocol_plugins.proto_plugin_for_level_with_store store head.header.level
+  in
+  let* metadata = Metadata.read_metadata_file ~dir:data_dir in
+  let*? metadata =
+    match metadata with
+    | None -> error_with "No rollup node metadata in %S." data_dir
+    | Some m -> Ok m
+  in
+  let (module C) = Plugin.Pvm.context metadata.kind in
+  let* context =
+    Context.load (module C) ~cache_size:100 Read_write context_dir
+  in
+  let*! head_ctxt =
+    Context.checkout
+      context
+      (Smart_rollup_context_hash.to_context_hash head.header.context)
+  in
+  match head_ctxt with
+  | Some _ -> return_unit
+  | None ->
+      let* current_protocol =
+        Node_context.protocol_of_level_with_store store head.header.level
+      in
+      let*? (module Plugin) =
+        Protocol_plugins.proto_plugin_for_protocol current_protocol.protocol
+      in
+      let* constants =
+        Plugin.Layer1_helpers.retrieve_constants
+          cctxt
+          ~block:(`Level head.header.level)
+      in
+      let current_protocol =
+        {
+          Node_context.hash = current_protocol.protocol;
+          proto_level = current_protocol.proto_level;
+          constants;
+        }
+      in
+      let* node_ctxt =
+        Node_context_loader.For_snapshots.create_node_context
+          cctxt
+          current_protocol
+          store
+          context
+          ~data_dir
+      in
+      let* () = reconstruct_context_from_first_available_level node_ctxt head in
+      let*! () = Context.close context in
+      let* () = Store.close store in
+      return_unit
+
 let post_checks ~action ~message snapshot_metadata ~dest =
   let open Lwt_result_syntax in
   let store_dir = Configuration.default_storage_dir dest in
@@ -692,6 +815,7 @@ let import ~no_checks ~force cctxt ~data_dir ~snapshot_file =
       ~snapshot_file
       ~dest:data_dir
   in
+  let* () = maybe_reconstruct_context cctxt ~data_dir in
   unless no_checks @@ fun () ->
   post_checks
     ~action:(`Import cctxt)
-- 
GitLab


From ea44a4b09e381237d11f9b3de5f550023e38049d Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:37:35 +0100
Subject: [PATCH 09/12] Rollup node: --compact argument for snapshot export

---
 .../main_smart_rollup_node.ml                 | 24 ++++++++++++-------
 src/lib_smart_rollup_node/cli.ml              |  6 +++++
 2 files changed, 21 insertions(+), 9 deletions(-)

diff --git a/src/bin_smart_rollup_node/main_smart_rollup_node.ml b/src/bin_smart_rollup_node/main_smart_rollup_node.ml
index 52589b63c632..984ceed409ad 100644
--- a/src/bin_smart_rollup_node/main_smart_rollup_node.ml
+++ b/src/bin_smart_rollup_node/main_smart_rollup_node.ml
@@ -384,8 +384,8 @@ let dump_durable_storage =
       | Error errs -> cctxt#error "%a" pp_print_trace errs)
 
 let export_snapshot
-    (data_dir, dest, no_checks, compress_on_the_fly, uncompressed) filename
-    (cctxt : Client_context.full) =
+    (data_dir, dest, no_checks, compress_on_the_fly, uncompressed, compact)
+    filename (cctxt : Client_context.full) =
   let open Lwt_result_syntax in
   let*! compression =
     match (compress_on_the_fly, uncompressed) with
@@ -396,7 +396,9 @@ let export_snapshot
     | false, true -> Lwt.return Snapshots.No
   in
   let* snapshot_file =
-    Snapshots.export ~no_checks ~compression ~data_dir ~dest ~filename
+    if compact then
+      Snapshots.export_compact ~compression ~data_dir ~dest ~filename
+    else Snapshots.export ~no_checks ~compression ~data_dir ~dest ~filename
   in
   let*! () = cctxt#message "Snapshot exported to %s@." snapshot_file in
   return_unit
@@ -406,12 +408,13 @@ let export_snapshot_auto_name =
   command
     ~group
     ~desc:"Export a snapshot of the rollup node state."
-    (args5
+    (args6
        data_dir_arg
        Cli.snapshot_dir_arg
        Cli.no_checks_arg
        Cli.compress_on_the_fly_arg
-       Cli.uncompressed)
+       Cli.uncompressed
+       Cli.compact)
     (prefixes ["snapshot"; "export"] @@ stop)
     (fun params cctxt -> export_snapshot params None cctxt)
 
@@ -420,15 +423,18 @@ let export_snapshot_named =
   command
     ~group
     ~desc:"Export a snapshot of the rollup node state to a given file."
-    (args4
+    (args5
        data_dir_arg
        Cli.no_checks_arg
        Cli.compress_on_the_fly_arg
-       Cli.uncompressed)
+       Cli.uncompressed
+       Cli.compact)
     (prefixes ["snapshot"; "export"] @@ Cli.snapshot_file_param @@ stop)
-    (fun (data_dir, no_checks, compress_on_the_fly, uncompressed) filename cctxt ->
+    (fun (data_dir, no_checks, compress_on_the_fly, uncompressed, compact)
+         filename
+         cctxt ->
       export_snapshot
-        (data_dir, None, no_checks, compress_on_the_fly, uncompressed)
+        (data_dir, None, no_checks, compress_on_the_fly, uncompressed, compact)
         (Some filename)
         cctxt)
 
diff --git a/src/lib_smart_rollup_node/cli.ml b/src/lib_smart_rollup_node/cli.ml
index e2de8d1e6d79..e32c57d2fec0 100644
--- a/src/lib_smart_rollup_node/cli.ml
+++ b/src/lib_smart_rollup_node/cli.ml
@@ -456,6 +456,12 @@ let uncompressed : (bool, Client_context.full) Tezos_clic.arg =
     ~doc:"Produce an uncompressed snapshot."
     ()
 
+let compact : (bool, Client_context.full) Tezos_clic.arg =
+  Tezos_clic.switch
+    ~long:"compact"
+    ~doc:"Produce a compact snapshot with a single commit for the context."
+    ()
+
 let string_list =
   Tezos_clic.parameter (fun (_cctxt : Client_context.full) s ->
       let list = String.split ',' s in
-- 
GitLab


From 1e5a94facb632ff3751b6fa1c5ab94a90c6248c1 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:53:43 +0100
Subject: [PATCH 10/12] Doc: documentation for compact snapshots

---
 docs/shell/smart_rollup_node.rst | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/docs/shell/smart_rollup_node.rst b/docs/shell/smart_rollup_node.rst
index c1bc8d56bb17..891db8e79219 100644
--- a/docs/shell/smart_rollup_node.rst
+++ b/docs/shell/smart_rollup_node.rst
@@ -606,6 +606,19 @@ ensure that the snapshot is not corrupted and can be imported by other users.
    It is also possible to use the ``--no-check`` option to disable the integrity
    checks during the export (i.e., phase 3), which will speed up the process.
 
+.. note::
+
+   Snapshots produced with the ``--compact`` option will be significantly
+   smaller (by a factor of 3) than otherwise as they contain a single commit of
+   the context for the first available block (instead of the full context
+   history). They take a comparable amount of time to be exported but take
+   longer to be imported because the context needs to be reconstructed.
+
+.. warning::
+
+   Snapshots exported with ``--compact`` for *archive* rollup nodes will need a
+   significant time to import because the context will need to be reconstructed
+   from the rollup genesis.
 
 Workflows
 ---------
-- 
GitLab


From 9717c0ae7da2b98c734d659a8ca113ad65a6290d Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 16:55:10 +0100
Subject: [PATCH 11/12] Doc: Changelog

---
 CHANGES.rst | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/CHANGES.rst b/CHANGES.rst
index 9c36eeb8919a..b528180cf0a0 100644
--- a/CHANGES.rst
+++ b/CHANGES.rst
@@ -137,6 +137,8 @@ Smart Rollup node
   Use ``helpers/proofs/outbox/<level>/messages?index=<index>`` to avoid generating the ```serialized_outbox_message`` yourself.
   (MR :gl:`!12140`)
 
+- Compact snapshots with context reconstruction. (MR :gl:`!11651`)
+
 Smart Rollup WASM Debugger
 --------------------------
 
-- 
GitLab


From 1dddaa34d26b94e4de20855de6dc227713e5a122 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Tue, 23 Jan 2024 17:46:07 +0100
Subject: [PATCH 12/12] Test: test export/import compact snapshots

---
 tezt/lib_tezos/sc_rollup_node.ml  |  6 ++-
 tezt/lib_tezos/sc_rollup_node.mli | 10 +++--
 tezt/tests/sc_rollup.ml           | 63 +++++++++++++++++++++----------
 3 files changed, 54 insertions(+), 25 deletions(-)

diff --git a/tezt/lib_tezos/sc_rollup_node.ml b/tezt/lib_tezos/sc_rollup_node.ml
index 396c3bacc7be..954a3255e546 100644
--- a/tezt/lib_tezos/sc_rollup_node.ml
+++ b/tezt/lib_tezos/sc_rollup_node.ml
@@ -622,7 +622,8 @@ let dump_durable_storage ~sc_rollup_node ~dump ?(block = "head") () =
   let process = spawn_command sc_rollup_node cmd in
   Process.check process
 
-let export_snapshot ?(compress_on_the_fly = false) sc_rollup_node dir =
+let export_snapshot ?(compress_on_the_fly = false) ?(compact = false)
+    sc_rollup_node dir =
   let process =
     spawn_command
       sc_rollup_node
@@ -634,7 +635,8 @@ let export_snapshot ?(compress_on_the_fly = false) sc_rollup_node dir =
          "--data-dir";
          data_dir sc_rollup_node;
        ]
-      @ Cli_arg.optional_switch "compress-on-the-fly" compress_on_the_fly)
+      @ Cli_arg.optional_switch "compress-on-the-fly" compress_on_the_fly
+      @ Cli_arg.optional_switch "compact" compact)
   in
   let parse process =
     let* output = Process.check_and_read_stdout process in
diff --git a/tezt/lib_tezos/sc_rollup_node.mli b/tezt/lib_tezos/sc_rollup_node.mli
index 29e27c025481..f3d4d27861d1 100644
--- a/tezt/lib_tezos/sc_rollup_node.mli
+++ b/tezt/lib_tezos/sc_rollup_node.mli
@@ -327,10 +327,14 @@ val change_node_mode : t -> mode -> t
 val dump_durable_storage :
   sc_rollup_node:t -> dump:string -> ?block:string -> unit -> unit Lwt.t
 
-(** [export_snapshot ?compress_on_the_fly rollup_node dir] creates a snapshot of
-    the rollup node in directory [dir]. *)
+(** [export_snapshot ?compress_on_the_fly ?compact rollup_node dir] creates a
+    snapshot of the rollup node in directory [dir]. *)
 val export_snapshot :
-  ?compress_on_the_fly:bool -> t -> string -> string Runnable.process
+  ?compress_on_the_fly:bool ->
+  ?compact:bool ->
+  t ->
+  string ->
+  string Runnable.process
 
 (** [import_snapshot ?force rollup_node ~snapshot_file] imports the snapshot
     [snapshot_file] in the rollup node [rollup_node].  *)
diff --git a/tezt/tests/sc_rollup.ml b/tezt/tests/sc_rollup.ml
index e5b2d1fd707d..72d7b801c3cf 100644
--- a/tezt/tests/sc_rollup.ml
+++ b/tezt/tests/sc_rollup.ml
@@ -968,14 +968,19 @@ let test_gc variant ?(tags = []) ~challenge_window ~commitment_period
    - we import the snapshot in the second and a fresh rollup node
    - we ensure they are all synchronized
    - we also try to import invalid snapshots to make sure they are rejected. *)
-let test_snapshots ~kind ~challenge_window ~commitment_period ~history_mode =
+let test_snapshots ~kind ~challenge_window ~commitment_period ~history_mode
+    ~compact =
   let history_mode_str = Sc_rollup_node.string_of_history_mode history_mode in
   test_full_scenario
     {
-      tags = ["snapshot"; history_mode_str];
+      tags =
+        (["snapshot"; history_mode_str] @ if compact then ["compact"] else []);
       variant = None;
       description =
-        sf "snapshot can be exported and checked (%s)" history_mode_str;
+        sf
+          "snapshot can be exported and checked (%s%s)"
+          history_mode_str
+          (if compact then " compact" else "");
     }
     ~kind
     ~challenge_window
@@ -1026,29 +1031,37 @@ let test_snapshots ~kind ~challenge_window ~commitment_period ~history_mode =
   let dir = Tezt.Temp.dir "snapshots" in
   let dir_on_the_fly = Tezt.Temp.dir "snapshots_on_the_fly" in
   let* snapshot_file =
-    Sc_rollup_node.export_snapshot sc_rollup_node dir |> Runnable.run
+    Sc_rollup_node.export_snapshot ~compact sc_rollup_node dir |> Runnable.run
   and* snapshot_file_on_the_fly =
     Sc_rollup_node.export_snapshot
       ~compress_on_the_fly:true
+      ~compact
       sc_rollup_node
       dir_on_the_fly
     |> Runnable.run
   in
-  Log.info "Checking if uncompressed snapshot files are identical." ;
-  (* Uncompress snapshots *)
-  let* () = Process.run "cp" [snapshot_file; snapshot_file ^ ".raw.gz"] in
-  let* () =
-    Process.run
-      "cp"
-      [snapshot_file_on_the_fly; snapshot_file_on_the_fly ^ ".raw.gz"]
-  in
-  let* () = Process.run "gzip" ["-d"; snapshot_file ^ ".raw.gz"] in
-  let* () = Process.run "gzip" ["-d"; snapshot_file_on_the_fly ^ ".raw.gz"] in
-  (* Compare uncompressed snapshots *)
   let* () =
-    Process.run
-      "cmp"
-      [snapshot_file ^ ".raw"; snapshot_file_on_the_fly ^ ".raw"]
+    if compact then
+      (* Compact snapshots are not deterministic due to the way irmin generates
+         the single commit context *)
+      unit
+    else (
+      Log.info "Checking if uncompressed snapshot files are identical." ;
+      (* Uncompress snapshots *)
+      let* () = Process.run "cp" [snapshot_file; snapshot_file ^ ".raw.gz"] in
+      let* () =
+        Process.run
+          "cp"
+          [snapshot_file_on_the_fly; snapshot_file_on_the_fly ^ ".raw.gz"]
+      in
+      let* () = Process.run "gzip" ["-d"; snapshot_file ^ ".raw.gz"] in
+      let* () =
+        Process.run "gzip" ["-d"; snapshot_file_on_the_fly ^ ".raw.gz"]
+      in
+      (* Compare uncompressed snapshots *)
+      Process.run
+        "cmp"
+        [snapshot_file ^ ".raw"; snapshot_file_on_the_fly ^ ".raw"])
   in
   let* exists = Lwt_unix.file_exists snapshot_file in
   if not exists then
@@ -1101,10 +1114,11 @@ let test_snapshots ~kind ~challenge_window ~commitment_period ~history_mode =
     @@ Sc_rollup_node.wait_for sc_rollup_node event_name (Fun.const (Some ()))
   in
   let* _ = Sc_rollup_node.wait_sync ~timeout:30.0 sc_rollup_node in
-  let*! snapshot_file = Sc_rollup_node.export_snapshot sc_rollup_node dir in
+  let*! snapshot_file =
+    Sc_rollup_node.export_snapshot ~compact sc_rollup_node dir
+  in
   (* The rollup node should not have published its commitment yet *)
   Log.info "Try importing snapshot without published commitment." ;
-  Log.info "Try importing outdated snapshot." ;
   let* () = Sc_rollup_node.terminate rollup_node_2 in
   let*? unpublished =
     Sc_rollup_node.import_snapshot ~force:true rollup_node_2 ~snapshot_file
@@ -5759,12 +5773,21 @@ let register_protocol_independent () =
     ~challenge_window:5
     ~commitment_period:2
     ~history_mode:Full
+    ~compact:false
+    protocols ;
+  test_snapshots
+    ~kind
+    ~challenge_window:5
+    ~commitment_period:2
+    ~history_mode:Full
+    ~compact:true
     protocols ;
   test_snapshots
     ~kind
     ~challenge_window:10
     ~commitment_period:5
     ~history_mode:Archive
+    ~compact:false
     protocols ;
   custom_mode_empty_operation_kinds ~kind protocols ;
   (* TODO: https://gitlab.com/tezos/tezos/-/issues/4373
-- 
GitLab