Merge remote-tracking branch 'origin/pq' into ab/compression-cleanup

cabal.project

@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 11288866f90bafb0892701b0e0679eddb030b5df
+    tag: dd22b5c823eb38310bdb51703b7941752877d27b
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."00ae2cb6e134e3cd7c8089e30f95a9430d3c4e3d" = "1dvghlsrf0dw8g279gnb4m2s7jrj9bwdibcq61hkkb9h5975f93d";
+  "https://github.com/simplex-chat/simplexmq.git"."dd22b5c823eb38310bdb51703b7941752877d27b" = "00nvy7a6ks1q5s19arlnzb9mdra0mh9zs89lm3wl6lpfmn7r8gnr";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

src/Simplex/Chat.hs

@@ -6106,7 +6106,7 @@ batchSndMessagesJSON = batchMessages maxRawMsgLength . L.toList
 --   compressed <- liftIO $ withCompressCtx maxChatMsgSize $ \cctx -> mapM (compressForBatch cctx) msgs
 --   pure . map toMsgBatch . SMP.batchTransmissions_ (maxEncodedMsgLength PQEncOff) $ L.zip compressed msgs
 --   where
---     compressForBatch cctx SndMessage {msgBody} = bimap (const TELargeMsg) smpEncode <$> compress cctx msgBody
+--     compressForBatch cctx SndMessage {msgBody} = smpEncode <$> compress cctx msgBody
 --     toMsgBatch :: SMP.TransportBatch SndMessage -> Either ChatError MsgBatch
 --     toMsgBatch = \case
 --       SMP.TBTransmissions combined _n sms -> Right $ MsgBatch (markCompressedBatch combined) sms
@@ -6128,9 +6128,7 @@ encodeConnInfoPQ pqSup chatMsgEvent = do
       | otherwise -> pure encodedBody
     ECMLarge -> throwChatError $ CEException "large message"
   where
-    compressedBatchMsgBody msgBody =
+    compressedBatchMsgBody msgBody = liftIO $ withCompressCtx (fromIntegral $ B.length msgBody) (`compressedBatchMsgBody_` msgBody)
-      liftEitherError (ChatError . CEException . mappend "compressedBatchMsgBody: ") $
-        withCompressCtx (B.length msgBody) (`compressedBatchMsgBody_` msgBody)
 
 deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m (Int64, PQEncryption)
 deliverMessage conn cmEventTag msgBody msgId = do
@@ -6155,13 +6153,12 @@ deliverMessagesB msgReqs = do
   void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent)
   withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent
   where
-    compressBodies = liftIO $ withCompressCtx maxRawMsgLength $ \cctx ->
+    compressBodies = liftIO $ withCompressCtx (fromIntegral maxRawMsgLength) $ \cctx ->
       forM msgReqs $ \case
         -- TODO PQ combine pqSupport and pqEncryption to one type:
         -- data PQMode = PQDisabled | PQSupported PQEncryption
         mr@(Right (conn@Connection {pqSupport, pqEncryption}, msgFlags, msgBody, msgId)) -> case pqSupport `CR.pqSupportOrEnc` pqEncryption of
-          PQSupportOn ->
+          PQSupportOn -> (\cBody -> Right (conn, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody
-            bimap (ChatError . CEException) (\cBody -> (conn, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody
           PQSupportOff -> pure mr
         skip -> pure skip
     toAgent = \case

src/Simplex/Chat/Protocol.hs

@@ -52,7 +52,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
 import Simplex.Messaging.Protocol (MsgBody)
-import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$$>), (<$?>))
+import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version hiding (version)
 
 -- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
@@ -554,18 +554,18 @@ parseChatMessages s = case B.head s of
   '[' -> case J.eitherDecodeStrict' s of
     Right v -> map parseItem v
     Left e -> [Left e]
-  'X' -> decodeCompressed (B.drop 1 s)
+  'X' -> decodeCompressedBatch (B.drop 1 s)
   _ -> [ACMsg SBinary <$> (appBinaryToCM =<< strDecode s)]
   where
     parseItem :: J.Value -> Either String AChatMessage
     parseItem v = ACMsg SJson <$> JT.parseEither parseJSON v
-    decodeCompressed :: ByteString -> [Either String AChatMessage]
+    decodeCompressedBatch :: ByteString -> [Either String AChatMessage]
-    decodeCompressed s' = case smpDecode s' of
+    decodeCompressedBatch s' = case smpDecode s' of
       Left e -> [Left e]
       Right compressed -> concatMap (either (pure . Left) parseChatMessages) . L.toList $ decompressBatch maxRawMsgLength compressed
 
-compressedBatchMsgBody_ :: CompressCtx -> MsgBody -> IO (Either String ByteString)
+compressedBatchMsgBody_ :: CompressCtx -> MsgBody -> IO MsgBody
-compressedBatchMsgBody_ ctx msgBody = markCompressedBatch . smpEncode . (L.:| []) <$$> compress ctx msgBody
+compressedBatchMsgBody_ ctx msgBody = markCompressedBatch . smpEncode . (L.:| []) <$> compress ctx msgBody
 
 markCompressedBatch :: ByteString -> ByteString
 markCompressedBatch = B.cons 'X'