dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-06-04 19:01:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'stable'

Browse Source
This commit is contained in:
Evgeny Poberezkin
2024-01-15 13:52:09 +00:00
parent 135e735dd4 8d7dcb550a
commit bfb274b037
8 changed files with 44 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Messages/Batch.hs
+20 -23
View File
@@ -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