Use Store IO in WalletEnv, remove atomically

We have to increase the delay in `postTx` of the mock environment.
cardano-foundation · Aug 5, 2024 · 6bb0184 · 6bb0184
1 parent 2b557cf
commit 6bb0184
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 29 deletions.
diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs
@@ -55,7 +55,6 @@ import Data.List.NonEmpty
     ( NonEmpty
     )
 
-import qualified Cardano.Wallet.Deposit.IO.DB as DB
 import qualified Cardano.Wallet.Deposit.IO.Network.Type as Network
 import qualified Cardano.Wallet.Deposit.Pure as Wallet
 import qualified Cardano.Wallet.Deposit.Read as Read
@@ -77,13 +76,12 @@ data WalletEnv m =
         { logger :: Tracer m WalletLog
         , genesisData :: Read.GenesisData
         , networkEnv :: Network.NetworkEnv m Read.Block
-        , database :: Store.UpdateStore DB.SqlM Wallet.DeltaWalletState
-        , atomically :: forall a. DB.SqlM a -> m a
+        , database :: Store.UpdateStore IO Wallet.DeltaWalletState
         }
 
 data WalletInstance = WalletInstance
     { env :: WalletEnv IO
-    , walletState :: DBVar.DBVar DB.SqlM Wallet.DeltaWalletState
+    , walletState :: DBVar.DBVar IO Wallet.DeltaWalletState
     }
 
 {-----------------------------------------------------------------------------
@@ -94,16 +92,16 @@ onWalletState
     :: WalletInstance
     -> Delta.Update Wallet.DeltaWalletState r
     -> IO r
-onWalletState WalletInstance{env,walletState} update' =
-    atomically env $ Delta.onDBVar walletState update'
+onWalletState WalletInstance{walletState} =
+    Delta.onDBVar walletState
     -- FIXME: Propagation of exceptions from Pure to IO.
 
 -- | Convenience to read the 'WalletState'.
 --
 -- Use 'onWalletState' if you want to use the result in an atomic update.
 readWalletState :: WalletInstance -> IO WalletState
-readWalletState WalletInstance{env,walletState} =
-    atomically env $ DBVar.readDBVar walletState
+readWalletState WalletInstance{walletState} =
+    DBVar.readDBVar walletState
 
 {-----------------------------------------------------------------------------
     Operations
@@ -117,8 +115,7 @@ withWalletInit
     -> (WalletInstance -> IO a)
     -> IO a
 withWalletInit env@WalletEnv{..} xpub knownCustomerCount action = do
-    walletState <- atomically
-        $ DBVar.initDBVar database
+    walletState <- DBVar.initDBVar database
         $ Wallet.fromXPubAndGenesis xpub knownCustomerCount genesisData
     withWalletDBVar env walletState action
 
@@ -128,12 +125,12 @@ withWalletLoad
     -> (WalletInstance -> IO a)
     -> IO a
 withWalletLoad env@WalletEnv{..} action = do
-    walletState <- atomically $ DBVar.loadDBVar database
+    walletState <- DBVar.loadDBVar database
     withWalletDBVar env walletState action
 
 withWalletDBVar
     :: WalletEnv IO
-    -> DBVar.DBVar DB.SqlM Wallet.DeltaWalletState
+    -> DBVar.DBVar IO Wallet.DeltaWalletState
     -> (WalletInstance -> IO a)
     -> IO a
 withWalletDBVar env@WalletEnv{..} walletState action = do

diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs
@@ -84,7 +84,7 @@ newNetworkEnvMock = do
             (block, tip) <- forgeBlock tx
             broadcast block tip
             -- brief delay to account for asynchronous chain followers
-            threadDelay 10
+            threadDelay 100
             pure $ Right ()
         }
 

diff --git a/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Blockchain.hs b/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Blockchain.hs
@@ -30,10 +30,6 @@ import Prelude
 import Cardano.Crypto.Wallet
     ( XPrv
     )
-import Cardano.Wallet.Deposit.IO.DB
-    ( SqlContext (..)
-    , withSqlContextInMemory
-    )
 import Cardano.Wallet.Deposit.IO.Network.Mock
     ( newNetworkEnvMock
     )
@@ -92,18 +88,15 @@ withWalletEnvMock
     :: ScenarioEnv
     -> (Wallet.WalletEnv IO -> IO a)
     -> IO a
-withWalletEnvMock ScenarioEnv{..} action =
-    withSqlContextInMemory nullTracer
-        $ \SqlContext{runSqlM} -> do
-            database <- runSqlM newStore
-            let walletEnv = Wallet.WalletEnv
-                    { Wallet.logger = nullTracer
-                    , Wallet.genesisData = genesisData
-                    , Wallet.networkEnv = networkEnv
-                    , Wallet.database = database
-                    , Wallet.atomically = runSqlM
-                    }
-            action walletEnv
+withWalletEnvMock ScenarioEnv{..} action = do
+    database <- newStore
+    let walletEnv = Wallet.WalletEnv
+            { Wallet.logger = nullTracer
+            , Wallet.genesisData = genesisData
+            , Wallet.networkEnv = networkEnv
+            , Wallet.database = database
+            }
+    action walletEnv
 
 {-----------------------------------------------------------------------------
     Faucet