Add a mock network env to the deposit wallet application

cardano-foundation · Nov 10, 2024 · e29b2d2 · e29b2d2
1 parent a744418
commit e29b2d2
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 12 deletions.
diff --git a/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs b/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs
@@ -1,6 +1,6 @@
 module Cardano.Wallet.Deposit.REST.Start
     ( loadDepositWalletFromDisk
-    , fakeBootEnv
+    , newFakeBootEnv
     )
 where
 
@@ -9,6 +9,12 @@ import Prelude
 import Cardano.Wallet.Deposit.IO
     ( WalletBootEnv (..)
     )
+import Cardano.Wallet.Deposit.IO.Network.Mock
+    ( newNetworkEnvMock
+    )
+import Cardano.Wallet.Deposit.IO.Network.Type
+    ( mapBlock
+    )
 import Cardano.Wallet.Deposit.REST
     ( WalletResource
     , loadWallet
@@ -52,10 +58,10 @@ loadDepositWalletFromDisk tr dir env resource = do
         Left e -> error $ show e
         Right _ -> pure ()
 
-fakeBootEnv :: MonadIO m => WalletBootEnv m
-fakeBootEnv =
-    ( WalletBootEnv
+newFakeBootEnv :: IO (WalletBootEnv IO)
+newFakeBootEnv =
+    WalletBootEnv
         (show >$< stdoutTracer)
         Read.mockGenesisDataMainnet
-        (error "network env not defined")
-    )
+        . mapBlock Read.EraValue
+        <$> newNetworkEnvMock
diff --git a/lib/exe/lib/Cardano/Wallet/Application.hs b/lib/exe/lib/Cardano/Wallet/Application.hs
@@ -95,15 +95,18 @@ import Cardano.Wallet.DB.Layer
 import Cardano.Wallet.DB.Sqlite.Migration.Old
     ( DefaultFieldValues (..)
     )
+import Cardano.Wallet.Deposit.IO
+    ( WalletBootEnv
+    )
 import Cardano.Wallet.Deposit.IO.Resource
     ( withResource
     )
 import Cardano.Wallet.Deposit.REST
     ( WalletResource
     )
 import Cardano.Wallet.Deposit.REST.Start
-    ( fakeBootEnv
-    , loadDepositWalletFromDisk
+    ( loadDepositWalletFromDisk
+    , newFakeBootEnv
     )
 import Cardano.Wallet.Flavor
     ( CredFromOf
@@ -378,6 +381,7 @@ serveWallet
         eDepositUiSocket <- bindDepositUiSocket
         eDepositSocket <- bindDepositSocket
         eShelleySocket <- bindApiSocket
+        fakeBootEnv <- lift newFakeBootEnv
         callCC $ \exit -> do
             case eShelleyUiSocket of
                 Left err -> do
@@ -438,6 +442,7 @@ serveWallet
                             let uiService =
                                     startDepositUiServer
                                         ui
+                                        fakeBootEnv
                                         databaseDir'
                                         socket
                                         sNetwork
@@ -476,6 +481,7 @@ serveWallet
                             let depositService =
                                     startDepositServer
                                         resource
+                                        fakeBootEnv
                                         databaseDir'
                                         socket
                             ContT $ \k ->
@@ -503,23 +509,26 @@ serveWallet
         bindApiSocket :: ContT r IO (Either ListenError (Warp.Port, Socket))
         bindApiSocket = ContT $ withListeningSocket hostPref listenShelley
 
-        bindShelleyUiSocket :: ContT r IO (Either ListenError (Maybe (Warp.Port, Socket)))
+        bindShelleyUiSocket
+            :: ContT r IO (Either ListenError (Maybe (Warp.Port, Socket)))
         bindShelleyUiSocket = case mListenShelleyUi of
             Nothing -> pure $ Right Nothing
             Just listenUi -> do
                 fmap (fmap Just)
                     $ ContT
                     $ withListeningSocket hostPref listenUi
 
-        bindDepositUiSocket :: ContT r IO (Either ListenError (Maybe (Warp.Port, Socket)))
+        bindDepositUiSocket
+            :: ContT r IO (Either ListenError (Maybe (Warp.Port, Socket)))
         bindDepositUiSocket = case mListenDepositUi of
             Nothing -> pure $ Right Nothing
             Just listenUi -> do
                 fmap (fmap Just)
                     $ ContT
                     $ withListeningSocket hostPref listenUi
 
-        bindDepositSocket :: ContT r IO (Either ListenError (Maybe (Warp.Port, Socket)))
+        bindDepositSocket
+            :: ContT r IO (Either ListenError (Maybe (Warp.Port, Socket)))
         bindDepositSocket = case mListenDeposit of
             Nothing -> pure $ Right Nothing
             Just listenDeposit ->
@@ -607,11 +616,13 @@ serveWallet
 
         startDepositServer
             :: WalletResource
+            -> WalletBootEnv IO
             -> FilePath
             -> Socket
             -> IO ()
         startDepositServer
             resource
+            fakeBootEnv
             databaseDir'
             socket =
                 do
@@ -635,6 +646,7 @@ serveWallet
              . ( HasSNetworkId n
                )
             => UILayer WalletResource
+            -> WalletBootEnv IO
             -> FilePath
             -> Socket
             -> SNetworkId n
@@ -643,6 +655,7 @@ serveWallet
             -> IO ()
         startDepositUiServer
             ui
+            fakeBootEnv
             databaseDir'
             socket
             _proxy
@@ -781,7 +794,8 @@ serveWallet
                 tokenMetaClient
                 coworker
 
-handleWalletExceptions :: forall x. Servant.Handler x -> Servant.Handler x
+handleWalletExceptions
+    :: forall x. Servant.Handler x -> Servant.Handler x
 handleWalletExceptions =
     Servant.Handler
         . ExceptT