dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-10 21:37:09 +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.hs
+6 -8
View File
@@ -28,7 +28,6 @@ import Data.Bifunctor (bimap, first, second)
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
@@ -5791,8 +5790,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
@@ -5802,21 +5800,21 @@ 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)
type MsgReq = (Connection, MsgFlags, LazyMsgBody, MessageId)
type MsgReq = (Connection, MsgFlags, MsgBody, MessageId)
deliverMessages :: ChatMonad' m => [MsgReq] -> m [Either ChatError Int64]
deliverMessages = deliverMessagesB . map Right
@@ -5827,7 +5825,7 @@ deliverMessagesB msgReqs = do
withStoreBatch $ \db -> map (bindRight $ createDelivery db) sent
where
toAgent = \case
Right (conn, msgFlags, msgBody, _msgId) -> Right (aConnId conn, msgFlags, LB.toStrict msgBody)
Right (conn, msgFlags, msgBody, _msgId) -> Right (aConnId conn, msgFlags, msgBody)
Left _ce -> Left (AP.INTERNAL "ChatError, skip") -- as long as it is Left, the agent batchers should just step over it
prepareBatch (Right req) (Right ar) = Right (req, ar)
prepareBatch (Left ce) _ = Left ce -- restore original ChatError