Implement EKG statistics

lib/cli/cardano-wallet-cli.cabal

@@ -32,6 +32,7 @@ library
       aeson
     , aeson-pretty
     , ansi-terminal
+    , async
     , base
     , bytestring
     , cardano-addresses
@@ -43,6 +44,8 @@ library
     , fmt
     , http-client
     , iohk-monitoring
+    , network-uri
+    , network
     , servant-client
     , servant-client-core
     , text

lib/cli/src/Cardano/CLI.hs

@@ -11,6 +11,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -94,6 +95,8 @@ module Cardano.CLI
     , getDataDir
     , setupDirectory
     , waitForService
+    , getPrometheusURL
+    , getEKGURL
     , WaitForServiceLog (..)
     ) where
 
@@ -104,8 +107,14 @@ import Cardano.BM.Backend.Switchboard
     ( Switchboard )
 import Cardano.BM.Configuration.Static
     ( defaultConfigStdout )
+import Cardano.BM.Counters
+    ( readCounters )
+import Cardano.BM.Data.Configuration
+    ( Endpoint (..) )
+import Cardano.BM.Data.Counter
+    ( Counter (..), nameCounter )
 import Cardano.BM.Data.LogItem
-    ( LoggerName )
+    ( LOContent (..), LoggerName, PrivacyAnnotation (..), mkLOMeta )
 import Cardano.BM.Data.Output
     ( ScribeDefinition (..)
     , ScribeFormat (..)
@@ -115,12 +124,14 @@ import Cardano.BM.Data.Output
     )
 import Cardano.BM.Data.Severity
     ( Severity (..) )
+import Cardano.BM.Data.SubTrace
+    ( SubTrace (..) )
 import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
 import Cardano.BM.Setup
     ( setupTrace_, shutdown )
 import Cardano.BM.Trace
-    ( Trace, appendName, logDebug )
+    ( Trace, appendName, logDebug, traceNamedObject )
 import Cardano.Mnemonic
     ( MkSomeMnemonic (..), SomeMnemonic (..) )
 import Cardano.Wallet.Api.Client
@@ -185,10 +196,14 @@ import Control.Applicative
     ( optional, some, (<|>) )
 import Control.Arrow
     ( first, left )
+import Control.Concurrent
+    ( threadDelay )
 import Control.Exception
     ( bracket, catch )
 import Control.Monad
-    ( join, unless, void, when )
+    ( forever, join, unless, void, when )
+import Control.Monad.IO.Class
+    ( MonadIO )
 import Control.Tracer
     ( Tracer, traceWith )
 import Data.Aeson
@@ -227,6 +242,8 @@ import Network.HTTP.Client
     , newManager
     , responseTimeoutNone
     )
+import Network.URI
+    ( URI (..), URIAuth (..) )
 import Options.Applicative
     ( ArgumentFields
     , CommandFields
@@ -286,6 +303,8 @@ import System.Directory
     , doesFileExist
     , getXdgDirectory
     )
+import System.Environment
+    ( lookupEnv )
 import System.Exit
     ( exitFailure, exitSuccess )
 import System.FilePath
@@ -306,11 +325,15 @@ import System.IO
     , stdin
     , stdout
     )
+import Text.Read
+    ( readMaybe )
 
 import qualified Cardano.BM.Configuration.Model as CM
 import qualified Cardano.BM.Data.BackendKind as CM
+import qualified Cardano.BM.Data.Observable as Obs
 import qualified Command.Key as Key
 import qualified Command.RecoveryPhrase as RecoveryPhrase
+import qualified Control.Concurrent.Async as Async
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.Aeson.Types as Aeson
@@ -1576,26 +1599,87 @@ 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 = T.unpack (toText prometheus_port)
+        }
+        , uriPath = ""
+        , uriQuery = ""
+        , uriFragment = ""
+        }
+
+getEKGURL :: IO URI
+getEKGURL = do
+    ekg_port <- fromMaybe 13788 . (>>= readMaybe @Int)
+        <$> lookupEnv "CARDANO_WALLET_EKG_PORT"
+    pure $ URI {
+          uriScheme = "http"
+        , uriAuthority = Just URIAuth {
+              uriUserInfo = ""
+            , uriRegName = "127.0.0.1"
+            , uriPort = T.unpack (toText 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
+    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.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 (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
+    startCapturingMetrics tr
     pure (sb, (cfg, tr))
+  where
+    -- https://github.com/input-output-hk/cardano-node/blob/f7d57e30c47028ba2aeb306a4f21b47bb41dec01/cardano-node/src/Cardano/Node/Configuration/Logging.hs#L224
+    startCapturingMetrics :: Trace IO Text -> IO ()
+    startCapturingMetrics trace0 = do
+      let trace = appendName "metrics" trace0
+          counters = [Obs.MemoryStats, Obs.ProcessStats
+            , Obs.NetStats, Obs.IOStats, Obs.GhcRtsStats, Obs.SysStats]
+      _ <- Async.async $ forever $ do
+        cts <- readCounters (ObservableTraceSelf counters)
+        traceCounters trace cts
+        threadDelay 30_000_000   -- 30 seconds
+      pure ()
+     where
+       traceCounters :: forall m a. MonadIO m => Trace m a -> [Counter] -> m ()
+       traceCounters _tr [] = return ()
+       traceCounters tr (c@(Counter _ct cn cv) : cs) = do
+         mle <- mkLOMeta Notice Confidential
+         traceNamedObject tr (mle, LogValue (nameCounter c <> "." <> cn) cv)
+         traceCounters tr cs
 
 -- | See 'withLoggingNamed'
 withLogging
     :: [LogOutput]
-    -> ((CM.Configuration, Trace IO Text) -> IO a)
+    -> ((Switchboard Text, (CM.Configuration, Trace IO Text)) -> IO a)
     -> IO a
 withLogging =
     withLoggingNamed "cardano-wallet"
@@ -1605,10 +1689,10 @@ withLogging =
 withLoggingNamed
     :: LoggerName
     -> [LogOutput]
-    -> ((CM.Configuration, Trace IO Text) -> IO a)
+    -> ((Switchboard Text, (CM.Configuration, Trace IO Text)) -> IO a)
     -- ^ The action to run with logging configured.
     -> IO a
-withLoggingNamed loggerName outputs action = bracket before after (action . snd)
+withLoggingNamed loggerName outputs = bracket before after
   where
     before = initTracer loggerName outputs
     after (sb, (_, tr)) = do

lib/shelley/cardano-wallet.cabal

@@ -117,6 +117,7 @@ executable cardano-wallet
     , cardano-wallet
     , contra-tracer
     , iohk-monitoring
+    , lobemo-backend-ekg
     , network
     , optparse-applicative
     , text
@@ -147,6 +148,7 @@ executable shelley-test-cluster
     , cardano-wallet
     , contra-tracer
     , iohk-monitoring
+    , network-uri
     , text
     , text-class
   hs-source-dirs:
@@ -230,6 +232,8 @@ test-suite integration
     , hspec
     , http-client
     , iohk-monitoring
+    , network
+    , network-uri
     , text
     , text-class
   build-tools:
@@ -309,6 +313,7 @@ benchmark latency
    , iohk-monitoring
    , stm
    , text
+   , text-class
   type:
      exitcode-stdio-1.0
   hs-source-dirs:

lib/shelley/exe/cardano-wallet.hs

@@ -27,6 +27,8 @@ import Prelude
 
 import Cardano.BM.Data.Severity
     ( Severity (..) )
+import Cardano.BM.Plugin
+    ( loadPlugin )
 import Cardano.BM.Trace
     ( Trace, appendName, logDebug, logError, logInfo, logNotice )
 import Cardano.CLI
@@ -134,6 +136,7 @@ import System.Environment
 import System.Exit
     ( ExitCode (..), exitWith )
 
+import qualified Cardano.BM.Backend.EKGView as EKG
 import qualified Data.Text as T
 
 {-------------------------------------------------------------------------------
@@ -293,14 +296,16 @@ withTracers
     -> (Trace IO MainLog -> Tracers IO -> IO a)
     -> IO a
 withTracers logOpt action =
-    withLogging [LogToStdout (loggingMinSeverity logOpt)] $ \(_, tr) -> do
+    withLogging [LogToStdout (loggingMinSeverity logOpt)] $ \(sb, (cfg, tr)) -> do
+        EKG.plugin cfg tr sb >>= loadPlugin sb
         let trMain = appendName "main" (transformTextTrace tr)
         let tracers = setupTracers (loggingTracers logOpt) tr
         logInfo trMain $ MsgVersion version gitRevision
         logInfo trMain =<< MsgCmdLine <$> getExecutablePath <*> getArgs
         action trMain tracers
 
 
+
 {-------------------------------------------------------------------------------
                                  Options
 -------------------------------------------------------------------------------}

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
@@ -208,8 +210,8 @@ main = do
     poolConfigs <- poolConfigsFromEnv
     withUtf8Encoding
         $ withLoggingNamed "cardano-wallet" walletLogs
-        $ \(_, trWallet) -> withLoggingNamed "test-cluster" clusterLogs
-        $ \(_, trCluster) -> withSystemTempDir (trMessageText trCluster) "testCluster"
+        $ \(_, (_, trWallet)) -> withLoggingNamed "test-cluster" clusterLogs
+        $ \(_, (_, trCluster)) -> withSystemTempDir (trMessageText trCluster) "testCluster"
         $ \dir -> withTempDir (trMessageText trCluster) dir "wallets"
         $ \db -> withCluster
             (contramap MsgCluster $ trMessageText trCluster)
@@ -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