core: batch sending messages (#3566)

* core: batch sending messages

* batch without iorefs (#3573)

* one-pass

* simplexmq

* simplexmq

* simplexmq

* simplexmq

* revert change to ios project file

* refactor

* simplify

---------

Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2023-12-20 06:38:39 +00:00
committed by GitHub
parent 7b073ba9f8
commit 6ba3100d34
7 changed files with 87 additions and 45 deletions
+15
View File
@@ -84,6 +84,7 @@ import Simplex.RemoteControl.Invitation (RCSignedInvitation, RCVerifiedInvitatio
import Simplex.RemoteControl.Types
import System.IO (Handle)
import System.Mem.Weak (Weak)
import qualified UnliftIO.Exception as E
import UnliftIO.STM
versionNumber :: String
@@ -1287,12 +1288,26 @@ withStoreCtx ctx_ action = do
handleInternal :: String -> SomeException -> IO (Either StoreError a)
handleInternal ctxStr e = pure . Left . SEInternalError $ show e <> ctxStr
withStoreBatch :: (ChatMonad' m, Traversable t) => (DB.Connection -> t (IO (Either ChatError a))) -> m (t (Either ChatError a))
withStoreBatch actions = do
ChatController {chatStore} <- ask
liftIO $ withTransaction chatStore $ mapM (`E.catch` handleInternal) . actions
where
handleInternal :: E.SomeException -> IO (Either ChatError a)
handleInternal = pure . Left . ChatError . CEInternalError . show
withStoreBatch' :: (ChatMonad' m, Traversable t) => (DB.Connection -> t (IO a)) -> m (t (Either ChatError a))
withStoreBatch' actions = withStoreBatch $ fmap (fmap Right) . actions
withAgent :: ChatMonad m => (AgentClient -> ExceptT AgentErrorType m a) -> m a
withAgent action =
asks smpAgent
>>= runExceptT . action
>>= liftEither . first (`ChatErrorAgent` Nothing)
withAgent' :: ChatMonad' m => (AgentClient -> m a) -> m a
withAgent' action = asks smpAgent >>= action
$(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CLQ") ''ChatListQuery)