diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal
index d79fecbf016..965defb33a9 100644
--- a/lib/core/cardano-wallet-core.cabal
+++ b/lib/core/cardano-wallet-core.cabal
@@ -86,6 +86,7 @@ library
     , quiet
     , random
     , random-shuffle
+    , resource-pool
     , retry
     , safe
     , scientific
@@ -393,7 +394,9 @@ benchmark db
     , cardano-crypto
     , cardano-wallet-core
     , cardano-wallet-launcher
+    , cardano-wallet-test-utils
     , containers
+    , contra-tracer
     , criterion
     , cryptonite
     , deepseq
@@ -402,9 +405,7 @@ benchmark db
     , fmt
     , iohk-monitoring
     , memory
-    , persistent-sqlite
     , random
-    , temporary
     , text
     , text-class
     , time
diff --git a/lib/core/src/Cardano/DB/Sqlite.hs b/lib/core/src/Cardano/DB/Sqlite.hs
index 0bfd30ef05c..30f2fb74648 100644
--- a/lib/core/src/Cardano/DB/Sqlite.hs
+++ b/lib/core/src/Cardano/DB/Sqlite.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -23,12 +24,18 @@
 
 module Cardano.DB.Sqlite
     ( SqliteContext (..)
+    , newSqliteContext
+    , newInMemorySqliteContext
+
+    -- * ConnectionPool
+    , ConnectionPool
+    , withConnectionPool
+
+    -- * Helpers
     , chunkSize
     , dbChunked
     , dbChunked'
-    , destroyDBLayer
     , handleConstraint
-    , startSqliteBackend
     , unsafeRunQuery
 
     -- * Manual Migration
@@ -49,18 +56,21 @@ import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
-import Cardano.DB.Sqlite.Delete
-    ( DeleteSqliteDatabaseLog )
 import Cardano.Wallet.Logging
     ( BracketLog, bracketTracer )
 import Control.Monad
-    ( join, mapM_, when )
+    ( join, mapM_, void, when )
 import Control.Monad.IO.Unlift
     ( MonadUnliftIO (..) )
 import Control.Monad.Logger
     ( LogLevel (..) )
 import Control.Retry
-    ( constantDelay, limitRetriesByCumulativeDelay, recovering )
+    ( RetryStatus (..)
+    , constantDelay
+    , limitRetriesByCumulativeDelay
+    , logRetries
+    , recovering
+    )
 import Control.Tracer
     ( Tracer, contramap, traceWith )
 import Data.Aeson
@@ -71,14 +81,16 @@ import Data.List
     ( isInfixOf )
 import Data.List.Split
     ( chunksOf )
-import Data.Maybe
-    ( fromMaybe )
+import Data.Pool
+    ( Pool, createPool, destroyAllResources, withResource )
 import Data.Proxy
     ( Proxy (..) )
 import Data.Text
     ( Text )
 import Data.Text.Class
     ( ToText (..) )
+import Data.Time.Clock
+    ( NominalDiffTime )
 import Database.Persist.Sql
     ( DBName (..)
     , EntityField
@@ -96,19 +108,19 @@ import Database.Persist.Sql
     , runSqlConn
     )
 import Database.Persist.Sqlite
-    ( SqlBackend, SqlPersistT, mkSqliteConnectionInfo, wrapConnectionInfo )
+    ( SqlBackend, SqlPersistT, wrapConnection )
 import Database.Sqlite
     ( Error (ErrorConstraint), SqliteException (SqliteException) )
 import Fmt
-    ( fmt, (+|), (+||), (|+), (||+) )
+    ( fmt, ordinalF, (+|), (+||), (|+), (||+) )
 import GHC.Generics
     ( Generic )
 import System.Log.FastLogger
     ( fromLogStr )
 import UnliftIO.Compat
-    ( handleIf, mkRetryHandler )
+    ( handleIf )
 import UnliftIO.Exception
-    ( Exception, bracket_, handleJust, tryJust )
+    ( Exception, bracket, bracket_, handleJust, tryJust )
 import UnliftIO.MVar
     ( newMVar, withMVarMasked )
 
@@ -123,24 +135,13 @@ import qualified Database.Sqlite as Sqlite
                             Sqlite connection set up
 -------------------------------------------------------------------------------}
 
--- | Context for the SQLite 'DBLayer'.
-data SqliteContext = SqliteContext
-    { getSqlBackend :: SqlBackend
-    -- ^ A handle to the Persistent SQL backend.
-    , runQuery :: forall a. SqlPersistT IO a -> IO a
-    -- ^ 'safely' run a query with logging and lock-protection
-    , dbFile :: Maybe FilePath
-    -- ^ The actual database file, if any. If none, runs in-memory
-    , trace :: Tracer IO DBLog
-    -- ^ A 'Tracer' for logging
+-- | 'SqliteContext' is a function to execute queries.
+newtype SqliteContext = SqliteContext
+    { runQuery :: forall a. SqlPersistT IO a -> IO a
+    -- ^ Run a query with a connection from the pool.
     }
 
--- | Error type for when migrations go wrong after opening a database.
-newtype MigrationError = MigrationError
-    { getMigrationErrorMessage :: Text }
-    deriving (Show, Eq, Generic, ToJSON)
-
-instance Exception MigrationError
+type ConnectionPool = Pool (SqlBackend, Sqlite.Connection)
 
 -- | Run a raw query from the outside using an instantiate DB layer. This is
 -- completely unsafe because it breaks the abstraction boundary and can have
@@ -148,28 +149,77 @@ instance Exception MigrationError
 unsafeRunQuery :: SqliteContext -> SqlPersistT IO a -> IO a
 unsafeRunQuery = runQuery
 
-queryLogFunc :: Tracer IO DBLog -> LogFunc
-queryLogFunc tr _loc _source level str = traceWith tr (MsgQuery msg sev)
-  where
-    -- Filter out parameters which appear after the statement semicolon.
-    -- They will contain sensitive material that we don't want in the log.
-    stmt = B8.takeWhile (/= ';') $ fromLogStr str
-    msg = T.decodeUtf8 stmt
-    sev = case level of
-        LevelDebug -> Debug
-        LevelInfo -> Info
-        LevelWarn -> Warning
-        LevelError -> Error
-        LevelOther _ -> Warning
-
 -- | Run an action, and convert any Sqlite constraints exception into the given
 -- error result. No other exceptions are handled.
 handleConstraint :: MonadUnliftIO m => e -> m a -> m (Either e a)
 handleConstraint e = handleJust select handler . fmap Right
   where
-      select (SqliteException ErrorConstraint _ _) = Just ()
-      select _ = Nothing
-      handler = const . pure  . Left $ e
+    select (SqliteException ErrorConstraint _ _) = Just ()
+    select _ = Nothing
+    handler = const . pure  . Left $ e
+
+{-------------------------------------------------------------------------------
+                           Internal / Database Setup
+-------------------------------------------------------------------------------}
+
+newInMemorySqliteContext
+    :: Tracer IO DBLog
+    -> [ManualMigration]
+    -> Migration
+    -> IO (IO (), SqliteContext)
+newInMemorySqliteContext tr manualMigrations autoMigration = do
+    conn <- Sqlite.open ":memory:"
+    mapM_ (`executeManualMigration` conn) manualMigrations
+    unsafeBackend <- wrapConnection conn (queryLogFunc tr)
+    void $ runSqlConn (runMigrationQuiet autoMigration) unsafeBackend
+
+    let observe :: forall a. IO a -> IO a
+        observe = bracketTracer (contramap MsgRun tr)
+
+    -- We still use a lock with the in-memory database to protect it from
+    -- concurrent accesses and ensure database integrity in case where multiple
+    -- threads would be reading/writing from/to it.
+    lock <- newMVar unsafeBackend
+    let runQuery :: forall a. SqlPersistT IO a -> IO a
+        runQuery cmd = withMVarMasked lock (observe . runSqlConn cmd)
+
+    return (close' unsafeBackend, SqliteContext { runQuery })
+
+-- | Sets up query logging and timing, runs schema migrations if necessary and
+-- provide a safe 'SqliteContext' for interacting with the database.
+newSqliteContext
+    :: Tracer IO DBLog
+    -> ConnectionPool
+    -> [ManualMigration]
+    -> Migration
+    -> IO (Either MigrationError SqliteContext)
+newSqliteContext tr pool manualMigrations autoMigration = do
+    migrationResult <- withResource pool $ \(backend, conn) -> do
+        let executeAutoMigration = runSqlConn (runMigrationQuiet autoMigration) backend
+        migrationResult <- withForeignKeysDisabled tr conn $ do
+            mapM_ (`executeManualMigration` conn) manualMigrations
+            executeAutoMigration
+                & tryJust (matchMigrationError @PersistException)
+                & tryJust (matchMigrationError @SqliteException)
+                & fmap join
+        traceWith tr $ MsgMigrations $ fmap length migrationResult
+        return migrationResult
+    return $ case migrationResult of
+        Left e  -> Left e
+        Right{} ->
+            let observe :: IO a -> IO a
+                observe = bracketTracer (contramap MsgRun tr)
+
+               -- Note that `withResource` does already mask async exception but
+               -- only for dealing with the pool resource acquisition. The action
+               -- is then ran unmasked with the acquired resource. If an
+               -- asynchronous exception occurs (or actually any exception), the
+               -- resource is NOT placed back in the pool.
+                runQuery :: SqlPersistT IO a -> IO a
+                runQuery cmd = withResource pool $
+                    observe . retryOnBusy tr . runSqlConn cmd . fst
+
+            in Right $ SqliteContext { runQuery }
 
 -- | Finalize database statements and close the database connection.
 --
@@ -178,15 +228,18 @@ handleConstraint e = handleJust select handler . fmap Right
 --
 -- This function is idempotent: if the database connection has already been
 -- closed, calling this function will exit without doing anything.
---
-destroyDBLayer :: SqliteContext -> IO ()
-destroyDBLayer (SqliteContext {getSqlBackend, trace, dbFile}) = do
-    traceWith trace (MsgClosing dbFile)
-    recovering pol (mkRetryHandler isBusy) (const $ close' getSqlBackend)
+destroySqliteBackend
+    :: Tracer IO DBLog
+    -> SqlBackend
+    -> FilePath
+    -> IO ()
+destroySqliteBackend tr sqlBackend dbFile = do
+    traceWith tr (MsgCloseSingleConnection dbFile)
+    retryOnBusy tr (close' sqlBackend)
         & handleIf isAlreadyClosed
-            (traceWith trace . MsgIsAlreadyClosed . showT)
+            (traceWith tr . MsgIsAlreadyClosed . showT)
         & handleIf statementAlreadyFinalized
-            (traceWith trace . MsgStatementAlreadyFinalized . showT)
+            (traceWith tr . MsgStatementAlreadyFinalized . showT)
   where
     isAlreadyClosed = \case
         -- Thrown when an attempt is made to close a connection that is already
@@ -202,48 +255,37 @@ destroyDBLayer (SqliteContext {getSqlBackend, trace, dbFile}) = do
     showT :: Show a => a -> Text
     showT = T.pack . show
 
-    isBusy (SqliteException name _ _) = pure (name == Sqlite.ErrorBusy)
-    pol = limitRetriesByCumulativeDelay (60000*ms) $ constantDelay (25*ms)
+-- | Retry an action if the database yields an 'SQLITE_BUSY' error.
+--
+-- From <https://www.sqlite.org/rescode.html#busy>
+--
+--     The SQLITE_BUSY result code indicates that the database file could not be
+--     written (or in some cases read) because of concurrent activity by some
+--     other database connection, usually a database connection in a separate
+--     process.
+--
+--     For example, if process A is in the middle of a large write transaction
+--     and at the same time process B attempts to start a new write transaction,
+--     process B will get back an SQLITE_BUSY result because SQLite only supports
+--     one writer at a time. Process B will need to wait for process A to finish
+--     its transaction before starting a new transaction. The sqlite3_busy_timeout()
+--     and sqlite3_busy_handler() interfaces and the busy_timeout pragma are
+--     available to process B to help it deal with SQLITE_BUSY errors.
+--
+retryOnBusy :: Tracer IO DBLog -> IO a -> IO a
+retryOnBusy tr action = recovering policy
+    [logRetries isBusy traceRetries]
+    (\st -> action <* trace MsgRetryDone st)
+  where
+    policy = limitRetriesByCumulativeDelay (60000*ms) $ constantDelay (25*ms)
     ms = 1000 -- microseconds in a millisecond
 
-{-------------------------------------------------------------------------------
-                           Internal / Database Setup
--------------------------------------------------------------------------------}
+    isBusy (SqliteException name _ _) = pure (name == Sqlite.ErrorBusy)
 
--- | Opens the SQLite database connection, sets up query logging and timing,
--- runs schema migrations if necessary.
-startSqliteBackend
-    :: ManualMigration
-    -> Migration
-    -> Tracer IO DBLog
-    -> Maybe FilePath
-    -> IO (Either MigrationError SqliteContext)
-startSqliteBackend manualMigration autoMigration tr fp = do
-    (unsafeBackend, connection) <-
-        createSqliteBackend tr fp manualMigration (queryLogFunc tr)
-    lock <- newMVar unsafeBackend
-    let observe :: IO a -> IO a
-        observe = bracketTracer (contramap MsgRun tr)
-    -- runSqlConn is guarded with a lock because it's not threadsafe in general.
-    -- It is also masked, so that the SqlBackend state is not corrupted if a
-    -- thread gets cancelled while running a query.
-    -- See: https://github.com/yesodweb/persistent/issues/981
-    let runQuery :: SqlPersistT IO a -> IO a
-        runQuery cmd = withMVarMasked lock $ \backend ->
-            observe $ runSqlConn cmd backend
-    autoMigrationResult <-
-        withForeignKeysDisabled tr connection
-            $ runQuery (runMigrationQuiet autoMigration)
-            & tryJust (matchMigrationError @PersistException)
-            & tryJust (matchMigrationError @SqliteException)
-            & fmap join
-    traceWith tr $ MsgMigrations $ fmap length autoMigrationResult
-    let ctx = SqliteContext unsafeBackend runQuery fp tr
-    case autoMigrationResult of
-        Left e -> do
-            destroyDBLayer ctx
-            pure $ Left e
-        Right _ -> pure $ Right ctx
+    traceRetries retr _ = trace $ if retr then MsgRetry else MsgRetryGaveUp
+
+    trace m RetryStatus{rsIterNumber} = traceWith tr $
+        MsgRetryOnBusy rsIterNumber m
 
 -- | Run the given task in a context where foreign key constraints are
 --   /temporarily disabled/, before re-enabling them.
@@ -321,6 +363,55 @@ updateForeignKeysSetting trace connection desiredValue = do
         ForeignKeysEnabled  -> "ON"
         ForeignKeysDisabled -> "OFF"
 
+withConnectionPool
+    :: Tracer IO DBLog
+    -> FilePath
+    -> (ConnectionPool -> IO a)
+    -> IO a
+withConnectionPool tr fp =
+    bracket (newConnectionPool tr fp) (destroyConnectionPool tr fp)
+
+newConnectionPool
+    :: Tracer IO DBLog
+    -> FilePath
+    -> IO ConnectionPool
+newConnectionPool tr fp = do
+    traceWith tr $ MsgStartConnectionPool fp
+
+    let acquireConnection = do
+            conn <- Sqlite.open (T.pack fp)
+            (,conn) <$> wrapConnection conn (queryLogFunc tr)
+
+    let releaseConnection = \(backend, _) -> do
+            destroySqliteBackend tr backend fp
+
+    createPool
+        acquireConnection
+        releaseConnection
+        numberOfStripes
+        timeToLive
+        maximumConnections
+  where
+    numberOfStripes = 1
+    maximumConnections = 10
+    timeToLive = 600 {- 10 minutes -} :: NominalDiffTime
+
+destroyConnectionPool :: Tracer IO DBLog -> FilePath -> Pool a -> IO ()
+destroyConnectionPool tr fp pool = do
+    traceWith tr (MsgStopConnectionPool fp)
+    destroyAllResources pool
+
+{-------------------------------------------------------------------------------
+                                    Migrations
+-------------------------------------------------------------------------------}
+
+-- | Error type for when migrations go wrong after opening a database.
+newtype MigrationError = MigrationError
+    { getMigrationErrorMessage :: Text }
+    deriving (Show, Eq, Generic, ToJSON)
+
+instance Exception MigrationError
+
 class Exception e => MatchMigrationError e where
     -- | Exception predicate for migration errors.
     matchMigrationError :: e -> Maybe MigrationError
@@ -345,52 +436,6 @@ instance MatchMigrationError SqliteException where
 newtype ManualMigration = ManualMigration
     { executeManualMigration :: Sqlite.Connection -> IO () }
 
-createSqliteBackend
-    :: Tracer IO DBLog
-    -> Maybe FilePath
-    -> ManualMigration
-    -> LogFunc
-    -> IO (SqlBackend, Sqlite.Connection)
-createSqliteBackend trace fp migration logFunc = do
-    let connStr = sqliteConnStr fp
-    traceWith trace $ MsgConnStr connStr
-    conn <- Sqlite.open connStr
-    executeManualMigration migration conn
-    backend <- wrapConnectionInfo (mkSqliteConnectionInfo connStr) conn logFunc
-    pure (backend, conn)
-
-sqliteConnStr :: Maybe FilePath -> Text
-sqliteConnStr = maybe ":memory:" T.pack
-
-{-------------------------------------------------------------------------------
-                                    Logging
--------------------------------------------------------------------------------}
-
-data DBLog
-    = MsgMigrations (Either MigrationError Int)
-    | MsgQuery Text Severity
-    | MsgRun BracketLog
-    | MsgConnStr Text
-    | MsgClosing (Maybe FilePath)
-    | MsgWillOpenDB (Maybe FilePath)
-    | MsgDatabaseReset
-    | MsgIsAlreadyClosed Text
-    | MsgStatementAlreadyFinalized Text
-    | MsgWaitingForDatabase Text (Maybe Int)
-    | MsgRemovingInUse Text Int
-    | MsgRemoving Text
-    | MsgRemovingDatabaseFile Text DeleteSqliteDatabaseLog
-    | MsgManualMigrationNeeded DBField Text
-    | MsgManualMigrationNotNeeded DBField
-    | MsgUpdatingForeignKeysSetting ForeignKeysSetting
-    | MsgFoundDatabase FilePath Text
-    | MsgUnknownDBFile FilePath
-    deriving (Generic, Show, Eq, ToJSON)
-
-{-------------------------------------------------------------------------------
-                                    Logging
--------------------------------------------------------------------------------}
-
 data DBField where
     DBField
         :: forall record typ. (PersistEntity record)
@@ -437,6 +482,29 @@ instance Eq DBField where
 instance ToJSON DBField where
     toJSON = Aeson.String . fieldName
 
+{-------------------------------------------------------------------------------
+                                    Logging
+-------------------------------------------------------------------------------}
+
+data DBLog
+    = MsgMigrations (Either MigrationError Int)
+    | MsgQuery Text Severity
+    | MsgRun BracketLog
+    | MsgCloseSingleConnection FilePath
+    | MsgStartConnectionPool FilePath
+    | MsgStopConnectionPool FilePath
+    | MsgDatabaseReset
+    | MsgIsAlreadyClosed Text
+    | MsgStatementAlreadyFinalized Text
+    | MsgManualMigrationNeeded DBField Text
+    | MsgManualMigrationNotNeeded DBField
+    | MsgUpdatingForeignKeysSetting ForeignKeysSetting
+    | MsgRetryOnBusy Int RetryLog
+    deriving (Generic, Show, Eq, ToJSON)
+
+data RetryLog = MsgRetry | MsgRetryGaveUp | MsgRetryDone
+    deriving (Generic, Show, Eq, ToJSON)
+
 instance HasPrivacyAnnotation DBLog
 instance HasSeverityAnnotation DBLog where
     getSeverityAnnotation ev = case ev of
@@ -445,21 +513,19 @@ instance HasSeverityAnnotation DBLog where
         MsgMigrations (Left _) -> Error
         MsgQuery _ sev -> sev
         MsgRun _ -> Debug
-        MsgConnStr _ -> Debug
-        MsgClosing _ -> Debug
-        MsgWillOpenDB _ -> Info
+        MsgCloseSingleConnection _ -> Info
+        MsgStartConnectionPool _ -> Info
+        MsgStopConnectionPool _ -> Info
         MsgDatabaseReset -> Notice
         MsgIsAlreadyClosed _ -> Warning
         MsgStatementAlreadyFinalized _ -> Warning
-        MsgWaitingForDatabase _ _ -> Info
-        MsgRemovingInUse _ _ -> Notice
-        MsgRemoving _ -> Info
-        MsgRemovingDatabaseFile _ msg -> getSeverityAnnotation msg
         MsgManualMigrationNeeded{} -> Notice
         MsgManualMigrationNotNeeded{} -> Debug
         MsgUpdatingForeignKeysSetting{} -> Debug
-        MsgFoundDatabase _ _ -> Info
-        MsgUnknownDBFile _ -> Notice
+        MsgRetryOnBusy n _
+            | n <= 1 -> Debug
+            | n <= 3 -> Notice
+            | otherwise -> Warning
 
 instance ToText DBLog where
     toText = \case
@@ -470,28 +536,21 @@ instance ToText DBLog where
         MsgMigrations (Left err) ->
             "Failed to migrate the database: " <> getMigrationErrorMessage err
         MsgQuery stmt _ -> stmt
-        MsgRun b -> "Running database action - " <> toText b
-        MsgWillOpenDB fp -> "Will open db at " <> (maybe "in-memory" T.pack fp)
-        MsgConnStr connStr -> "Using connection string: " <> connStr
-        MsgClosing fp -> "Closing database ("+|fromMaybe "in-memory" fp|+")"
+        MsgRun b ->
+            "Running database action - " <> toText b
+        MsgStartConnectionPool fp ->
+            "Starting connection pool for " <> T.pack fp
+        MsgStopConnectionPool fp ->
+            "Stopping database connection pool " <> T.pack fp
         MsgDatabaseReset ->
             "Non backward compatible database found. Removing old database \
             \and re-creating it from scratch. Ignore the previous error."
+        MsgCloseSingleConnection fp ->
+            "Closing single database connection ("+|fp|+")"
         MsgIsAlreadyClosed msg ->
             "Attempted to close an already closed connection: " <> msg
         MsgStatementAlreadyFinalized msg ->
             "Statement already finalized: " <> msg
-        MsgWaitingForDatabase wid Nothing ->
-            "Database "+|wid|+" is ready to be deleted"
-        MsgWaitingForDatabase wid (Just count) ->
-            "Waiting for "+|count|+" withDatabase "+|wid|+" call(s) to finish"
-        MsgRemovingInUse wid count ->
-            "Timed out waiting for "+|count|+" withDatabase "+|wid|+" call(s) to finish. " <>
-            "Attempting to remove the database anyway."
-        MsgRemoving wid ->
-            "Removing wallet's database. Wallet id was " <> wid
-        MsgRemovingDatabaseFile wid msg ->
-            "Removing " <> wid <> ": " <> toText msg
         MsgManualMigrationNeeded field value -> mconcat
             [ tableName field
             , " table does not contain required field '"
@@ -512,12 +571,33 @@ instance ToText DBLog where
             , T.pack $ show value
             , "."
             ]
-        MsgFoundDatabase _file wid ->
-            "Found existing wallet: " <> wid
-        MsgUnknownDBFile file -> mconcat
-            [ "Found something other than a database file in "
-            , "the database folder: ", T.pack file
-            ]
+        MsgRetryOnBusy n msg -> case msg of
+            MsgRetry
+                | n <= 10 ->
+                    "Retrying db query because db was busy " <>
+                    "for the " +| ordinalF n |+ " time."
+                | n == 11 ->
+                    "No more logs until it finishes..."
+                | otherwise -> ""
+            MsgRetryGaveUp -> "Gave up on retrying the db query."
+            MsgRetryDone
+                | n > 3 -> "DB query succeeded after " +| n |+ " attempts."
+                | otherwise -> ""
+
+-- | Produce a persistent 'LogFunc' backed by 'Tracer IO DBLog'
+queryLogFunc :: Tracer IO DBLog -> LogFunc
+queryLogFunc tr _loc _source level str = traceWith tr (MsgQuery msg sev)
+  where
+    -- Filter out parameters which appear after the statement semicolon.
+    -- They will contain sensitive material that we don't want in the log.
+    stmt = B8.takeWhile (/= ';') $ fromLogStr str
+    msg = T.decodeUtf8 stmt
+    sev = case level of
+        LevelDebug -> Debug
+        LevelInfo -> Info
+        LevelWarn -> Warning
+        LevelError -> Error
+        LevelOther _ -> Warning
 
 {-------------------------------------------------------------------------------
                                Extra DB Helpers
diff --git a/lib/core/src/Cardano/Pool/DB/Sqlite.hs b/lib/core/src/Cardano/Pool/DB/Sqlite.hs
index 7ad3581368d..f96473dd796 100644
--- a/lib/core/src/Cardano/Pool/DB/Sqlite.hs
+++ b/lib/core/src/Cardano/Pool/DB/Sqlite.hs
@@ -30,6 +30,7 @@ module Cardano.Pool.DB.Sqlite
     , undecoratedDB
     , defaultFilePath
     , DatabaseView (..)
+    , createViews
     ) where
 
 import Prelude
@@ -38,13 +39,14 @@ import Cardano.DB.Sqlite
     ( DBField (..)
     , DBLog (..)
     , ManualMigration (..)
-    , MigrationError (..)
+    , MigrationError
     , SqliteContext (..)
-    , destroyDBLayer
     , fieldName
     , handleConstraint
-    , startSqliteBackend
+    , newInMemorySqliteContext
+    , newSqliteContext
     , tableName
+    , withConnectionPool
     )
 import Cardano.Pool.DB
     ( DBLayer (..), ErrPointAlreadyExists (..), determinePoolLifeCycleStatus )
@@ -136,7 +138,7 @@ import System.FilePath
 import System.Random
     ( newStdGen )
 import UnliftIO.Exception
-    ( bracket, throwIO )
+    ( bracket, catch, throwIO )
 
 import qualified Cardano.Pool.DB.Sqlite.TH as TH
 import qualified Cardano.Wallet.Primitive.Types as W
@@ -201,12 +203,21 @@ withDecoratedDBLayer
     -> (DBLayer IO -> IO a)
        -- ^ Action to run.
     -> IO a
-withDecoratedDBLayer dbDecorator trace fp ti action = do
-    traceWith trace (MsgGeneric $ MsgWillOpenDB fp)
-    bracket before after (action . decorateDBLayer dbDecorator . snd)
+withDecoratedDBLayer dbDecorator tr mDatabaseDir ti action = do
+    case mDatabaseDir of
+        Nothing -> bracket
+            (newInMemorySqliteContext tr' createViews migrateAll)
+            fst
+            (action . decorateDBLayer dbDecorator . newDBLayer tr ti . snd)
+
+        Just fp -> handlingPersistError tr fp $
+            withConnectionPool tr' fp $ \pool -> do
+                ctx <- newSqliteContext tr' pool createViews migrateAll
+                ctx & either
+                    throwIO
+                    (action . decorateDBLayer dbDecorator . newDBLayer tr ti)
   where
-    before = newDBLayer trace fp ti
-    after = destroyDBLayer . fst
+    tr' = contramap MsgGeneric tr
 
 -- | Sets up a connection to the SQLite database.
 --
@@ -221,21 +232,13 @@ withDecoratedDBLayer dbDecorator trace fp ti action = do
 newDBLayer
     :: Tracer IO PoolDbLog
        -- ^ Logging object
-    -> Maybe FilePath
-       -- ^ Database file location, or Nothing for in-memory database
     -> TimeInterpreter IO
-    -> IO (SqliteContext, DBLayer IO)
-newDBLayer trace fp ti = do
-    let io = startSqliteBackend
-            (migrateManually trace)
-            migrateAll
-            (contramap MsgGeneric trace)
-            fp
-    ctx@SqliteContext{runQuery} <- handlingPersistError trace fp io
-    pure (ctx, mkDBLayer runQuery)
-  where
-    mkDBLayer :: (forall a. SqlPersistT IO a -> IO a) -> DBLayer IO
-    mkDBLayer runQuery = DBLayer {..}
+       -- ^ Time interpreter for slot to time conversions
+    -> SqliteContext
+        -- ^ A (thread-) safe wrapper for running db queries.
+    -> DBLayer IO
+newDBLayer tr ti SqliteContext{runQuery} =
+    DBLayer {..}
       where
         putPoolProduction point pool = ExceptT $
             handleConstraint (ErrPointAlreadyExists point) $
@@ -254,7 +257,7 @@ newDBLayer trace fp ti = do
 
             pure (foldl' toMap Map.empty production)
 
-        readTotalProduction = Map.fromList <$> runRawQuery trace
+        readTotalProduction = Map.fromList <$> runRawQuery tr
             (RawQuery "readTotalProduction" query [] parseRow)
           where
             query = T.unwords
@@ -417,7 +420,7 @@ newDBLayer trace fp ti = do
                 , Desc PoolRegistrationSlotInternalIndex
                 ]
 
-        listRetiredPools epochNo = runRawQuery trace $
+        listRetiredPools epochNo = runRawQuery tr $
             RawQuery "listRetiredPools" query parameters parseRow
           where
             query = T.unwords
@@ -431,7 +434,7 @@ newDBLayer trace fp ti = do
                     <$> fromPersistValue poolId
                     <*> fromPersistValue retirementEpoch
 
-        listPoolLifeCycleData epochNo = runRawQuery trace $ RawQuery
+        listPoolLifeCycleData epochNo = runRawQuery tr $ RawQuery
             "listPoolLifeCycleData" query parameters parseRow
           where
             query = T.unwords
@@ -501,7 +504,7 @@ newDBLayer trace fp ti = do
             fmap (delistedPoolId . entityVal) <$> selectList [] []
 
         removePools = mapM_ $ \pool -> do
-            liftIO $ traceWith trace $ MsgRemovingPool pool
+            liftIO $ traceWith tr $ MsgRemovingPool pool
             deleteWhere [ PoolProductionPoolId ==. pool ]
             deleteWhere [ PoolOwnerPoolId ==. pool ]
             deleteWhere [ PoolRegistrationPoolId ==. pool ]
@@ -515,11 +518,11 @@ newDBLayer trace fp ti = do
                 traceInner retirementCerts
                 removePools (view #poolId <$> retirementCerts)
                 pure retirementCerts
-            traceOuter = trace
+            traceOuter = tr
                 & natTracer liftIO
                 & contramap (MsgRemovingRetiredPoolsForEpoch epoch)
             traceInner = liftIO
-                . traceWith trace
+                . traceWith tr
                 . MsgRemovingRetiredPools
 
         readPoolProductionCursor k = do
@@ -674,26 +677,24 @@ runRawQuery
     => Tracer IO PoolDbLog
     -> RawQuery a b
     -> SqlPersistT IO [b]
-runRawQuery trace q = do
+runRawQuery tr q = do
     (failures, results) <- partitionEithers . fmap (queryParser q) <$> rawSql
         (queryDefinition q)
         (queryParameters q)
     forM_ failures
         $ liftIO
-        . traceWith trace
+        . traceWith tr
         . MsgParseFailure
         . ParseFailure (queryName q)
     pure results
 
-migrateManually
-    :: Tracer IO PoolDbLog
-    -> ManualMigration
-migrateManually _tr =
-    ManualMigration $ \conn -> do
-        createView conn activePoolLifeCycleData
-        createView conn activePoolOwners
-        createView conn activePoolRegistrations
-        createView conn activePoolRetirements
+createViews :: [ManualMigration]
+createViews = ManualMigration <$>
+    [ createView activePoolLifeCycleData
+    , createView activePoolOwners
+    , createView activePoolRegistrations
+    , createView activePoolRetirements
+    ]
 
 -- | Represents a database view.
 --
@@ -706,8 +707,8 @@ data DatabaseView = DatabaseView
 
 -- | Creates the specified database view, if it does not already exist.
 --
-createView :: Sqlite.Connection -> DatabaseView -> IO ()
-createView conn (DatabaseView name definition) = do
+createView :: DatabaseView -> Sqlite.Connection -> IO ()
+createView (DatabaseView name definition) conn = do
     deleteQuery <- Sqlite.prepare conn deleteQueryString
     Sqlite.step deleteQuery *> Sqlite.finalize deleteQuery
     createQuery <- Sqlite.prepare conn createQueryString
@@ -857,17 +858,16 @@ activePoolRetirements = DatabaseView "active_pool_retirements" [i|
 handlingPersistError
     :: Tracer IO PoolDbLog
        -- ^ Logging object
-    -> Maybe FilePath
+    -> FilePath
        -- ^ Database file location, or Nothing for in-memory database
-    -> IO (Either MigrationError ctx)
-       -- ^ Action to set up the context.
-    -> IO ctx
-handlingPersistError trace fp action = action >>= \case
-    Right ctx -> pure ctx
-    Left _ -> do
-        traceWith trace $ MsgGeneric MsgDatabaseReset
-        maybe (pure ()) removeFile fp
-        action >>= either throwIO pure
+    -> IO a
+       -- ^ Action to retry
+    -> IO a
+handlingPersistError tr fp action =
+    action `catch` \(_e :: MigrationError) -> do
+        traceWith tr $ MsgGeneric MsgDatabaseReset
+        removeFile fp
+        action
 
 -- | Compute a new date from a base date, with an increasing delay.
 --
diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
index bacec918cf3..95c6354548f 100644
--- a/lib/core/src/Cardano/Wallet/Api/Server.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -1061,11 +1061,15 @@ deleteWallet
     => ctx
     -> ApiT WalletId
     -> Handler NoContent
-deleteWallet ctx (ApiT wid) =
-    withWorkerCtx @_ @s @k ctx wid liftE liftE $ \_ -> do
-        liftIO $ Registry.unregister re wid
-        liftIO $ removeDatabase df wid
-        return NoContent
+deleteWallet ctx (ApiT wid) = do
+    -- Start a context so that an error is throw if the wallet doesn't exist.
+    withWorkerCtx @_ @s @k ctx wid liftE
+        (const $ pure()) (const $ pure ())
+
+    liftIO $ Registry.unregister re wid
+    liftIO $ removeDatabase df wid
+
+    return NoContent
   where
     re = ctx ^. workerRegistry @s @k
     df = ctx ^. dbFactory @s @k
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
index 020ce674db3..523af662788 100644
--- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
+++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
@@ -24,24 +25,34 @@
 -- An implementation of the DBLayer which uses Persistent and SQLite.
 
 module Cardano.Wallet.DB.Sqlite
-    ( newDBLayer
-    , newDBLayerWith
-    , CacheBehavior (..)
-    , newDBFactory
+    ( -- * Directory of single-file wallet databases
+      newDBFactory
     , findDatabases
+    , DBFactoryLog (..)
+
+    -- * Internal implementation
     , withDBLayer
+    , withDBLayerInMemory
+    , WalletDBLog (..)
+    , newDBLayerWith
+    , CacheBehavior (..)
 
     -- * Interfaces
     , PersistState (..)
 
     -- * Migration Support
     , DefaultFieldValues (..)
+
     ) where
 
 import Prelude
 
 import Cardano.Address.Derivation
     ( XPrv, XPub )
+import Cardano.BM.Data.Severity
+    ( Severity (..) )
+import Cardano.BM.Data.Tracer
+    ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
 import Cardano.DB.Sqlite
     ( DBField (..)
     , DBLog (..)
@@ -50,15 +61,21 @@ import Cardano.DB.Sqlite
     , chunkSize
     , dbChunked
     , dbChunked'
-    , destroyDBLayer
     , fieldName
     , fieldType
     , handleConstraint
-    , startSqliteBackend
+    , newInMemorySqliteContext
+    , newSqliteContext
     , tableName
+    , withConnectionPool
     )
 import Cardano.DB.Sqlite.Delete
-    ( deleteSqliteDatabase, newRefCount, waitForFree, withRef )
+    ( DeleteSqliteDatabaseLog
+    , deleteSqliteDatabase
+    , newRefCount
+    , waitForFree
+    , withRef
+    )
 import Cardano.Wallet.DB
     ( DBFactory (..)
     , DBLayer (..)
@@ -124,7 +141,7 @@ import Cardano.Wallet.Primitive.Types.TokenBundle
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( AssetId (..) )
 import Control.Monad
-    ( forM, forM_, unless, void, when )
+    ( forM, forM_, unless, void, when, (<=<) )
 import Control.Monad.Extra
     ( concatMapM )
 import Control.Monad.IO.Class
@@ -145,8 +162,6 @@ import Data.Functor
     ( (<&>) )
 import Data.Generics.Internal.VL.Lens
     ( view, (^.) )
-import Data.IORef
-    ( modifyIORef', newIORef, readIORef )
 import Data.List
     ( nub, sortOn, unzip3 )
 import Data.List.Split
@@ -154,7 +169,7 @@ import Data.List.Split
 import Data.Map.Strict
     ( Map )
 import Data.Maybe
-    ( catMaybes, mapMaybe )
+    ( catMaybes, isJust, mapMaybe )
 import Data.Ord
     ( Down (..) )
 import Data.Proxy
@@ -202,7 +217,9 @@ import Database.Persist.Sqlite
 import Database.Persist.Types
     ( PersistValue (..), fromPersistValueText )
 import Fmt
-    ( pretty )
+    ( pretty, (+|), (|+) )
+import GHC.Generics
+    ( Generic )
 import System.Directory
     ( doesFileExist, listDirectory )
 import System.FilePath
@@ -210,7 +227,7 @@ import System.FilePath
 import UnliftIO.Exception
     ( Exception, bracket, throwIO )
 import UnliftIO.MVar
-    ( modifyMVar, modifyMVar_, newMVar, readMVar )
+    ( MVar, modifyMVar, modifyMVar_, newMVar, readMVar, withMVar )
 
 import qualified Cardano.Wallet.Primitive.AddressDerivation as W
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Random as Rnd
@@ -228,67 +245,49 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import qualified Database.Sqlite as Sqlite
 
--- | Runs an action with a connection to the SQLite database.
---
--- Database migrations are run to create tables if necessary.
---
--- If the given file path does not exist, it will be created by the sqlite
--- library.
-withDBLayer
-    :: forall s k a.
-        ( PersistState s
-        , PersistPrivateKey (k 'RootK)
-        , WalletKey k
-        )
-    => Tracer IO DBLog
-       -- ^ Logging object
-    -> DefaultFieldValues
-       -- ^ Default database field values, used during migration.
-    -> Maybe FilePath
-       -- ^ Path to database directory, or Nothing for in-memory database
-    -> TimeInterpreter IO
-    -> ((SqliteContext, DBLayer IO s k) -> IO a)
-       -- ^ Action to run.
-    -> IO a
-withDBLayer trace defaultFieldValues mDatabaseDir ti =
-    bracket before after
-  where
-    before = newDBLayer trace defaultFieldValues mDatabaseDir ti
-    after = destroyDBLayer . fst
+{-------------------------------------------------------------------------------
+                               Database "factory"
+             (a directory containing one database file per wallet)
+-------------------------------------------------------------------------------}
 
--- | Instantiate a 'DBFactory' from a given directory
+-- | Instantiate a 'DBFactory' from a given directory, or in-memory for testing.
 newDBFactory
     :: forall s k.
         ( PersistState s
         , PersistPrivateKey (k 'RootK)
         , WalletKey k
         )
-    => Tracer IO DBLog
+    => Tracer IO DBFactoryLog
        -- ^ Logging object
     -> DefaultFieldValues
        -- ^ Default database field values, used during migration.
     -> TimeInterpreter IO
-
+       -- ^ Time interpreter for slot to time conversions
     -> Maybe FilePath
        -- ^ Path to database directory, or Nothing for in-memory database
     -> IO (DBFactory IO s k)
 newDBFactory tr defaultFieldValues ti = \case
     Nothing -> do
-        -- NOTE
+        -- NOTE1
         -- For the in-memory database, we do actually preserve the database
         -- after the 'action' is done. This allows for calling 'withDatabase'
         -- several times within the same execution and get back the same
         -- database. The memory is only cleaned up when calling
         -- 'removeDatabase', to mimic the way the file database works!
+        --
+        -- NOTE2
+        -- The in-memory withDatabase will leak memory unless removeDatabase is
+        -- called after using the database. In practice, this is only a problem
+        -- for testing.
         mvar <- newMVar mempty
         pure DBFactory
             { withDatabase = \wid action -> do
                 db <- modifyMVar mvar $ \m -> case Map.lookup wid m of
-                    Just (_, db) -> pure (m, db)
+                    Just db -> pure (m, db)
                     Nothing -> do
-                        (ctx, db) <-
-                            newDBLayer tr defaultFieldValues Nothing ti
-                        pure (Map.insert wid (ctx, db) m, db)
+                        let tr' = contramap (MsgWalletDB "") tr
+                        (_cleanup, db) <- newDBLayerInMemory tr' ti
+                        pure (Map.insert wid db m, db)
                 action db
             , removeDatabase = \wid -> do
                 traceWith tr $ MsgRemoving (pretty wid)
@@ -302,16 +301,18 @@ newDBFactory tr defaultFieldValues ti = \case
         refs <- newRefCount
         pure DBFactory
             { withDatabase = \wid action -> withRef refs wid $ withDBLayer
-                tr
+                (contramap (MsgWalletDB (databaseFile wid)) tr)
                 defaultFieldValues
-                (Just $ databaseFile wid)
+                (databaseFile wid)
                 ti
-                (action . snd)
+                action
             , removeDatabase = \wid -> do
                 let widp = pretty wid
                 -- 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
@@ -332,7 +333,7 @@ newDBFactory tr defaultFieldValues ti = \case
 --   specified directory.
 findDatabases
     :: forall k. WalletKey k
-    => Tracer IO DBLog
+    => Tracer IO DBFactoryLog
     -> FilePath
     -> IO [W.WalletId]
 findDatabases tr dir = do
@@ -352,6 +353,63 @@ findDatabases tr dir = do
   where
     expectedPrefix = T.pack $ keyTypeDescriptor $ Proxy @k
 
+data DBFactoryLog
+    = MsgFoundDatabase FilePath Text
+    | MsgUnknownDBFile FilePath
+    | MsgRemoving Text
+    | MsgRemovingInUse Text Int
+    | MsgRemovingDatabaseFile Text DeleteSqliteDatabaseLog
+    | MsgWaitingForDatabase Text (Maybe Int)
+    | MsgWalletDB FilePath WalletDBLog
+    deriving (Generic, Show, Eq)
+
+instance HasPrivacyAnnotation DBFactoryLog
+instance HasSeverityAnnotation DBFactoryLog where
+    getSeverityAnnotation ev = case ev of
+        MsgFoundDatabase _ _ -> Info
+        MsgUnknownDBFile _ -> Notice
+        MsgRemoving _ -> Info
+        MsgRemovingInUse _ _ -> Notice
+        MsgRemovingDatabaseFile _ msg -> getSeverityAnnotation msg
+        MsgWaitingForDatabase _ _ -> Info
+        MsgWalletDB _ msg -> getSeverityAnnotation msg
+
+instance ToText DBFactoryLog where
+    toText = \case
+        MsgFoundDatabase _file wid ->
+            "Found existing wallet: " <> wid
+        MsgUnknownDBFile file -> mconcat
+            [ "Found something other than a database file in "
+            , "the database folder: ", T.pack file
+            ]
+        MsgRemoving wid ->
+            "Removing wallet's database. Wallet id was " <> wid
+        MsgRemovingDatabaseFile wid msg ->
+            "Removing " <> wid <> ": " <> toText msg
+        MsgWaitingForDatabase wid Nothing ->
+            "Database "+|wid|+" is ready to be deleted"
+        MsgWaitingForDatabase wid (Just count) ->
+            "Waiting for "+|count|+" withDatabase "+|wid|+" call(s) to finish"
+        MsgRemovingInUse wid count ->
+            "Timed out waiting for "+|count|+" withDatabase "+|wid|+" call(s) to finish. " <>
+            "Attempting to remove the database anyway."
+        MsgWalletDB _file msg -> toText msg
+
+{-------------------------------------------------------------------------------
+                           Database Schema Migrations
+-------------------------------------------------------------------------------}
+
+-- | A set of default field values that can be consulted when performing a
+--   database migration.
+--
+data DefaultFieldValues = DefaultFieldValues
+    { defaultActiveSlotCoefficient :: W.ActiveSlotCoefficient
+    , defaultDesiredNumberOfPool :: Word16
+    , defaultMinimumUTxOValue :: W.Coin
+    , defaultHardforkEpoch :: Maybe W.EpochNo
+    , defaultKeyDeposit :: W.Coin
+    }
+
 -- | A data-type for capturing column status. Used to be represented as a
 -- 'Maybe Bool' which is somewhat confusing to interpret.
 data SqlColumnStatus
@@ -368,42 +426,31 @@ migrateManually
     => Tracer IO DBLog
     -> Proxy k
     -> DefaultFieldValues
-    -> ManualMigration
+    -> [ManualMigration]
 migrateManually tr proxy defaultFieldValues =
-    ManualMigration $ \conn -> do
-        cleanupCheckpointTable conn
-
-        assignDefaultPassphraseScheme conn
-
-        addDesiredPoolNumberIfMissing conn
-
-        addMinimumUTxOValueIfMissing conn
-
-        addHardforkEpochIfMissing conn
-
-        -- FIXME
-        -- Temporary migration to fix Daedalus flight wallets. This should
-        -- really be removed as soon as we have a fix for the cardano-sl:wallet
-        -- currently in production.
-        removeSoftRndAddresses conn
-
-        removeOldTxParametersTable conn
-
-        addAddressStateIfMissing conn
-
-        addSeqStateDerivationPrefixIfMissing conn
-
-        renameRoleColumn conn
-
-        renameRoleFields conn
-
-        updateFeeValueAndAddKeyDeposit conn
-
-        addFeeToTransaction conn
-
-        moveRndUnusedAddresses conn
-
-        cleanupSeqStateTable conn
+    ManualMigration <$>
+    [ cleanupCheckpointTable
+    , assignDefaultPassphraseScheme
+    , addDesiredPoolNumberIfMissing
+    , addMinimumUTxOValueIfMissing
+    , addHardforkEpochIfMissing
+
+      -- FIXME
+      -- Temporary migration to fix Daedalus flight wallets. This should
+      -- really be removed as soon as we have a fix for the cardano-sl:wallet
+      -- currently in production.
+    , removeSoftRndAddresses
+
+    , removeOldTxParametersTable
+    , addAddressStateIfMissing
+    , addSeqStateDerivationPrefixIfMissing
+    , renameRoleColumn
+    , renameRoleFields
+    , updateFeeValueAndAddKeyDeposit
+    , addFeeToTransaction
+    , moveRndUnusedAddresses
+    , cleanupSeqStateTable
+    ]
   where
     -- NOTE
     -- We originally stored script pool gap inside sequential state in the 'SeqState' table,
@@ -1065,19 +1112,105 @@ runSql conn raw = do
             Sqlite.Done -> do
                 return (reverse acc)
 
--- | A set of default field values that can be consulted when performing a
---   database migration.
+{-------------------------------------------------------------------------------
+                                 Database layer
+-------------------------------------------------------------------------------}
+
+-- | Runs an action with a connection to the SQLite database.
 --
-data DefaultFieldValues = DefaultFieldValues
-    { defaultActiveSlotCoefficient :: W.ActiveSlotCoefficient
-    , defaultDesiredNumberOfPool :: Word16
-    , defaultMinimumUTxOValue :: W.Coin
-    , defaultHardforkEpoch :: Maybe W.EpochNo
-    , defaultKeyDeposit :: W.Coin
-    }
+-- Database migrations are run to create tables if necessary.
+--
+-- If the given file path does not exist, it will be created by the sqlite
+-- library.
+withDBLayer
+    :: forall s k a.
+        ( PersistState s
+        , PersistPrivateKey (k 'RootK)
+        , WalletKey k
+        )
+    => Tracer IO WalletDBLog
+       -- ^ Logging object
+    -> DefaultFieldValues
+       -- ^ Default database field values, used during migration.
+    -> FilePath
+       -- ^ Path to database file
+    -> TimeInterpreter IO
+       -- ^ Time interpreter for slot to time conversions
+    -> (DBLayer IO s k -> IO a)
+       -- ^ Action to run.
+    -> IO a
+withDBLayer tr defaultFieldValues dbFile ti action = do
+    let trDB = contramap MsgDB tr
+    let manualMigrations = migrateManually trDB (Proxy @k) defaultFieldValues
+    let autoMigrations   = migrateAll
+    withConnectionPool trDB dbFile $ \pool -> do
+        res <- newSqliteContext trDB pool manualMigrations autoMigrations
+        either throwIO (action <=< newDBLayerWith CacheLatestCheckpoint tr ti) res
+
+data WalletDBLog
+    = MsgDB DBLog
+    | MsgCheckpointCache W.WalletId CheckpointCacheLog
+    deriving (Generic, Show, Eq)
+
+data CheckpointCacheLog
+    = MsgPutCheckpoint
+    | MsgGetCheckpoint Bool
+    | MsgRefresh
+    | MsgDrop
+    deriving (Generic, Show, Eq)
+
+instance HasPrivacyAnnotation WalletDBLog
+instance HasSeverityAnnotation WalletDBLog where
+    getSeverityAnnotation = \case
+        MsgDB msg -> getSeverityAnnotation msg
+        MsgCheckpointCache _ _ -> Debug
+
+instance ToText WalletDBLog where
+    toText = \case
+        MsgDB msg -> toText msg
+        MsgCheckpointCache wid msg -> "Checkpoint cache " <> toText wid <> ": " <> toText msg
+
+instance ToText CheckpointCacheLog where
+    toText = \case
+        MsgPutCheckpoint -> "Put"
+        MsgGetCheckpoint hit -> "Get " <> if hit then "hit" else "miss"
+        MsgRefresh -> "Refresh"
+        MsgDrop -> "Drop"
+
+-- | Runs an IO action with a new 'DBLayer' backed by a sqlite in-memory
+-- database.
+withDBLayerInMemory
+    :: forall s k a.
+        ( PersistState s
+        , PersistPrivateKey (k 'RootK)
+        )
+    => Tracer IO WalletDBLog
+       -- ^ Logging object
+    -> TimeInterpreter IO
+       -- ^ Time interpreter for slot to time conversions
+    -> (DBLayer IO s k -> IO a)
+    -> IO a
+withDBLayerInMemory tr ti action = bracket (newDBLayerInMemory tr ti) fst (action . snd)
 
--- | A type to capture what to do with regards to caching. This is useful to
--- disable caching in database benchmarks.
+-- | Creates a 'DBLayer' backed by a sqlite in-memory database.
+newDBLayerInMemory
+    :: forall s k.
+        ( PersistState s
+        , PersistPrivateKey (k 'RootK)
+        )
+    => Tracer IO WalletDBLog
+       -- ^ Logging object
+    -> TimeInterpreter IO
+       -- ^ Time interpreter for slot to time conversions
+    -> IO (IO (), DBLayer IO s k)
+newDBLayerInMemory tr ti = do
+    let tr' = contramap MsgDB tr
+    (destroy, ctx) <- newInMemorySqliteContext tr' [] migrateAll
+    db <- newDBLayer tr ti ctx
+    pure (destroy, db)
+
+-- | What to do with regards to caching. This is useful to disable caching in
+-- database benchmarks.
 data CacheBehavior
     = NoCache
     | CacheLatestCheckpoint
@@ -1090,48 +1223,39 @@ data CacheBehavior
 -- If the given file path does not exist, it will be created by the sqlite
 -- library.
 --
--- 'getDBLayer' will provide the actual 'DBLayer' implementation. The database
--- should be closed with 'destroyDBLayer'. If you use 'withDBLayer' then both of
--- these things will be handled for you.
+-- 'newDBLayer' will provide the actual 'DBLayer' implementation. It requires an
+-- 'SqliteContext' which can be obtained from a database connection pool. This
+-- is better initialized with 'withDBLayer'.
 newDBLayer
     :: forall s k.
         ( PersistState s
         , PersistPrivateKey (k 'RootK)
-        , WalletKey k
         )
-    => Tracer IO DBLog
-       -- ^ Logging object
-    -> DefaultFieldValues
-       -- ^ Default database field values, used during migration.
-    -> Maybe FilePath
-       -- ^ Path to database file, or Nothing for in-memory database
+    => Tracer IO WalletDBLog
+       -- ^ Logging
     -> TimeInterpreter IO
-    -> IO (SqliteContext, DBLayer IO s k)
-newDBLayer =
-    newDBLayerWith @s @k CacheLatestCheckpoint
+       -- ^ Time interpreter for slot to time conversions
+    -> SqliteContext
+       -- ^ A (thread-)safe wrapper for query execution.
+    -> IO (DBLayer IO s k)
+newDBLayer = newDBLayerWith @s @k CacheLatestCheckpoint
 
 -- | Like 'newDBLayer', but allows to explicitly specify the caching behavior.
 newDBLayerWith
     :: forall s k.
         ( PersistState s
         , PersistPrivateKey (k 'RootK)
-        , WalletKey k
         )
     => CacheBehavior
-    -> Tracer IO DBLog
-    -> DefaultFieldValues
-    -> Maybe FilePath
+       -- ^ Option to disable caching.
+    -> Tracer IO WalletDBLog
+       -- ^ Logging
     -> TimeInterpreter IO
-    -> IO (SqliteContext, DBLayer IO s k)
-newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
-    ctx@SqliteContext{runQuery} <-
-        either throwIO pure =<<
-        startSqliteBackend
-            (migrateManually trace (Proxy @k) defaultFieldValues)
-            migrateAll
-            trace
-            mDatabaseFile
-
+       -- ^ Time interpreter for slot to time conversions
+    -> SqliteContext
+       -- ^ A (thread-)safe wrapper for query execution.
+    -> IO (DBLayer IO s k)
+newDBLayerWith cacheBehavior tr ti SqliteContext{runQuery} = do
     -- NOTE1
     -- We cache the latest checkpoint for read operation such that we prevent
     -- needless marshalling and unmarshalling with the database. Many handlers
@@ -1149,58 +1273,71 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
     -- short-circuit the most frequent database lookups.
     --
     -- NOTE2
-    -- We use an IORef here without fearing race-conditions because every
-    -- database query can only be run within calls to `atomically` which
-    -- enforces that there's only a single thread executing a given
-    -- `SqlPersistT`.
-    --
-    -- NOTE3
     -- When 'cacheBehavior' is set to 'NoCache', we simply never write anything
-    -- to the cache, which forces 'selectLatestCheckpoint' to always perform a
+    -- to the cache, which forces 'selectLatestCheckpointCached' to always perform a
     -- database lookup.
-    cache <- newIORef Map.empty
 
-    let readCache :: W.WalletId -> SqlPersistT IO (Maybe (W.Wallet s))
-        readCache wid = Map.lookup wid <$> liftIO (readIORef cache)
+    cacheVar <- newMVar Map.empty :: IO (MVar (Map W.WalletId (W.Wallet s)))
 
-    let writeCache :: W.WalletId -> Maybe (W.Wallet s) -> SqlPersistT IO ()
-        writeCache wid = case cacheBehavior of
-            NoCache -> const (pure ())
-            CacheLatestCheckpoint -> \case
-                Nothing ->
-                    liftIO $ modifyIORef' cache $ Map.delete wid
-                Just cp -> do
-                    let tip = cp ^. #currentTip . #blockHeight
-                    let alter = \case
-                            Just old | tip < old ^. #currentTip .  #blockHeight ->
-                                Just old
-                            _ ->
-                                Just cp
-                    liftIO $ modifyIORef' cache $ Map.alter alter wid
-
-    let selectLatestCheckpoint
+    --
+    -- NOTE3
+    -- This cache will not work properly unless 'atomically' is protected by a
+    -- mutex (queryLock), which means no concurrent queries.
+    --
+    queryLock <- newMVar () -- fixme: ADP-586
+
+    -- Gets cached checkpoint for a given wallet.
+    -- If caching is disabled it unconditionally returns Nothing
+    let getCache :: W.WalletId -> SqlPersistT IO (Maybe (W.Wallet s))
+        getCache wid = Map.lookup wid <$> readMVar cacheVar
+
+        -- Adjust a wallet entry in the cache.
+        modifyCache :: W.WalletId -> (Maybe (W.Wallet s) -> SqlPersistT IO (Maybe (W.Wallet s))) -> SqlPersistT IO ()
+        modifyCache wid action = modifyMVar_ cacheVar $ \cache -> do
+            let old = Map.lookup wid cache
+            action old >>= \case
+                Nothing -> pure $ Map.delete wid cache
+                Just cp -> pure $ case cacheBehavior of
+                    NoCache -> cache -- stick to initial value
+                    CacheLatestCheckpoint -> Map.insert wid cp cache
+
+        -- This condition is required to make property tests pass, where
+        -- checkpoints may be generated in any order.
+        alterCache :: W.Wallet s -> Maybe (W.Wallet s) -> Maybe (W.Wallet s)
+        alterCache cp = \case
+            Just old | getHeight cp < getHeight old -> Just old
+            _ -> Just cp
+
+        getHeight = view (#currentTip . #blockHeight)
+
+    -- Inserts a checkpoint into the database and checkpoint cache
+    let insertCheckpointCached wid cp = modifyCache wid $ \old -> do
+            liftIO $ traceWith tr $ MsgCheckpointCache wid MsgPutCheckpoint
+            insertCheckpoint wid cp
+            pure (alterCache cp old)
+
+    -- Checks for cached a checkpoint before running selectLatestCheckpoint
+    let selectLatestCheckpointCached
             :: W.WalletId
             -> SqlPersistT IO (Maybe (W.Wallet s))
-        selectLatestCheckpoint wid = do
-            readCache wid >>= maybe fromDatabase (pure . Just)
-          where
-            fromDatabase = do
-                mcp <- fmap entityVal <$> selectFirst
-                    [ CheckpointWalletId ==. wid ]
-                    [ LimitTo 1, Desc CheckpointSlot ]
-                case mcp of
-                    Nothing -> pure Nothing
-                    Just cp -> do
-                        utxo <- selectUTxO cp
-                        s <- selectState (checkpointId cp)
-                        pure (checkpointFromEntity @s cp utxo <$> s)
-
-    let invalidateCache :: W.WalletId -> SqlPersistT IO ()
-        invalidateCache wid = do
-            writeCache wid Nothing
-            selectLatestCheckpoint wid >>= writeCache wid
-
-    return (ctx, DBLayer
+        selectLatestCheckpointCached wid = do
+            cp <- getCache wid
+            liftIO $ traceWith tr $ MsgCheckpointCache wid $ MsgGetCheckpoint $ isJust cp
+            maybe (selectLatestCheckpoint @s wid) (pure . Just) cp
+
+    -- Re-run the selectLatestCheckpoint query
+    let refreshCache :: W.WalletId -> SqlPersistT IO ()
+        refreshCache wid = modifyCache wid $ const $ do
+            liftIO $ traceWith tr $ MsgCheckpointCache wid MsgRefresh
+            selectLatestCheckpoint @s wid
+
+    -- Delete the cache for a wallet
+    let dropCache :: W.WalletId -> SqlPersistT IO ()
+        dropCache wid = modifyCache wid $ const $ do
+            liftIO $ traceWith tr $ MsgCheckpointCache wid MsgDrop
+            pure Nothing
+
+    return DBLayer
 
         {-----------------------------------------------------------------------
                                       Wallets
@@ -1210,7 +1347,7 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
             res <- handleConstraint (ErrWalletAlreadyExists wid) $
                 insert_ (mkWalletEntity wid meta gp)
             when (isRight res) $ do
-                insertCheckpoint wid cp <* writeCache wid (Just cp)
+                insertCheckpointCached wid cp
                 let (metas, txins, txouts, txoutTokens, ws) =
                         mkTxHistory wid txs
                 putTxs metas txins txouts txoutTokens ws
@@ -1222,7 +1359,7 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
                 Just _  -> Right <$> do
                     deleteCascadeWhere [WalId ==. wid]
                     deleteLooseTransactions
-                    invalidateCache wid
+                    dropCache wid
 
         , listWallets =
             map (PrimaryKey . unWalletKey) <$> selectKeysList [] [Asc WalId]
@@ -1236,10 +1373,10 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
                 Nothing ->
                     pure $ Left $ ErrNoSuchWallet wid
                 Just _  ->
-                    Right <$> (insertCheckpoint wid cp <* writeCache wid (Just cp))
+                    Right <$> insertCheckpointCached wid cp
 
         , readCheckpoint = \(PrimaryKey wid) -> do
-            selectLatestCheckpoint wid
+            selectLatestCheckpointCached wid
 
         , listCheckpoints = \(PrimaryKey wid) -> do
             map (blockHeaderFromEntity . entityVal) <$> selectList
@@ -1274,11 +1411,11 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
                     deleteStakeKeyCerts wid
                         [ StakeKeyCertSlot >. nearestPoint
                         ]
-                    invalidateCache wid
+                    refreshCache wid
                     pure (Right nearestPoint)
 
         , prune = \(PrimaryKey wid) epochStability -> ExceptT $ do
-            selectLatestCheckpoint wid >>= \case
+            selectLatestCheckpointCached wid >>= \case
                 Nothing -> pure $ Left $ ErrNoSuchWallet wid
                 Just cp -> Right <$> do
                     pruneCheckpoints wid epochStability cp
@@ -1297,7 +1434,7 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
                     pure $ Right ()
 
         , readWalletMeta = \(PrimaryKey wid) -> do
-            selectLatestCheckpoint wid >>= \case
+            selectLatestCheckpointCached wid >>= \case
                 Nothing -> pure Nothing
                 Just cp -> do
                     currentEpoch <- liftIO $
@@ -1351,7 +1488,7 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
                     pure $ Right ()
 
         , readTxHistory = \(PrimaryKey wid) minWithdrawal order range status -> do
-            selectLatestCheckpoint wid >>= \case
+            selectLatestCheckpointCached wid >>= \case
                 Nothing -> pure []
                 Just cp -> selectTxHistory cp
                     ti wid minWithdrawal order $ catMaybes
@@ -1385,7 +1522,7 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
                             else Right ()
 
         , getTx = \(PrimaryKey wid) tid -> ExceptT $ do
-            selectLatestCheckpoint wid >>= \case
+            selectLatestCheckpointCached wid >>= \case
                 Nothing -> pure $ Left $ ErrNoSuchWallet wid
                 Just cp -> do
                     metas <- selectTxHistory cp
@@ -1436,9 +1573,8 @@ newDBLayerWith cacheBehavior trace defaultFieldValues mDatabaseFile ti = do
                                      ACID Execution
         -----------------------------------------------------------------------}
 
-        , atomically = runQuery
-
-        })
+        , atomically = withMVar queryLock . const . runQuery
+        }
 
 readWalletMetadata
     :: W.WalletId
@@ -1814,6 +1950,21 @@ selectWallet :: MonadIO m => W.WalletId -> SqlPersistT m (Maybe Wallet)
 selectWallet wid =
     fmap entityVal <$> selectFirst [WalId ==. wid] []
 
+selectLatestCheckpoint
+    :: forall s. (PersistState s)
+    => W.WalletId
+    -> SqlPersistT IO (Maybe (W.Wallet s))
+selectLatestCheckpoint wid = do
+    mcp <- fmap entityVal <$> selectFirst
+        [ CheckpointWalletId ==. wid ]
+        [ LimitTo 1, Desc CheckpointSlot ]
+    case mcp of
+        Nothing -> pure Nothing
+        Just cp -> do
+            utxo <- selectUTxO cp
+            s <- selectState (checkpointId cp)
+            pure (checkpointFromEntity @s cp utxo <$> s)
+
 insertCheckpoint
     :: forall s. (PersistState s)
     => W.WalletId
diff --git a/lib/core/src/Cardano/Wallet/Network.hs b/lib/core/src/Cardano/Wallet/Network.hs
index 44e5065bd32..60005d83058 100644
--- a/lib/core/src/Cardano/Wallet/Network.hs
+++ b/lib/core/src/Cardano/Wallet/Network.hs
@@ -71,6 +71,8 @@ import Data.Functor
     ( ($>) )
 import Data.List.NonEmpty
     ( NonEmpty (..) )
+import Data.Quantity
+    ( Quantity (..) )
 import Data.Text
     ( Text )
 import Data.Text.Class
@@ -348,7 +350,7 @@ follow nl tr cps yield header =
 
         Right (RollForward cursor' tip (blockFirst : blocksRest)) -> do
             let blocks = blockFirst :| blocksRest
-            traceWith tr $ MsgApplyBlocks (header <$> blocks)
+            traceWith tr $ MsgApplyBlocks tip (header <$> blocks)
             action <- yield blocks tip
             traceWith tr $ MsgFollowAction (fmap show action)
             continueWith cursor' True action
@@ -407,7 +409,7 @@ data FollowLog
     | MsgUnhandledException Text
     | MsgNextBlockFailed ErrGetBlock
     | MsgSynced
-    | MsgApplyBlocks (NonEmpty BlockHeader)
+    | MsgApplyBlocks BlockHeader (NonEmpty BlockHeader)
     | MsgWillRollback SlotNo
     | MsgWillIgnoreRollback SlotNo Text -- Reason
     deriving (Show, Eq)
@@ -423,13 +425,16 @@ instance ToText FollowLog where
             T.pack $ "Failed to get next blocks: " <> show e
         MsgSynced ->
             "In sync with the node."
-        MsgApplyBlocks hdrs ->
-            let (slFst, slLst) =
-                    ( slotNo $ NE.head hdrs
-                    , slotNo $ NE.last hdrs
-                    )
+        MsgApplyBlocks tipHdr hdrs ->
+            let slot = pretty . slotNo
+                buildRange (x :| []) = x
+                buildRange xs = NE.head xs <> ".." <> NE.last xs
+                blockHeights = pretty . getQuantity . blockHeight <$> hdrs
             in mconcat
-                [ "Applying blocks [", pretty slFst, " ... ", pretty slLst, "]" ]
+                [ "Applying block numbers [", buildRange blockHeights, "]"
+                , "  Wallet/node slots: ", slot (NE.last hdrs)
+                , "/", slot tipHdr
+                ]
         MsgWillRollback sl ->
             "Will rollback to " <> pretty sl
         MsgWillIgnoreRollback sl reason ->
@@ -444,6 +449,6 @@ instance HasSeverityAnnotation FollowLog where
         MsgUnhandledException _ -> Error
         MsgNextBlockFailed _ -> Warning
         MsgSynced -> Debug
-        MsgApplyBlocks _ -> Info
+        MsgApplyBlocks _ _ -> Info
         MsgWillRollback _ -> Debug
         MsgWillIgnoreRollback _ _ -> Debug
diff --git a/lib/core/test/bench/db/Main.hs b/lib/core/test/bench/db/Main.hs
index 3aacd705fd9..9c37631e4e5 100644
--- a/lib/core/test/bench/db/Main.hs
+++ b/lib/core/test/bench/db/Main.hs
@@ -53,7 +53,11 @@ import Cardano.BM.Data.Tracer
 import Cardano.BM.Setup
     ( setupTrace_, shutdown )
 import Cardano.DB.Sqlite
-    ( DBLog, SqliteContext, destroyDBLayer )
+    ( ConnectionPool
+    , SqliteContext (..)
+    , newSqliteContext
+    , withConnectionPool
+    )
 import Cardano.Mnemonic
     ( EntropySize, SomeMnemonic (..), entropyToMnemonic, genEntropy )
 import Cardano.Startup
@@ -61,11 +65,9 @@ import Cardano.Startup
 import Cardano.Wallet.DB
     ( DBLayer (..), PrimaryKey (..), cleanDB )
 import Cardano.Wallet.DB.Sqlite
-    ( CacheBehavior (..)
-    , DefaultFieldValues (..)
-    , PersistState
-    , newDBLayerWith
-    )
+    ( CacheBehavior (..), PersistState, WalletDBLog (..), newDBLayerWith )
+import Cardano.Wallet.DB.Sqlite.TH
+    ( migrateAll )
 import Cardano.Wallet.DummyTarget.Primitive.Types
     ( block0, dummyGenesisParameters, mkTxId )
 import Cardano.Wallet.Logging
@@ -102,7 +104,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
 import Cardano.Wallet.Primitive.Model
     ( Wallet, initWallet, unsafeInitWallet )
 import Cardano.Wallet.Primitive.Slotting
-    ( hoistTimeInterpreter, mkSingleEraInterpreter )
+    ( TimeInterpreter, hoistTimeInterpreter, mkSingleEraInterpreter )
 import Cardano.Wallet.Primitive.Types
     ( ActiveSlotCoefficient (..)
     , Block (..)
@@ -144,11 +146,13 @@ import Cardano.Wallet.Primitive.Types.UTxO
 import Cardano.Wallet.Unsafe
     ( someDummyMnemonic, unsafeRunExceptT )
 import Control.DeepSeq
-    ( NFData (..), force )
+    ( NFData (..), deepseq, force )
 import Control.Monad
     ( join )
 import Control.Monad.Trans.Except
     ( mapExceptT )
+import Control.Tracer
+    ( contramap )
 import Criterion.Main
     ( Benchmark
     , Benchmarkable
@@ -186,22 +190,22 @@ import Data.Time.Clock.System
     ( SystemTime (..), systemToUTCTime )
 import Data.Word
     ( Word64 )
-import Database.Sqlite
-    ( SqliteException (..) )
 import Fmt
     ( build, padLeftF, padRightF, pretty, (+|), (|+) )
 import System.Directory
-    ( doesFileExist, getFileSize, removeFile )
+    ( doesFileExist, getFileSize )
 import System.FilePath
     ( takeFileName )
-import System.IO.Temp
-    ( emptySystemTempFile )
 import System.IO.Unsafe
     ( unsafePerformIO )
 import System.Random
     ( mkStdGen, randoms )
+import Test.Utils.Resource
+    ( unBracket )
 import UnliftIO.Exception
-    ( bracket, handle )
+    ( bracket, throwIO )
+import UnliftIO.Temporary
+    ( withSystemTempFile )
 
 import qualified Cardano.BM.Configuration.Model as CM
 import qualified Cardano.BM.Data.BackendKind as CM
@@ -652,10 +656,22 @@ withDB
         , PersistPrivateKey (k 'RootK)
         , WalletKey k
         )
-    => Tracer IO DBLog
+    => Tracer IO WalletDBLog
     -> (DBLayer IO s k -> Benchmark)
     -> Benchmark
-withDB tr bm = envWithCleanup (setupDB tr) cleanupDB (\ ~(_, _, db) -> bm db)
+withDB tr bm = envWithCleanup (setupDB tr) cleanupDB (\(BenchEnv _ _ db) -> bm db)
+
+data BenchEnv s k = BenchEnv
+    { cleanupDB :: IO ()
+    , _dbFile :: FilePath
+    , _dbLayer :: !(DBLayer IO s k)
+    }
+
+instance NFData (BenchEnv s k) where
+    rnf (BenchEnv _ fp db) = deepseq (rnf fp) $ deepseq (rnf db) ()
+
+withTempSqliteFile :: (FilePath -> IO a) -> IO a
+withTempSqliteFile action = withSystemTempFile "bench.db" $ \fp _ -> action fp
 
 setupDB
     :: forall s k.
@@ -663,14 +679,22 @@ setupDB
         , PersistPrivateKey (k 'RootK)
         , WalletKey k
         )
-    => Tracer IO DBLog
-    -> IO (FilePath, SqliteContext, DBLayer IO s k)
+    => Tracer IO WalletDBLog
+    -> IO (BenchEnv s k)
 setupDB tr = do
-    f <- emptySystemTempFile "bench.db"
-    (ctx, db) <- newDBLayerWith NoCache tr defaultFieldValues (Just f) ti
-    pure (f, ctx, db)
+    (createPool, destroyPool) <- unBracket withSetup
+    uncurry (BenchEnv destroyPool) <$> createPool
   where
-    ti = hoistTimeInterpreter (pure . runIdentity) $ mkSingleEraInterpreter
+    withSetup action = withTempSqliteFile $ \fp -> do
+        let trDB = contramap MsgDB tr
+        withConnectionPool trDB fp $ \pool -> do
+            ctx <- either throwIO pure =<< newSqliteContext trDB pool [] migrateAll
+            db <- newDBLayerWith NoCache tr singleEraInterpreter ctx
+            action (fp, db)
+
+singleEraInterpreter :: TimeInterpreter IO
+singleEraInterpreter = hoistTimeInterpreter (pure . runIdentity) $
+    mkSingleEraInterpreter
         (StartTime $ posixSecondsToUTCTime 0)
         (SlottingParameters
         { getSlotLength = SlotLength 1
@@ -679,25 +703,6 @@ setupDB tr = do
         , getSecurityParameter = Quantity 2160
         })
 
-defaultFieldValues :: DefaultFieldValues
-defaultFieldValues = DefaultFieldValues
-    { defaultActiveSlotCoefficient = ActiveSlotCoefficient 1.0
-    , defaultDesiredNumberOfPool = 50
-    , defaultMinimumUTxOValue = Coin 0
-    , defaultHardforkEpoch = Nothing
-        -- NOTE value in the genesis when at the time this migration was needed.
-    , defaultKeyDeposit = Coin 0
-    }
-
-cleanupDB :: (FilePath, SqliteContext, DBLayer IO s k) -> IO ()
-cleanupDB (db, ctx, _) = do
-    handle (\SqliteException{} -> pure ()) $ destroyDBLayer ctx
-    mapM_ remove [db, db <> "-shm", db <> "-wal"]
-  where
-    remove f = doesFileExist f >>= \case
-        True -> removeFile f
-        False -> pure ()
-
 -- | Cleans the database before running the benchmark.
 -- It also cleans the database after running the benchmark. That is just to
 -- exercise the delete functions.
@@ -736,7 +741,7 @@ walletFixtureByron db@DBLayer{..} = do
 -- These are not proper criterion benchmarks but use the benchmark test data to
 -- measure size on disk of the database and its temporary files.
 
-utxoDiskSpaceTests :: Tracer IO DBLog -> IO ()
+utxoDiskSpaceTests :: Tracer IO WalletDBLog -> IO ()
 utxoDiskSpaceTests tr = do
     putStrLn "Database disk space usage tests for UTxO\n"
     sequence_
@@ -758,7 +763,7 @@ utxoDiskSpaceTests tr = do
         walletFixture db
         benchPutUTxO n s 0 db
 
-txHistoryDiskSpaceTests :: Tracer IO DBLog -> IO ()
+txHistoryDiskSpaceTests :: Tracer IO WalletDBLog -> IO ()
 txHistoryDiskSpaceTests tr = do
     putStrLn "Database disk space usage tests for TxHistory\n"
     sequence_
@@ -774,13 +779,14 @@ txHistoryDiskSpaceTests tr = do
         walletFixture db
         benchPutTxHistory n i o 0 [1..100] db
 
-benchDiskSize :: Tracer IO DBLog -> (DBLayerBench -> IO ()) -> IO ()
-benchDiskSize tr action = bracket (setupDB tr) cleanupDB $ \(f, ctx, db) -> do
-    action db
-    mapM_ (printFileSize "") [f, f <> "-shm", f <> "-wal"]
-    destroyDBLayer ctx
-    printFileSize " (closed)" f
-    putStrLn ""
+benchDiskSize :: Tracer IO WalletDBLog -> (DBLayerBench -> IO ()) -> IO ()
+benchDiskSize tr action = bracket (setupDB tr) cleanupDB
+    $ \(BenchEnv destroyPool f db) -> do
+        action db
+        mapM_ (printFileSize "") [f, f <> "-shm", f <> "-wal"]
+        destroyPool
+        printFileSize " (closed)" f
+        putStrLn ""
   where
     printFileSize sfx f = do
         size <- doesFileExist f >>= \case
@@ -814,6 +820,9 @@ instance NFData (DBLayer m s k) where
 instance NFData SqliteContext where
     rnf _ = ()
 
+instance NFData ConnectionPool where
+    rnf _ = ()
+
 testCp :: WalletBench
 testCp = snd $ initWallet block0 initDummySeqState
 
diff --git a/lib/core/test/unit/Cardano/Pool/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Pool/DB/SqliteSpec.hs
index 08e6f25d466..7704c31a9e9 100644
--- a/lib/core/test/unit/Cardano/Pool/DB/SqliteSpec.hs
+++ b/lib/core/test/unit/Cardano/Pool/DB/SqliteSpec.hs
@@ -68,7 +68,7 @@ test_migrationFromv20191216 =
                 withDBLayer tr (Just path) ti $ \_ -> pure ()
                 withDBLayer tr (Just path) ti $ \_ -> pure ()
 
-            let databaseConnMsg  = filter isMsgConnStr logs
+            let databaseConnMsg  = filter isMsgOpenDB logs
             let databaseResetMsg = filter (== MsgGeneric MsgDatabaseReset) logs
             let migrationErrMsg  = filter isMsgMigrationError logs
 
@@ -76,9 +76,9 @@ test_migrationFromv20191216 =
             length databaseResetMsg `shouldBe` 1
             length migrationErrMsg  `shouldBe` 1
 
-isMsgConnStr :: PoolDbLog -> Bool
-isMsgConnStr (MsgGeneric (MsgConnStr _)) = True
-isMsgConnStr _ = False
+isMsgOpenDB :: PoolDbLog -> Bool
+isMsgOpenDB (MsgGeneric (MsgStartConnectionPool _)) = True
+isMsgOpenDB _ = False
 
 isMsgMigrationError :: PoolDbLog -> Bool
 isMsgMigrationError (MsgGeneric (MsgMigrations (Left _))) = True
diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs
index bf0c40c5898..06541cb83ef 100644
--- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs
+++ b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs
@@ -47,7 +47,7 @@ import Cardano.BM.Trace
 import Cardano.Crypto.Wallet
     ( XPrv )
 import Cardano.DB.Sqlite
-    ( DBLog (..), SqliteContext, fieldName )
+    ( DBField, DBLog (..), SqliteContext, fieldName, newInMemorySqliteContext )
 import Cardano.Mnemonic
     ( SomeMnemonic (..) )
 import Cardano.Wallet.DB
@@ -62,7 +62,13 @@ import Cardano.Wallet.DB.Arbitrary
 import Cardano.Wallet.DB.Properties
     ( properties )
 import Cardano.Wallet.DB.Sqlite
-    ( DefaultFieldValues (..), PersistState, newDBFactory, withDBLayer )
+    ( DefaultFieldValues (..)
+    , PersistState
+    , WalletDBLog (..)
+    , newDBFactory
+    , withDBLayer
+    , withDBLayerInMemory
+    )
 import Cardano.Wallet.DB.StateMachine
     ( prop_parallel, prop_sequential, validateGenerators )
 import Cardano.Wallet.DummyTarget.Primitive.Types
@@ -160,10 +166,6 @@ import Data.ByteString
     ( ByteString )
 import Data.Coerce
     ( coerce )
-import Data.Function
-    ( (&) )
-import Data.Functor
-    ( ($>) )
 import Data.Generics.Internal.VL.Lens
     ( (^.) )
 import Data.Generics.Labels
@@ -406,7 +408,7 @@ spec = parallel $ do
 sqliteSpecSeq :: Spec
 sqliteSpecSeq = do
     validateGenerators @(SeqState 'Mainnet ShelleyKey)
-    around (withDBLayer' Nothing) $ do
+    around withShelleyDBLayerInMemory $ do
         parallel $ describe "Sqlite" properties
         parallel $ describe "Sqlite State machine tests" $ do
             it "Sequential" (prop_sequential :: TestDBSeq -> Property)
@@ -415,7 +417,7 @@ sqliteSpecSeq = do
 sqliteSpecRnd :: Spec
 sqliteSpecRnd = do
     validateGenerators @(RndState 'Mainnet)
-    around (withByronDBLayer Nothing) $ do
+    around withByronDBLayer $ do
         parallel $ describe "Sqlite State machine (RndState)" $ do
             it "Sequential state machine tests"
                 (prop_sequential :: TestDBRnd -> Property)
@@ -440,8 +442,8 @@ testMigrationTxMetaFee dbName expectedLength caseByCase = do
         let ti = dummyTimeInterpreter
         copyFile orig path
         (logs, result) <- captureLogging $ \tr -> do
-            withDBLayer @s @k tr defaultFieldValues (Just path) ti
-                $ \(_, db) -> db & \DBLayer{..} -> atomically
+            withDBLayer @s @k tr defaultFieldValues path ti
+                $ \DBLayer{..} -> atomically
                 $ do
                     [wid] <- listWallets
                     readTxHistory wid Nothing Descending wholeRange Nothing
@@ -467,14 +469,14 @@ testMigrationTxMetaFee dbName expectedLength caseByCase = do
                 Just TransactionInfo{txInfoFee} ->
                     txInfoFee `shouldBe` Just expectedFee
   where
-    isMsgManualMigration :: DBLog -> Bool
-    isMsgManualMigration = \case
-        MsgManualMigrationNeeded field _ ->
-            fieldName field == unDBName fieldInDb
-        _ ->
-            False
-      where
-        fieldInDb = fieldDB $ persistFieldDef DB.TxMetaFee
+    isMsgManualMigration = matchMsgManualMigration $ \field ->
+        let fieldInDB = fieldDB $ persistFieldDef DB.TxMetaFee
+        in fieldName field == unDBName fieldInDB
+
+matchMsgManualMigration :: (DBField -> Bool) -> WalletDBLog -> Bool
+matchMsgManualMigration p = \case
+    MsgDB (MsgManualMigrationNeeded field _) -> p field
+    _ -> False
 
 testMigrationCleanupCheckpoints
     :: forall k s.
@@ -496,8 +498,8 @@ testMigrationCleanupCheckpoints dbName genesisParameters tip = do
         let ti = dummyTimeInterpreter
         copyFile orig path
         (logs, result) <- captureLogging $ \tr -> do
-            withDBLayer @s @k tr defaultFieldValues (Just path) ti
-                $ \(_, db) -> db & \DBLayer{..} -> atomically
+            withDBLayer @s @k tr defaultFieldValues path ti
+                $ \DBLayer{..} -> atomically
                 $ do
                     [wid] <- listWallets
                     (,) <$> readGenesisParameters wid <*> readCheckpoint wid
@@ -511,12 +513,9 @@ testMigrationCleanupCheckpoints dbName genesisParameters tip = do
     fieldGenesisHash = fieldDB $ persistFieldDef DB.WalGenesisHash
     fieldGenesisStart = fieldDB $ persistFieldDef DB.WalGenesisStart
 
-    isMsgManualMigration :: DBName -> DBLog -> Bool
-    isMsgManualMigration fieldInDb = \case
-        MsgManualMigrationNeeded field _ ->
-            fieldName field == unDBName fieldInDb
-        _ ->
-            False
+    isMsgManualMigration :: DBName -> WalletDBLog -> Bool
+    isMsgManualMigration fieldInDB = matchMsgManualMigration $ \field ->
+        fieldName field == unDBName fieldInDB
 
 testMigrationRole
     :: forall k s.
@@ -535,8 +534,8 @@ testMigrationRole dbName = do
         let ti = dummyTimeInterpreter
         copyFile orig path
         (logs, Just cp) <- captureLogging $ \tr -> do
-            withDBLayer @s @k tr defaultFieldValues (Just path) ti
-                $ \(_, db) -> db & \DBLayer{..} -> atomically
+            withDBLayer @s @k tr defaultFieldValues path ti
+                $ \DBLayer{..} -> atomically
                 $ do
                     [wid] <- listWallets
                     readCheckpoint wid
@@ -544,14 +543,10 @@ testMigrationRole dbName = do
         length migrationMsg `shouldBe` 3
         length (knownAddresses $ getState cp) `shouldBe` 71
   where
-    isMsgManualMigration :: DBLog -> Bool
-    isMsgManualMigration = \case
-        MsgManualMigrationNeeded field _ ->
-            fieldName field == unDBName fieldInDb
-        _ ->
-            False
-      where
-        fieldInDb = fieldDB $ persistFieldDef DB.SeqStateAddressRole
+    isMsgManualMigration :: WalletDBLog -> Bool
+    isMsgManualMigration = matchMsgManualMigration $ \field ->
+        let fieldInDB = fieldDB $ persistFieldDef DB.SeqStateAddressRole
+        in fieldName field == unDBName fieldInDB
 
 testMigrationSeqStateDerivationPrefix
     :: forall k s.
@@ -573,8 +568,8 @@ testMigrationSeqStateDerivationPrefix dbName prefix = do
         let ti = dummyTimeInterpreter
         copyFile orig path
         (logs, Just cp) <- captureLogging $ \tr -> do
-            withDBLayer @s @k tr defaultFieldValues (Just path) ti
-                $ \(_, db) -> db & \DBLayer{..} -> atomically
+            withDBLayer @s @k tr defaultFieldValues path ti
+                $ \DBLayer{..} -> atomically
                 $ do
                     [wid] <- listWallets
                     readCheckpoint wid
@@ -582,13 +577,9 @@ testMigrationSeqStateDerivationPrefix dbName prefix = do
         length migrationMsg `shouldBe` 1
         derivationPrefix (getState cp) `shouldBe` DerivationPrefix prefix
   where
-    isMsgManualMigration :: DBLog -> Bool
-    isMsgManualMigration = \case
-        MsgManualMigrationNeeded field _ ->
-            fieldName field ==
-                unDBName (fieldDB $ persistFieldDef DB.SeqStateDerivationPrefix)
-        _ ->
-            False
+    isMsgManualMigration = matchMsgManualMigration $ \field ->
+        let fieldInDB = fieldDB $ persistFieldDef DB.SeqStateDerivationPrefix
+        in fieldName field == unDBName fieldInDB
 
 testMigrationPassphraseScheme
     :: forall s k. (k ~ ShelleyKey, s ~ SeqState 'Mainnet k)
@@ -600,8 +591,8 @@ testMigrationPassphraseScheme = do
         let ti = dummyTimeInterpreter
         copyFile orig path
         (logs, (a,b,c,d)) <- captureLogging $ \tr -> do
-            withDBLayer @s @k tr defaultFieldValues (Just path) ti
-                $ \(_, db) -> db & \DBLayer{..} -> atomically
+            withDBLayer @s @k tr defaultFieldValues path ti
+                $ \DBLayer{..} -> atomically
                 $ do
                     Just a <- readWalletMeta $ PrimaryKey walNeedMigration
                     Just b <- readWalletMeta $ PrimaryKey walNewScheme
@@ -630,13 +621,9 @@ testMigrationPassphraseScheme = do
         -- account public key), so it should still have NO scheme.
         (passphraseScheme <$> passphraseInfo d) `shouldBe` Nothing
   where
-    isMsgManualMigration :: DBLog -> Bool
-    isMsgManualMigration = \case
-        MsgManualMigrationNeeded field _ ->
-            fieldName field ==
-                unDBName (fieldDB $ persistFieldDef DB.WalPassphraseScheme)
-        _ ->
-            False
+    isMsgManualMigration = matchMsgManualMigration $ \field ->
+        let fieldInDB = fieldDB $ persistFieldDef DB.WalPassphraseScheme
+        in  fieldName field == unDBName fieldInDB
 
     -- Coming from __test/data/passphraseScheme-v2020-03-16.sqlite__:
     --
@@ -681,7 +668,6 @@ loggingSpec = withLoggingDB @(SeqState 'Mainnet ShelleyKey) $ do
             msgs <- findObserveDiffs <$> getLogs
             length msgs `shouldBe` count * 2
 
-
 withLoggingDB
     :: PersistState s
     => SpecWith (IO [DBLog], DBLayer IO s ShelleyKey)
@@ -690,16 +676,18 @@ withLoggingDB = around f . beforeWith clean
   where
     f act = do
         logVar <- newTVarIO []
-        withDBLayer
+        withDBLayerInMemory
             (traceInTVarIO logVar)
-            defaultFieldValues
-            Nothing
             dummyTimeInterpreter
-            (\(_, db) -> act (logVar, db))
+            (\db -> act (logVar, db))
     clean (logs, db) = do
         cleanDB db
         STM.atomically $ writeTVar logs []
-        pure (readTVarIO logs, db)
+        pure (mapMaybe getMsgDB <$> readTVarIO logs, db)
+
+getMsgDB :: WalletDBLog -> Maybe DBLog
+getMsgDB (MsgDB msg) = Just msg
+getMsgDB _ = Nothing
 
 shouldHaveMsgQuery :: [DBLog] -> Text -> Expectation
 shouldHaveMsgQuery msgs str = unless (any match msgs) $
@@ -730,8 +718,8 @@ fileModeSpec =  do
     describe "Check db opening/closing" $ do
         it "Opening and closing of db works" $ do
             replicateM_ 25 $ do
-                db <- Just <$> temporaryDBFile
-                withDBLayer' @(SeqState 'Mainnet ShelleyKey) db
+                db <- temporaryDBFile
+                withShelleyDBLayer @(SeqState 'Mainnet ShelleyKey) db
                     (\_ -> pure ())
 
     describe "DBFactory" $ do
@@ -809,13 +797,13 @@ fileModeSpec =  do
         describe "Check db reading/writing from/to file and cleaning" $ do
 
         it "create and list wallet works" $ \f -> do
-            withDBLayer' (Just f) $ \DBLayer{..} -> do
+            withShelleyDBLayer f $ \DBLayer{..} -> do
                 atomically $ unsafeRunExceptT $
                     initializeWallet testPk testCp testMetadata mempty gp
             testOpeningCleaning f listWallets' [testPk] []
 
         it "create and get meta works" $ \f -> do
-            meta <- withDBLayer' (Just f) $ \DBLayer{..} -> do
+            meta <- withShelleyDBLayer f $ \DBLayer{..} -> do
                 now <- getCurrentTime
                 let meta = testMetadata
                        { passphraseInfo = Just $ WalletPassphraseInfo now EncryptWithPBKDF2 }
@@ -824,15 +812,15 @@ fileModeSpec =  do
                 return meta
             testOpeningCleaning f (`readWalletMeta'` testPk) (Just meta) Nothing
 
-        it "create and get private key" $ \f-> do
-            (k, h) <- withDBLayer' (Just f) $ \db@DBLayer{..} -> do
+        it "create and get private key" $ \f -> do
+            (k, h) <- withShelleyDBLayer f $ \db@DBLayer{..} -> do
                 atomically $ unsafeRunExceptT $
                     initializeWallet testPk testCp testMetadata mempty gp
                 unsafeRunExceptT $ attachPrivateKey db testPk
             testOpeningCleaning f (`readPrivateKey'` testPk) (Just (k, h)) Nothing
 
         it "put and read tx history (Ascending)" $ \f -> do
-            withDBLayer' (Just f) $ \DBLayer{..} -> do
+            withShelleyDBLayer f $ \DBLayer{..} -> do
                 atomically $ do
                     unsafeRunExceptT $
                         initializeWallet testPk testCp testMetadata mempty gp
@@ -844,7 +832,7 @@ fileModeSpec =  do
                 mempty
 
         it "put and read tx history (Decending)" $ \f -> do
-            withDBLayer' (Just f) $ \DBLayer{..} -> do
+            withShelleyDBLayer f $ \DBLayer{..} -> do
                 atomically $ do
                     unsafeRunExceptT $
                         initializeWallet testPk testCp testMetadata mempty gp
@@ -856,7 +844,7 @@ fileModeSpec =  do
                 mempty
 
         it "put and read checkpoint" $ \f -> do
-            withDBLayer' (Just f) $ \DBLayer{..} -> do
+            withShelleyDBLayer f $ \DBLayer{..} -> do
                 atomically $ do
                     unsafeRunExceptT $
                         initializeWallet testPk testCp testMetadata mempty gp
@@ -868,8 +856,9 @@ fileModeSpec =  do
             let dummyAddr x = Address $ x <> BS.pack (replicate (32 - (BS.length x)) 0)
 
             it "(Regression test #1575) - TxMetas and checkpoints should \
-               \rollback to the same place"
-               $ \f -> withDBLayer' (Just f) $ \db@DBLayer{..} -> do
+               \rollback to the same place" $ \f -> do
+              withShelleyDBLayer f $ \db@DBLayer{..} -> do
+
                 let ourAddrs = knownAddresses (getState testCp)
 
                 atomically $ unsafeRunExceptT $ initializeWallet
@@ -950,13 +939,12 @@ prop_randomOpChunks (KeyValPairs pairs) =
   where
     prop = do
         filepath <- temporaryDBFile
-        withDBLayer' (Just filepath) $ \dbF -> do
+        withShelleyDBLayer filepath $ \dbF -> do
             cleanDB dbF
-            withDBLayer' Nothing $ \dbM -> do
+            withShelleyDBLayerInMemory $ \dbM -> do
                 cleanDB dbM
                 forM_ pairs (insertPair dbM)
-                cutRandomly pairs >>= mapM_ (\chunk -> do
-                    withDBLayer' (Just filepath) (forM_ chunk . insertPair))
+                cutRandomly pairs >>= mapM_ (mapM (insertPair dbF))
                 dbF `shouldBeConsistentWith` dbM
 
     insertPair
@@ -999,13 +987,12 @@ testOpeningCleaning
     -> s
     -> Expectation
 testOpeningCleaning filepath call expectedAfterOpen expectedAfterClean = do
-    withDBLayer' (Just filepath) $ \db1 -> do
-        call db1 `shouldReturn` expectedAfterOpen
-        _ <- cleanDB db1
-        call db1 `shouldReturn` expectedAfterClean
-    withDBLayer' (Just filepath) $ \db2 -> do
-        call db2 `shouldReturn` expectedAfterClean
-
+    withShelleyDBLayer filepath $ \db -> do
+        call db `shouldReturn` expectedAfterOpen
+        _ <- cleanDB db
+        call db `shouldReturn` expectedAfterClean
+    withShelleyDBLayer filepath $ \db -> do
+        call db `shouldReturn` expectedAfterClean
 
 -- | Run a test action inside withDBLayer, then check assertions.
 withTestDBFile
@@ -1021,9 +1008,9 @@ withTestDBFile action expectations = do
         withDBLayer
             (trMessageText trace)
             defaultFieldValues
-            (Just fp)
+            fp
             ti
-            (action . snd)
+            action
         expectations fp
   where
     ti = dummyTimeInterpreter
@@ -1040,23 +1027,32 @@ defaultFieldValues = DefaultFieldValues
     , defaultKeyDeposit = Coin 2_000_000
     }
 
-withDBLayer'
-    :: (PersistState s)
-    => Maybe FilePath -- ^ Just for on-disk db, Nothing for in-memory.
-    -> (((DBLayer IO s ShelleyKey) -> IO a) -> IO a)
-withDBLayer' fp = withDBLayer nullTracer defaultFieldValues fp ti . (. snd)
-  where
-    ti = dummyTimeInterpreter
-
 -- Note: Having two separate helpers with concrete key types reduces the need
 -- for type-application everywhere.
 withByronDBLayer
-    :: (PersistState s)
-    => Maybe FilePath -- ^ Just for on-disk db, Nothing for in-memory.
-    -> (((DBLayer IO s ByronKey) -> IO a) -> IO a)
-withByronDBLayer fp = withDBLayer nullTracer defaultFieldValues fp ti . (. snd)
-  where
-    ti = dummyTimeInterpreter
+    :: PersistState s
+    => ((DBLayer IO s ByronKey) -> IO a)
+    -> IO a
+withByronDBLayer = withDBLayerInMemory
+    nullTracer
+    dummyTimeInterpreter
+
+withShelleyDBLayer
+    :: PersistState s
+    => FilePath
+    -> (DBLayer IO s ShelleyKey -> IO a)
+    -> IO a
+withShelleyDBLayer fp = withDBLayer
+    nullTracer  -- fixme: capture logging
+    defaultFieldValues
+    fp
+    dummyTimeInterpreter
+
+withShelleyDBLayerInMemory
+    :: PersistState s
+    => (DBLayer IO s ShelleyKey -> IO a)
+    -> IO a
+withShelleyDBLayerInMemory = withDBLayerInMemory nullTracer dummyTimeInterpreter
 
 listWallets'
     :: DBLayer m s k
diff --git a/lib/shelley/bench/Restore.hs b/lib/shelley/bench/Restore.hs
index 68ab41b793c..73092f7d4a3 100644
--- a/lib/shelley/bench/Restore.hs
+++ b/lib/shelley/bench/Restore.hs
@@ -53,8 +53,6 @@ import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
 import Cardano.BM.Trace
     ( Trace, nullTracer )
-import Cardano.DB.Sqlite
-    ( destroyDBLayer )
 import Cardano.Mnemonic
     ( SomeMnemonic (..), entropyToMnemonic )
 import Cardano.Wallet
@@ -73,7 +71,7 @@ import Cardano.Wallet.BenchShared
 import Cardano.Wallet.DB
     ( DBLayer )
 import Cardano.Wallet.DB.Sqlite
-    ( PersistState, newDBLayer )
+    ( PersistState, withDBLayer )
 import Cardano.Wallet.Logging
     ( trMessageText )
 import Cardano.Wallet.Network
@@ -205,7 +203,7 @@ import Type.Reflection
 import UnliftIO.Concurrent
     ( forkIO, threadDelay )
 import UnliftIO.Exception
-    ( bracket, evaluate, throwString )
+    ( evaluate, throwString )
 import UnliftIO.Temporary
     ( withSystemTempFile )
 
@@ -669,7 +667,7 @@ dummySeedFromName = SomeMnemonic @24
 
 traceProgressForPlotting :: Tracer IO Text -> Tracer IO WalletLog
 traceProgressForPlotting tr = Tracer $ \case
-    MsgFollow (MsgApplyBlocks bs) -> do
+    MsgFollow (MsgApplyBlocks _nodeTip bs) -> do
         let tip = pretty . getQuantity . blockHeight . NE.last $ bs
         time <- pretty . utcTimeToPOSIXSeconds <$> getCurrentTime
         traceWith tr (time <> " " <> tip)
@@ -691,10 +689,8 @@ withBenchDBLayer
     -> (DBLayer IO s k -> IO a)
     -> IO a
 withBenchDBLayer ti tr action =
-    withSystemTempFile "bench.db" $ \dbFile _ -> do
-        let before = newDBLayer (trMessageText tr) migrationDefaultValues (Just dbFile) ti
-        let after = destroyDBLayer . fst
-        bracket before after $ \(_ctx, db) -> action db
+    withSystemTempFile "bench.db" $ \dbFile _ ->
+        withDBLayer tr' migrationDefaultValues dbFile ti action
   where
     migrationDefaultValues = Sqlite.DefaultFieldValues
         { Sqlite.defaultActiveSlotCoefficient = 1
@@ -703,6 +699,7 @@ withBenchDBLayer ti tr action =
         , Sqlite.defaultHardforkEpoch = Nothing
         , Sqlite.defaultKeyDeposit = Coin 0
         }
+    tr' = trMessageText tr
 
 prepareNode
     :: forall n. (NetworkDiscriminantVal n)
diff --git a/lib/shelley/src/Cardano/Wallet/Shelley.hs b/lib/shelley/src/Cardano/Wallet/Shelley.hs
index b8720d3502e..99a650b896c 100644
--- a/lib/shelley/src/Cardano/Wallet/Shelley.hs
+++ b/lib/shelley/src/Cardano/Wallet/Shelley.hs
@@ -50,8 +50,6 @@ import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..), filterSeverity )
 import Cardano.BM.Trace
     ( Trace, appendName, nullTracer )
-import Cardano.DB.Sqlite
-    ( DBLog )
 import Cardano.Launcher.Node
     ( CardanoNodeConn )
 import Cardano.Pool.DB
@@ -72,7 +70,7 @@ import Cardano.Wallet.Api.Types
     , EncodeStakeAddress
     )
 import Cardano.Wallet.DB.Sqlite
-    ( DefaultFieldValues (..), PersistState )
+    ( DBFactoryLog, DefaultFieldValues (..), PersistState )
 import Cardano.Wallet.Logging
     ( trMessageText )
 import Cardano.Wallet.Network
@@ -497,7 +495,7 @@ data Tracers' f = Tracers
     , apiServerTracer     :: f ApiLog
     , tokenMetadataTracer :: f TokenMetadataLog
     , walletEngineTracer  :: f (WorkerLog WalletId WalletLog)
-    , walletDbTracer      :: f DBLog
+    , walletDbTracer      :: f DBFactoryLog
     , poolsEngineTracer   :: f (WorkerLog Text StakePoolLog)
     , poolsDbTracer       :: f PoolDbLog
     , ntpClientTracer     :: f NtpTrace
diff --git a/lib/test-utils/cardano-wallet-test-utils.cabal b/lib/test-utils/cardano-wallet-test-utils.cabal
index 13273f92a51..1432b05b824 100644
--- a/lib/test-utils/cardano-wallet-test-utils.cabal
+++ b/lib/test-utils/cardano-wallet-test-utils.cabal
@@ -49,6 +49,7 @@ library
     , text-class
     , time
     , unliftio
+    , unliftio-core
     , wai-app-static
     , warp
   hs-source-dirs:
@@ -61,6 +62,7 @@ library
       Test.Utils.Laws.PartialOrd
       Test.Utils.Paths
       Test.Utils.Roundtrip
+      Test.Utils.Resource
       Test.Utils.StaticServer
       Test.Utils.Time
       Test.Utils.Trace
@@ -82,8 +84,10 @@ test-suite unit
     , cardano-wallet-test-utils
     , hspec
     , hspec-core
+    , hspec-expectations-lifted
     , silently
     , unliftio
+    , unliftio-core
   build-tools:
       hspec-discover
   type:
diff --git a/lib/test-utils/src/Test/Hspec/Extra.hs b/lib/test-utils/src/Test/Hspec/Extra.hs
index 75ab08f42fd..7464eed90f5 100644
--- a/lib/test-utils/src/Test/Hspec/Extra.hs
+++ b/lib/test-utils/src/Test/Hspec/Extra.hs
@@ -39,90 +39,33 @@ import Test.Hspec
     )
 import Test.HUnit.Lang
     ( HUnitFailure (..), assertFailure, formatFailureReason )
+import Test.Utils.Resource
+    ( unBracket )
 import Test.Utils.Windows
     ( isWindows )
 import UnliftIO.Async
-    ( async, race, wait )
+    ( race )
 import UnliftIO.Concurrent
     ( threadDelay )
 import UnliftIO.Exception
-    ( catch, finally, throwIO, throwString )
+    ( catch, throwIO )
 import UnliftIO.MVar
-    ( MVar, newEmptyMVar, putMVar, takeMVar, tryPutMVar, tryTakeMVar )
+    ( newEmptyMVar, tryPutMVar, tryTakeMVar )
 
 import qualified Test.Hspec as Hspec
 
 -- | Run a 'bracket' resource acquisition function around all the specs. The
--- bracket opens before the first test case and closes after the last test case.
---
--- It works by actually spawning a new thread responsible for the resource
--- acquisition, passing the resource along to the parent threads via a shared
--- MVar. Then, there's a bit of logic to synchronize both threads and make sure
--- that:
---
--- a) The 'Resource Owner' thread is terminated when the main thread is done
---    with the resource.
---
--- b) The 'Main Thread' only exists when the resource owner has released the
---    resource. Exiting the main thread before the 'Resource Owner' has
---    released the resource could left a hanging resource open. This is
---    particularly annoying when the resource is a running process!
---
---     Main Thread            Resource Owner
---          x
---          |         Spawn
---          |----------------------->x
---          |                        |
---          |                        |-- Acquire resource
---          |     Send Resource      |
---          |<-----------------------|
---          |                        |
---          |                        |
---         ...                      ... Await main thread signal
---          |                        |
---          |                        |
---          |      Send Signal       |
---          |----------------------->|
---          |                        |
---          |                       ... Release resource
---          |      Send Done         |
---          |<-----------------------|
---          |                       Exit
---          |
---         Exit
+-- resource is allocated just before the first test case and released
+-- immediately after the last test case.
 --
+-- Each test is given the resource as a function parameter.
 aroundAll
-    :: forall a.
-       (HasCallStack)
+    :: forall a. HasCallStack
     => (ActionWith a -> IO ())
     -> SpecWith a
     -> Spec
 aroundAll acquire =
-    beforeAll setup . afterAll snd . beforeWith (pure . fst)
-  where
-    setup :: IO (a, IO ())
-    setup = do
-        resource <- newEmptyMVar
-        release  <- newEmptyMVar
-        done     <- newEmptyMVar
-
-        pid <- async $ flip finally (unlock done) $ acquire $ \a -> do
-            putMVar resource a
-            await release
-
-        let cleanup = do
-                unlock release
-                await done
-
-        race (wait pid) (takeMVar resource) >>= \case
-            Left _ -> throwString "aroundAll: failed to setup"
-            Right a -> pure (a, cleanup)
-
-    await :: MVar () -> IO ()
-    await = takeMVar
-
-    unlock  :: MVar () -> IO ()
-    unlock = flip putMVar ()
+    beforeAll (unBracket acquire) . afterAll snd . beforeWith fst
 
 -- | A drop-in replacement for 'it' that'll automatically retry a scenario once
 -- if it fails, to cope with potentially flaky tests, if the environment
diff --git a/lib/test-utils/src/Test/Utils/Resource.hs b/lib/test-utils/src/Test/Utils/Resource.hs
new file mode 100644
index 00000000000..0783f1e4946
--- /dev/null
+++ b/lib/test-utils/src/Test/Utils/Resource.hs
@@ -0,0 +1,103 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- |
+-- Copyright: © 2018-2020 IOHK
+-- License: Apache-2.0
+--
+-- A helper function for using the bracket pattern in code.
+--
+
+module Test.Utils.Resource
+    ( unBracket
+    ) where
+
+import Prelude
+
+import Control.Monad.IO.Unlift
+    ( MonadUnliftIO )
+import GHC.Stack
+    ( HasCallStack )
+import UnliftIO.Async
+    ( async, race, waitCatch )
+import UnliftIO.Exception
+    ( finally, throwIO, throwString )
+import UnliftIO.Memoize
+    ( memoizeMVar, runMemoized )
+import UnliftIO.MVar
+    ( MVar, newEmptyMVar, putMVar, takeMVar )
+
+-- | Decompose a bracket pattern resource acquisition function into two separate
+-- functions: "allocate" and "release".
+--
+-- It almost goes without saying that you should always call "release" after
+-- "allocate", otherwise bad things will happen.
+--
+-- It works by actually spawning a new thread responsible for the resource
+-- acquisition, passing the resource along to the parent threads via a shared
+-- MVar. Then, there's a bit of logic to synchronize both threads and make sure
+-- that:
+--
+-- a) The 'Resource Owner' thread is terminated when the main thread is done
+--    with the resource.
+--
+-- b) The 'Main Thread' only exists when the resource owner has released the
+--    resource. Exiting the main thread before the 'Resource Owner' has
+--    released the resource could left a hanging resource open. This is
+--    particularly annoying when the resource is a running process!
+--
+--     Main Thread            Resource Owner
+--          x
+--          |         Spawn
+--          |----------------------->x
+--          |                        |
+--          |                        |-- Acquire resource
+--          |     Send Resource      |
+--          |<-----------------------|
+--          |                        |
+--          |                        |
+--         ...                      ... Await main thread signal
+--          |                        |
+--          |                        |
+--          |      Send Signal       |
+--          |----------------------->|
+--          |                        |
+--          |                       ... Release resource
+--          |      Send Done         |
+--          |<-----------------------|
+--          |                       Exit
+--          |
+--         Exit
+--
+unBracket
+    :: forall m a. (HasCallStack, MonadUnliftIO m)
+    => ((a -> m ()) -> m ())
+    -> m (m a, m ())
+unBracket withResource = do
+    allocated <- newEmptyMVar
+    released  <- newEmptyMVar
+    done      <- newEmptyMVar
+
+    let cont a = do
+            putMVar allocated a
+            await released
+
+    release <- memoizeMVar $ do
+        unlock released
+        await done
+
+    allocate <- memoizeMVar $ do
+        pid <- async $ withResource cont `finally` unlock done
+        race (waitCatch pid) (takeMVar allocated) >>= \case
+            Left (Left e) -> throwIO e
+            Left (Right ()) -> throwString "aroundAll: failed to setup"
+            Right a -> pure a
+
+    pure (runMemoized allocate, runMemoized release)
+
+  where
+    await :: MVar () -> m ()
+    await = takeMVar
+
+    unlock :: MVar () -> m ()
+    unlock = flip putMVar ()
diff --git a/lib/test-utils/test/Test/Hspec/ExtraSpec.hs b/lib/test-utils/test/Test/Hspec/ExtraSpec.hs
index d3ccdddd20f..2fa80c0d639 100644
--- a/lib/test-utils/test/Test/Hspec/ExtraSpec.hs
+++ b/lib/test-utils/test/Test/Hspec/ExtraSpec.hs
@@ -1,7 +1,14 @@
-module Test.Hspec.ExtraSpec where
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Hspec.ExtraSpec (spec) where
 
 import Prelude
 
+import Control.Monad.IO.Unlift
+    ( MonadUnliftIO (..) )
+import Data.Bifunctor
+    ( first )
 import Data.IORef
     ( IORef, newIORef, readIORef, writeIORef )
 import Data.List
@@ -9,7 +16,7 @@ import Data.List
 import System.Environment
     ( setEnv )
 import System.IO.Silently
-    ( capture_ )
+    ( capture_, silence )
 import Test.Hspec
     ( ActionWith
     , Expectation
@@ -24,47 +31,61 @@ import Test.Hspec
     , shouldContain
     )
 import Test.Hspec.Core.Runner
-    ( defaultConfig, runSpec )
+    ( Summary (..), defaultConfig, runSpec )
+import Test.Hspec.Core.Spec
+    ( runIO, sequential )
+import Test.Hspec.Expectations.Lifted
+    ( shouldReturn )
+import Test.Hspec.Extra
+    ( aroundAll )
 import UnliftIO.Concurrent
     ( threadDelay )
+import UnliftIO.Exception
+    ( bracket, throwString, tryAny )
+import UnliftIO.MVar
+    ( MVar, newEmptyMVar, newMVar, putMVar, tryReadMVar, tryTakeMVar )
 
 import qualified Test.Hspec.Extra as Extra
 
 spec :: Spec
 spec = do
-    describe "Extra.it" $ before_ (setEnv "TESTS_RETRY_FAILED" "y") $ do
-        it "equals Hspec.it on success" $ do
-            let test = 1 `shouldBe` (1::Int)
-            test `shouldMatchHSpecIt` test
-
-        it "equals Hspec.it on failure" $ do
-            let test = (2+2) `shouldBe` (5::Int)
-            test `shouldMatchHSpecIt` test
-
-        describe "when first attempt fails due to flakiness" $ do
-            describe "when the retry succeeds" $ do
-                let flaky = expectationFailure "flaky test"
-                let succeed = 1 `shouldBe` (1 :: Int)
-                it "succeeds" $ do
-                    outcomes <- newIORef [flaky, succeed]
-                    (dynamically outcomes) `shouldMatchHSpecIt` succeed
-
-            describe "when the retry also fails" $ do
-                -- Some tests use limited resources and cannot be retried.
-                -- On failures, we should make sure to show the first failure
-                -- which is the interesting one.
-                it "fails with the first error" $ do
-                    let failure = expectationFailure "failure"
-                    let noRetry = expectationFailure "test can't be retried"
-                    outcomes <- newIORef [failure, noRetry]
-                    (dynamically outcomes) `shouldMatchHSpecIt` failure
-        it "can time out" $ do
-            let micro = (1000*1000 *)
-            let timeout = do
-                    threadDelay (micro 10)
-                    expectationFailure "should have timed out"
-            res <- run (Extra.itWithCustomTimeout 2) timeout
-            res `shouldContain` "timed out in 2 seconds"
+    itSpec
+    aroundAllSpec
+
+itSpec :: Spec
+itSpec = describe "Extra.it" $ before_ (setEnv "TESTS_RETRY_FAILED" "y") $ do
+    it "equals Hspec.it on success" $ do
+        let test = 1 `shouldBe` (1::Int)
+        test `shouldMatchHSpecIt` test
+
+    it "equals Hspec.it on failure" $ do
+        let test = (2+2) `shouldBe` (5::Int)
+        test `shouldMatchHSpecIt` test
+
+    describe "when first attempt fails due to flakiness" $ do
+        describe "when the retry succeeds" $ do
+            let flaky = expectationFailure "flaky test"
+            let succeed = 1 `shouldBe` (1 :: Int)
+            it "succeeds" $ do
+                outcomes <- newIORef [flaky, succeed]
+                (dynamically outcomes) `shouldMatchHSpecIt` succeed
+
+        describe "when the retry also fails" $ do
+            -- Some tests use limited resources and cannot be retried.
+            -- On failures, we should make sure to show the first failure
+            -- which is the interesting one.
+            it "fails with the first error" $ do
+                let failure = expectationFailure "failure"
+                let noRetry = expectationFailure "test can't be retried"
+                outcomes <- newIORef [failure, noRetry]
+                (dynamically outcomes) `shouldMatchHSpecIt` failure
+    it "can time out" $ do
+        let micro = (1000*1000 *)
+        let timeout = do
+                threadDelay (micro 10)
+                expectationFailure "should have timed out"
+        res <- run (Extra.itWithCustomTimeout 2) timeout
+        res `shouldContain` "timed out in 2 seconds"
 
   where
     -- | lhs `shouldMatchHSpecIt` rhs asserts that the output of running
@@ -104,3 +125,61 @@ spec = do
         outcome:rest <- readIORef outcomes
         writeIORef outcomes rest
         outcome
+
+aroundAllSpec :: Spec
+aroundAllSpec = sequential $ do
+    let withMockResource :: MonadUnliftIO m => a -> (a -> m r) -> m r
+        withMockResource a = bracket (pure a) (const $ pure ())
+
+        withMVarResource :: (Show a, Eq a, MonadUnliftIO m) => a -> (MVar a -> m r) -> m r
+        withMVarResource a = bracket (newMVar a) (takeMVarCheck a)
+
+        takeMVarCheck :: (Show a, Eq a, MonadUnliftIO m) => a -> MVar a -> m ()
+        takeMVarCheck a var = tryTakeMVar var `shouldReturn` Just a
+
+        resourceA = 1 :: Int
+
+    describe "Extra.aroundAll" $ do
+        describe "trivial" $ aroundAll (withMockResource resourceA) $ do
+            it "provides resource to first test"
+                (`shouldBe` resourceA)
+            it "provides resource to second test"
+                (`shouldBe` resourceA)
+
+        describe "basic" $ aroundAll (withMVarResource resourceA) $ do
+            it "provides resource to first test" $ \var ->
+               tryReadMVar @IO var `shouldReturn` Just resourceA
+
+            it "provides resource to second test" $ \var ->
+                tryReadMVar @IO var `shouldReturn` Just resourceA
+
+        mvar <- runIO newEmptyMVar
+        let withResource = bracket (putMVar mvar ()) (`takeMVarCheck` mvar)
+
+        describe "lazy allocation" $ aroundAll withResource $ do
+            before <- runIO $ tryReadMVar mvar
+            it "not before the spec runs" $ \_ -> do
+                before `shouldBe` Nothing
+                tryReadMVar mvar `shouldReturn` Just ()
+
+        describe "prompt release" $
+            it "after the spec runs" $
+                tryReadMVar @IO mvar `shouldReturn` Nothing
+
+        describe "exceptions" $ do
+            let trySpec = fmap (first show) . tryAny
+                    . silence . flip runSpec defaultConfig
+            let bombBefore = bracket (throwString "bomb1") (const $ pure ())
+            let bombAfter = bracket (pure ()) (const $ throwString "bomb2")
+
+            it "while allocating resource" $ do
+                a <- trySpec $ aroundAll bombBefore $
+                        it "should never happen" $ const $
+                            False `shouldBe` True
+                a `shouldBe` Right (Summary 1 1)
+
+            it "while releasing resource" $ do
+                b <- trySpec $ aroundAll bombAfter $
+                        it "spec" $ const $
+                            pure @IO ()
+                b `shouldBe` Right (Summary 1 0)
diff --git a/nix/.stack.nix/cardano-wallet-core.nix b/nix/.stack.nix/cardano-wallet-core.nix
index c112293c6d6..5503c4a7225 100644
--- a/nix/.stack.nix/cardano-wallet-core.nix
+++ b/nix/.stack.nix/cardano-wallet-core.nix
@@ -82,6 +82,7 @@
           (hsPkgs."quiet" or (errorHandler.buildDepError "quiet"))
           (hsPkgs."random" or (errorHandler.buildDepError "random"))
           (hsPkgs."random-shuffle" or (errorHandler.buildDepError "random-shuffle"))
+          (hsPkgs."resource-pool" or (errorHandler.buildDepError "resource-pool"))
           (hsPkgs."retry" or (errorHandler.buildDepError "retry"))
           (hsPkgs."safe" or (errorHandler.buildDepError "safe"))
           (hsPkgs."scientific" or (errorHandler.buildDepError "scientific"))
@@ -210,7 +211,9 @@
             (hsPkgs."cardano-crypto" or (errorHandler.buildDepError "cardano-crypto"))
             (hsPkgs."cardano-wallet-core" or (errorHandler.buildDepError "cardano-wallet-core"))
             (hsPkgs."cardano-wallet-launcher" or (errorHandler.buildDepError "cardano-wallet-launcher"))
+            (hsPkgs."cardano-wallet-test-utils" or (errorHandler.buildDepError "cardano-wallet-test-utils"))
             (hsPkgs."containers" or (errorHandler.buildDepError "containers"))
+            (hsPkgs."contra-tracer" or (errorHandler.buildDepError "contra-tracer"))
             (hsPkgs."criterion" or (errorHandler.buildDepError "criterion"))
             (hsPkgs."cryptonite" or (errorHandler.buildDepError "cryptonite"))
             (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq"))
@@ -219,9 +222,7 @@
             (hsPkgs."fmt" or (errorHandler.buildDepError "fmt"))
             (hsPkgs."iohk-monitoring" or (errorHandler.buildDepError "iohk-monitoring"))
             (hsPkgs."memory" or (errorHandler.buildDepError "memory"))
-            (hsPkgs."persistent-sqlite" or (errorHandler.buildDepError "persistent-sqlite"))
             (hsPkgs."random" or (errorHandler.buildDepError "random"))
-            (hsPkgs."temporary" or (errorHandler.buildDepError "temporary"))
             (hsPkgs."text" or (errorHandler.buildDepError "text"))
             (hsPkgs."text-class" or (errorHandler.buildDepError "text-class"))
             (hsPkgs."time" or (errorHandler.buildDepError "time"))
diff --git a/nix/.stack.nix/cardano-wallet-test-utils.nix b/nix/.stack.nix/cardano-wallet-test-utils.nix
index ea0a3fcab51..94ed73d992a 100644
--- a/nix/.stack.nix/cardano-wallet-test-utils.nix
+++ b/nix/.stack.nix/cardano-wallet-test-utils.nix
@@ -49,6 +49,7 @@
           (hsPkgs."text-class" or (errorHandler.buildDepError "text-class"))
           (hsPkgs."time" or (errorHandler.buildDepError "time"))
           (hsPkgs."unliftio" or (errorHandler.buildDepError "unliftio"))
+          (hsPkgs."unliftio-core" or (errorHandler.buildDepError "unliftio-core"))
           (hsPkgs."wai-app-static" or (errorHandler.buildDepError "wai-app-static"))
           (hsPkgs."warp" or (errorHandler.buildDepError "warp"))
           ];
@@ -61,8 +62,10 @@
             (hsPkgs."cardano-wallet-test-utils" or (errorHandler.buildDepError "cardano-wallet-test-utils"))
             (hsPkgs."hspec" or (errorHandler.buildDepError "hspec"))
             (hsPkgs."hspec-core" or (errorHandler.buildDepError "hspec-core"))
+            (hsPkgs."hspec-expectations-lifted" or (errorHandler.buildDepError "hspec-expectations-lifted"))
             (hsPkgs."silently" or (errorHandler.buildDepError "silently"))
             (hsPkgs."unliftio" or (errorHandler.buildDepError "unliftio"))
+            (hsPkgs."unliftio-core" or (errorHandler.buildDepError "unliftio-core"))
             ];
           build-tools = [
             (hsPkgs.buildPackages.hspec-discover or (pkgs.buildPackages.hspec-discover or (errorHandler.buildToolDepError "hspec-discover")))