From 56af9977ba15a6edb0e1266cde226b826256bdd7 Mon Sep 17 00:00:00 2001 From: paolino Date: Wed, 15 May 2024 12:04:03 +0000 Subject: [PATCH] Add network layer access in the local-cluster http service specs --- .../Wallet/Launch/Cluster/Faucet/Serialize.hs | 8 -- lib/local-cluster/local-cluster.cabal | 17 ++-- .../Wallet/Launch/Cluster/Http/ServiceSpec.hs | 95 +++++++++++++++---- 3 files changed, 90 insertions(+), 30 deletions(-) diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Faucet/Serialize.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Faucet/Serialize.hs index a668029385f..0bb2fe43f4b 100644 --- a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Faucet/Serialize.hs +++ b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Faucet/Serialize.hs @@ -83,14 +83,6 @@ faucetFundsToValue FaucetFunds{..} = massiveWalletFunds' = encodeAddrCoins massiveWalletFunds encodeAddrCoins = map (\(addr, Coin coin) -> (bech32 addr, coin)) - -- encodeTokenBundle :: (TokenBundle, [(String, String)]) -> Value - -- encodeTokenBundle (bundle, keys) = - -- let (Coin c, assets) = toFlatList bundle - -- in object - -- [ "coin" .= c - -- , "assets" .= (encodeAssets <$> assets) - -- , "keys" .= keys - -- ] encodeTokenBundle :: (TokenBundle, [(String, String)]) -> Value encodeTokenBundle (bundle, keys) = let (Coin c, assets) = toFlatList bundle diff --git a/lib/local-cluster/local-cluster.cabal b/lib/local-cluster/local-cluster.cabal index 5e2d672c59f..62d3dc36198 100644 --- a/lib/local-cluster/local-cluster.cabal +++ b/lib/local-cluster/local-cluster.cabal @@ -10,7 +10,9 @@ maintainer: hal@cardanofoundation.org copyright: 2023 Cardano Foundation category: Web build-type: Simple -data-files: data/swagger.json + +data-files: + data/swagger.json common language default-language: Haskell2010 @@ -26,6 +28,7 @@ common language -Wmissing-deriving-strategies -Wmissing-local-signatures -Wpartial-fields -Wredundant-constraints -Wtabs -Wunused-foralls -Wunused-packages + -Wno-missing-home-modules flag release description: Enable optimization and `-Werror` @@ -202,6 +205,7 @@ common test-common , cardano-ledger-shelley , cardano-wallet-application-extras , cardano-wallet-launcher + , cardano-wallet-network-layer , cardano-wallet-primitive , cardano-wallet-test-utils , contra-tracer @@ -227,6 +231,12 @@ common test-common , hspec-discover:hspec-discover , local-cluster:local-cluster +-- until cabal has no support for multi home, hls requires to have only one home +-- for the other modules , so we cannot use the common test-common for those +test-suite test-local-cluster + import: test-common + main-is: test.hs + type: exitcode-stdio-1.0 other-modules: Cardano.Wallet.Launch.Cluster.Faucet.SerializeSpec Cardano.Wallet.Launch.Cluster.Http.Faucet.APISpec @@ -240,11 +250,6 @@ common test-common Spec SpecHook -test-suite test-local-cluster - import: test-common - main-is: test.hs - type: exitcode-stdio-1.0 - executable test-local-cluster-exe import: test-common main-is: test-exe.hs diff --git a/lib/local-cluster/test/unit/Cardano/Wallet/Launch/Cluster/Http/ServiceSpec.hs b/lib/local-cluster/test/unit/Cardano/Wallet/Launch/Cluster/Http/ServiceSpec.hs index e902ae76b38..b9a009728d0 100644 --- a/lib/local-cluster/test/unit/Cardano/Wallet/Launch/Cluster/Http/ServiceSpec.hs +++ b/lib/local-cluster/test/unit/Cardano/Wallet/Launch/Cluster/Http/ServiceSpec.hs @@ -24,6 +24,7 @@ import Cardano.Launcher import Cardano.Wallet.Launch.Cluster ( FaucetFunds (FaucetFunds) , FileOf (..) + , RunningNode (..) ) import Cardano.Wallet.Launch.Cluster.Faucet.Serialize ( saveFunds @@ -44,15 +45,32 @@ import Cardano.Wallet.Launch.Cluster.Monitoring.Phase ( History (..) , Phase (..) ) +import Cardano.Wallet.Network + ( NetworkLayer (currentNodeTip) + ) +import Cardano.Wallet.Network.Implementation + ( withNetworkLayer + ) +import Cardano.Wallet.Network.Implementation.Ouroboros + ( tunedForMainnetPipeliningStrategy + ) import Cardano.Wallet.Network.Ports ( PortNumber , getRandomPort ) +import Cardano.Wallet.Primitive.Ledger.Shelley + ( CardanoBlock + , StandardCrypto + , fromGenesisData + ) import Cardano.Wallet.Primitive.NetworkId ( NetworkId (..) , SNetworkId (SMainnet) , withSNetworkId ) +import Cardano.Wallet.Primitive.SyncProgress + ( SyncTolerance (SyncTolerance) + ) import Control.Monad ( forM_ , unless @@ -112,6 +130,8 @@ import UnliftIO.Directory ( createDirectoryIfMissing ) +import qualified Cardano.Wallet.Network.Implementation as NL + testService :: MonitorState -> (Tracer IO Phase -> RunMonitorQ IO -> IO ()) @@ -192,9 +212,8 @@ getClusterLogsMinSeverity = lookupEnv "CLUSTER_LOGS_MIN_SEVERITY" testServiceWithCluster :: FilePath -> FaucetFunds - -> ((RunMonitorQ IO, RunFaucetQ IO) -> IO ()) - -> IO () -testServiceWithCluster name faucetFundsValue action = evalContT $ do + -> ContT () IO ((RunMonitorQ IO, RunFaucetQ IO), ToTextTracer) +testServiceWithCluster name faucetFundsValue = do port <- liftIO getRandomPort faucetFundsPath <- ContT withTempFile liftIO $ saveFunds (FileOf $ absFile faucetFundsPath) faucetFundsValue @@ -215,7 +234,23 @@ testServiceWithCluster name faucetFundsValue action = evalContT $ do DoNotSendSigINT queries <- withSNetworkId (NTestnet 42) $ \network -> withServiceClient network port nullTracer - liftIO $ action queries + pure (queries, ToTextTracer processLogs) + +withNetwork + :: Tracer IO NL.Log + -> RunningNode + -> ContT r IO (NetworkLayer IO (CardanoBlock StandardCrypto)) +withNetwork tr (RunningNode sock genesisData vData) = do + let (np, _, _) = fromGenesisData genesisData + let sTol = SyncTolerance 60 + ContT + $ withNetworkLayer + tr + tunedForMainnetPipeliningStrategy + np + sock + vData + sTol noFunds :: FaucetFunds noFunds = FaucetFunds [] [] [] @@ -278,16 +313,44 @@ spec = do (History phases, _state) <- query ObserveQ snd <$> phases `shouldBe` [RetrievingFunds] describe "withService application" $ do - it "can start and stop" $ do - testServiceWithCluster - "can-start-and-stop" noFunds - $ \(RunQuery query, _) -> do + it "can start and stop" $ evalContT $ do + ((RunQuery query, _), _) <- + testServiceWithCluster + "can-start-and-stop" + noFunds + liftIO $ do + result <- query ReadyQ + result `shouldBe` False + it "can wait for cluster ready before ending" $ evalContT $ do + ((RunQuery query, _), _) <- + testServiceWithCluster + "can-wait-for-cluster-ready-before-ending" + noFunds + liftIO $ do + fix $ \loop -> do result <- query ReadyQ - result `shouldBe` False - it "can wait for cluster ready before ending" $ do - testServiceWithCluster - "can-wait-for-cluster-ready-before-ending" noFunds - $ \(RunQuery query, _) -> do - fix $ \loop -> do - result <- query ReadyQ - unless result $ threadDelay 10000 >> loop + unless result $ threadDelay 10000 >> loop + describe "withNetwork" $ do + it "can start and stop" $ evalContT $ do + ((query, _), ToTextTracer tr) <- + testServiceWithCluster + "withNetwork-can-start-and-stop" + noFunds + node <- liftIO $ waitForNode query + nl <- withNetwork tr node + tip <- liftIO $ currentNodeTip nl + tip `seq` pure () + +waitForNode :: RunMonitorQ IO -> IO RunningNode +waitForNode (RunQuery query) = fix $ \loop -> do + (history', _) <- query ObserveQ + case getNode history' of + Nothing -> threadDelay 10000 >> loop + Just node -> pure node + +getNode :: History -> Maybe RunningNode +getNode (History phases) = case phases of + [] -> Nothing + (_time, phase) : _ -> case phase of + Cluster (Just node) -> Just node + _ -> Nothing