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

servers: blocking records for content moderation (#1430)

Browse Source 
* servers: blocking records for content moderation

* update

* encode BLOCKED as AUTH in old versions

* update

* unblock queue command

* test, status command
This commit is contained in:
Evgeny
2025-01-12 19:34:00 +00:00
committed by GitHub
parent 9d9ec8cd0b
commit 3d4e0b06c0
20 changed files with 415 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Server/QueueStore/STM.hs
+25 -1
View File
@@ -21,6 +21,8 @@ module Simplex.Messaging.Server.QueueStore.STM
addQueueNotifier,
deleteQueueNotifier,
suspendQueue,
blockQueue,
unblockQueue,
updateQueueTime,
deleteQueue',
readQueueStore,
@@ -118,7 +120,27 @@ suspendQueue st sq =
where
qr = queueRec' sq
suspend q = do
writeTVar qr $! Just q {status = QueueOff}
writeTVar qr $! Just q {status = EntityOff}
pure $ recipientId q
blockQueue :: STMQueueStore s => s -> StoreQueue s -> BlockingInfo -> IO (Either ErrorType ())
blockQueue st sq info =
atomically (readQueueRec qr >>= mapM block)
$>>= \rId -> withLog "blockQueue" st (\sl -> logBlockQueue sl rId info)
where
qr = queueRec' sq
block q = do
writeTVar qr $ Just q {status = EntityBlocked info}
pure $ recipientId q
unblockQueue :: STMQueueStore s => s -> StoreQueue s -> IO (Either ErrorType ())
unblockQueue st sq =
atomically (readQueueRec qr >>= mapM unblock)
$>>= \rId -> withLog "unblockQueue" st (`logUnblockQueue` rId)
where
qr = queueRec' sq
unblock q = do
writeTVar qr $ Just q {status = EntityActive}
pure $ recipientId q
updateQueueTime :: STMQueueStore s => s -> StoreQueue s -> RoundedSystemTime -> IO (Either ErrorType QueueRec)
@@ -177,6 +199,8 @@ readQueueStore f st = withFile f ReadMode $ LB.hGetContents >=> mapM_ processLin
SecureQueue qId sKey -> withQueue qId "SecureQueue" $ \q -> secureQueue st q sKey
AddNotifier qId ntfCreds -> withQueue qId "AddNotifier" $ \q -> addQueueNotifier st q ntfCreds
SuspendQueue qId -> withQueue qId "SuspendQueue" $ suspendQueue st
BlockQueue qId info -> withQueue qId "BlockQueue" $ \q -> blockQueue st q info
UnblockQueue qId -> withQueue qId "UnblockQueue" $ unblockQueue st
DeleteQueue qId -> withQueue qId "DeleteQueue" $ deleteQueue st qId
DeleteNotifier qId -> withQueue qId "DeleteNotifier" $ deleteQueueNotifier st
UpdateTime qId t -> withQueue qId "UpdateTime" $ \q -> updateQueueTime st q t