From 097cec1c351f0beaf85f92bd157fd9c1338d9a03 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Tue, 19 Mar 2024 14:13:42 +0200
Subject: [PATCH] utils: add stateless compress1 (#1053)

---
 src/Simplex/Messaging/Compression.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Compression.hs b/src/Simplex/Messaging/Compression.hs
index fec9f8151..339107bea 100644
--- a/src/Simplex/Messaging/Compression.hs
+++ b/src/Simplex/Messaging/Compression.hs
@@ -3,6 +3,7 @@
 
 module Simplex.Messaging.Compression where
 
+import qualified Codec.Compression.Zstd as Z1
 import qualified Codec.Compression.Zstd.FFI as Z
 import Control.Monad (forM)
 import Control.Monad.Except
@@ -28,6 +29,9 @@ data Compressed
 maxLengthPassthrough :: Int
 maxLengthPassthrough = 180 -- Sampled from real client data. Messages with length > 180 rapidly gain compression ratio.
 
+compressionLevel :: Num a => a
+compressionLevel = 3
+
 instance Encoding Compressed where
   smpEncode = \case
     Passthrough bytes -> "0" <> smpEncode bytes
@@ -38,6 +42,12 @@ instance Encoding Compressed where
       '1' -> Compressed <$> smpP
       x -> fail $ "unknown Compressed tag: " <> show x
 
+-- | Compress as single chunk using stack-allocated context.
+compress1 :: ByteString -> Compressed
+compress1 bs
+  | B.length bs <= maxLengthPassthrough = Passthrough bs
+  | otherwise = Compressed . Large $ Z1.compress compressionLevel bs
+
 type CompressCtx = (Ptr Z.CCtx, Ptr CChar, CSize)
 
 withCompressCtx :: CSize -> (CompressCtx -> IO a) -> IO a
@@ -56,7 +66,7 @@ compress_ (cctx, scratchPtr, scratchSize) bs
   | otherwise =
       B.unsafeUseAsCStringLen bs $ \(sourcePtr, sourceSize) -> runExceptT $ do
         -- should not fail, unless input buffer is too short
-        dstSize <- ExceptT $ Z.checkError $ Z.compressCCtx cctx scratchPtr scratchSize sourcePtr (fromIntegral sourceSize) 3
+        dstSize <- ExceptT $ Z.checkError $ Z.compressCCtx cctx scratchPtr scratchSize sourcePtr (fromIntegral sourceSize) compressionLevel
         liftIO $ Compressed . Large <$> B.packCStringLen (scratchPtr, fromIntegral dstSize)
 
 type DecompressCtx = (Ptr Z.DCtx, Ptr CChar, CSize)