Remove cluster config instance duplicated definition

cardano-foundation · Apr 23, 2024 · 1e70367 · 1e70367
1 parent 5fa3a5d
commit 1e70367
Showing 1 changed file with 31 additions and 54 deletions.
diff --git a/lib/integration/framework/Test/Integration/Framework/Setup.hs b/lib/integration/framework/Test/Integration/Framework/Setup.hs
@@ -321,10 +321,9 @@ recordPoolGarbageCollectionEvents TestingCtx{..} eventsRef =
 
 withServer
     :: TestingCtx
-    -> DirOf "cluster-configs"
+    -> Cluster.Config
     -> FaucetFunds
     -> Pool.DBDecorator IO
-    -> Maybe (FileOf "node-output")
     -> ( T.Text
          -> CardanoNodeConn
          -> NetworkParameters
@@ -334,32 +333,14 @@ withServer
     -> IO ExitCode
 withServer
     ctx@TestingCtx{..}
-    clusterConfigs
+    clusterConfig
     faucetFunds
     dbDecorator
-    nodeOutputFile
     onReady =
         bracketTracer' tr "withServer" $ do
-            let tr' = contramap MsgCluster tr
-            era <- clusterEraFromEnv
+            let tr' = Cluster.cfgTracer clusterConfig
             traceWith tr $ MsgInfo "Starting SMASH server ..."
-            withSMASH tr' (toFilePath . absDirOf $ testDir) $ \smashUrl -> do
-                let clusterConfig =
-                        Cluster.Config
-                            { cfgStakePools = Cluster.defaultPoolConfigs
-                            , cfgLastHardFork = era
-                            , cfgNodeLogging = LogFileConfig Info Nothing Info
-                            , cfgClusterDir = testDir
-                            , cfgClusterConfigs = clusterConfigs
-                            , cfgTestnetMagic = testnetMagic
-                            , cfgShelleyGenesisMods = []
-                            , cfgTracer = tr'
-                            , cfgNodeOutputFile = nodeOutputFile
-                            , cfgRelayNodePath = mkRelDirOf "relay"
-                            , cfgClusterLogFile = Just
-                                $ FileOf @"cluster-logs"
-                                $ absDirOf testDir </> relFile "cluster.logs"
-                            }
+            withSMASH tr' (toFilePath $ absDirOf testDir) $ \smashUrl -> do
                 traceWith tr $ MsgInfo "Starting local cluster ..."
                 withLocalCluster Nothing clusterConfig faucetFunds
                     $ onClusterStart
@@ -429,30 +410,28 @@ httpManager = do
 
 setupContext
     :: TestingCtx
+    -> Cluster.Config
     -> MVar Context
     -> ClientEnv
     -- ^ Faucet client environment
     -> IORef [PoolGarbageCollectionEvent]
-    -> Maybe (FileOf "node-output")
     -> T.Text
     -> CardanoNodeConn
     -> NetworkParameters
     -> URI
     -> IO ()
 setupContext
     TestingCtx{..}
+    clusterConfig
     ctx
     faucetClientEnv
     poolGarbageCollectionEvents
-    nodeOutputFile
     smashUrl
     nodeConnection
     networkParameters
     baseUrl =
         bracketTracer' tr "setupContext" $ do
-            clusterConfigs <- Cluster.localClusterConfigsFromEnv
             faucet <- Faucet.initFaucet faucetClientEnv
-            let tr' = contramap MsgCluster tr
             prometheusUrl <-
                 let packPort (h, p) =
                         T.pack h <> ":" <> toText @(Port "Prometheus") p
@@ -464,24 +443,6 @@ setupContext
             traceWith tr $ MsgBaseUrl baseUrl ekgUrl prometheusUrl smashUrl
             manager <- httpManager
             mintSeaHorseAssetsLock <- newMVar ()
-
-            let withConfig =
-                    runClusterM
-                        $ Cluster.Config
-                            { cfgStakePools = error "cfgStakePools: unused"
-                            , cfgLastHardFork = localClusterEra
-                            , cfgNodeLogging = error "cfgNodeLogging: unused"
-                            , cfgClusterDir = testDir
-                            , cfgClusterConfigs = clusterConfigs
-                            , cfgTestnetMagic = testnetMagic
-                            , cfgShelleyGenesisMods = []
-                            , cfgTracer = tr'
-                            , cfgNodeOutputFile = nodeOutputFile
-                            , cfgRelayNodePath = mkRelDirOf "relay"
-                            , cfgClusterLogFile = Just
-                                $ FileOf @"cluster-logs"
-                                $ absDirOf testDir </> relFile "cluster.logs"
-                            }
             traceWith tr $ MsgInfo "Context set up."
             putMVar
                 ctx
@@ -497,7 +458,7 @@ setupContext
                     , _smashUrl = smashUrl
                     , _mintSeaHorseAssets = \nPerAddr batchSize c addrs ->
                         withMVar mintSeaHorseAssetsLock $ \() ->
-                            withConfig
+                            runClusterM clusterConfig
                                 $ sendFaucetAssetsTo
                                     nodeConnection
                                     batchSize
@@ -514,24 +475,40 @@ withContext testingCtx@TestingCtx{..} action = do
         poolGarbageCollectionEvents <- newIORef []
         traceWith tr $ MsgInfo "Getting faucet funds..."
         faucetFunds <- runFaucetM faucetClientEnv $ mkFaucetFunds testnetMagic
-
+        era <- clusterEraFromEnv
+        let clusterConfig =
+                Cluster.Config
+                    { cfgStakePools = Cluster.defaultPoolConfigs
+                    , cfgLastHardFork = era
+                    , cfgNodeLogging = LogFileConfig Info Nothing Info
+                    , cfgClusterDir = testDir
+                    , cfgClusterConfigs = clusterConfigs
+                    , cfgTestnetMagic = testnetMagic
+                    , cfgShelleyGenesisMods = []
+                    , cfgTracer = contramap MsgCluster tr
+                    , cfgNodeOutputFile = nodeOutputFile
+                    , cfgRelayNodePath = mkRelDirOf "relay"
+                    , cfgClusterLogFile =
+                        Just
+                            $ FileOf @"cluster-logs"
+                            $ absDirOf testDir </> relFile "cluster.logs"
+                    }
         let dbEventRecorder =
                 recordPoolGarbageCollectionEvents
                     testingCtx
                     poolGarbageCollectionEvents
             cluster =
                 withServer
                     testingCtx
-                    clusterConfigs
+                    clusterConfig
                     faucetFunds
                     dbEventRecorder
-                    nodeOutputFile
                     $ setupContext
                         testingCtx
+                        clusterConfig
                         ctx
                         faucetClientEnv
                         poolGarbageCollectionEvents
-                        nodeOutputFile
             test = do
                 traceWith tr $ MsgInfo "Waiting for cluster to start..."
                 c <- takeMVar ctx
@@ -565,10 +542,10 @@ withContext testingCtx@TestingCtx{..} action = do
             w <- walletFromMnemonic ctx mw
             _ <-
                 joinStakePool
-                @('Testnet 0) -- protocol magic doesn't matter
-                ctx
-                (SpecificPool pool)
-                (w, fixturePassphrase)
+                    @('Testnet 0) -- protocol magic doesn't matter
+                    ctx
+                    (SpecificPool pool)
+                    (w, fixturePassphrase)
             pure ()
 
 bracketTracer' :: Tracer IO TestsLog -> Text -> IO a -> IO a