blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: update simplexmq, optimize batching, remove builder (#3685)

Browse Source 
* core: update simplexmq (optimize batching, remove builder)

* do not use builder to batch

* refactor
This commit is contained in:
Evgeny Poberezkin
2024-01-15 10:46:13 +00:00
committed by GitHub
parent 045b195483
commit 8d7dcb550a
8 changed files with 45 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+7 -9
View File
@@ -29,7 +29,6 @@ import Data.Bifunctor (bimap, first)
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Builder (toLazyByteString)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
@@ -5656,8 +5655,7 @@ sendGroupMemberMessages user conn@Connection {connId} events groupId = do
processBatch batch `catchChatError` (toView . CRChatError (Just user))
where
processBatch :: MsgBatch -> m ()
processBatch (MsgBatch builder sndMsgs) = do
let batchBody = LB.toStrict $ toLazyByteString builder
processBatch (MsgBatch batchBody sndMsgs) = do
agentMsgId <- withAgent $ \a -> sendMessage a (aConnId conn) MsgFlags {notification = True} batchBody
let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId}
void . withStoreBatch' $ \db -> map (\SndMessage {msgId} -> createSndMsgDelivery db sndMsgDelivery msgId) sndMsgs
@@ -5677,28 +5675,28 @@ directMessage chatMsgEvent = do
chatVRange <- chatVersionRange
let r = encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
case r of
ECMEncoded encodedBody -> pure . LB.toStrict $ encodedBody
ECMEncoded encodedBody -> pure encodedBody
ECMLarge -> throwChatError $ CEException "large message"
deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> LazyMsgBody -> MessageId -> m Int64
deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m Int64
deliverMessage conn cmEventTag msgBody msgId = do
let msgFlags = MsgFlags {notification = hasNotification cmEventTag}
deliverMessage' conn msgFlags msgBody msgId
deliverMessage' :: ChatMonad m => Connection -> MsgFlags -> LazyMsgBody -> MessageId -> m Int64
deliverMessage' :: ChatMonad m => Connection -> MsgFlags -> MsgBody -> MessageId -> m Int64
deliverMessage' conn msgFlags msgBody msgId =
deliverMessages [(conn, msgFlags, msgBody, msgId)] >>= \case
[r] -> liftEither r
rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs)
deliverMessages :: ChatMonad' m => [(Connection, MsgFlags, LazyMsgBody, MessageId)] -> m [Either ChatError Int64]
deliverMessages :: ChatMonad' m => [(Connection, MsgFlags, MsgBody, MessageId)] -> m [Either ChatError Int64]
deliverMessages msgReqs = do
sent <- zipWith prepareBatch msgReqs <$> withAgent' (`sendMessages` aReqs)
withStoreBatch $ \db -> map (bindRight $ createDelivery db) sent
where
aReqs = map (\(conn, msgFlags, msgBody, _msgId) -> (aConnId conn, msgFlags, LB.toStrict msgBody)) msgReqs
aReqs = map (\(conn, msgFlags, msgBody, _msgId) -> (aConnId conn, msgFlags, msgBody)) msgReqs
prepareBatch req = bimap (`ChatErrorAgent` Nothing) (req,)
createDelivery :: DB.Connection -> ((Connection, MsgFlags, LazyMsgBody, MessageId), AgentMsgId) -> IO (Either ChatError Int64)
createDelivery :: DB.Connection -> ((Connection, MsgFlags, MsgBody, MessageId), AgentMsgId) -> IO (Either ChatError Int64)
createDelivery db ((Connection {connId}, _, _, msgId), agentMsgId) =
Right <$> createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId}) msgId