From cb1ef43df701dd58e23d14dc1bb56cc2bb8ab29f Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Thu, 12 Nov 2020 19:19:47 +0100 Subject: [PATCH] Implement EKG statistics --- lib/cli/cardano-wallet-cli.cabal | 3 + lib/cli/src/Cardano/CLI.hs | 98 +++++++++++++++++++++++-- lib/shelley/cardano-wallet.cabal | 5 ++ lib/shelley/exe/cardano-wallet.hs | 7 +- lib/shelley/exe/shelley-test-cluster.hs | 24 ++++-- lib/shelley/test/integration/Main.hs | 50 +++++++------ nix/.stack.nix/cardano-wallet-cli.nix | 3 + nix/.stack.nix/cardano-wallet.nix | 5 ++ 8 files changed, 158 insertions(+), 37 deletions(-) diff --git a/lib/cli/cardano-wallet-cli.cabal b/lib/cli/cardano-wallet-cli.cabal index 0547146fdb7..052ce114df1 100644 --- a/lib/cli/cardano-wallet-cli.cabal +++ b/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 diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs index 49ae7867d68..6fd88193fff 100644 --- a/lib/cli/src/Cardano/CLI.hs +++ b/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,6 +1599,37 @@ 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 @@ -1583,19 +1637,49 @@ initTracer -> [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 diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index 4082c15e9a5..3a5cea1a9d9 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/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: diff --git a/lib/shelley/exe/cardano-wallet.hs b/lib/shelley/exe/cardano-wallet.hs index 85de90718b9..5416d9e3c2c 100644 --- a/lib/shelley/exe/cardano-wallet.hs +++ b/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,7 +296,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 + EKG.plugin cfg tr sb >>= loadPlugin sb let trMain = appendName "main" (transformTextTrace tr) let tracers = setupTracers (loggingTracers logOpt) tr logInfo trMain $ MsgVersion version gitRevision @@ -301,6 +305,7 @@ withTracers logOpt action = action trMain tracers + {------------------------------------------------------------------------------- Options -------------------------------------------------------------------------------} diff --git a/lib/shelley/exe/shelley-test-cluster.hs b/lib/shelley/exe/shelley-test-cluster.hs index 8abdd44b392..61d350ca965 100644 --- a/lib/shelley/exe/shelley-test-cluster.hs +++ b/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,20 +253,24 @@ 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 @@ -270,5 +278,5 @@ instance HasPrivacyAnnotation TestsLog instance HasSeverityAnnotation TestsLog where getSeverityAnnotation = \case MsgSettingUpFaucet -> Notice - MsgBaseUrl _ -> Notice + MsgBaseUrl {} -> Notice MsgCluster msg -> getSeverityAnnotation msg diff --git a/lib/shelley/test/integration/Main.hs b/lib/shelley/test/integration/Main.hs index 77e27227a6a..66975764bc0 100644 --- a/lib/shelley/test/integration/Main.hs +++ b/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 @@ -168,21 +170,21 @@ main = withUtf8Encoding $ withTracers $ \tracers -> do ByronTransactions.spec @n ByronHWWallets.spec @n - -- possible conflict with StakePools - Settings.spec @n + -- possible conflict with StakePools + Settings.spec @n - -- Hydra runs tests with code coverage enabled. CLI tests run - -- multiple processes. These processes can try to write to the - -- same .tix file simultaneously, causing errors. - -- - -- Because of this, don't run the CLI tests in parallel in hydra. - parallelIf (not nix) $ describe "CLI Specifications" $ do - AddressesCLI.spec @n - TransactionsCLI.spec @n - WalletsCLI.spec @n - HWWalletsCLI.spec @n - PortCLI.spec @t - NetworkCLI.spec @t + -- Hydra runs tests with code coverage enabled. CLI tests run + -- multiple processes. These processes can try to write to the + -- same .tix file simultaneously, causing errors. + -- + -- Because of this, don't run the CLI tests in parallel in hydra. + parallelIf (not nix) $ describe "CLI Specifications" $ do + AddressesCLI.spec @n + TransactionsCLI.spec @n + WalletsCLI.spec @n + HWWalletsCLI.spec @n + PortCLI.spec @t + NetworkCLI.spec @t where parallelIf :: forall a. Bool -> SpecWith a -> SpecWith a parallelIf flag = if flag then parallel else id @@ -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 @@ -348,8 +356,8 @@ withTracers action = do testLogOutputs <- ([LogToStdout testMinSeverity] ++) <$> extraOutput "test.log" - withLogging walletLogOutputs $ \(_, walTr) -> do - withLogging testLogOutputs $ \(_, testTr) -> do + withLogging walletLogOutputs $ \(_, (_, walTr)) -> do + withLogging testLogOutputs $ \(_, (_, testTr)) -> do let trTests = appendName "integration" testTr let tracers = setupTracers (tracerSeverities (Just Info)) walTr diff --git a/nix/.stack.nix/cardano-wallet-cli.nix b/nix/.stack.nix/cardano-wallet-cli.nix index f5b4328d409..a8a0e73f215 100644 --- a/nix/.stack.nix/cardano-wallet-cli.nix +++ b/nix/.stack.nix/cardano-wallet-cli.nix @@ -29,6 +29,7 @@ (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) (hsPkgs."aeson-pretty" or (errorHandler.buildDepError "aeson-pretty")) (hsPkgs."ansi-terminal" or (errorHandler.buildDepError "ansi-terminal")) + (hsPkgs."async" or (errorHandler.buildDepError "async")) (hsPkgs."base" or (errorHandler.buildDepError "base")) (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) (hsPkgs."cardano-addresses" or (errorHandler.buildDepError "cardano-addresses")) @@ -40,6 +41,8 @@ (hsPkgs."fmt" or (errorHandler.buildDepError "fmt")) (hsPkgs."http-client" or (errorHandler.buildDepError "http-client")) (hsPkgs."iohk-monitoring" or (errorHandler.buildDepError "iohk-monitoring")) + (hsPkgs."network-uri" or (errorHandler.buildDepError "network-uri")) + (hsPkgs."network" or (errorHandler.buildDepError "network")) (hsPkgs."servant-client" or (errorHandler.buildDepError "servant-client")) (hsPkgs."servant-client-core" or (errorHandler.buildDepError "servant-client-core")) (hsPkgs."text" or (errorHandler.buildDepError "text")) diff --git a/nix/.stack.nix/cardano-wallet.nix b/nix/.stack.nix/cardano-wallet.nix index d567192f1ab..109bacd07ae 100644 --- a/nix/.stack.nix/cardano-wallet.nix +++ b/nix/.stack.nix/cardano-wallet.nix @@ -96,6 +96,7 @@ (hsPkgs."cardano-wallet" or (errorHandler.buildDepError "cardano-wallet")) (hsPkgs."contra-tracer" or (errorHandler.buildDepError "contra-tracer")) (hsPkgs."iohk-monitoring" or (errorHandler.buildDepError "iohk-monitoring")) + (hsPkgs."lobemo-backend-ekg" or (errorHandler.buildDepError "lobemo-backend-ekg")) (hsPkgs."network" or (errorHandler.buildDepError "network")) (hsPkgs."optparse-applicative" or (errorHandler.buildDepError "optparse-applicative")) (hsPkgs."text" or (errorHandler.buildDepError "text")) @@ -114,6 +115,7 @@ (hsPkgs."cardano-wallet" or (errorHandler.buildDepError "cardano-wallet")) (hsPkgs."contra-tracer" or (errorHandler.buildDepError "contra-tracer")) (hsPkgs."iohk-monitoring" or (errorHandler.buildDepError "iohk-monitoring")) + (hsPkgs."network-uri" or (errorHandler.buildDepError "network-uri")) (hsPkgs."text" or (errorHandler.buildDepError "text")) (hsPkgs."text-class" or (errorHandler.buildDepError "text-class")) ]; @@ -170,6 +172,8 @@ (hsPkgs."hspec" or (errorHandler.buildDepError "hspec")) (hsPkgs."http-client" or (errorHandler.buildDepError "http-client")) (hsPkgs."iohk-monitoring" or (errorHandler.buildDepError "iohk-monitoring")) + (hsPkgs."network" or (errorHandler.buildDepError "network")) + (hsPkgs."network-uri" or (errorHandler.buildDepError "network-uri")) (hsPkgs."text" or (errorHandler.buildDepError "text")) (hsPkgs."text-class" or (errorHandler.buildDepError "text-class")) ]; @@ -222,6 +226,7 @@ (hsPkgs."iohk-monitoring" or (errorHandler.buildDepError "iohk-monitoring")) (hsPkgs."stm" or (errorHandler.buildDepError "stm")) (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."text-class" or (errorHandler.buildDepError "text-class")) ]; buildable = true; };