diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal index 7b2bd1fcb28..3bf107ee8a2 100644 --- a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal +++ b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal @@ -58,11 +58,11 @@ library , contra-tracer , customer-deposit-wallet-pure , delta-store + , delta-table , delta-types , io-classes , iohk-monitoring-extra , OddWord - , persistent , sqlite-simple , text , transformers diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/DB.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/DB.hs index 0c2ca7fe16a..ea11be61815 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/DB.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/DB.hs @@ -1,76 +1,61 @@ -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE Rank2Types #-} module Cardano.Wallet.Deposit.IO.DB - ( SqlM - , SqlContext (..) + ( Connection , withSqliteFile - , withSqlContextInMemory + , withSqliteInMemory + + , SqlM + , runSqlM , DBLog (..) ) where import Prelude -import Cardano.BM.Extra - ( bracketTracer - ) -import Cardano.DB.Sqlite - ( DBLog (..) - ) -import Control.Concurrent.MVar - ( newMVar - , withMVar - ) -import Control.Monad.Trans.Reader - ( ReaderT (..) - ) import Control.Tracer ( Tracer - , contramap , traceWith ) - -import qualified Database.SQLite.Simple as Sqlite +import Database.Table.SQLite.Simple + ( Connection + , SqlM + , runSqlM + , withConnection + ) {----------------------------------------------------------------------------- SqlContext ------------------------------------------------------------------------------} --- | Monad to run SQL queries in. -type SqlM = ReaderT Sqlite.Connection IO - --- | A facility to run 'SqlM' computations. --- Importantly, computations are not run in parallel, but sequenced. -newtype SqlContext = SqlContext - { runSqlM :: forall a. SqlM a -> IO a - } - --- | Acquire and release an 'SqlContext' in memory. -withSqlContextInMemory +-- | Acquire and release an SQLite 'Connection' in memory. +withSqliteInMemory :: Tracer IO DBLog -- ^ Logging - -> (SqlContext -> IO a) + -> (Connection -> IO a) -- ^ Action to run -> IO a -withSqlContextInMemory tr = withSqliteFile tr ":memory:" +withSqliteInMemory tr = withSqliteFile tr ":memory:" --- | Use sqlite to open a database file --- and provide an 'SqlContext' for running 'SqlM' actions. +-- | Acquire and release an SQLite 'Connection' from a file. withSqliteFile :: Tracer IO DBLog -- ^ Logging -> FilePath -- ^ Database file - -> (SqlContext -> IO a) + -> (Connection -> IO a) -- ^ Action to run -> IO a withSqliteFile tr filepath action = - Sqlite.withConnection filepath $ \connection0 -> do - traceWith tr $ MsgOpenSingleConnection filepath - -- The lock ensures that database operations are sequenced. - lock <- newMVar connection0 - let runSqlM :: SqlM a -> IO a - runSqlM cmd = withMVar lock (observe . runReaderT cmd) - action SqlContext{runSqlM} - where - observe :: IO a -> IO a - observe = bracketTracer (contramap MsgRun tr) + withConnection filepath $ \conn -> do + traceWith tr $ MsgStartConnection filepath + result <- action conn + traceWith tr $ MsgDoneConnection filepath + pure result + +{------------------------------------------------------------------------------- + Logging +-------------------------------------------------------------------------------} + +data DBLog + = MsgStartConnection FilePath + | MsgDoneConnection FilePath + deriving (Show, Eq)