Wallet E2E refactor: improve preprod bootstrapping code

cabal.project

@@ -127,8 +127,8 @@ source-repository-package
     type: git
     location: https://github.com/cardano-foundation/cardano-wallet-client.git
     tag: 353412ca621dc28af53e4a19795338b19bab1b7b
-    subdir: generated
     --sha256: 04q58c82wy6x9nkwqbvcxbv6s61fx08h5kf62sb511aqp08id4bb
+    subdir: generated
 
 -- -------------------------------------------------------------------------
 -- Constraints tweaking

justfile

@@ -16,3 +16,7 @@ e2e-local:
   nix run '.#cardano-wallet-e2e' -- local \
     -s lib/wallet-e2e/test-state \
     -c lib/wallet-e2e/config/cardano-node/local
+
+# run wallet-e2e suite against the manually started node/wallet
+e2e-manual:
+  nix run '.#cardano-wallet-e2e' -- manual

lib/wallet-e2e/src/Cardano/Wallet/Spec/Data/Network/NodeStatus.hs

@@ -11,6 +11,11 @@ fromString "syncing" = Just NodeIsSyncing
 fromString "not_responding" = Just NodeIsNotResponding
 fromString _ = Nothing
 
+toString :: NodeStatus -> String
+toString NodeIsSynced = "ready"
+toString NodeIsSyncing = "syncing"
+toString NodeIsNotResponding = "not_responding"
+
 fromClientResponse
     :: W.GetNetworkInformationResponseBody200Sync_progress -> Maybe NodeStatus
 fromClientResponse

lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Node/Cli.hs

@@ -67,3 +67,21 @@ queryTip nodeApi = do
             case Aeson.eitherDecodeWith Aeson.value parser stdout of
                 Left err -> pure $ Left $ CliErrorDecode err stdout
                 Right tip -> pure $ Right tip
+
+checkSocket :: NodeApi -> IO Bool
+checkSocket nodeApi = do
+    (exitCode, _stdout, _stderr) <-
+        readProcess . shell
+            $ String.unwords
+                [ "cardano-cli"
+                , "query"
+                , "tip"
+                , "--testnet-magic"
+                , "1"
+                , "--socket-path"
+                , toFilePath (nodeApiSocket nodeApi)
+                ]
+    case exitCode of
+        ExitSuccess -> pure True
+        ExitFailure _code -> pure False
+

lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Preprod.hs

@@ -6,21 +6,26 @@ module Cardano.Wallet.Spec.Network.Preprod
 
 import qualified Cardano.Node.Cli.Launcher as Node
 import qualified Cardano.Wallet.Cli.Launcher as Wallet
+import qualified Cardano.Wallet.Spec.Data.Network.NodeStatus as NodeStatus
 import qualified Cardano.Wallet.Spec.Network.Node.Cli as NodeCli
 import qualified Cardano.Wallet.Spec.Network.Wallet.Cli as WalletCli
 
 import Cardano.Node.Cli.Launcher
-    ( NodeProcessConfig (..) )
+    ( NodeApi, NodeProcessConfig (..) )
 import Cardano.Wallet.Cli.Launcher
-    ( WalletProcessConfig (..) )
+    ( WalletApi, WalletProcessConfig (..) )
 import Cardano.Wallet.Spec.Data.Network.NodeStatus
     ( NodeStatus (..) )
 import Cardano.Wallet.Spec.Network.Config
     ( NetworkConfig (..) )
+import Cardano.Wallet.Spec.Network.Node.Cli
+    ( CliError, NodeTip )
+import Cardano.Wallet.Spec.Network.Wallet.Cli
+    ( NetworkInformation )
 import Control.Monad.Trans.Resource
     ( allocate, runResourceT )
 import Control.Retry
-    ( capDelay, fibonacciBackoff, retrying )
+    ( RetryStatus, capDelay, fibonacciBackoff, retrying )
 import Path
     ( Abs, Dir, Path, reldir, relfile, (</>) )
 
@@ -30,81 +35,110 @@ nodeWalletSetup
     -> (NetworkConfig -> IO ())
     -> IO ()
 nodeWalletSetup stateDir nodeConfigDir withNetworkConfig = runResourceT do
-    -- Start node
-    let nodeDir = stateDir </> [reldir|node|]
-    let nodeProcessConfig =
-            NodeProcessConfig
-                { nodeDir
-                , nodeConfig = nodeConfigDir </> [relfile|config.json|]
-                , nodeTopology = nodeConfigDir </> [relfile|topology.json|]
-                , nodeDatabase = nodeDir </> [reldir|db|]
-                }
-    (_nodeReleaseKey, (_nodeInstance, nodeApi)) <-
-        allocate (Node.start nodeProcessConfig) (Node.stop . fst)
-
-    -- Start wallet
-    let walletDir = stateDir </> [reldir|wallet|]
-    let walletProcessConfig =
-            WalletProcessConfig
-                { walletDir
-                , walletDatabase = walletDir </> [reldir|db|]
-                , walletNodeApi = nodeApi
-                , walletListenHost = Nothing
-                , walletListenPort = Nothing
-                , walletByronGenesis =
-                    nodeConfigDir </> [relfile|byron-genesis.json|]
-                }
-    (_walletReleaseKey, (_walletInstance, walletApi)) <-
-        allocate (Wallet.start walletProcessConfig) (Wallet.stop . fst)
-
-    -- Wait for the node to start and open the socket
-    void $ retrying
-        (capDelay 10_000 (fibonacciBackoff 1_000))
-        do \_retryStatus -> pure
-        do
+    nodeApi <- startNode
+
+    walletApi <- startWallet nodeApi
+
+    unlessM (waitForNodeSocket nodeApi) do
+        fail "Node socket is not available, giving up. Please check node logs."
+
+    unlessM (waitUntilNodeIsSynced nodeApi) do
+        fail "Node is not synced, giving up. Please check node logs."
+
+    unlessM (waitUntilWalletIsSynced walletApi) do
+        fail "Wallet is not synced, giving up. Please check wallet logs."
+
+    liftIO do
+        withNetworkConfig NetworkConfig{networkConfigWallet = walletApi, ..}
+  where
+    startNode = do
+        let nodeDir = stateDir </> [reldir|node|]
+        let nodeProcessConfig = NodeProcessConfig
+                    { nodeDir
+                    , nodeConfig = nodeConfigDir </> [relfile|config.json|]
+                    , nodeTopology = nodeConfigDir </> [relfile|topology.json|]
+                    , nodeDatabase = nodeDir </> [reldir|db|]
+                    }
+        (_nodeReleaseKey, (_nodeInstance, nodeApi)) <-
+            allocate (Node.start nodeProcessConfig) (Node.stop . fst)
+        pure nodeApi
+
+    startWallet nodeApi = do
+      let walletDir = stateDir </> [reldir|wallet|]
+      let walletProcessConfig =
+              WalletProcessConfig
+                  { walletDir
+                  , walletDatabase = walletDir </> [reldir|db|]
+                  , walletNodeApi = nodeApi
+                  , walletListenHost = Nothing
+                  , walletListenPort = Nothing
+                  , walletByronGenesis =
+                      nodeConfigDir </> [relfile|byron-genesis.json|]
+                  }
+      (_walletReleaseKey, (_walletInstance, walletApi)) <-
+          allocate (Wallet.start walletProcessConfig) (Wallet.stop . fst)
+      pure walletApi
+
+waitForNodeSocket :: forall m. MonadIO m => NodeApi -> m Bool
+waitForNodeSocket nodeApi = do
+    let policy = capDelay (seconds 60) (fibonacciBackoff (seconds 1))
+    retrying policy shouldRepeat \_ -> liftIO do NodeCli.checkSocket nodeApi
+  where
+    shouldRepeat :: RetryStatus -> Bool -> m Bool
+    shouldRepeat _retryStatus = pure . not
+
+waitUntilNodeIsSynced :: forall m. MonadIO m => NodeApi -> m Bool
+waitUntilNodeIsSynced nodeApi =
+    either (const False) isSynced <$> retrying
+        (capDelay (hours 1) (fibonacciBackoff (seconds 1)))
+        shouldRepeat
+        \_retryStatus -> liftIO do NodeCli.queryTip nodeApi
+  where
+    isSynced :: NodeTip -> Bool
+    isSynced = (>= 99.99) . NodeCli.syncProgress
+
+    shouldRepeat :: RetryStatus -> Either CliError NodeTip -> m Bool
+    shouldRepeat _retryStatus = \case
+        Left (NodeCli.CliErrorExitCode _code out) ->
+            True <$ putStrLn ("CLI Error: " <> decodeUtf8 out)
+        Left (NodeCli.CliErrorDecode (_jsonPath, e) _out) -> do
+            True <$ putStrLn ("Failed to decode cardano-cli response: " <> e)
+        Right tip ->
+            not (isSynced tip) <$ putStrLn do
+                "Node sync progress: " <> show (NodeCli.syncProgress tip) <> "%"
+
+waitUntilWalletIsSynced :: forall m. MonadIO m => WalletApi -> m Bool
+waitUntilWalletIsSynced walletApi =
+    either (const False) ((== NodeIsSynced) . WalletCli.nodeStatus)
+        <$> retrying
+            (capDelay (hours 1) (fibonacciBackoff (seconds 1)))
+            shouldRepeat
             \_retryStatus -> liftIO do
-                NodeCli.queryTip nodeApi >>= \case
-                    Left (NodeCli.CliErrorExitCode _code _out) ->
-                        False <$ putTextLn "Waiting for the node socket ..."
-                    _ -> do
-                        putTextLn "Node socket is ready"
-                        pure True
-
-    -- Wait for the node to sync with the network
-    waitFor (>= 99.99) do
-        NodeCli.queryTip nodeApi >>= \case
-            Left (NodeCli.CliErrorExitCode _code _out) ->
-                0.0 <$ putTextLn "Waiting for the node socket ..."
-            Left (NodeCli.CliErrorDecode (_jsonPath, e) _out) -> do
-                putTextLn $ "Failed to decode cardano-cli response: " <> toText e
-                pure 100
-            Right tip -> do
-                let progress = NodeCli.syncProgress tip
-                progress <$ putTextLn do
-                    "Node sync progress: " <> show progress <> "%"
-
-    -- Wait for the wallet to sync with the node
-    waitFor (== Just NodeIsSynced) do
-        WalletCli.queryNetworkInformation walletApi >>= \case
-            Left err -> do
-                putTextLn ("Waiting for wallet to start: " <> show err)
-                pure Nothing
-            Right networkInformation -> do
-                let nodeStatus = WalletCli.nodeStatus networkInformation
-                Just nodeStatus <$ putTextLn do
-                    "Node status as reported by Wallet: " <> show nodeStatus
-
-    liftIO
-        $ withNetworkConfig
-            NetworkConfig
-                { networkConfigWallet = walletApi
-                , ..
-                }
-
-waitFor :: MonadIO m => (a -> Bool) -> IO a -> m ()
-waitFor condition action =
-    void
-        $ retrying
-            (capDelay 10_000_000 (fibonacciBackoff 1_000_000))
-            (\_retryStatus -> pure . not . condition)
-            (\_retryStatus -> liftIO action)
+                WalletCli.queryNetworkInformation walletApi
+  where
+    shouldRepeat
+        :: RetryStatus
+        -> Either WalletCli.Error NetworkInformation
+        -> m Bool
+    shouldRepeat _retryStatus = \case
+        Left err ->
+            True <$ putTextLn ("Waiting for wallet to start: " <> show err)
+        Right networkInformation -> do
+            let nodeStatus = WalletCli.nodeStatus networkInformation
+            (NodeIsSynced /= nodeStatus)
+                <$ putStrLn
+                    ( "Node status as reported by wallet: "
+                        <> NodeStatus.toString nodeStatus
+                    )
+
+--------------------------------------------------------------------------------
+-- Helpers ---------------------------------------------------------------------
+
+seconds :: Int -> Int
+seconds = (* 1_000_000)
+
+minutes :: Int -> Int
+minutes = (* 60) . seconds
+
+hours :: Int -> Int
+hours = (* 60) . minutes

nix/project-package-list.nix

@@ -1 +1 @@
-[ "cardano-balance-tx" "cardano-coin-selection" "cardano-numeric" "cardano-wallet" "cardano-wallet-benchmarks" "cardano-wallet-launcher" "cardano-wallet-primitive" "cardano-wallet-test-utils" "delta-store" "delta-table" "delta-types" "text-class" "wai-middleware-logging" ]
+[ "cardano-balance-tx" "cardano-coin-selection" "cardano-numeric" "cardano-wallet" "cardano-wallet-benchmarks" "cardano-wallet-launcher" "cardano-wallet-primitive" "cardano-wallet-test-utils" "delta-store" "delta-table" "delta-types" "local-cluster" "text-class" "wai-middleware-logging" ]