smp server: batch commands (#1559)

* protocol: refactor types and encoding

* clean

* smp server: batch commands (#1560)

* smp server: batch commands verification into one DB transaction

* ghc 8.10.7

* flatten transmission tuples

* diff

* only use batch logic if there is more than one transmission

* func

* reset NTF service when adding notifier

* version

* Revert "smp server: use separate database pool for reading queues and creating service records (#1561)"

This reverts commit 3df2425162.

* version

* Revert "version"

This reverts commit d80a6b74c5.
This commit is contained in:
Evgeny
2025-06-12 23:05:04 +01:00
committed by GitHub
parent 1658048c2c
commit da37384335
24 changed files with 556 additions and 377 deletions
@@ -324,6 +324,8 @@ instance QueueStoreClass (JournalQueue s) (QStore s) where
{-# INLINE addQueue_ #-}
getQueue_ = withQS getQueue_
{-# INLINE getQueue_ #-}
getQueues_ = withQS getQueues_
{-# INLINE getQueues_ #-}
addQueueLinkData = withQS addQueueLinkData
{-# INLINE addQueueLinkData #-}
getQueueLinkData = withQS getQueueLinkData
+15 -5
View File
@@ -18,6 +18,7 @@
module Simplex.Messaging.Server.MsgStore.Types where
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Trans.Except
import Data.Functor (($>))
import Data.Int (Int64)
@@ -107,14 +108,23 @@ addQueue :: MsgStoreClass s => s -> RecipientId -> QueueRec -> IO (Either ErrorT
addQueue st = addQueue_ (queueStore st) (mkQueue st True)
{-# INLINE addQueue #-}
getQueue :: (MsgStoreClass s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
getQueue :: (MsgStoreClass s, QueueParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
getQueue st = getQueue_ (queueStore st) (mkQueue st)
{-# INLINE getQueue #-}
getQueueRec :: (MsgStoreClass s, DirectParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s, QueueRec))
getQueueRec st party qId =
getQueue st party qId
$>>= (\q -> maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec q))
getQueueRec :: (MsgStoreClass s, QueueParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s, QueueRec))
getQueueRec st party qId = getQueue st party qId $>>= readQueueRec
getQueues :: (MsgStoreClass s, BatchParty p) => s -> SParty p -> [QueueId] -> IO [Either ErrorType (StoreQueue s)]
getQueues st = getQueues_ (queueStore st) (mkQueue st)
{-# INLINE getQueues #-}
getQueueRecs :: (MsgStoreClass s, BatchParty p) => s -> SParty p -> [QueueId] -> IO [Either ErrorType (StoreQueue s, QueueRec)]
getQueueRecs st party qIds = getQueues st party qIds >>= mapM (fmap join . mapM readQueueRec)
readQueueRec :: StoreQueueClass q => q -> IO (Either ErrorType (q, QueueRec))
readQueueRec q = maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec q)
{-# INLINE readQueueRec #-}
getQueueSize :: MsgStoreClass s => s -> StoreQueue s -> ExceptT ErrorType IO Int
getQueueSize st q = withPeekMsgQueue st q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)