Add EKG/Prometheus URLs to MsgBaseUrl

lib/cli/cardano-wallet-cli.cabal

@@ -45,6 +45,7 @@ library
     , http-client
     , iohk-monitoring
     , lobemo-backend-ekg
+    , network-uri
     , servant-client
     , servant-client-core
     , text

lib/cli/src/Cardano/CLI.hs

@@ -95,6 +95,8 @@ module Cardano.CLI
     , getDataDir
     , setupDirectory
     , waitForService
+    , getPrometheusURL
+    , getEKGURL
     , WaitForServiceLog (..)
     ) where
 
@@ -242,6 +244,8 @@ import Network.HTTP.Client
     , newManager
     , responseTimeoutNone
     )
+import Network.URI
+    ( URI (..), URIAuth (..) )
 import Options.Applicative
     ( ArgumentFields
     , CommandFields
@@ -1598,25 +1602,58 @@ mkScribeId :: LogOutput -> ScribeId
 mkScribeId (LogToStdout _) = "StdoutSK::text"
 mkScribeId (LogToFile file _) = T.pack $ "FileSK::" <> file
 
+getPrometheusURL :: IO URI
+getPrometheusURL = do
+    prometheus_port <- fromMaybe 13798 . (>>= readMaybe @Int)
+        <$> lookupEnv "CARDANO_WALLET_PROMETHEUS_PORT"
+    pure $ URI {
+          uriScheme = "http"
+        , uriAuthority = Just URIAuth {
+              uriUserInfo = ""
+            , uriRegName = "127.0.0.1"
+            , uriPort = show prometheus_port
+        }
+        , uriPath = ""
+        , uriQuery = ""
+        , uriFragment = ""
+        }
+
+getEKGURL :: IO URI
+getEKGURL = do
+    ekg_port <- fromMaybe 13798 . (>>= readMaybe @Int)
+        <$> lookupEnv "CARDANO_WALLET_EKG_PORT"
+    pure $ URI {
+          uriScheme = "http"
+        , uriAuthority = Just URIAuth {
+              uriUserInfo = ""
+            , uriRegName = "127.0.0.1"
+            , uriPort = show ekg_port
+            }
+        , uriPath = ""
+        , uriQuery = ""
+        , uriFragment = ""
+        }
 
 -- | Initialize logging at the specified minimum 'Severity' level.
 initTracer
     :: LoggerName
     -> [LogOutput]
     -> IO (Switchboard Text, (CM.Configuration, Trace IO Text))
 initTracer loggerName outputs = do
-    ekg_port <- fromMaybe 13788 . (>>= readMaybe @Int)
-        <$> lookupEnv "CARDANO_WALLET_EKG_PORT"
-    prometheus_port <- fromMaybe 13798 . (>>= readMaybe @Int)
-        <$> lookupEnv "CARDANO_WALLET_PROMETHEUS_PORT"
+    URI { uriAuthority = Just URIAuth {
+            uriRegName = prometheus_host, uriPort = prometheus_port
+        } } <- getPrometheusURL
+    URI { uriAuthority = Just URIAuth {
+            uriRegName = ekg_host, uriPort = ekg_port
+        } } <- getEKGURL
     cfg <- do
         c <- defaultConfigStdout
         CM.setSetupBackends c [CM.KatipBK, CM.AggregationBK, CM.EKGViewBK, CM.EditorBK]
         CM.setDefaultBackends c [CM.KatipBK, CM.EKGViewBK]
         CM.setSetupScribes c $ map mkScribe outputs
         CM.setDefaultScribes c $ map mkScribeId outputs
-        CM.setEKGBindAddr c $ Just (Endpoint ("127.0.0.1", ekg_port))
-        CM.setPrometheusBindAddr c $ Just ("127.0.0.1", prometheus_port)
+        CM.setEKGBindAddr c $ Just (Endpoint (ekg_host, read ekg_port))
+        CM.setPrometheusBindAddr c $ Just (prometheus_host, read prometheus_port)
         CM.setBackends c "cardano-wallet.metrics" (Just [CM.EKGViewBK])
         pure c
     (tr, sb) <- setupTrace_ cfg loggerName

lib/shelley/cardano-wallet.cabal

@@ -148,6 +148,7 @@ executable shelley-test-cluster
     , cardano-wallet
     , contra-tracer
     , iohk-monitoring
+    , network-uri
     , text
     , text-class
   hs-source-dirs:
@@ -231,6 +232,7 @@ test-suite integration
     , hspec
     , http-client
     , iohk-monitoring
+    , network-uri
     , text
     , text-class
   build-tools:

lib/shelley/exe/shelley-test-cluster.hs

@@ -15,7 +15,7 @@ import Cardano.BM.Data.Severity
 import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
 import Cardano.CLI
-    ( LogOutput (..), withLoggingNamed )
+    ( LogOutput (..), getEKGURL, getPrometheusURL, withLoggingNamed )
 import Cardano.Startup
     ( withUtf8Encoding )
 import Cardano.Wallet.Api.Types
@@ -63,6 +63,8 @@ import Data.Text
     ( Text )
 import Data.Text.Class
     ( ToText (..) )
+import Network.URI
+    ( uriToString )
 import System.IO
     ( BufferMode (..), hSetBuffering, stdout )
 import Test.Integration.Faucet
@@ -236,6 +238,8 @@ main = do
     whenReady tr trCluster db (RunningNode socketPath block0 (gp, vData)) = do
         let tracers = setupTracers (tracerSeverities (Just Info)) tr
         listen <- walletListenFromEnv
+        prometheusUrl <- (\uri -> T.pack $ uriToString id uri "") <$> getPrometheusURL
+        ekgUrl <- (\uri -> T.pack $ uriToString id uri "") <$> getEKGURL
         void $ serveWallet @(IO Shelley)
             (SomeNetworkDiscriminant $ Proxy @'Mainnet)
             tracers
@@ -249,26 +253,30 @@ main = do
             socketPath
             block0
             (gp, vData)
-            (traceWith trCluster . MsgBaseUrl . T.pack . show)
+            (\u -> traceWith trCluster $ MsgBaseUrl (T.pack . show $ u)
+                ekgUrl prometheusUrl)
 
 -- Logging
 
 data TestsLog
-    = MsgBaseUrl Text
+    = MsgBaseUrl Text Text Text -- wallet url, ekg url, prometheus url
     | MsgSettingUpFaucet
     | MsgCluster ClusterLog
     deriving (Show)
 
 instance ToText TestsLog where
     toText = \case
-        MsgBaseUrl addr ->
-            "Wallet backend server listening on " <> T.pack (show addr)
+        MsgBaseUrl walletUrl ekgUrl prometheusUrl -> mconcat
+            [ "Wallet url: " , walletUrl
+            , ", EKG url: " , ekgUrl
+            , ", Prometheus url:", prometheusUrl
+            ]
         MsgSettingUpFaucet -> "Setting up faucet..."
         MsgCluster msg -> toText msg
 
 instance HasPrivacyAnnotation TestsLog
 instance HasSeverityAnnotation TestsLog where
     getSeverityAnnotation = \case
         MsgSettingUpFaucet -> Notice
-        MsgBaseUrl _ -> Notice
+        MsgBaseUrl {} -> Notice
         MsgCluster msg -> getSeverityAnnotation msg

lib/shelley/test/integration/Main.hs

@@ -21,7 +21,7 @@ import Cardano.BM.Data.Tracer
 import Cardano.BM.Trace
     ( appendName )
 import Cardano.CLI
-    ( LogOutput (..), Port (..), withLogging )
+    ( LogOutput (..), Port (..), getEKGURL, getPrometheusURL, withLogging )
 import Cardano.Launcher
     ( ProcessHasExited (..) )
 import Cardano.Startup
@@ -93,6 +93,8 @@ import Network.HTTP.Client
     , newManager
     , responseTimeoutMicro
     )
+import Network.URI
+    ( uriToString )
 import System.FilePath
     ( (</>) )
 import System.IO
@@ -201,7 +203,9 @@ specWithServer (tr, tracers) = aroundAll withContext
                 recordPoolGarbageCollectionEvents poolGarbageCollectionEvents
         let setupContext np wAddr = bracketTracer' tr "setupContext" $ do
                 let baseUrl = "http://" <> T.pack (show wAddr) <> "/"
-                traceWith tr $ MsgBaseUrl baseUrl
+                prometheusUrl <- (\uri -> T.pack $ uriToString id uri "") <$> getPrometheusURL
+                ekgUrl <- (\uri -> T.pack $ uriToString id uri "") <$> getEKGURL
+                traceWith tr $ MsgBaseUrl baseUrl ekgUrl prometheusUrl
                 let fiveMinutes = 300*1000*1000 -- 5 minutes in microseconds
                 manager <- (baseUrl,) <$> newManager (defaultManagerSettings
                     { managerResponseTimeout =
@@ -300,7 +304,7 @@ specWithServer (tr, tracers) = aroundAll withContext
 
 data TestsLog
     = MsgBracket Text BracketLog
-    | MsgBaseUrl Text
+    | MsgBaseUrl Text Text Text -- wallet url, ekg url, prometheus url
     | MsgSettingUpFaucet
     | MsgCluster ClusterLog
     | MsgPoolGarbageCollectionEvent PoolGarbageCollectionEvent
@@ -309,7 +313,11 @@ data TestsLog
 instance ToText TestsLog where
     toText = \case
         MsgBracket name b -> name <> ": " <> toText b
-        MsgBaseUrl txt -> txt
+        MsgBaseUrl walletUrl ekgUrl prometheusUrl -> mconcat
+            [ "Wallet url: " , walletUrl
+            , ", EKG url: " , ekgUrl
+            , ", Prometheus url:", prometheusUrl
+            ]
         MsgSettingUpFaucet -> "Setting up faucet..."
         MsgCluster msg -> toText msg
         MsgPoolGarbageCollectionEvent e -> mconcat
@@ -329,7 +337,7 @@ instance HasSeverityAnnotation TestsLog where
     getSeverityAnnotation = \case
         MsgBracket _ _ -> Debug
         MsgSettingUpFaucet -> Notice
-        MsgBaseUrl _ -> Notice
+        MsgBaseUrl {} -> Notice
         MsgCluster msg -> getSeverityAnnotation msg
         MsgPoolGarbageCollectionEvent _ -> Info