diff --git a/justfile b/justfile index 74996f2a6b4..407579f1906 100644 --- a/justfile +++ b/justfile @@ -19,9 +19,9 @@ e2e-preprod: # run wallet-e2e suite against the local test cluster e2e-local: - nix run '.#cardano-wallet-e2e' -- local \ - -s lib/wallet-e2e/test-state \ - -c lib/wallet-e2e/config/cardano-node/local + nix shell \ + '.#local-cluster' '.#cardano-node' '.#cardano-wallet' '.#cardano-wallet-e2e' '.#local-cluster' \ + -c wallet-e2e local -s lib/wallet-e2e/test-state -c lib/local-cluster/test/data/cluster-configs # run wallet-e2e suite against the manually started node/wallet e2e-manual: diff --git a/lib/local-cluster/exe/Main.hs b/lib/local-cluster/exe/Main.hs index 028a5be7112..7067684ba90 100644 --- a/lib/local-cluster/exe/Main.hs +++ b/lib/local-cluster/exe/Main.hs @@ -1,6 +1,6 @@ -import qualified Service +import qualified Cardano.Wallet.LocalCluster as LocalCluster import Prelude main :: IO () -main = Service.main +main = LocalCluster.main diff --git a/lib/local-cluster/lib/Service.hs b/lib/local-cluster/lib/Cardano/Wallet/LocalCluster.hs similarity index 90% rename from lib/local-cluster/lib/Service.hs rename to lib/local-cluster/lib/Cardano/Wallet/LocalCluster.hs index 5e7762ab298..45de8de7070 100644 --- a/lib/local-cluster/lib/Service.hs +++ b/lib/local-cluster/lib/Cardano/Wallet/LocalCluster.hs @@ -10,7 +10,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -module Service where +module Cardano.Wallet.LocalCluster where import Prelude @@ -42,6 +42,10 @@ import Cardano.Wallet.Launch.Cluster import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) +import Control.Applicative + ( optional + , (<**>) + ) import Control.Monad.Trans.Resource ( allocate , runResourceT @@ -78,6 +82,7 @@ import qualified Cardano.Node.Cli.Launcher as NC import qualified Cardano.Wallet.Cli.Launcher as WC import qualified Cardano.Wallet.Faucet.Mnemonics as Mnemonics import qualified Cardano.Wallet.Launch.Cluster as Cluster +import qualified Options.Applicative as O import qualified Path import qualified Path.IO as PathIO @@ -213,7 +218,9 @@ main = withUtf8 $ do cfgNodeLogging <- Cluster.logFileConfigFromEnv (Just (Cluster.clusterEraToString clusterEra)) - cfgClusterConfigs <- getClusterConfigsPath + cfgClusterConfigs <- parseCommandLineOptions >>= \case + CommandLineOptions Nothing -> getClusterConfigsPathFromEnv + CommandLineOptions (Just path) -> pure path let clusterCfg = Cluster.Config { cfgStakePools = Cluster.defaultPoolConfigs , cfgLastHardFork = clusterEra @@ -270,8 +277,25 @@ main = withUtf8 $ do -- | Returns a path to the local cluster configuration, which is usually relative to the -- package sources, but can be overridden by the @LOCAL_CLUSTER_CONFIGS@ environment -- variable. -getClusterConfigsPath :: IO (Tagged "cluster-configs" FilePath) -getClusterConfigsPath = +getClusterConfigsPathFromEnv :: IO (Tagged "cluster-configs" FilePath) +getClusterConfigsPathFromEnv = lookupEnvNonEmpty "LOCAL_CLUSTER_CONFIGS" <&> Tagged . \case Nothing -> $(getTestData) "cluster-configs" Just fp -> fp + + +newtype CommandLineOptions = CommandLineOptions + { clusterConfigsDir :: Maybe (Tagged "cluster-configs" FilePath) + } + +parseCommandLineOptions :: IO CommandLineOptions +parseCommandLineOptions = O.execParser $ + O.info (parser <**> O.helper) (O.progDesc "Local Cluster for testing") + where + parser = CommandLineOptions <$> optional ( + Tagged <$> O.strOption + ( O.long "cluster-configs" + <> O.metavar "LOCAL_CLUSTER_CONFIGS" + <> O.help "Path to the local cluster configuration directory" + ) + ) diff --git a/lib/local-cluster/local-cluster.cabal b/lib/local-cluster/local-cluster.cabal index 55ac62846e5..e2d3d4873f6 100644 --- a/lib/local-cluster/local-cluster.cabal +++ b/lib/local-cluster/local-cluster.cabal @@ -49,7 +49,7 @@ library Cardano.Wallet.Faucet.Mnemonics Cardano.Wallet.Faucet.Shelley Cardano.Wallet.Launch.Cluster - Service + Cardano.Wallet.LocalCluster hs-source-dirs: lib build-depends: @@ -91,6 +91,7 @@ library , memory ^>=0.18 , network-uri ^>=2.6.4.2 , OddWord ^>=1.0.1 + , optparse-applicative , ouroboros-network ^>=0.8.1 , ouroboros-network-api ^>=0.5 , path ^>=0.9.2 diff --git a/lib/wallet-e2e/cardano-wallet-e2e.cabal b/lib/wallet-e2e/cardano-wallet-e2e.cabal index 68109b6e5dd..69032321aa6 100644 --- a/lib/wallet-e2e/cardano-wallet-e2e.cabal +++ b/lib/wallet-e2e/cardano-wallet-e2e.cabal @@ -105,11 +105,12 @@ library Cardano.Wallet.Spec.Effect.Trace Cardano.Wallet.Spec.Interpreters.Effectfully Cardano.Wallet.Spec.Interpreters.Pure - Cardano.Wallet.Spec.Network.Config + Cardano.Wallet.Spec.Network.Configured Cardano.Wallet.Spec.Network.Local Cardano.Wallet.Spec.Network.Manual Cardano.Wallet.Spec.Network.Node.Cli Cardano.Wallet.Spec.Network.Preprod + Cardano.Wallet.Spec.Network.Wait Cardano.Wallet.Spec.Network.Wallet.Cli Cardano.Wallet.Spec.Stories.Language Cardano.Wallet.Spec.Stories.Wallet diff --git a/lib/wallet-e2e/exe/Main.hs b/lib/wallet-e2e/exe/Main.hs index 7ab734fcbcd..243127d9d3a 100644 --- a/lib/wallet-e2e/exe/Main.hs +++ b/lib/wallet-e2e/exe/Main.hs @@ -69,11 +69,12 @@ testNetworkOptionsToConfig = \case TestNetworkOptionManual -> pure TestNetworkManual TestNetworkOptionLocal stateDir nodeConfigsDir -> do - absStateDir <- makeDirAbsolute (untag stateDir) - pure (TestNetworkLocal absStateDir) + absStateDir <- traverse makeDirAbsolute stateDir + absNodeConfigsDir <- traverse makeDirAbsolute nodeConfigsDir + pure (TestNetworkLocal absStateDir absNodeConfigsDir) TestNetworkOptionPreprod stateDir nodeConfigsDir -> do - absStateDir <- makeDirAbsolute (untag stateDir) - absNodeConfigsDir <- makeDirAbsolute (untag nodeConfigsDir) + absStateDir <- traverse makeDirAbsolute stateDir + absNodeConfigsDir <- traverse makeDirAbsolute nodeConfigsDir pure (TestNetworkPreprod absStateDir absNodeConfigsDir) where makeDirAbsolute = \case diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec.hs index f268d9d2f64..4552bcbf2d2 100644 --- a/lib/wallet-e2e/src/Cardano/Wallet/Spec.hs +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec.hs @@ -11,8 +11,8 @@ import qualified Cardano.Wallet.Spec.Network.Preprod as Preprod import Cardano.Wallet.Spec.Interpreters.Effectfully ( story ) -import Cardano.Wallet.Spec.Network.Config - ( NetworkConfig +import Cardano.Wallet.Spec.Network.Configured + ( ConfiguredNetwork ) import Cardano.Wallet.Spec.Stories.Wallet ( createdWalletHasZeroAda @@ -22,6 +22,12 @@ import Cardano.Wallet.Spec.Stories.Wallet import Cardano.Wallet.Spec.TimeoutSpec ( timeoutSpec ) +import Control.Monad.Trans.Resource + ( runResourceT + ) +import Data.Tagged + ( Tagged + ) import Path ( Abs , Dir @@ -35,12 +41,11 @@ import Test.Syd ) walletSpec :: TestNetworkConfig -> Spec -walletSpec networkConfig = - aroundAll (setupForNetwork networkConfig) do - describe "Wallet Backend API" $ sequential do - story "Created wallet is listed" createdWalletListed - story "Created wallet can be retrieved by id" createdWalletRetrievable - story "Created wallet has zero ADA balance" createdWalletHasZeroAda +walletSpec config = aroundAll (configureTestNet config) do + describe "Wallet Backend API" $ sequential do + story "Created wallet is listed" createdWalletListed + story "Created wallet can be retrieved by id" createdWalletRetrievable + story "Created wallet has zero ADA balance" createdWalletHasZeroAda effectsSpec :: Spec effectsSpec = describe "Effect interpreters" do @@ -51,14 +56,20 @@ effectsSpec = describe "Effect interpreters" do data TestNetworkConfig = TestNetworkManual - | TestNetworkLocal !(Path Abs Dir) - | TestNetworkPreprod !(Path Abs Dir) !(Path Abs Dir) + | TestNetworkLocal + (Tagged "state" (Path Abs Dir)) + (Tagged "config" (Path Abs Dir)) + | TestNetworkPreprod + (Tagged "state" (Path Abs Dir)) + (Tagged "config" (Path Abs Dir)) -setupForNetwork :: TestNetworkConfig -> (NetworkConfig -> IO ()) -> IO () -setupForNetwork = \case - TestNetworkManual -> - Manual.nodeWalletSetup - TestNetworkLocal stateDir -> - Local.nodeWalletSetup stateDir - TestNetworkPreprod stateDir nodeConfigDir -> - Preprod.nodeWalletSetup stateDir nodeConfigDir +configureTestNet :: TestNetworkConfig -> (ConfiguredNetwork -> IO ()) -> IO () +configureTestNet testNetworkConfig withConfiguredNetwork = runResourceT $ do + config <- case testNetworkConfig of + TestNetworkManual -> + pure Manual.configuredNetwork + TestNetworkLocal stateDir nodeConfigDir -> + Local.configuredNetwork stateDir nodeConfigDir + TestNetworkPreprod stateDir nodeConfigDir -> + Preprod.configuredNetwork stateDir nodeConfigDir + liftIO $ withConfiguredNetwork config diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Effect/Query.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Effect/Query.hs index 11e4e389b02..cde54b70e4c 100644 --- a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Effect/Query.hs +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Effect/Query.hs @@ -53,8 +53,8 @@ import Cardano.Wallet.Spec.Effect.Trace ( FxTrace , trace ) -import Cardano.Wallet.Spec.Network.Config - ( NetworkConfig (..) +import Cardano.Wallet.Spec.Network.Configured + ( ConfiguredNetwork (..) ) import Effectful ( (:>) @@ -158,10 +158,10 @@ runQuery , FxAssert :> es , FxTrace :> es ) - => NetworkConfig + => ConfiguredNetwork -> Eff (FxQuery : es) a -> Eff es a -runQuery networkConfig = interpret \_ -> \case +runQuery configuredNetwork = interpret \_ -> \case ListKnownWallets -> do resp <- runClient LW.listWallets assert "ListKnownWallets response status" @@ -321,20 +321,20 @@ runQuery networkConfig = interpret \_ -> \case >>= \case Left (e :: SomeException) -> environmentException - $ WalletNetworkInfoException networkConfig e + $ WalletNetworkInfoException configuredNetwork e Right resp | status <- responseStatus resp -> do unless (status == ok200) do environmentException - $ WalletNetworkInfoStatus networkConfig status + $ WalletNetworkInfoStatus configuredNetwork status case responseBody resp of W.GetNetworkInformationResponseError err -> environmentException - $ WalletNetworkInfoError networkConfig (toText err) + $ WalletNetworkInfoError configuredNetwork (toText err) W.GetNetworkInformationResponse406 W.GetNetworkInformationResponseBody406{..} -> environmentException $ WalletNetworkInfoError - networkConfig + configuredNetwork getNetworkInformationResponseBody406Message W.GetNetworkInformationResponse200 W.GetNetworkInformationResponseBody200{..} -> do @@ -342,7 +342,7 @@ runQuery networkConfig = interpret \_ -> \case NodeStatus.fromClientResponse getNetworkInformationResponseBody200Sync_progress & maybe ( environmentException - $ WalletNetworkInfoUnknownNodeStatus networkConfig + $ WalletNetworkInfoUnknownNodeStatus configuredNetwork ) pure pure NetworkInfo{nodeStatus} @@ -352,7 +352,7 @@ runQuery networkConfig = interpret \_ -> \case WC.runWithConfiguration WC.Configuration { WC.configBaseURL = - walletInstanceApiUrl (networkConfigWallet networkConfig) + walletInstanceApiUrl (configuredNetworkWallet configuredNetwork) , WC.configSecurityScheme = WC.anonymousSecurityScheme , WC.configIncludeUserAgent = False , WC.configApplicationName = "" @@ -362,33 +362,33 @@ environmentException :: (Fail :> es) => ExecutionEnvironmentException -> Eff es environmentException = fail . displayException data ExecutionEnvironmentException - = WalletNetworkInfoException NetworkConfig SomeException - | WalletNetworkInfoStatus NetworkConfig Http.Status - | WalletNetworkInfoError NetworkConfig Text - | NodeIsNotReady NetworkConfig - | WalletNetworkInfoUnknownNodeStatus NetworkConfig + = WalletNetworkInfoException ConfiguredNetwork SomeException + | WalletNetworkInfoStatus ConfiguredNetwork Http.Status + | WalletNetworkInfoError ConfiguredNetwork Text + | NodeIsNotReady ConfiguredNetwork + | WalletNetworkInfoUnknownNodeStatus ConfiguredNetwork deriving anyclass (Exception) instance Show ExecutionEnvironmentException where show = \case - WalletNetworkInfoException networkConfig se -> - requirement networkConfig + WalletNetworkInfoException configuredNetwork se -> + requirement configuredNetwork <> "However, an exception happened when trying to retrieve \n\ \network information from the wallet backend: \n\n" <> displayException se - WalletNetworkInfoUnknownNodeStatus networkConfig -> - requirement networkConfig - WalletNetworkInfoStatus networkConfig _ -> - requirement networkConfig - WalletNetworkInfoError networkConfig _ -> - requirement networkConfig - NodeIsNotReady networkConfig -> - requirement networkConfig + WalletNetworkInfoUnknownNodeStatus configuredNetwork -> + requirement configuredNetwork + WalletNetworkInfoStatus configuredNetwork _ -> + requirement configuredNetwork + WalletNetworkInfoError configuredNetwork _ -> + requirement configuredNetwork + NodeIsNotReady configuredNetwork -> + requirement configuredNetwork where - requirement :: NetworkConfig -> String + requirement :: ConfiguredNetwork -> String requirement configuration = "E2E test suite requires a running cardano-wallet instance \n\ \connected to a running cardano-node and listenting on " <> show - (walletInstanceApiUrl (networkConfigWallet configuration)) + (walletInstanceApiUrl (configuredNetworkWallet configuration)) <> "\n\n" diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Interpreters/Effectfully.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Interpreters/Effectfully.hs index e0d9942e9df..966115c3a31 100644 --- a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Interpreters/Effectfully.hs +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Interpreters/Effectfully.hs @@ -30,8 +30,8 @@ import Cardano.Wallet.Spec.Effect.Trace , recordTraceLog , runTracePure ) -import Cardano.Wallet.Spec.Network.Config - ( NetworkConfig +import Cardano.Wallet.Spec.Network.Configured + ( ConfiguredNetwork ) import Effectful ( Eff @@ -73,7 +73,7 @@ type Story a = ] a -story :: String -> Story () -> TestDefM '[NetworkConfig] () () +story :: String -> Story () -> TestDefM '[ConfiguredNetwork] () () story label story' = itWithOuter label \network -> do interpretStory network story' >>= \(result, log) -> do @@ -83,10 +83,10 @@ story label story' = Right () -> pass interpretStory - :: NetworkConfig + :: ConfiguredNetwork -> Story a -> IO (Either String a, Seq Text) -interpretStory networkConfig story' = do +interpretStory configuredNetwork story' = do connectionManager <- Http.newManager Http.defaultManagerSettings @@ -94,7 +94,7 @@ interpretStory networkConfig story' = do } stdGen <- initStdGen story' - & runQuery networkConfig + & runQuery configuredNetwork & runHttpClient connectionManager & runRandom stdGen & runTimeout diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Configured.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Configured.hs new file mode 100644 index 00000000000..3e5360c96ce --- /dev/null +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Configured.hs @@ -0,0 +1,9 @@ +module Cardano.Wallet.Spec.Network.Configured where + +import Cardano.Wallet.Cli.Launcher + ( WalletApi + ) + +newtype ConfiguredNetwork = ConfiguredNetwork + { configuredNetworkWallet :: WalletApi + } diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Local.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Local.hs index 64d2e77165b..5c9fe8bf8b0 100644 --- a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Local.hs +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Local.hs @@ -1,17 +1,76 @@ +{-# LANGUAGE QuasiQuotes #-} + module Cardano.Wallet.Spec.Network.Local - ( nodeWalletSetup + ( configuredNetwork ) where -import Cardano.Wallet.Spec.Network.Config - ( NetworkConfig (..) +import qualified Cardano.Wallet.Spec.Network.Wait as Wait + +import Cardano.Wallet.Cli.Launcher + ( WalletApi (..) + ) +import Cardano.Wallet.Spec.Network.Configured + ( ConfiguredNetwork (..) + ) +import Control.Monad.Trans.Resource + ( ResourceT + , allocate + ) +import Data.Tagged + ( Tagged + , untag ) import Path ( Abs , Dir , Path + , relfile + , toFilePath + , () ) +import System.IO + ( openFile + ) +import System.Process.Typed + ( Process + , proc + , setStderr + , setStdout + , startProcess + , stopProcess + , useHandleClose + ) + +configuredNetwork + :: Tagged "state" (Path Abs Dir) + -> Tagged "config" (Path Abs Dir) + -> ResourceT IO ConfiguredNetwork +configuredNetwork stateDir clusterConfigsDir = do + walletApi <- startCluster + + unlessM (Wait.untilWalletIsConnected walletApi) do + fail "Wallet is not synced, giving up. Please check wallet logs." + + pure ConfiguredNetwork{configuredNetworkWallet = walletApi, ..} + where + startCluster :: ResourceT IO WalletApi = do + (_clusterReleaseKey, _clusterProcess) <- + allocate startLocalClusterProcess stopProcess + pure WalletApi + { walletInstanceApiUrl = "http://localhost:8090/v2" + , walletInstanceApiHost = "localhost" + , walletInstanceApiPort = 8090 + } -nodeWalletSetup :: Path Abs Dir -> (NetworkConfig -> IO ()) -> IO () -nodeWalletSetup _stateDir withNetworkConfig = do - putTextLn "TODO: implement nodeWalletSetup for a local test cluster" - withNetworkConfig NetworkConfig{networkConfigWallet = error "TODO"} + startLocalClusterProcess :: IO (Process () () ()) + startLocalClusterProcess = do + let clusterLog = untag stateDir [relfile|cluster.log|] + handle <- openFile (toFilePath clusterLog) AppendMode + putStrLn $ "Writing cluster logs to " <> toFilePath clusterLog + startProcess + $ setStderr (useHandleClose handle) + $ setStdout (useHandleClose handle) + $ proc "local-cluster" + [ "--cluster-configs" + , toFilePath (untag clusterConfigsDir) + ] diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Manual.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Manual.hs index b11d7cd17d0..fd4ca642b9d 100644 --- a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Manual.hs +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Manual.hs @@ -3,18 +3,17 @@ module Cardano.Wallet.Spec.Network.Manual where import Cardano.Wallet.Cli.Launcher ( WalletApi (..) ) -import Cardano.Wallet.Spec.Network.Config - ( NetworkConfig (..) +import Cardano.Wallet.Spec.Network.Configured + ( ConfiguredNetwork (..) ) -nodeWalletSetup :: (NetworkConfig -> IO ()) -> IO () -nodeWalletSetup withNetworkConfig = do - withNetworkConfig - NetworkConfig - { networkConfigWallet = - WalletApi - { walletInstanceApiUrl = "http://localhost:8090/v2" - , walletInstanceApiHost = "localhost" - , walletInstanceApiPort = 8090 - } - } +configuredNetwork :: ConfiguredNetwork +configuredNetwork = + ConfiguredNetwork + { configuredNetworkWallet = + WalletApi + { walletInstanceApiUrl = "http://localhost:8090/v2" + , walletInstanceApiHost = "localhost" + , walletInstanceApiPort = 8090 + } + } diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Preprod.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Preprod.hs index 95b607f019e..8289b5832a2 100644 --- a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Preprod.hs +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Preprod.hs @@ -1,45 +1,29 @@ {-# LANGUAGE QuasiQuotes #-} module Cardano.Wallet.Spec.Network.Preprod - ( nodeWalletSetup + ( configuredNetwork ) where 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 qualified Cardano.Wallet.Spec.Network.Wait as Wait import Cardano.Node.Cli.Launcher - ( NodeApi - , NodeProcessConfig (..) + ( NodeProcessConfig (..) ) import Cardano.Wallet.Cli.Launcher - ( WalletApi - , WalletProcessConfig (..) + ( 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 Cardano.Wallet.Spec.Network.Configured + ( ConfiguredNetwork (..) ) import Control.Monad.Trans.Resource - ( allocate - , runResourceT + ( ResourceT + , allocate ) -import Control.Retry - ( RetryStatus - , capDelay - , fibonacciBackoff - , retrying +import Data.Tagged + ( Tagged + , untag ) import Path ( Abs @@ -50,116 +34,54 @@ import Path , () ) -nodeWalletSetup - :: Path Abs Dir - -> Path Abs Dir - -> (NetworkConfig -> IO ()) - -> IO () -nodeWalletSetup stateDir nodeConfigDir withNetworkConfig = runResourceT do +configuredNetwork + :: Tagged "state" (Path Abs Dir) + -> Tagged "config" (Path Abs Dir) + -> ResourceT IO ConfiguredNetwork +configuredNetwork stateDir nodeConfigDir = do nodeApi <- startNode walletApi <- startWallet nodeApi - unlessM (waitForNodeSocket nodeApi) do + unlessM (Wait.forNodeSocket nodeApi) do fail "Node socket is not available, giving up. Please check node logs." - unlessM (waitUntilNodeIsSynced nodeApi) do + unlessM (Wait.untilNodeIsSynced nodeApi) do fail "Node is not synced, giving up. Please check node logs." - unlessM (waitUntilWalletIsSynced walletApi) do + unlessM (Wait.untilWalletIsConnected walletApi) do fail "Wallet is not synced, giving up. Please check wallet logs." - liftIO do - withNetworkConfig NetworkConfig{networkConfigWallet = walletApi, ..} + pure ConfiguredNetwork{configuredNetworkWallet = 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|] - } + let nodeDir = untag stateDir [reldir|node|] + let nodeProcessConfig = + NodeProcessConfig + { nodeDir + , nodeConfig = + untag nodeConfigDir [relfile|config.json|] + , nodeTopology = + untag 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 walletDir = untag stateDir [reldir|wallet|] let walletProcessConfig = WalletProcessConfig - { walletDir - , walletDatabase = walletDir [reldir|db|] - , walletNodeApi = nodeApi - , walletListenHost = Nothing - , walletListenPort = Nothing - , walletByronGenesisForTestnet = Just $ - nodeConfigDir [relfile|byron-genesis.json|] - } + { walletDir + , walletDatabase = walletDir [reldir|db|] + , walletNodeApi = nodeApi + , walletListenHost = Nothing + , walletListenPort = Nothing + , walletByronGenesisForTestnet = Just $ + untag 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 - 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 diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Wait.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Wait.hs new file mode 100644 index 00000000000..589db6ef11b --- /dev/null +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Network/Wait.hs @@ -0,0 +1,92 @@ +module Cardano.Wallet.Spec.Network.Wait where + +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 + ( NodeApi + ) +import Cardano.Wallet.Cli.Launcher + ( WalletApi + ) +import Cardano.Wallet.Spec.Data.Network.NodeStatus + ( NodeStatus (..) + ) +import Cardano.Wallet.Spec.Network.Node.Cli + ( CliError + , NodeTip + ) +import Cardano.Wallet.Spec.Network.Wallet.Cli + ( NetworkInformation + ) +import Control.Retry + ( RetryStatus + , capDelay + , fibonacciBackoff + , retrying + ) + +forNodeSocket :: forall m. MonadIO m => NodeApi -> m Bool +forNodeSocket 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 + +untilNodeIsSynced :: forall m. MonadIO m => NodeApi -> m Bool +untilNodeIsSynced 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) <> "%" + +untilWalletIsConnected :: forall m. MonadIO m => WalletApi -> m Bool +untilWalletIsConnected walletApi = + either (const False) ((== NodeIsSynced) . WalletCli.nodeStatus) + <$> retrying + (capDelay (hours 1) (fibonacciBackoff (seconds 1))) + shouldRepeat + \_retryStatus -> liftIO do + 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 diff --git a/lib/wallet/bench/latency-bench.hs b/lib/wallet/bench/latency-bench.hs index 5900e210099..276a86859e7 100644 --- a/lib/wallet/bench/latency-bench.hs +++ b/lib/wallet/bench/latency-bench.hs @@ -212,10 +212,10 @@ import UnliftIO.STM import qualified Cardano.Address as CA import qualified Cardano.Wallet.Api.Link as Link import qualified Cardano.Wallet.Launch.Cluster as Cluster +import qualified Cardano.Wallet.LocalCluster as LocalCluster import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP -import qualified Service as ClusterService main :: forall n. (n ~ 'Mainnet) => IO () main = withUtf8 $ @@ -555,7 +555,7 @@ withShelleyServer tracers action = do withSystemTempDir nullTracer "latency" skipCleanup $ \dir -> do let db = dir "wallets" createDirectory db - cfgClusterConfigs <- ClusterService.getClusterConfigsPath + cfgClusterConfigs <- LocalCluster.getClusterConfigsPathFromEnv let clusterConfig = Cluster.Config { Cluster.cfgStakePools = NE.head defaultPoolConfigs :| [] , Cluster.cfgLastHardFork = maxBound diff --git a/lib/wallet/test/integration/shelley-integration-test.hs b/lib/wallet/test/integration/shelley-integration-test.hs index 386d958ccd0..3e52982f0fa 100644 --- a/lib/wallet/test/integration/shelley-integration-test.hs +++ b/lib/wallet/test/integration/shelley-integration-test.hs @@ -237,8 +237,8 @@ import qualified Cardano.Pool.DB as Pool import qualified Cardano.Pool.DB.Sqlite as Pool import qualified Cardano.Wallet.Faucet.Mnemonics as Mnemonics import qualified Cardano.Wallet.Launch.Cluster as Cluster +import qualified Cardano.Wallet.LocalCluster as LocalCluster import qualified Data.Text as T -import qualified Service as ClusterService import qualified Test.Integration.Scenario.API.Blocks as Blocks import qualified Test.Integration.Scenario.API.Byron.Addresses as ByronAddresses import qualified Test.Integration.Scenario.API.Byron.CoinSelections as ByronCoinSelections @@ -441,7 +441,7 @@ specWithServer testnetMagic testDir (tr, tracers) = aroundAll withContext withServer dbDecorator onReady = bracketTracer' tr "withServer" $ withSMASH tr' testDir $ \smashUrl -> do - cfgClusterConfigs <- ClusterService.getClusterConfigsPath + cfgClusterConfigs <- LocalCluster.getClusterConfigsPathFromEnv let clusterConfig = Cluster.Config { Cluster.cfgStakePools = Cluster.defaultPoolConfigs , Cluster.cfgLastHardFork = BabbageHardFork