Implement EKG statistics

cabal.project

@@ -1,4 +1,5 @@
 -- Generated by stackage-to-hackage
+--
 
 index-state: 2020-11-11T15:40:10Z
 

lib/cli/cardano-wallet-cli.cabal

@@ -32,6 +32,7 @@ library
       aeson
     , aeson-pretty
     , ansi-terminal
+    , async
     , base
     , bytestring
     , cardano-addresses

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,9 @@ module Cardano.CLI
     , getDataDir
     , setupDirectory
     , waitForService
+    , getPrometheusURL
+    , getEKGURL
+    , ekgEnabled
     , WaitForServiceLog (..)
     ) where
 
@@ -104,8 +108,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 +125,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 +197,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 )
+    ( forM_, forever, join, unless, void, when )
+import Control.Monad.IO.Class
+    ( MonadIO )
 import Control.Tracer
     ( Tracer, traceWith )
 import Data.Aeson
@@ -200,7 +216,7 @@ import Data.Char
 import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Maybe
-    ( fromMaybe )
+    ( fromMaybe, isJust )
 import Data.Quantity
     ( Quantity (..) )
 import Data.String
@@ -286,6 +302,8 @@ import System.Directory
     , doesFileExist
     , getXdgDirectory
     )
+import System.Environment
+    ( lookupEnv )
 import System.Exit
     ( exitFailure, exitSuccess )
 import System.FilePath
@@ -309,8 +327,10 @@ import System.IO
 
 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 +1596,85 @@ mkScribeId :: LogOutput -> ScribeId
 mkScribeId (LogToStdout _) = "StdoutSK::text"
 mkScribeId (LogToFile file _) = T.pack $ "FileSK::" <> file
 
+getPrometheusURL :: IO (Maybe (String, Port "Prometheus"))
+getPrometheusURL = do
+    prometheus_port <- lookupEnv "CARDANO_WALLET_PROMETHEUS_PORT"
+    prometheus_host <- fromMaybe "localhost" <$> lookupEnv "CARDANO_WALLET_PROMETHEUS_HOST"
+    case (prometheus_host, prometheus_port) of
+        (host, Just port) ->
+            case fromText @(Port "Prometheus") $ T.pack port of
+                Right port' -> pure $ Just (host, port')
+                _ -> do
+                    TIO.hPutStr stderr
+                        "Port value for prometheus metrics invalid. Will be disabled."
+                    pure Nothing
+        _ -> pure Nothing
+
+getEKGURL :: IO (Maybe (String, Port "EKG"))
+getEKGURL = do
+    ekg_port <- lookupEnv "CARDANO_WALLET_EKG_PORT"
+    ekg_host <- fromMaybe "localhost" <$> lookupEnv "CARDANO_WALLET_EKG_HOST"
+    case (ekg_host, ekg_port) of
+        (host, Just port) ->
+            case fromText @(Port "EKG") $ T.pack port of
+                Right port' -> pure $ Just (host, port')
+                _ -> do
+                    TIO.hPutStr stderr
+                        "Port value for EKB metrics invalid. Will be disabled."
+                    pure Nothing
+        _ -> pure Nothing
+
+ekgEnabled :: IO Bool
+ekgEnabled = isJust <$> getEKGURL
 
 -- | Initialize logging at the specified minimum 'Severity' level.
 initTracer
     :: LoggerName
     -> [LogOutput]
     -> IO (Switchboard Text, (CM.Configuration, Trace IO Text))
 initTracer loggerName outputs = do
+    prometheusHP <- getPrometheusURL
+    ekgHP <- 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.setBackends c "test-cluster.metrics" (Just [CM.EKGViewBK])
+        CM.setBackends c "cardano-wallet.metrics" (Just [CM.EKGViewBK])
+        forM_ ekgHP $ \(h, p) -> do
+            CM.setEKGBindAddr c $ Just (Endpoint (h, getPort p))
+        forM_ prometheusHP $ \(h, p) ->
+            CM.setPrometheusBindAddr c $ Just (h, getPort p)
         pure c
     (tr, sb) <- setupTrace_ cfg loggerName
+    ekgEnabled >>= flip when (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 +1684,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

@@ -118,6 +118,7 @@ executable cardano-wallet
     , cardano-wallet
     , contra-tracer
     , iohk-monitoring
+    , lobemo-backend-ekg
     , network
     , optparse-applicative
     , text
@@ -148,6 +149,7 @@ executable shelley-test-cluster
     , cardano-wallet
     , contra-tracer
     , iohk-monitoring
+    , lobemo-backend-ekg
     , text
     , text-class
   hs-source-dirs:
@@ -234,6 +236,7 @@ test-suite integration
     , hspec
     , http-client
     , iohk-monitoring
+    , lobemo-backend-ekg
     , text
     , text-class
   build-tools:

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
@@ -43,6 +45,7 @@ import Cardano.CLI
     , cmdWallet
     , cmdWalletCreate
     , databaseOption
+    , ekgEnabled
     , enableWindowsANSI
     , helperTracing
     , hostPreferenceOption
@@ -102,7 +105,7 @@ import Cardano.Wallet.Version
 import Control.Applicative
     ( Const (..), optional )
 import Control.Monad
-    ( void )
+    ( void, when )
 import Control.Monad.Trans.Except
     ( runExceptT )
 import Control.Tracer
@@ -134,6 +137,7 @@ import System.Environment
 import System.Exit
     ( ExitCode (..), exitWith )
 
+import qualified Cardano.BM.Backend.EKGView as EKG
 import qualified Cardano.Wallet.Version as V
 import qualified Data.Text as T
 
@@ -294,7 +298,8 @@ 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
+        ekgEnabled >>= flip when (EKG.plugin cfg tr sb >>= loadPlugin sb)
         let trMain = appendName "main" (transformTextTrace tr)
         let tracers = setupTracers (loggingTracers logOpt) tr
         logInfo trMain $ MsgVersion V.version gitRevision

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

@@ -14,8 +14,16 @@ import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
+import Cardano.BM.Plugin
+    ( loadPlugin )
 import Cardano.CLI
-    ( LogOutput (..), withLoggingNamed )
+    ( LogOutput (..)
+    , Port
+    , ekgEnabled
+    , getEKGURL
+    , getPrometheusURL
+    , withLoggingNamed
+    )
 import Cardano.Startup
     ( setDefaultFilePermissions, withUtf8Encoding )
 import Cardano.Wallet.Api.Types
@@ -54,7 +62,7 @@ import Cardano.Wallet.Shelley.Launch
 import Control.Arrow
     ( first )
 import Control.Monad
-    ( void )
+    ( void, when )
 import Control.Tracer
     ( contramap, traceWith )
 import Data.Proxy
@@ -68,6 +76,7 @@ import System.IO
 import Test.Integration.Faucet
     ( genRewardAccounts, mirMnemonics, shelleyIntegrationTestFunds )
 
+import qualified Cardano.BM.Backend.EKGView as EKG
 import qualified Data.Text as T
 
 -- |
@@ -208,8 +217,8 @@ main = withUtf8Encoding $ do
 
     poolConfigs <- poolConfigsFromEnv
     withLoggingNamed "cardano-wallet" walletLogs
-        $ \(_, trWallet) -> withLoggingNamed "test-cluster" clusterLogs
-        $ \(_, trCluster) -> withSystemTempDir (trMessageText trCluster) "testCluster"
+        $ \(sb, (cfg, trWallet)) -> withLoggingNamed "test-cluster" clusterLogs
+        $ \(_, (_, trCluster)) -> withSystemTempDir (trMessageText trCluster) "testCluster"
         $ \dir -> withTempDir (trMessageText trCluster) dir "wallets"
         $ \db -> withCluster
             (contramap MsgCluster $ trMessageText trCluster)
@@ -219,7 +228,7 @@ main = withUtf8Encoding $ do
             Nothing
             whenByron
             (whenShelley dir (trMessageText trCluster))
-            (whenReady trWallet (trMessageText trCluster) db)
+            (whenReady sb cfg trWallet (trMessageText trCluster) db)
   where
     whenByron _ = pure ()
 
@@ -233,9 +242,19 @@ main = withUtf8Encoding $ do
         sendFaucetFundsTo trCluster' dir addresses
         moveInstantaneousRewardsTo trCluster' dir rewards
 
-    whenReady tr trCluster db (RunningNode socketPath block0 (gp, vData)) = do
+    whenReady sb cfg tr trCluster db (RunningNode socketPath block0 (gp, vData)) = do
+        ekgEnabled >>= flip when (EKG.plugin cfg tr sb >>= loadPlugin sb)
+
         let tracers = setupTracers (tracerSeverities (Just Info)) tr
         listen <- walletListenFromEnv
+        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
         void $ serveWallet @(IO Shelley)
             (SomeNetworkDiscriminant $ Proxy @'Mainnet)
             tracers
@@ -249,26 +268,30 @@ main = withUtf8Encoding $ 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