directory service: fix queries (#6539)

* fix directory service queries

* fix

* reduce postgres pool size to 1

* stabilize postgres client tests, remove slow handshake tests

* update simplexmq

* fix test

* test delay
This commit is contained in:
Evgeny
2026-01-04 19:04:32 +00:00
committed by GitHub
parent ed3be9c228
commit f0467aee00
11 changed files with 117 additions and 257 deletions
+18 -14
View File
@@ -96,7 +96,12 @@ import Simplex.RemoteControl.Types
import System.IO (Handle)
import System.Mem.Weak (Weak)
import UnliftIO.STM
#if !defined(dbPostgres)
#if defined(dbPostgres)
import qualified Database.PostgreSQL.Simple as PSQL
type SQLError = PSQL.SqlError
#else
import Database.SQLite.Simple (SQLError)
import qualified Database.SQLite.Simple as SQL
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
@@ -1542,25 +1547,24 @@ withFastStore = withStorePriority True
withStorePriority :: Bool -> (DB.Connection -> ExceptT StoreError IO a) -> CM a
withStorePriority priority action = do
ChatController {chatStore} <- ask
liftIOEither $ withTransactionPriority chatStore priority (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
liftIOEither $ withTransactionPriority chatStore priority (runExceptT . withExceptT ChatErrorStore . action) `E.catch` handleDBErrors
withStoreBatch :: Traversable t => (DB.Connection -> t (IO (Either ChatError a))) -> CM' (t (Either ChatError a))
withStoreBatch actions = do
ChatController {chatStore} <- ask
liftIO $ withTransaction chatStore $ mapM (`E.catches` handleDBErrors) . actions
liftIO $ withTransaction chatStore $ mapM (`E.catch` handleDBErrors) . actions
-- TODO [postgres] postgres specific error handling
handleDBErrors :: [E.Handler (Either ChatError a)]
handleDBErrors =
#if !defined(dbPostgres)
( E.Handler $ \(e :: SQLError) ->
let se = SQL.sqlError e
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e
) :
handleDBErrors :: E.SomeException -> IO (Either ChatError a)
handleDBErrors e = pure $ Left $ ChatErrorStore $ case E.fromException e of
Just (e' :: SQLError) ->
#if defined(dbPostgres)
SEDBException $ show e'
#else
let se = SQL.sqlError e'
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
in (if busy then SEDBBusyError else SEDBException) $ show e'
#endif
[ E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e
]
Nothing -> SEDBException $ show e
withStoreBatch' :: Traversable t => (DB.Connection -> t (IO a)) -> CM' (t (Either ChatError a))
withStoreBatch' actions = withStoreBatch $ fmap (fmap Right) . actions