mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-05-29 20:24:15 +00:00
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 commit3df2425162. * version * Revert "version" This reverts commitd80a6b74c5.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user