diff --git a/cabal.project b/cabal.project index 044df08006c..011cd887a41 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,5 @@ -- Generated by stackage-to-hackage +-- index-state: 2020-11-11T15:40:10Z diff --git a/lib/cli/cardano-wallet-cli.cabal b/lib/cli/cardano-wallet-cli.cabal index 999d097b279..1ca67250caa 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 diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs index 49ae7867d68..b57bd21c677 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,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,6 +1596,36 @@ 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 @@ -1583,19 +1633,48 @@ initTracer -> [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 diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index 9c8dedfd2e6..aa478774a67 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/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: diff --git a/lib/shelley/exe/cardano-wallet.hs b/lib/shelley/exe/cardano-wallet.hs index f52e3653407..83117849699 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 @@ -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 diff --git a/lib/shelley/exe/shelley-test-cluster.hs b/lib/shelley/exe/shelley-test-cluster.hs index e311e8cd9b8..f3fddf948e0 100644 --- a/lib/shelley/exe/shelley-test-cluster.hs +++ b/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,20 +268,24 @@ 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 @@ -270,5 +293,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 623c27d8fbf..055b3057993 100644 --- a/lib/shelley/test/integration/Main.hs +++ b/lib/shelley/test/integration/Main.hs @@ -18,10 +18,18 @@ import Cardano.BM.Data.Severity ( Severity (..) ) import Cardano.BM.Data.Tracer ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) ) +import Cardano.BM.Plugin + ( loadPlugin ) import Cardano.BM.Trace ( appendName ) import Cardano.CLI - ( LogOutput (..), Port (..), withLogging ) + ( LogOutput (..) + , Port (..) + , ekgEnabled + , getEKGURL + , getPrometheusURL + , withLogging + ) import Cardano.Launcher ( ProcessHasExited (..) ) import Cardano.Startup @@ -75,6 +83,8 @@ import Control.Concurrent.MVar ( newEmptyMVar, putMVar, takeMVar ) import Control.Exception ( throwIO ) +import Control.Monad + ( when ) import Control.Monad.IO.Class ( liftIO ) import Control.Tracer @@ -110,6 +120,7 @@ import Test.Integration.Framework.DSL import Test.Utils.Paths ( inNixBuild ) +import qualified Cardano.BM.Backend.EKGView as EKG import qualified Cardano.Pool.DB as Pool import qualified Cardano.Pool.DB.Sqlite as Pool import qualified Data.Text as T @@ -202,7 +213,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 <- (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 let fiveMinutes = 300*1000*1000 -- 5 minutes in microseconds manager <- (baseUrl,) <$> newManager (defaultManagerSettings { managerResponseTimeout = @@ -301,7 +314,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 @@ -310,7 +323,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 @@ -330,7 +347,7 @@ instance HasSeverityAnnotation TestsLog where getSeverityAnnotation = \case MsgBracket _ _ -> Debug MsgSettingUpFaucet -> Notice - MsgBaseUrl _ -> Notice + MsgBaseUrl {} -> Notice MsgCluster msg -> getSeverityAnnotation msg MsgPoolGarbageCollectionEvent _ -> Info @@ -349,8 +366,9 @@ withTracers action = do testLogOutputs <- ([LogToStdout testMinSeverity] ++) <$> extraOutput "test.log" - withLogging walletLogOutputs $ \(_, walTr) -> do - withLogging testLogOutputs $ \(_, testTr) -> do + withLogging walletLogOutputs $ \(sb, (cfg, walTr)) -> do + ekgEnabled >>= flip when (EKG.plugin cfg walTr sb >>= loadPlugin sb) + 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 45fcff71a4c..1707415bb15 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")) diff --git a/nix/.stack.nix/cardano-wallet.nix b/nix/.stack.nix/cardano-wallet.nix index 78a1b6cd663..e60d4b759e1 100644 --- a/nix/.stack.nix/cardano-wallet.nix +++ b/nix/.stack.nix/cardano-wallet.nix @@ -97,6 +97,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")) @@ -115,6 +116,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."text" or (errorHandler.buildDepError "text")) (hsPkgs."text-class" or (errorHandler.buildDepError "text-class")) ]; @@ -173,6 +175,7 @@ (hsPkgs."hspec" or (errorHandler.buildDepError "hspec")) (hsPkgs."http-client" or (errorHandler.buildDepError "http-client")) (hsPkgs."iohk-monitoring" or (errorHandler.buildDepError "iohk-monitoring")) + (hsPkgs."lobemo-backend-ekg" or (errorHandler.buildDepError "lobemo-backend-ekg")) (hsPkgs."text" or (errorHandler.buildDepError "text")) (hsPkgs."text-class" or (errorHandler.buildDepError "text-class")) ];