blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

use priority database access

Browse Source
This commit is contained in:
Evgeny Poberezkin
2024-07-29 15:12:18 +01:00
parent 42669454b0
commit ca166d7f96
4 changed files with 295 additions and 281 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+16 -3
View File
@@ -73,7 +73,7 @@ import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWo
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, ServerCfg)
import Simplex.Messaging.Agent.Lock
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction)
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction, withTransactionPriority)
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Client (SMPProxyFallback (..), SMPProxyMode (..), SocksMode (..))
@@ -1393,11 +1393,24 @@ toView' ev = do
withStore' :: (DB.Connection -> IO a) -> CM a
withStore' action = withStore $ liftIO . action
{-# INLINE withStore' #-}
withFastStore' :: (DB.Connection -> IO a) -> CM a
withFastStore' action = withFastStore $ liftIO . action
{-# INLINE withFastStore' #-}
withStore :: (DB.Connection -> ExceptT StoreError IO a) -> CM a
withStore action = do
withStore = withStorePriority False
{-# INLINE withStore #-}
withFastStore :: (DB.Connection -> ExceptT StoreError IO a) -> CM a
withFastStore = withStorePriority True
{-# INLINE withFastStore #-}
withStorePriority :: Bool -> (DB.Connection -> ExceptT StoreError IO a) -> CM a
withStorePriority priority action = do
ChatController {chatStore} <- ask
liftIOEither $ withTransaction chatStore (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
liftIOEither $ withTransactionPriority chatStore priority (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
withStoreBatch :: Traversable t => (DB.Connection -> t (IO (Either ChatError a))) -> CM' (t (Either ChatError a))
withStoreBatch actions = do