Revert "db error busy treatments (#796)" (#808)

This reverts commit 1afcefa5e7.

src/Simplex/Messaging/Agent/Store/SQLite/Common.hs

@@ -1,61 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Common
-  ( SQLiteStore (..),
-    withConnection,
-    withTransaction,
-    withTransactionCtx,
-    dbBusyLoop,
-  )
-where
-
-import Control.Concurrent (threadDelay)
-import Data.Time.Clock (diffUTCTime, getCurrentTime)
-import Database.SQLite.Simple (SQLError)
-import qualified Database.SQLite.Simple as DB
-import Simplex.Messaging.Util (diffToMilliseconds)
-import UnliftIO.Exception (bracket)
-import qualified UnliftIO.Exception as E
-import UnliftIO.STM
-
-data SQLiteStore = SQLiteStore
-  { dbFilePath :: FilePath,
-    dbEncrypted :: TVar Bool,
-    dbConnection :: TMVar DB.Connection,
-    dbNew :: Bool
-  }
-
-withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withConnection SQLiteStore {dbConnection} =
-  bracket
-    (atomically $ takeTMVar dbConnection)
-    (atomically . putTMVar dbConnection)
-
-withTransaction :: forall a. SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransaction = withTransactionCtx Nothing
-
-withTransactionCtx :: forall a. Maybe String -> SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransactionCtx ctx_ st action = withConnection st $ \db -> dbBusyLoop (transactionWithCtx db)
-  where
-    transactionWithCtx db = 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
-
-dbBusyLoop :: forall a. IO a -> IO a
-dbBusyLoop action = loop 500 3000000
-  where
-    loop :: Int -> Int -> IO a
-    loop t tLim =
-      action `E.catch` \(e :: SQLError) ->
-        if tLim > t && DB.sqlError e == DB.ErrorBusy
-          then do
-            threadDelay t
-            loop (t * 9 `div` 8) (tLim - t)
-          else E.throwIO e

src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs

@@ -42,7 +42,6 @@ import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
 import GHC.Generics (Generic)
 import Simplex.Messaging.Agent.Protocol (extraSMPServerHosts)
-import Simplex.Messaging.Agent.Store.SQLite.Common
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
@@ -106,42 +105,44 @@ app = sortOn name $ map migration schemaMigrations
   where
     migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}
 
-get :: SQLiteStore -> [Migration] -> IO (Either MTRError MigrationsToRun)
-get st migrations = migrationsToRun migrations <$> withTransaction st getCurrent
+get :: Connection -> [Migration] -> IO (Either MTRError MigrationsToRun)
+get db migrations = migrationsToRun migrations <$> getCurrent db
 
 getCurrent :: Connection -> IO [Migration]
 getCurrent db = map toMigration <$> DB.query_ db "SELECT name, down FROM migrations ORDER BY name ASC;"
   where
     toMigration (name, down) = Migration {name, up = "", down}
 
-run :: SQLiteStore -> MigrationsToRun -> IO ()
-run st = \case
+run :: Connection -> MigrationsToRun -> IO ()
+run db = \case
   MTRUp [] -> pure ()
-  MTRUp ms -> mapM_ runUp ms >> withConnection st (`execSQL` "VACUUM;")
+  MTRUp ms -> mapM_ runUp ms >> execSQL "VACUUM;"
   MTRDown ms -> mapM_ runDown $ reverse ms
   MTRNone -> pure ()
   where
-    runUp Migration {name, up, down} = withTransaction st $ \db -> do
-      when (name == "m20220811_onion_hosts") $ updateServers db
-      insert db >> execSQL db up
+    runUp Migration {name, up, down} = do
+      when (name == "m20220811_onion_hosts") updateServers
+      DB.withImmediateTransaction db $ insert >> execSQL up
       where
-        insert db = DB.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
-        updateServers db = forM_ (M.assocs extraSMPServerHosts) $ \(h, h') ->
-          let hs = decodeLatin1 . strEncode $ ([h, h'] :: NonEmpty TransportHost)
-           in DB.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
-    runDown DownMigration {downName, downQuery} = withTransaction st $ \db -> do
-      execSQL db downQuery
-      DB.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
-    execSQL db = SQLite3.exec $ DB.connectionHandle db
+        insert = DB.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
+        updateServers = forM_ (M.assocs extraSMPServerHosts) $ \(h, h') ->
+          DB.withImmediateTransaction db $
+            let hs = decodeLatin1 . strEncode $ ([h, h'] :: NonEmpty TransportHost)
+             in DB.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
+    runDown DownMigration {downName, downQuery} = do
+      DB.withImmediateTransaction db $ do
+        execSQL downQuery
+        DB.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
+    execSQL = SQLite3.exec $ DB.connectionHandle db
 
-initialize :: SQLiteStore -> IO ()
-initialize st = withTransaction st $ \db -> do
+initialize :: Connection -> IO ()
+initialize db = do
   cs :: [Text] <- map fromOnly <$> DB.query_ db "SELECT name FROM pragma_table_info('migrations')"
   case cs of
-    [] -> createMigrations db
+    [] -> createMigrations
     _ -> when ("down" `notElem` cs) $ DB.execute_ db "ALTER TABLE migrations ADD COLUMN down TEXT"
   where
-    createMigrations db =
+    createMigrations =
       DB.execute_
         db
         [sql|