diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 78c21bd75..94eeb3a54 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -8,6 +8,7 @@ module Simplex.Messaging.Agent.Store.SQLite where import Control.Monad.IO.Unlift +import Data.Int (Int64) import Database.SQLite.Simple (NamedParam (..)) import qualified Database.SQLite.Simple as DB import Multiline (s) @@ -57,19 +58,23 @@ newSQLiteStore dbFile = do } withLock :: MonadUnliftIO m => SQLiteStore -> (SQLiteStore -> TMVar ()) -> (DB.Connection -> m a) -> m a -withLock store tableLock query = do - let lock = tableLock store +withLock st tableLock f = do + let lock = tableLock st E.bracket_ (atomically $ takeTMVar lock) (atomically $ putTMVar lock ()) - (query $ conn store) + (f $ conn st) + +insertWithLock :: MonadUnliftIO m => SQLiteStore -> (SQLiteStore -> TMVar ()) -> DB.Query -> [DB.NamedParam] -> m Int64 +insertWithLock st tableLock q qParams = do + withLock st tableLock $ \c -> liftIO $ do + DB.executeNamed c q qParams + DB.lastInsertRowId c instance MonadUnliftIO m => MonadAgentStore SQLiteStore m where addServer :: SQLiteStore -> SMPServer -> m (Either StoreError SMPServerId) - addServer store SMPServer {host, port, keyHash} = - withLock store serversLock $ \c -> liftIO $ do - DB.executeNamed c addServerQuery [":host_address" := host, ":port" := port, ":key_hash" := keyHash] - Right <$> DB.lastInsertRowId c + addServer st SMPServer {host, port, keyHash} = + Right <$> insertWithLock st serversLock addServerQuery [":host_address" := host, ":port" := port, ":key_hash" := keyHash] -- createRcvConn :: DB.Connection -> Maybe ConnAlias -> ReceiveQueue -> m (Either StoreError (Connection CReceive)) -- createRcvConn conn connAlias q = do