dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-08-28 05:04:40 +00:00
Code Issues Packages Projects Releases Wiki Activity

add with withTransaction version with logging (#757)

Browse Source
This commit is contained in:
spaced4ndy
2023-05-26 20:33:48 +04:00
committed by GitHub
parent 6c6f22051d
commit 4a3c5abf32
1 changed files with 18 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Agent/Store/SQLite.hs
+18 -4
View File
@@ -184,6 +184,7 @@ module Simplex.Messaging.Agent.Store.SQLite
-- * utilities
withConnection,
withTransaction,
withTransactionCtx,
firstRow,
firstRow',
maybeFirstRow,
@@ -214,7 +215,7 @@ import Data.Ord (Down (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
import Data.Word (Word32)
import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), Query (..), SQLError, ToRow, field, (:.) (..))
import qualified Database.SQLite.Simple as DB
@@ -243,7 +244,7 @@ import Simplex.Messaging.Parsers (blobFieldParser, dropPrefix, fromTextField_, s
import Simplex.Messaging.Protocol
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (bshow, eitherToMaybe, ($>>=), (<$$>))
import Simplex.Messaging.Util (bshow, diffToMilliseconds, eitherToMaybe, ($>>=), (<$$>))
import Simplex.Messaging.Version
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
import System.Exit (exitFailure)
@@ -430,16 +431,29 @@ withConnection SQLiteStore {dbConnection} =
(atomically . putTMVar dbConnection)
withTransaction :: forall a. SQLiteStore -> (DB.Connection -> IO a) -> IO a
withTransaction st action = withConnection st $ loop 500 3_000_000
withTransaction = withTransactionCtx Nothing
withTransactionCtx :: forall a. Maybe String -> SQLiteStore -> (DB.Connection -> IO a) -> IO a
withTransactionCtx ctx_ st action = withConnection st $ loop 500 3_000_000
where
loop :: Int -> Int -> DB.Connection -> IO a
loop t tLim db =
DB.withImmediateTransaction db (action db) `E.catch` \(e :: SQLError) ->
transactionWithCtx `E.catch` \(e :: SQLError) ->
if tLim > t && DB.sqlError e == DB.ErrorBusy
then do
threadDelay t
loop (t * 9 `div` 8) (tLim - t) db
else E.throwIO e
where
transactionWithCtx = case ctx_ of
Nothing -> DB.withImmediateTransaction db (action db)
Just ctx -> do
t1 <- getCurrentTime
r <- DB.withImmediateTransaction db (action db)
t2 <- getCurrentTime
putStrLn $ "withTransactionCtx start :: " <> show t1 <> " :: " <> ctx
putStrLn $ "withTransactionCtx end :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
pure r
createUserRecord :: DB.Connection -> IO UserId
createUserRecord db = do