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

core: publish sendMessagesB (#949)

Browse Source
This commit is contained in:
Alexander Bondarenko
2024-01-04 17:37:13 +02:00
committed by GitHub
parent 37d30240fd
commit 6d4834f306
1 changed files with 8 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Agent.hs
+8 -4
View File
@@ -65,6 +65,7 @@ module Simplex.Messaging.Agent
resubscribeConnections,
sendMessage,
sendMessages,
sendMessagesB,
ackMessage,
switchConnection,
abortConnectionSwitch,
@@ -289,6 +290,9 @@ type MsgReq = (ConnId, MsgFlags, MsgBody)
sendMessages :: MonadUnliftIO m => AgentClient -> [MsgReq] -> m [Either AgentErrorType AgentMsgId]
sendMessages c = withAgentEnv c . sendMessages' c
sendMessagesB :: (MonadUnliftIO m, Traversable t) => AgentClient -> t (Either AgentErrorType MsgReq) -> m (t (Either AgentErrorType AgentMsgId))
sendMessagesB c = withAgentEnv c . sendMessagesB' c
ackMessage :: AgentErrorMonad m => AgentClient -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> m ()
ackMessage c = withAgentEnv c .:. ackMessage' c
@@ -879,14 +883,14 @@ getNotificationMessage' c nonce encNtfInfo = do
-- | Send message to the connection (SEND command) in Reader monad
sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgFlags -> MsgBody -> m AgentMsgId
sendMessage' c connId msgFlags msg = liftEither . runIdentity =<< sendMessagesB c (Identity (Right (connId, msgFlags, msg)))
sendMessage' c connId msgFlags msg = liftEither . runIdentity =<< sendMessagesB' c (Identity (Right (connId, msgFlags, msg)))
-- | Send multiple messages to different connections (SEND command) in Reader monad
sendMessages' :: forall m. AgentMonad' m => AgentClient -> [MsgReq] -> m [Either AgentErrorType AgentMsgId]
sendMessages' c = sendMessagesB c . map Right
sendMessages' c = sendMessagesB' c . map Right
sendMessagesB :: forall m t. (AgentMonad' m, Traversable t) => AgentClient -> t (Either AgentErrorType MsgReq) -> m (t (Either AgentErrorType AgentMsgId))
sendMessagesB c reqs = withConnLocks c connIds "sendMessages" $ do
sendMessagesB' :: forall m t. (AgentMonad' m, Traversable t) => AgentClient -> t (Either AgentErrorType MsgReq) -> m (t (Either AgentErrorType AgentMsgId))
sendMessagesB' c reqs = withConnLocks c connIds "sendMessages" $ do
reqs' <- withStoreBatch c (\db -> fmap (bindRight $ \req@(connId, _, _) -> bimap storeError (req,) <$> getConn db connId) reqs)
let reqs'' = fmap (>>= prepareConn) reqs'
enqueueMessagesB c reqs''