mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-10 19:27:08 +00:00
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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user