tests, refactor

src/Simplex/Chat/Library/Internal.hs

@@ -2443,10 +2443,9 @@ encodeConnInfoPQ pqSup chatMsgEvent = do
   let info = ChatMessage {chatVRange = vr cxt, msgId = Nothing, chatMsgEvent}
   case encodeChatMessage maxEncodedInfoLength info of
     ECMEncoded connInfo -> case pqSup of
-      PQSupportOn | B.length connInfo > maxCompressedInfoLength -> do
-        let connInfo' = compressedBatchMsgBody_ connInfo
-        when (B.length connInfo' > maxCompressedInfoLength) $ throwChatError $ CEException "large compressed info"
-        pure connInfo'
+      -- with PQ off the budget is larger, so compressing is wasted work; service payloads need no
+      -- such gate because the request JOIN is PQSupportOn and the reply inherits it
+      PQSupportOn -> maybe (throwChatError $ CEException "large compressed info") pure $ compressBodyTo maxCompressedInfoLength connInfo
       _ -> pure connInfo
     ECMLarge -> throwChatError $ CEException "large info"
 
@@ -2502,10 +2501,8 @@ deliverMessagesB msgReqs = do
     compressBodies =
       forME msgReqs $ \(conn, msgFlags, (mbr, msgIds)) -> runExceptT $ do
         mbr' <- case mbr of
-          VRValue i msgBody | B.length msgBody > maxCompressedMsgLength -> do
-            let msgBody' = compressedBatchMsgBody_ msgBody
-            when (B.length msgBody' > maxCompressedMsgLength) $ throwError $ ChatError $ CEException "large compressed message"
-            pure $ VRValue i msgBody'
+          VRValue i msgBody ->
+            VRValue i <$> maybe (throwError $ ChatError $ CEException "large compressed message") pure (compressBodyTo maxCompressedMsgLength msgBody)
           v -> pure v
         pure (conn, msgFlags, (mbr', msgIds))
     toAgent prev = \case

src/Simplex/Chat/Protocol.hs

@@ -1039,16 +1039,20 @@ markCompressedBatch :: ByteString -> ByteString
 markCompressedBatch = B.cons 'X'
 {-# INLINE markCompressedBatch #-}
 
+-- Compress a body that is over the bound, and fail when it is still over it compressed.
+compressBodyTo :: Int -> ByteString -> Maybe ByteString
+compressBodyTo maxLen body
+  | B.length body <= maxLen = Just body
+  | B.length body' > maxLen = Nothing
+  | otherwise = Just body'
+  where
+    body' = compressedBatchMsgBody_ body
+
 -- Service payloads are padded to e2eEncConnInfoLength, the same budget as connection info,
 -- so they use the compression, marker and size bound of encodeConnInfoPQ. A JSON payload
 -- never starts with 'X', so the marker is unambiguous.
 compressServiceBody :: ByteString -> Either String ByteString
-compressServiceBody body
-  | B.length body <= maxCompressedInfoLength = Right body
-  | B.length body' > maxCompressedInfoLength = Left "service payload is too large"
-  | otherwise = Right body'
-  where
-    body' = compressedBatchMsgBody_ body
+compressServiceBody = maybe (Left "service payload is too large") Right . compressBodyTo maxCompressedInfoLength
 
 decompressServiceBody :: ByteString -> Either String ByteString
 decompressServiceBody body = case B.uncons body of