smp server: do not cache all queues from database while processing expirations (#1483)

* smp server: expire only active queues

* version

* do not cache all queues while processing expirations

* refactor

* foldWithOptions_

* version

* use shared lock when expiring all queues

* use TMVar

* comment

* rename

* remove fold options

* do not create locks in the Map for temporarily loaded queues

* fix

* revert version
This commit is contained in:
Evgeny
2025-03-15 20:11:30 +00:00
committed by GitHub
parent fdf8bd7ee2
commit 1b5a9f3b0c
9 changed files with 186 additions and 97 deletions
@@ -23,7 +23,6 @@ module Simplex.Messaging.Server.QueueStore.Postgres
PostgresStoreCfg (..),
batchInsertQueues,
foldQueueRecs,
foldQueues,
)
where
@@ -166,11 +165,26 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
loadRcvQueue = loadQueue " WHERE recipient_id = ?" $ \_ -> pure ()
loadSndQueue = loadQueue " WHERE sender_id = ?" $ \rId -> TM.insert qId rId senders
loadNtfQueue = loadQueue " WHERE notifier_id = ?" $ \_ -> pure () -- do NOT cache ref - ntf subscriptions are rare
loadQueue condition insertRef = runExceptT $ loadQueueRec >>= liftIO . cachedOrLoadedQueue st mkQ insertRef
where
loadQueueRec =
loadQueue condition insertRef =
runExceptT $ do
(rId, qRec) <-
withDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
DB.query db (queueRecQuery <> condition <> " AND deleted_at IS NULL") (Only qId)
liftIO $ do
sq <- mkQ rId qRec -- loaded queue
-- This lock prevents the scenario when the queue is added to cache,
-- while another thread is proccessing the same queue in withAllMsgQueues
-- without adding it to cache, possibly trying to open the same files twice.
-- Alse see comment in idleDeleteExpiredMsgs.
withQueueLock sq "getQueue_" $ atomically $
-- checking the cache again for concurrent reads,
-- use previously loaded queue if exists.
TM.lookup rId queues >>= \case
Just sq' -> pure sq'
Nothing -> do
insertRef rId
TM.insert rId sq queues
pure sq
secureQueue :: PostgresQueueStore q -> q -> SndPublicAuthKey -> IO (Either ErrorType ())
secureQueue st sq sKey =
@@ -311,18 +325,15 @@ insertQueueQuery =
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|]
foldQueues :: Monoid a => Bool -> PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> (q -> IO a) -> IO a
foldQueues tty st mkQ f =
foldQueueRecs tty st $ cachedOrLoadedQueue st mkQ (\_ -> pure ()) >=> f
foldQueueRecs :: Monoid a => Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
foldQueueRecs tty st f = do
(n, r) <- withConnection (dbStore st) $ \db ->
DB.fold_ db (queueRecQuery <> " WHERE deleted_at IS NULL") (0 :: Int, mempty) $ \(!i, !acc) row -> do
DB.fold_ db (queueRecQuery <> " WHERE deleted_at IS NULL") (0 :: Int, mempty) $ \(i, acc) row -> do
r <- f $ rowToQueueRec row
let i' = i + 1
when (tty && i' `mod` 100000 == 0) $ putStr (progress i <> "\r") >> hFlush stdout
pure (i', acc <> r)
let !i' = i + 1
!acc' = acc <> r
when (tty && i' `mod` 100000 == 0) $ putStr (progress i' <> "\r") >> hFlush stdout
pure (i', acc')
when tty $ putStrLn $ progress n
pure r
where
@@ -338,19 +349,6 @@ queueRecQuery =
FROM msg_queues
|]
cachedOrLoadedQueue :: PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> (RecipientId -> STM ()) -> (RecipientId, QueueRec) -> IO q
cachedOrLoadedQueue PostgresQueueStore {queues} mkQ insertRef (rId, qRec) = do
sq <- liftIO $ mkQ rId qRec -- loaded queue
atomically $
-- checking the cache again for concurrent reads,
-- use previously loaded queue if exists.
TM.lookup rId queues >>= \case
Just sq' -> pure sq'
Nothing -> do
insertRef rId
TM.insert rId sq queues
pure sq
type QueueRecRow = (RecipientId, RcvPublicAuthKey, RcvDhSecret, SenderId, Maybe SndPublicAuthKey, SenderCanSecure, Maybe NotifierId, Maybe NtfPublicAuthKey, Maybe RcvNtfDhSecret, ServerEntityStatus, Maybe RoundedSystemTime)
queueRecToRow :: (RecipientId, QueueRec) -> QueueRecRow