Add network layer access in the local-cluster http service specs

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

lib/local-cluster/local-cluster.cabal

@@ -10,7 +10,9 @@ maintainer:    [email protected]
 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

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