Merge branch 'stable'

src/Simplex/Chat/Messages.hs

@@ -25,7 +25,6 @@ import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as JQ
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64 as B64
-import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace)
 import Data.Int (Int64)
@@ -812,12 +811,10 @@ checkChatType x = case testEquality (chatTypeI @c) (chatTypeI @c') of
   Just Refl -> Right x
   Nothing -> Left "bad chat type"
 
-type LazyMsgBody = L.ByteString
-
 data SndMessage = SndMessage
   { msgId :: MessageId,
     sharedMsgId :: SharedMsgId,
-    msgBody :: LazyMsgBody
+    msgBody :: MsgBody
   }
   deriving (Show)
 
@@ -839,7 +836,7 @@ data RcvMessage = RcvMessage
 data PendingGroupMessage = PendingGroupMessage
   { msgId :: MessageId,
     cmEventTag :: ACMEventTag,
-    msgBody :: LazyMsgBody,
+    msgBody :: MsgBody,
     introId_ :: Maybe Int64
   }
 

src/Simplex/Chat/Messages/Batch.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Chat.Messages.Batch
@@ -9,32 +10,28 @@ module Simplex.Chat.Messages.Batch
   )
 where
 
-import Data.ByteString.Builder (Builder, charUtf8, lazyByteString)
-import qualified Data.ByteString.Lazy as LB
-import Data.Int (Int64)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
 import Simplex.Chat.Messages
 
-data MsgBatch = MsgBatch Builder [SndMessage]
+data MsgBatch = MsgBatch ByteString [SndMessage]
 
--- | Batches [SndMessage] into batches of ByteString builders in form of JSON arrays.
+-- | Batches [SndMessage] into batches of ByteStrings in form of JSON arrays.
 -- Does not check if the resulting batch is a valid JSON.
 -- If a single element is passed, it is returned as is (a JSON string).
 -- If an element exceeds maxLen, it is returned as ChatError.
-batchMessages :: Int64 -> [SndMessage] -> [Either ChatError MsgBatch]
-batchMessages maxLen msgs =
-  let (batches, batch, _, n) = foldr addToBatch ([], [], 0, 0) msgs
-   in if n == 0 then batches else msgBatch batch : batches
+batchMessages :: Int -> [SndMessage] -> [Either ChatError MsgBatch]
+batchMessages maxLen = addBatch . foldr addToBatch ([], [], 0, 0)
   where
     msgBatch batch = Right (MsgBatch (encodeMessages batch) batch)
-    addToBatch :: SndMessage -> ([Either ChatError MsgBatch], [SndMessage], Int64, Int) -> ([Either ChatError MsgBatch], [SndMessage], Int64, Int)
-    addToBatch msg@SndMessage {msgBody} (batches, batch, len, n)
+    addToBatch :: SndMessage -> ([Either ChatError MsgBatch], [SndMessage], Int, Int) -> ([Either ChatError MsgBatch], [SndMessage], Int, Int)
+    addToBatch msg@SndMessage {msgBody} acc@(batches, batch, len, n)
       | batchLen <= maxLen = (batches, msg : batch, len', n + 1)
-      | msgLen <= maxLen = (batches', [msg], msgLen, 1)
-      | otherwise = (errLarge msg : (if n == 0 then batches else batches'), [], 0, 0)
+      | msgLen <= maxLen = (addBatch acc, [msg], msgLen, 1)
+      | otherwise = (errLarge msg : addBatch acc, [], 0, 0)
       where
-        msgLen = LB.length msgBody
-        batches' = msgBatch batch : batches
+        msgLen = B.length msgBody
         len'
           | n == 0 = msgLen
           | otherwise = msgLen + len + 1 -- 1 accounts for comma
@@ -42,11 +39,11 @@ batchMessages maxLen msgs =
           | n == 0 = len'
           | otherwise = len' + 2 -- 2 accounts for opening and closing brackets
         errLarge SndMessage {msgId} = Left $ ChatError $ CEInternalError ("large message " <> show msgId)
-
-encodeMessages :: [SndMessage] -> Builder
-encodeMessages = \case
-  [] -> mempty
-  [msg] -> encodeMsg msg
-  (msg : msgs) -> charUtf8 '[' <> encodeMsg msg <> mconcat [charUtf8 ',' <> encodeMsg msg' | msg' <- msgs] <> charUtf8 ']'
-  where
-    encodeMsg SndMessage {msgBody} = lazyByteString msgBody
+    addBatch :: ([Either ChatError MsgBatch], [SndMessage], Int, Int) -> [Either ChatError MsgBatch]
+    addBatch (batches, batch, _, n) = if n == 0 then batches else msgBatch batch : batches
+    encodeMessages :: [SndMessage] -> ByteString
+    encodeMessages = \case
+      [] -> mempty
+      [msg] -> body msg
+      msgs -> B.concat ["[", B.intercalate "," (map body msgs), "]"]
+    body SndMessage {msgBody} = msgBody

src/Simplex/Chat/Protocol.hs

@@ -29,9 +29,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Internal (c2w, w2c)
-import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
 import Data.String
 import Data.Text (Text)
@@ -495,20 +493,20 @@ $(JQ.deriveJSON defaultJSON ''QuotedMsg)
 
 -- this limit reserves space for metadata in forwarded messages
 -- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, round to 15610
-maxChatMsgSize :: Int64
+maxChatMsgSize :: Int
 maxChatMsgSize = 15610
 
-data EncodedChatMessage = ECMEncoded L.ByteString | ECMLarge
+data EncodedChatMessage = ECMEncoded ByteString | ECMLarge
 
 encodeChatMessage :: MsgEncodingI e => ChatMessage e -> EncodedChatMessage
 encodeChatMessage msg = do
   case chatToAppMessage msg of
     AMJson m -> do
-      let body = J.encode m
-      if LB.length body > maxChatMsgSize
+      let body = LB.toStrict $ J.encode m
+      if B.length body > maxChatMsgSize
         then ECMLarge
         else ECMEncoded body
-    AMBinary m -> ECMEncoded . LB.fromStrict $ strEncode m
+    AMBinary m -> ECMEncoded $ strEncode m
 
 parseChatMessages :: ByteString -> [Either String AChatMessage]
 parseChatMessages "" = [Left "empty string"]