dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-03-30 22:55:50 +00:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Evgeny
2025-06-09 12:47:35 +01:00
committed by GitHub
parent 5241f5fe5e
commit 3df2425162
1 changed files with 13 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
src/Simplex/Messaging/Server/QueueStore/Postgres.hs
View File

@@ -210,7 +210,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
mask = E.uninterruptibleMask_ . runExceptT
cacheSender rId = TM.insert qId rId senders
loadQueue condition =
withDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
withFastDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
DB.query db (queueRecQuery <> condition <> " AND deleted_at IS NULL") (Only qId)
cacheQueue rId qRec insertRef = do
sq <- mkQ True rId qRec -- loaded queue
@@ -391,7 +391,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
getCreateService st sr@ServiceRec {serviceId = newSrvId, serviceRole, serviceCertHash = XV.Fingerprint fp} =
withLockMap (serviceLocks st) fp "getCreateService" $ E.uninterruptibleMask_ $ runExceptT $ do
(serviceId, new) <-
withDB "getCreateService" st $ \db ->
withFastDB "getCreateService" st $ \db ->
maybeFirstRow id (DB.query db "SELECT service_id, service_role FROM services WHERE service_cert_hash = ?" (Only (Binary fp))) >>= \case
Just (serviceId, role)
| role == serviceRole -> pure $ Right (serviceId, False)
@@ -640,10 +640,19 @@ assertUpdated = (>>= \n -> when (n == 0) (throwE AUTH))
withDB' :: Text -> PostgresQueueStore q -> (DB.Connection -> IO a) -> ExceptT ErrorType IO a
withDB' op st action = withDB op st $ fmap Right . action
{-# INLINE withDB' #-}
withFastDB :: forall a q. Text -> PostgresQueueStore q -> (DB.Connection -> IO (Either ErrorType a)) -> ExceptT ErrorType IO a
withFastDB op st = withDB_ op st True
{-# INLINE withFastDB #-}
withDB :: forall a q. Text -> PostgresQueueStore q -> (DB.Connection -> IO (Either ErrorType a)) -> ExceptT ErrorType IO a
withDB op st action =
ExceptT $ E.try (withConnection (dbStore st) action) >>= either logErr pure
withDB op st = withDB_ op st False
{-# INLINE withDB #-}
withDB_ :: forall a q. Text -> PostgresQueueStore q -> Bool -> (DB.Connection -> IO (Either ErrorType a)) -> ExceptT ErrorType IO a
withDB_ op st priority action =
ExceptT $ E.try (withTransactionPriority (dbStore st) priority action) >>= either logErr pure
where
logErr :: E.SomeException -> IO (Either ErrorType a)
logErr e = logError ("STORE: " <> err) $> Left (STORE err)