Move DB instantiation and aquisition logic into DB modules

Previously, creating a SQLite DB file, creating read-only and read-write connection pools, and gatekeeping connection types (e.g., `ReadWrite`)
against the Kupo instance type (e.g., read only replica) was exposed by the `SQLite` module and performed in `Kupo`.

Now, those functions are encapsulated within the DB-specific modules to allow unique implementations. For instance, PostgreSQL does not have a DB file
and does not need separate pools for read-only and read-write connections.

Makefile

@@ -1,7 +1,7 @@
 OUT := dist
 
 GHC := 9.6.3
-STYLISH_HASKELL_VERSION := 0.13.0.0
+STYLISH_HASKELL_VERSION := 0.14.5.0
 
 # Default network for snapshots.
 NETWORK := preview

src/Kupo.hs

@@ -41,16 +41,6 @@ import Kupo.Prelude
 import Control.Exception.Safe
     ( isAsyncException
     )
-import Data.Pool
-    ( defaultPoolConfig
-    , destroyAllResources
-    , newPool
-    , tryWithResource
-    , withResource
-    )
-import GHC.Conc
-    ( getNumCapabilities
-    )
 import Kupo.App
     ( ChainSyncClient
     , TraceConsumer (..)
@@ -67,19 +57,13 @@ import Kupo.App.ChainSync
     ( withChainSyncExceptionHandler
     )
 import Kupo.App.Configuration
-    ( TraceConfiguration (..)
-    , newPatternsCache
+    ( newPatternsCache
     , startOrResume
     )
 import Kupo.App.Database
     ( ConnectionType (..)
-    , Database (..)
+    , DBPool (..)
     , copyDatabase
-    , createShortLivedConnection
-    , newDatabaseFile
-    , newLock
-    , withLongLivedConnection
-    , withShortLivedConnection
     )
 import Kupo.App.Health
     ( connectionStatusToggle
@@ -148,6 +132,9 @@ import System.Exit
     ( ExitCode (..)
     )
 
+import Kupo.App.Database.SQLite
+    ( mkDBPool
+    )
 import qualified Kupo.Data.Health as Health
 
 --
@@ -210,42 +197,29 @@ kupoWith tr withProducer withFetchBlock =
             }
         } <- ask
 
-    (maxConcurrentWriters, maxConcurrentReaders) <- liftIO getNumCapabilities <&> \n -> (n,  5 * n)
-
-    liftIO $ logWith (tracerConfiguration tr) $
-        ConfigurationMaxConcurrency
-            { maxConcurrentReaders
-            , maxConcurrentWriters = if isReadOnlyReplica config then 0 else maxConcurrentWriters
-            }
-
-    dbFile <- newDatabaseFile (tracerDatabase tr) workDir
-
-    lock <- liftIO newLock
+    -- (maxConcurrentWriters, maxConcurrentReaders) <- liftIO getNumCapabilities <&> \n -> (n,  5 * n)
 
-    readOnlyPool <- liftIO $ newPool $ defaultPoolConfig
-        (createShortLivedConnection (tracerDatabase tr) ReadOnly lock longestRollback dbFile)
-        (\Database{close} -> close)
-        600
-        maxConcurrentReaders
+    -- liftIO $ logWith (tracerConfiguration tr) $
+    --     ConfigurationMaxConcurrency
+    --         { maxConcurrentReaders
+    --         , maxConcurrentWriters = if isReadOnlyReplica config then 0 else maxConcurrentWriters
+    --         }
 
-    readWritePool <- liftIO $ newPool $ defaultPoolConfig
-        (createShortLivedConnection (tracerDatabase tr) ReadWrite lock longestRollback dbFile)
-        (\Database{close} -> close)
-        30
-        maxConcurrentWriters
+    dbPool <- liftIO $ mkDBPool (isReadOnlyReplica config) (tracerDatabase tr) workDir longestRollback
 
     let run action
             | isReadOnlyReplica config =
                 -- NOTE: 'ShortLived' is a bad name here. What it really means is 'occasional
                 -- writers but mostly readers'. However, in the 'ReadOnlyReplica' mode we only
                 -- ever allow read-only connections and never perform a single write.
-                withShortLivedConnection
-                    (tracerDatabase tr)
-                    ReadOnly
-                    lock
-                    longestRollback
-                    dbFile
-                    (action InstallIndexesIfNotExist)
+                (withDatabase dbPool) ReadOnly (action InstallIndexesIfNotExist)
+                -- withShortLivedConnection
+                --     (tracerDatabase tr)
+                --     ReadOnly
+                --     lock
+                --     longestRollback
+                --     dbFile
+                --     (action InstallIndexesIfNotExist)
             | otherwise =
                 handle
                     (\NodeTipHasBeenReached{distance} -> do
@@ -255,16 +229,18 @@ kupoWith tr withProducer withFetchBlock =
                     (io deferIndexes)
               where
                 io indexMode =
-                    withLongLivedConnection
-                        (tracerDatabase tr)
-                        lock
-                        longestRollback
-                        dbFile
-                        indexMode
-                        (action indexMode)
-                      `finally` do
-                           destroyAllResources readOnlyPool
-                           destroyAllResources readWritePool
+                  (withDatabaseExclusiveWriter dbPool) indexMode (action indexMode)
+                    `finally` destroyResources dbPool
+                    -- withLongLivedConnection
+                    --     (tracerDatabase tr)
+                    --     lock
+                    --     longestRollback
+                    --     dbFile
+                    --     indexMode
+                    --     (action indexMode)
+                    --   `finally` do
+                    --        destroyAllResources readOnlyPool
+                    --        destroyAllResources readWritePool
 
     liftIO $ handle (onUnknownException crashWith) $ run $ \indexMode db -> do
         patterns <- newPatternsCache (tracerConfiguration tr) config db
@@ -278,16 +254,7 @@ kupoWith tr withProducer withFetchBlock =
                     -- HTTP Server
                     ( httpServer
                         (tracerHttp tr)
-                        (\case
-                            ReadOnly  ->
-                                tryWithResource readOnlyPool
-                            ReadWrite | isReadOnlyReplica config ->
-                                const (fail "cannot acquire read/write connection on read-only replica.")
-                            ReadWrite ->
-                                tryWithResource readWritePool
-                            WriteOnly ->
-                                const (fail "impossible: tried to acquire WriteOnly database?")
-                        )
+                        (tryWithDatabase dbPool)
                         forceRollback
                         fetchBlock
                         patterns
@@ -319,7 +286,7 @@ kupoWith tr withProducer withFetchBlock =
                             (tracerGardener tr)
                             config
                             patterns
-                            (withResource readWritePool)
+                            (withDatabase dbPool ReadWrite)
                     )
 
                     -- Block producer, fetching blocks from the network

src/Kupo/App/Database.hs

@@ -3,8 +3,8 @@
 --  file, You can obtain one at http://mozilla.org/MPL/2.0/.
 
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 
 module Kupo.App.Database
     ( -- * Database DSL
@@ -34,23 +34,14 @@ module Kupo.App.Database
     , rollbackQryDeleteCheckpoints
 
       -- * Setup
-    , newDatabaseFile
-    , createShortLivedConnection
-    , withLongLivedConnection
-    , withShortLivedConnection
     , copyDatabase
-    , Connection
     , ConnectionType (..)
-    , DatabaseFile (..)
+    , DBPool (..)
 
       -- * Internal
     , installIndexes
     , installIndex
 
-      -- ** Lock
-    , DBLock
-    , newLock
-
       -- * Tracer
     , TraceDatabase (..)
     ) where
@@ -59,4 +50,10 @@ module Kupo.App.Database
 import Kupo.App.Database.Postgres
 #else
 import Kupo.App.Database.SQLite
-#endif
+import Kupo.App.Database.Types
+    ( ConnectionType (..)
+    , DBPool (..)
+    , DBTransaction
+    , Database (..)
+    )
+#endif