From 72f670431fa7f382cf3c6f4deead2f20422228bb Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Wed, 25 Sep 2024 17:21:26 +0200
Subject: [PATCH] Rollup node/store: compress messages in database

---
 src/lib_smart_rollup_node/sql_store.ml | 49 +++++++++++++++++++++++++-
 1 file changed, 48 insertions(+), 1 deletion(-)

diff --git a/src/lib_smart_rollup_node/sql_store.ml b/src/lib_smart_rollup_node/sql_store.ml
index a576a6c491ed..dfe55416d51f 100644
--- a/src/lib_smart_rollup_node/sql_store.ml
+++ b/src/lib_smart_rollup_node/sql_store.ml
@@ -69,6 +69,30 @@ let with_transaction store k =
 module Types = struct
   let level = int32
 
+  let feed input =
+    let length = String.length input in
+    fun pos buf ->
+      let size = min (Bytes.length buf) (length - !pos) in
+      Bytes.blit_string input !pos buf 0 size ;
+      pos := !pos + size ;
+      size
+
+  let output res buf n = Buffer.add_subbytes res buf 0 n
+
+  let compress ?level s =
+    let compressed = Buffer.create 1024 in
+    Zlib.compress ?level ~header:false (feed s (ref 0)) (output compressed) ;
+    Buffer.contents compressed
+
+  let decompress input =
+    let uncompressed = Buffer.create 1_024 in
+    try
+      Zlib.uncompress ~header:false (feed input (ref 0)) (output uncompressed) ;
+      Ok (Buffer.contents uncompressed)
+    with Zlib.Error (func, msg) ->
+      let message = Format.asprintf "in %s: %s" func msg in
+      Error message
+
   let from_encoding ~name encoding =
     custom
       ~encode:(fun v ->
@@ -87,6 +111,29 @@ module Types = struct
                 Data_encoding.Binary.pp_read_error))
       octets
 
+  let from_encoding_compressed ~name encoding =
+    custom
+      ~encode:(fun v ->
+        match Data_encoding.Binary.to_string encoding v with
+        | Error e ->
+            Error
+              (Format.asprintf
+                 "Fail to encode %s for database: %a"
+                 name
+                 Data_encoding.Binary.pp_write_error
+                 e)
+        | Ok s -> Ok (compress s))
+      ~decode:(fun s ->
+        let open Result_syntax in
+        let* s = decompress s in
+        Data_encoding.Binary.of_string encoding s
+        |> Result.map_error
+             (Format.asprintf
+                "Fail to decode %s in database: %a"
+                name
+                Data_encoding.Binary.pp_read_error))
+      octets
+
   let tzcustom ~encode ~decode t =
     custom
       ~encode:(fun v -> Ok (encode v))
@@ -164,7 +211,7 @@ module Types = struct
     from_encoding ~name:"Inbox.history_proof" Inbox.history_proof_encoding
 
   let messages_list =
-    from_encoding
+    from_encoding_compressed
       ~name:"message list"
       Data_encoding.(list @@ dynamic_size (Variable.string' Hex))
 
-- 
GitLab