dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-08-28 00:44:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: tweak compress api (#1029)

Browse Source 
* convert compress to a wrapper with passthrough fallback

* add compress1 for non-batched compression

* use original size as upper bound for scratch

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
Alexander Bondarenko
2024-03-07 14:17:32 +00:00
committed by GitHub
co-authored by Evgeny Poberezkin
parent 11288866f9
commit dd22b5c823
1 changed files with 18 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Compression.hs
+18 -12
View File
@@ -5,9 +5,12 @@ module Simplex.Messaging.Compression where
import qualified Codec.Compression.Zstd.FFI as Z
import Control.Monad (forM)
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.Either (fromRight)
import Data.List.NonEmpty (NonEmpty)
import Foreign
import Foreign.C.Types
@@ -23,7 +26,7 @@ data Compressed
-- | Messages below this length are not encoded to avoid compression overhead.
maxLengthPassthrough :: Int
maxLengthPassthrough = 181 -- Sampled from real client data. Messages with length >=181 rapidly gain compression ratio.
maxLengthPassthrough = 180 -- Sampled from real client data. Messages with length > 180 rapidly gain compression ratio.
instance Encoding Compressed where
smpEncode = \case
@@ -35,23 +38,26 @@ instance Encoding Compressed where
'1' -> Compressed <$> smpP
x -> fail $ "unknown Compressed tag: " <> show x
type CompressCtx = (Ptr Z.CCtx, Ptr CChar, Int)
type CompressCtx = (Ptr Z.CCtx, Ptr CChar, CSize)
withCompressCtx :: Int -> (CompressCtx -> IO a) -> IO a
withCompressCtx :: CSize -> (CompressCtx -> IO a) -> IO a
withCompressCtx scratchSize action =
bracket Z.createCCtx Z.freeCCtx $ \cctx ->
allocaBytes scratchSize $ \scratchPtr ->
allocaBytes (fromIntegral scratchSize) $ \scratchPtr ->
action (cctx, scratchPtr, scratchSize)
compress :: CompressCtx -> ByteString -> IO (Either String Compressed)
compress (cctx, scratchPtr, scratchSize) bs
| B.length bs < maxLengthPassthrough = pure . Right $ Passthrough bs
-- | Compress bytes, falling back to Passthrough in case of some internal error.
compress :: CompressCtx -> ByteString -> IO Compressed
compress ctx bs = fromRight (Passthrough bs) <$> compress_ ctx bs
compress_ :: CompressCtx -> ByteString -> IO (Either String Compressed)
compress_ (cctx, scratchPtr, scratchSize) bs
| B.length bs <= maxLengthPassthrough = pure . Right $ Passthrough bs
| otherwise =
B.unsafeUseAsCStringLen bs $ \(sourcePtr, sourceSize) -> do
res <- Z.checkError $ Z.compressCCtx cctx scratchPtr (fromIntegral scratchSize) sourcePtr (fromIntegral sourceSize) 3
case res of
Left e -> pure $ Left e -- should not happen, unless input buffer is too short
Right dstSize -> Right . Compressed . Large <$> B.packCStringLen (scratchPtr, fromIntegral dstSize)
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
liftIO $ Compressed . Large <$> B.packCStringLen (scratchPtr, fromIntegral dstSize)
type DecompressCtx = (Ptr Z.DCtx, Ptr CChar, CSize)