core: clean up msg compression

This commit is contained in:
Alexander Bondarenko
2024-03-06 21:51:17 +02:00
parent 61a3eb32ee
commit d6c76e8c87
4 changed files with 9 additions and 12 deletions
+4 -7
View File
@@ -6090,7 +6090,7 @@ batchSndMessagesJSON = batchMessages (maxEncodedMsgLength PQEncOff) . 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
@@ -6112,9 +6112,7 @@ directMessagePQ pqEnc maxMsgSize chatMsgEvent = do
| otherwise -> pure encodedBody
ECMLarge -> throwChatError $ CEException "large message"
where
compressedBatchMsgBody msgBody =
liftEitherError (ChatError . CEException . mappend "compressedBatchMsgBody: ") $
withCompressCtx (B.length msgBody) (`compressedBatchMsgBody_` msgBody)
compressedBatchMsgBody msgBody = liftIO $ withCompressCtx (fromIntegral $ B.length msgBody) (`compressedBatchMsgBody_` msgBody)
deliverMessage :: ChatMonad m => Connection -> CR.PQEncryption -> CMEventTag e -> MsgBody -> MessageId -> m (Int64, CR.PQEncryption)
deliverMessage conn pqEnc cmEventTag msgBody msgId = do
@@ -6139,11 +6137,10 @@ 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
mr@(Right (conn, pqEnc, msgFlags, msgBody, msgId))
| pqEnc == CR.PQEncOn -> do
bimap (ChatError . CEException) (\cBody -> (conn, pqEnc, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody
| pqEnc == CR.PQEncOn -> compressedBatchMsgBody_ cctx msgBody >>= \msgBodyC -> pure $ Right (conn, pqEnc, msgFlags, msgBodyC, msgId)
| otherwise -> pure mr
skip -> pure skip
toAgent = \case
+3 -3
View File
@@ -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.
@@ -561,8 +561,8 @@ parseChatMessages s = case B.head 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_ ctx msgBody = markCompressedBatch . smpEncode . (L.:| []) <$$> compress ctx msgBody
compressedBatchMsgBody_ :: CompressCtx -> MsgBody -> IO MsgBody
compressedBatchMsgBody_ ctx msgBody = markCompressedBatch . smpEncode . (L.:| []) <$> compress ctx msgBody
markCompressedBatch :: ByteString -> ByteString
markCompressedBatch = B.cons 'X'