Remove unsightly CARDANO_WALLET_SMASH_URL from integration tests

lib/core-integration/src/Test/Integration/Framework/Context.hs

@@ -51,6 +51,8 @@ data Context = Context
         :: IORef [PoolGarbageCollectionEvent]
         -- ^ The complete list of pool garbage collection events.
         -- Most recent events are stored at the head of the list.
+    , _smashUrl :: Text
+        -- ^ Base URL of the mock smash server.
     }
     deriving Generic
 

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs

@@ -82,8 +82,6 @@ import Data.Text.Class
     ( showT, toText )
 import Numeric.Natural
     ( Natural )
-import System.Environment
-    ( getEnv )
 import Test.Hspec
     ( SpecWith, describe, pendingWith )
 import Test.Hspec.Expectations.Lifted
@@ -1152,8 +1150,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
     it "STAKE_POOLS_SMASH_01 - fetching metadata from SMASH works with delisted pools" $
         \ctx -> runResourceT $ bracketSettings ctx $ do
             liftIO $ flakyBecauseOf "#2337 (theorized)"
-            smashUrl <- liftIO $ getEnv "CARDANO_WALLET_SMASH_URL"
-            updateMetadataSource ctx (T.pack smashUrl)
+            updateMetadataSource ctx (_smashUrl ctx)
             eventually "metadata is fetched" $ do
                 r <- listPools ctx arbitraryStake
                 verify r
@@ -1192,8 +1189,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
 
     it "STAKE_POOLS_SMASH_HEALTH_01 - Can check SMASH health when configured" $
         \ctx -> runResourceT $ bracketSettings ctx $ do
-            smashUrl <- liftIO $ getEnv "CARDANO_WALLET_SMASH_URL"
-            updateMetadataSource ctx (T.pack smashUrl)
+            updateMetadataSource ctx (_smashUrl ctx)
             r <- request @ApiHealthCheck
                 ctx Link.getCurrentSMASHHealth
                 Default Empty
@@ -1212,9 +1208,8 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
 
     it "STAKE_POOLS_SMASH_HEALTH_03 - Can check SMASH health via url" $
         \ctx -> runResourceT $ do
-            smashUrl <- liftIO $ getEnv "CARDANO_WALLET_SMASH_URL"
-            let withUrl f (method, link) = (method, link <> "?url=" <> T.pack f)
-            let link = withUrl smashUrl Link.getCurrentSMASHHealth
+            let withUrl f (method, link) = (method, link <> "?url=" <> f)
+            let link = withUrl (_smashUrl ctx) Link.getCurrentSMASHHealth
 
             r <- request @ApiHealthCheck ctx link Default Empty
             expectResponseCode HTTP.status200 r

lib/shelley/bench/Latency.hs

@@ -394,6 +394,7 @@ withShelleyServer tracers action = do
                 , _networkParameters = np
                 , _poolGarbageCollectionEvents =
                     error "poolGarbageCollectionEvents not available"
+                , _smashUrl = ""
                 }
     race_ (takeMVar ctx >>= action) (withServer setupContext)
 

lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs

@@ -936,42 +936,39 @@ withStakePool tr baseDir idx params pledgeAmt poolConfig action =
 
 -- | Run a SMASH stub server, serving some delisted pool IDs.
 withSMASH
-    :: Tracer IO ClusterLog
-    -> IO a
+    :: FilePath
+    -- ^ Parent directory to store static files
+    -> (String -> IO a)
+    -- ^ Action, taking base URL
     -> IO a
-withSMASH tr action =
-    withSystemTempDir (contramap MsgTempDir tr) "smash" $ \fp -> do
-        let baseDir = fp </> "api/v1"
-
-        -- write pool metadatas
-        pools <- readMVar operators
-        forM_ pools $ \(poolId, _, _, _, metadata) -> do
-            let bytes = Aeson.encode metadata
-
-            let metadataDir = baseDir </> "metadata"
-                poolDir = metadataDir </> T.unpack (toText poolId)
-                hash = blake2b256S (BL.toStrict bytes)
-                hashFile = poolDir </> hash
-
-            createDirectoryIfMissing True poolDir
-            BL8.writeFile (poolDir </> hashFile) bytes
-
-        -- write delisted pools
-        let delisted = [SMASHPoolId (T.pack
-                "b45768c1a2da4bd13ebcaa1ea51408eda31dcc21765ccbd407cda9f2")]
-            bytes = Aeson.encode delisted
-        BL8.writeFile (baseDir </> "delisted") bytes
-
-        -- health check
-        let health = Aeson.encode (HealthStatusSMASH "OK" "1.2.0")
-        BL8.writeFile (baseDir </> "status") health
-
-        withStaticServer fp $ \baseUrl -> do
-            setEnv envVar baseUrl
-            action
-  where
-    envVar :: String
-    envVar = "CARDANO_WALLET_SMASH_URL"
+withSMASH parentDir action = do
+    let staticDir = parentDir </> "smash"
+    let baseDir = staticDir </> "api" </> "v1"
+
+    -- write pool metadatas
+    pools <- readMVar operators
+    forM_ pools $ \(poolId, _, _, _, metadata) -> do
+        let bytes = Aeson.encode metadata
+
+        let metadataDir = baseDir </> "metadata"
+            poolDir = metadataDir </> T.unpack (toText poolId)
+            hash = blake2b256S (BL.toStrict bytes)
+            hashFile = poolDir </> hash
+
+        createDirectoryIfMissing True poolDir
+        BL8.writeFile (poolDir </> hashFile) bytes
+
+    -- write delisted pools
+    let delisted = [SMASHPoolId (T.pack
+            "b45768c1a2da4bd13ebcaa1ea51408eda31dcc21765ccbd407cda9f2")]
+        bytes = Aeson.encode delisted
+    BL8.writeFile (baseDir </> "delisted") bytes
+
+    -- health check
+    let health = Aeson.encode (HealthStatusSMASH "OK" "1.2.0")
+    BL8.writeFile (baseDir </> "status") health
+
+    withStaticServer staticDir action
 
 withCardanoNodeProcess
     :: Tracer IO ClusterLog

lib/shelley/test/integration/Main.hs

@@ -236,11 +236,12 @@ specWithServer testDir (tr, tracers) era = aroundAll withContext
         poolGarbageCollectionEvents <- newIORef []
         let dbEventRecorder =
                 recordPoolGarbageCollectionEvents poolGarbageCollectionEvents
-        let setupContext np wAddr = bracketTracer' tr "setupContext" $ do
+        let setupContext smashUrl np wAddr = bracketTracer' tr "setupContext" $ do
                 let baseUrl = "http://" <> T.pack (show wAddr) <> "/"
                 prometheusUrl <- (maybe "none" (\(h, p) -> T.pack h <> ":" <> toText @(Port "Prometheus") p)) <$> getPrometheusURL
                 ekgUrl <- (maybe "none" (\(h, p) -> T.pack h <> ":" <> toText @(Port "EKG") p)) <$> getEKGURL
-                traceWith tr $ MsgBaseUrl baseUrl ekgUrl prometheusUrl
+                traceWith tr $
+                    MsgBaseUrl baseUrl ekgUrl prometheusUrl smashUrl
                 let fiveMinutes = 300*1000*1000 -- 5 minutes in microseconds
                 manager <- (baseUrl,) <$> newManager (defaultManagerSettings
                     { managerResponseTimeout =
@@ -256,6 +257,7 @@ specWithServer testDir (tr, tracers) era = aroundAll withContext
                     , _feeEstimator = error "feeEstimator: unused in shelley specs"
                     , _networkParameters = np
                     , _poolGarbageCollectionEvents = poolGarbageCollectionEvents
+                    , _smashUrl = smashUrl
                     }
         let action' = bracketTracer' tr "spec" . action
         res <- race
@@ -285,10 +287,11 @@ specWithServer testDir (tr, tracers) era = aroundAll withContext
                     atomicModifyIORef' eventsRef ((, ()) . (event :))
                 pure certificates
 
-    withServer dbDecorator action = bracketTracer' tr "withServer" $ withSMASH tr' $ do
-        clusterCfg <- localClusterConfigFromEnv era
-        withCluster tr' testDir clusterCfg $
-            onClusterStart action dbDecorator
+    withServer dbDecorator onReady = bracketTracer' tr "withServer" $
+        withSMASH testDir $ \smashUrl -> do
+            clusterCfg <- localClusterConfigFromEnv era
+            withCluster tr' testDir clusterCfg $
+                onClusterStart (onReady $ T.pack smashUrl) dbDecorator
 
     tr' = contramap MsgCluster tr
     setupFaucet = do
@@ -329,7 +332,7 @@ specWithServer testDir (tr, tracers) era = aroundAll withContext
 
 data TestsLog
     = MsgBracket Text BracketLog
-    | MsgBaseUrl Text Text Text
+    | MsgBaseUrl Text Text Text Text
     | MsgSettingUpFaucet
     | MsgCluster ClusterLog
     | MsgPoolGarbageCollectionEvent PoolGarbageCollectionEvent
@@ -339,10 +342,11 @@ data TestsLog
 instance ToText TestsLog where
     toText = \case
         MsgBracket name b -> name <> ": " <> toText b
-        MsgBaseUrl walletUrl ekgUrl prometheusUrl -> mconcat
-            [ "Wallet url: " , walletUrl
-            , ", EKG url: " , ekgUrl
-            , ", Prometheus url:", prometheusUrl
+        MsgBaseUrl walletUrl ekgUrl prometheusUrl smashUrl -> T.unlines
+            [ "Wallet url: " <> walletUrl
+            , "EKG url: " <> ekgUrl
+            , "Prometheus url: " <> prometheusUrl
+            , "SMASH url: " <> smashUrl
             ]
         MsgSettingUpFaucet -> "Setting up faucet..."
         MsgCluster msg -> toText msg