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

smp server: add created/updated/used date to queues to manage expiration (#1306)

Browse Source 
* smp server: add created/updated/used date to queues to manage expiration, all: make Map updates strict in value

* remove strict

* remove time precision

* diff

* style

* only update when time changed
This commit is contained in:
Evgeny
2024-09-09 14:53:11 +01:00
committed by GitHub
parent 75712641ee
commit 990dcec348
4 changed files with 112 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Server/QueueStore/STM.hs
+16 -11
View File
@@ -19,6 +19,7 @@ module Simplex.Messaging.Server.QueueStore.STM
addQueueNotifier,
deleteQueueNotifier,
suspendQueue,
updateQueueTime,
deleteQueue,
)
where
@@ -65,8 +66,8 @@ getQueue QueueStore {queues, senders, notifiers} party qId =
SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)
secureQueue :: QueueStore -> RecipientId -> SndPublicAuthKey -> IO (Either ErrorType QueueRec)
secureQueue QueueStore {queues} rId sKey =
atomically $ withQueue rId queues $ \qVar ->
secureQueue QueueStore {queues} rId sKey = toResult <$> do
TM.lookupIO rId queues $>>= \qVar -> atomically $
readTVar qVar >>= \q -> case senderKey q of
Just k -> pure $ if sKey == k then Just q else Nothing
_ ->
@@ -74,26 +75,30 @@ secureQueue QueueStore {queues} rId sKey =
in writeTVar qVar q' $> Just q'
addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType QueueRec)
addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = atomically $ do
ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $
addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do
ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $
withQueue rId queues $ \qVar -> do
q <- readTVar qVar
forM_ (notifier q) $ (`TM.delete` notifiers) . notifierId
writeTVar qVar $! q {notifier = Just ntfCreds}
let !q' = q {notifier = Just ntfCreds}
writeTVar qVar q'
TM.insert nId rId notifiers
pure $ Just q
pure q'
deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType ())
deleteQueueNotifier QueueStore {queues, notifiers} rId =
atomically $ withQueue rId queues $ \qVar -> do
withQueue rId queues $ \qVar -> do
q <- readTVar qVar
forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
writeTVar qVar $! q {notifier = Nothing}
pure $ Just ()
suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ())
suspendQueue QueueStore {queues} rId =
atomically $ withQueue rId queues $ \qVar -> modifyTVar' qVar (\q -> q {status = QueueOff}) $> Just ()
withQueue rId queues (`modifyTVar'` \q -> q {status = QueueOff})
updateQueueTime :: QueueStore -> RecipientId -> RoundedSystemTime -> IO ()
updateQueueTime QueueStore {queues} rId t =
void $ withQueue rId queues (`modifyTVar'` \q -> q {updatedAt = Just t})
deleteQueue :: QueueStore -> RecipientId -> IO (Either ErrorType QueueRec)
deleteQueue QueueStore {queues, senders, notifiers} rId = atomically $ do
@@ -108,5 +113,5 @@ deleteQueue QueueStore {queues, senders, notifiers} rId = atomically $ do
toResult :: Maybe a -> Either ErrorType a
toResult = maybe (Left AUTH) Right
withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM (Maybe a)) -> STM (Either ErrorType a)
withQueue rId queues f = toResult <$> TM.lookup rId queues $>>= f
withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM a) -> IO (Either ErrorType a)
withQueue rId queues f = toResult <$> TM.lookupIO rId queues >>= atomically . mapM f