newConnectionPool -> withConnectionPool

lib/core/src/Cardano/DB/Sqlite.hs

@@ -29,8 +29,7 @@ module Cardano.DB.Sqlite
 
     -- * ConnectionPool
     , ConnectionPool
-    , newConnectionPool
-    , destroyConnectionPool
+    , withConnectionPool
 
     -- * Helpers
     , chunkSize
@@ -122,7 +121,7 @@ import System.Log.FastLogger
 import UnliftIO.Compat
     ( handleIf, mkRetryHandler )
 import UnliftIO.Exception
-    ( Exception, bracket_, handleJust, mask_, tryJust )
+    ( Exception, bracket, bracket_, handleJust, mask_, tryJust )
 import UnliftIO.MVar
     ( newMVar, withMVarMasked )
 
@@ -417,6 +416,14 @@ instance MatchMigrationError SqliteException where
 newtype ManualMigration = ManualMigration
     { executeManualMigration :: Sqlite.Connection -> IO () }
 
+withConnectionPool
+    :: Tracer IO DBLog
+    -> FilePath
+    -> (ConnectionPool -> IO a)
+    -> IO a
+withConnectionPool tr fp =
+    bracket (newConnectionPool tr fp) destroyConnectionPool
+
 newConnectionPool
     :: Tracer IO DBLog
     -> FilePath

lib/core/src/Cardano/Pool/DB/Sqlite.hs

@@ -41,13 +41,12 @@ import Cardano.DB.Sqlite
     , ManualMigration (..)
     , MigrationError
     , SqliteContext (..)
-    , destroyConnectionPool
     , fieldName
     , handleConstraint
-    , newConnectionPool
     , newInMemorySqliteContext
     , newSqliteContext
     , tableName
+    , withConnectionPool
     )
 import Cardano.Pool.DB
     ( DBLayer (..), ErrPointAlreadyExists (..), determinePoolLifeCycleStatus )
@@ -139,7 +138,7 @@ import System.FilePath
 import System.Random
     ( newStdGen )
 import UnliftIO.Exception
-    ( bracket, catch, throwIO )
+    ( catch, throwIO )
 
 import qualified Cardano.Pool.DB.Sqlite.TH as TH
 import qualified Cardano.Wallet.Primitive.Types as W
@@ -210,14 +209,12 @@ withDecoratedDBLayer dbDecorator tr mDatabaseDir ti action = do
             ctx <- newInMemorySqliteContext tr' createViews migrateAll
             action (decorateDBLayer dbDecorator $ newDBLayer tr ti ctx)
 
-        Just fp -> do
-            let acquirePool = newConnectionPool tr' fp
-            handlingPersistError tr fp $
-                bracket acquirePool destroyConnectionPool $ \pool -> do
-                    ctx <- newSqliteContext tr' pool createViews migrateAll fp
-                    ctx & either
-                        throwIO
-                        (action . decorateDBLayer dbDecorator . newDBLayer tr ti)
+        Just fp -> handlingPersistError tr fp $
+            withConnectionPool tr' fp $ \pool -> do
+                ctx <- newSqliteContext tr' pool createViews migrateAll fp
+                ctx & either
+                    throwIO
+                    (action . decorateDBLayer dbDecorator . newDBLayer tr ti)
   where
     tr' = contramap MsgGeneric tr
 

lib/core/src/Cardano/Wallet/DB/Sqlite.hs

@@ -52,14 +52,13 @@ import Cardano.DB.Sqlite
     , chunkSize
     , dbChunked
     , dbChunked'
-    , destroyConnectionPool
     , fieldName
     , fieldType
     , handleConstraint
-    , newConnectionPool
     , newInMemorySqliteContext
     , newSqliteContext
     , tableName
+    , withConnectionPool
     )
 import Cardano.DB.Sqlite.Delete
     ( deleteSqliteDatabase, newRefCount, waitForFree, withRef )
@@ -214,7 +213,7 @@ import System.Directory
 import System.FilePath
     ( (</>) )
 import UnliftIO.Exception
-    ( Exception, bracket, throwIO )
+    ( Exception, throwIO )
 import UnliftIO.MVar
     ( modifyMVar, modifyMVar_, newMVar, readMVar )
 
@@ -267,8 +266,7 @@ withDBLayer tr defaultFieldValues mDatabaseDir ti action =
         Just fp -> do
             let manualMigrations = migrateManually tr (Proxy @k) defaultFieldValues
             let autoMigrations   = migrateAll
-            let acquirePool      = newConnectionPool tr fp
-            bracket acquirePool destroyConnectionPool $ \pool -> do
+            withConnectionPool tr fp $ \pool -> do
                 ctx <- newSqliteContext tr pool manualMigrations autoMigrations fp
                 either throwIO (action <=< newDBLayer ti) ctx
 
@@ -328,6 +326,8 @@ newDBFactory tr defaultFieldValues ti = \case
                 -- try to wait for all 'withDatabase' calls to finish before
                 -- deleting database file.
                 let trWait = contramap (MsgWaitingForDatabase widp) tr
+                -- TODO: rather than refcounting, why not keep retrying the
+                -- delete until there are no file busy errors?
                 waitForFree trWait refs wid $ \inUse -> do
                     unless (inUse == 0) $
                         traceWith tr $ MsgRemovingInUse widp inUse