diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index d3f54f39243..6d49261dae5 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -113,6 +113,7 @@ library Cardano.Node.Tracing.Tracers.KESInfo Cardano.Node.Tracing.Tracers.NodeToClient Cardano.Node.Tracing.Tracers.NodeToNode + Cardano.Node.Tracing.Tracers.NodeVersion Cardano.Node.Tracing.Tracers.NonP2P Cardano.Node.Tracing.Tracers.P2P Cardano.Node.Tracing.Tracers.Peer diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 2ae989006dd..6599ac799a6 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -8,9 +8,11 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + + {-# OPTIONS_GHC -Wno-unused-imports #-} #if !defined(mingw32_HOST_OS) @@ -74,6 +76,8 @@ import Paths_cardano_node (version) import qualified Cardano.Crypto.Init as Crypto +import Cardano.Node.Tracing.Tracers.NodeVersion (getNodeVersion) + import Cardano.Node.Configuration.Logging (LoggingLayer (..), createLoggingLayer, nodeBasicInfo, shutdownLoggingLayer) import Cardano.Node.Configuration.NodeAddress @@ -102,12 +106,12 @@ import qualified Ouroboros.Network.Diffusion.P2P as P2P import Ouroboros.Network.NodeToClient (LocalAddress (..), LocalSocket (..)) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), ConnectionId, PeerSelectionTargets (..), RemoteAddress) +import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) + import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) import Ouroboros.Network.Protocol.ChainSync.Codec import Ouroboros.Network.Subscription (DnsSubscriptionTarget (..), IPSubscriptionTarget (..)) -import Ouroboros.Network.PeerSelection.Bootstrap - (UseBootstrapPeers (..)) import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..), gatherConfiguredSockets, getSocketOrSocketInfoAddr) @@ -124,11 +128,14 @@ import Cardano.Node.Protocol.Types import Cardano.Node.Queries import Cardano.Node.TraceConstraints (TraceConstraints) import Cardano.Tracing.Tracers -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) -import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, WarmValency) +import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers) import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers) + +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable) -import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers) + +import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, WarmValency) + {- HLINT ignore "Fuse concatMap/map" -} {- HLINT ignore "Redundant <$>" -} @@ -240,8 +247,8 @@ handleNodeWithTracers cmdPc nc0 p networkMagic blockType runP = do blockForging <- snd (Api.protocolInfo runP) traceWith (startupTracer tracers) (BlockForgingUpdate (if null blockForging - then EnabledBlockForging - else DisabledBlockForging)) + then DisabledBlockForging + else EnabledBlockForging)) handleSimpleNode blockType runP p2pMode tracers nc (\nk -> do @@ -280,12 +287,13 @@ handleNodeWithTracers cmdPc nc0 p networkMagic blockType runP = do getStartupInfo nc p fp >>= mapM_ (traceWith $ startupTracer tracers) + traceWith (nodeVersionTracer tracers) getNodeVersion + blockForging <- snd (Api.protocolInfo runP) traceWith (startupTracer tracers) (BlockForgingUpdate (if null blockForging - then EnabledBlockForging - else DisabledBlockForging)) - + then DisabledBlockForging + else EnabledBlockForging)) -- We ignore peer logging thread if it dies, but it will be killed -- when 'handleSimpleNode' terminates. diff --git a/cardano-node/src/Cardano/Node/Tracing.hs b/cardano-node/src/Cardano/Node/Tracing.hs index 148322d5282..027d988d086 100644 --- a/cardano-node/src/Cardano/Node/Tracing.hs +++ b/cardano-node/src/Cardano/Node/Tracing.hs @@ -16,6 +16,8 @@ import Cardano.Node.Tracing.StateRep (NodeState) import Cardano.Node.Tracing.Tracers.ConsensusStartupException (ConsensusStartupException (..)) import Cardano.Node.Tracing.Tracers.Peer (PeerT) +import Cardano.Node.Tracing.Tracers.NodeVersion (NodeVersionTrace) + import qualified Ouroboros.Consensus.Network.NodeToClient as NodeToClient import qualified Ouroboros.Consensus.Network.NodeToNode as NodeToNode import qualified Ouroboros.Consensus.Node.Tracers as Consensus @@ -48,6 +50,7 @@ data Tracers peer localPeer blk p2p = Tracers , startupTracer :: !(Tracer IO (StartupTrace blk)) , shutdownTracer :: !(Tracer IO ShutdownTrace) , nodeInfoTracer :: !(Tracer IO NodeInfo) + , nodeVersionTracer :: !(Tracer IO NodeVersionTrace) , nodeStartupInfoTracer :: !(Tracer IO NodeStartupInfo) , nodeStateTracer :: !(Tracer IO NodeState) , resourcesTracer :: !(Tracer IO ResourceStats) diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index 846f5807d43..e7328a59512 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -27,6 +27,8 @@ import Cardano.Node.Tracing.Tracers.Diffusion () import Cardano.Node.Tracing.Tracers.KESInfo () import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () +import Cardano.Node.Tracing.Tracers.NodeVersion (NodeVersionTrace) + import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Node.Tracing.Tracers.P2P () import Cardano.Node.Tracing.Tracers.Peer @@ -130,6 +132,9 @@ getAllNamespaces = (allNamespaces :: [Namespace (StartupTrace blk)]) shutdownNS = map (nsGetTuple . nsReplacePrefix ["Shutdown"]) (allNamespaces :: [Namespace ShutdownTrace]) + nodeVersionNS = map (nsGetTuple . nsReplacePrefix ["Version"]) + (allNamespaces :: [Namespace NodeVersionTrace]) + chainDBNS = map (nsGetTuple . nsReplacePrefix ["ChainDB"]) (allNamespaces :: [Namespace (ChainDB.TraceEvent blk)]) replayBlockNS = map (nsGetTuple . nsReplacePrefix ["ChainDB", "ReplayBlock"]) @@ -366,6 +371,7 @@ getAllNamespaces = <> resourcesNS <> startupNS <> shutdownNS + <> nodeVersionNS <> chainDBNS <> replayBlockNS -- Consensus diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index 2fdc5f908e8..e109c8354c1 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -35,6 +35,8 @@ import Cardano.Node.Tracing.Tracers.ForgingThreadStats (ForgeThreadSta import Cardano.Node.Tracing.Tracers.KESInfo () import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () +import Cardano.Node.Tracing.Tracers.NodeVersion (NodeVersionTrace) + import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Node.Tracing.Tracers.P2P () import Cardano.Node.Tracing.Tracers.Peer @@ -192,6 +194,12 @@ docTracersFirstPhase condConfigFileName = do nodeStartupInfoDpDoc <- documentTracer (nodeStartupInfoDp :: Trace IO NodeStartupInfo) + nodeVersionTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Version"] + configureTracers configReflection trConfig [nodeVersionTr] + nodeVersionDoc <- documentTracer (nodeVersionTr :: Trace IO NodeVersionTrace) + -- State tracer stateTr <- mkCardanoTracer trBase trForward mbTrEKG @@ -677,6 +685,7 @@ docTracersFirstPhase condConfigFileName = do <> resourcesTrDoc <> startupTrDoc <> shutdownTrDoc + <> nodeVersionDoc <> peersTrDoc <> chainDBTrDoc <> replayBlockTrDoc diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index e031c08a4fc..2eef28c0d34 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -33,6 +33,8 @@ import Cardano.Node.Tracing.Tracers.ForgingThreadStats (forgeThreadSta import Cardano.Node.Tracing.Tracers.KESInfo import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () +import Cardano.Node.Tracing.Tracers.NodeVersion (getNodeVersion) + import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Node.Tracing.Tracers.P2P () import Cardano.Node.Tracing.Tracers.Peer () @@ -125,6 +127,10 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl !chainDBTr <- mkCardanoTracer' trBase trForward mbTrEKG ["ChainDB"] withAddedToCurrentChainEmptyLimited configureTracers configReflection trConfig [chainDBTr] + + !nodeVersionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Version"] + configureTracers configReflection trConfig [nodeVersionTr] + -- Filter out replayed blocks for this tracer let chainDBTr' = filterTrace (\case (_, ChainDB.TraceLedgerReplayEvent @@ -170,6 +176,8 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl traceEffectiveConfiguration trBase trForward trConfig + traceWith nodeVersionTr getNodeVersion + pure Tracers { chainDBTracer = Tracer (traceWith chainDBTr') @@ -188,6 +196,7 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl , nodeStartupInfoTracer = Tracer (traceWith nodeStartupInfoDP) , nodeStateTracer = Tracer (traceWith stateTr) <> Tracer (traceWith nodeStateDP) + , nodeVersionTracer = Tracer (traceWith nodeVersionTr) , resourcesTracer = Tracer (traceWith resourcesTr) , peersTracer = Tracer (traceWith peersTr) <> Tracer (traceNodePeers nodePeersDP) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeVersion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeVersion.hs new file mode 100644 index 00000000000..e8cf32208a6 --- /dev/null +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeVersion.hs @@ -0,0 +1,153 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +{-# OPTIONS_GHC -Wno-name-shadowing #-} + +module Cardano.Node.Tracing.Tracers.NodeVersion +( + NodeVersionTrace (..) + , getNodeVersion + , getCardanoBuildInfo +) + where + +import Data.Aeson (toJSON, (.=)) +import Data.Text (Text, pack) +import Data.Version (Version (..), showVersion) +#if MIN_VERSION_base(4,15,0) +import System.Info (arch, compilerName, fullCompilerVersion, os) +#else +import System.Info (arch, compilerName, compilerVersion, os) +#endif + +import Cardano.Git.Rev (gitRev) +import Cardano.Logging + +import Paths_cardano_node (version) + + + +-- | Node version information + +data NodeVersionTrace = NodeVersionTrace + { applicationName :: Text + , applicationVersion :: Version + , osName :: Text + , architecture :: Text + , compilerName :: Text + , compilerVersion :: Version + , gitRevision :: Text + } deriving (Eq, Show) + +-- | Get the node version information + +getComplierVersion :: Version +#if MIN_VERSION_base(4,15,0) +getComplierVersion = System.Info.fullCompilerVersion +#else +getComplierVersion = System.Info.compilerVersion +#endif + +getNodeVersion :: NodeVersionTrace +getNodeVersion = + let applicationName = "cardano-node" + applicationVersion = version + osName = pack os + architecture = pack arch + compilerName = pack System.Info.compilerName + compilerVersion = getComplierVersion + gitRevision = $(gitRev) + in NodeVersionTrace {..} + + +instance MetaTrace NodeVersionTrace where + namespaceFor NodeVersionTrace {} = + Namespace [] ["NodeVersion"] + severityFor (Namespace _ ["NodeVersion"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor (Namespace _ ["NodeVersion"]) = Just "Node version information" + + documentFor _ = Nothing + + metricsDocFor (Namespace _ ["NodeVersion"]) = + [("cardano_version_major", "Cardano node version information") + ,("cardano_version_minor", "Cardano node version information") + ,("cardano_version_patch", "Cardano node version information") + ,("haskell_compiler_major", "Cardano compiler version information") + ,("haskell_compiler_minor", "Cardano compiler version information") + +#if MIN_VERSION_base(4,15,0) + ,("haskell_compiler_patch", "Cardano compiler version information") +#endif + ,("cardano_build_info", "Cardano node build info") + ] + metricsDocFor _ = [] + + allNamespaces = [Namespace [] ["NodeVersion"]] + +instance LogFormatting NodeVersionTrace where + forHuman NodeVersionTrace {..} = mconcat + [ "cardano-node ", pack (showVersion applicationVersion) + , " git rev ", gitRevision + , " - ", pack os, "-", pack arch + , " - ", compilerName, "-", pack (showVersion compilerVersion) + ] + + forMachine _dtal NodeVersionTrace {..} = mconcat + + [ "applicationName" .= applicationName + , "applicationVersion" .= toJSON applicationVersion + , "gitRevision" .= gitRevision + , "osName" .= osName + , "architecture" .= architecture + , "compilerName" .= compilerName + , "compilerVersion" .= toJSON compilerVersion + ] + + asMetrics nvt@NodeVersionTrace {..} = + [ IntM "cardano_version_major" (fromIntegral (getMajor applicationVersion)) + , IntM "cardano_version_minor" (fromIntegral (getMinor applicationVersion)) + , IntM "cardano_version_patch" (fromIntegral (getPatch applicationVersion)) + , IntM "haskell_compiler_major" (fromIntegral (getMajor compilerVersion)) + , IntM "haskell_compiler_minor" (fromIntegral (getMinor compilerVersion)) +#if MIN_VERSION_base(4,15,0) + , IntM "haskell_compiler_patch" (fromIntegral (getPatch compilerVersion)) +#endif + , PrometheusM "cardano_build_info" (getCardanoBuildInfo nvt) + ] + +getCardanoBuildInfo :: NodeVersionTrace -> [(Text,Text)] +getCardanoBuildInfo NodeVersionTrace {..} = + [ ("version_major", pack (show (getMajor applicationVersion))) + , ("version_minor", pack (show (getMinor applicationVersion))) + , ("version_patch", pack (show (getPatch applicationVersion))) + , ("version", pack (showVersion applicationVersion)) + , ("revision", gitRevision) + , ("compiler_name", compilerName) + , ("compiler_version", pack (showVersion compilerVersion)) + , ("compiler_version_major", pack (show (getMajor compilerVersion))) + , ("compiler_version_minor", pack (show (getMinor compilerVersion))) +#if MIN_VERSION_base(4,15,0) + , ("compiler_version_patch", pack (show (getPatch compilerVersion))) +#endif + , ("architecture", architecture) + , ("os_name", osName) + ] + +getMajor :: Version -> Int +getMajor (Version (x:_) _) = x +getMajor _ = 0 + +getMinor :: Version -> Int +getMinor (Version (_:x:_) _) = x +getMinor _ = 0 + +getPatch :: Version -> Int +getPatch (Version (_:_:x:_) _) = x +getPatch _ = 0 + + + diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index 4e572fd454e..4275319979b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -25,7 +25,9 @@ import Cardano.Logging import Cardano.Node.Configuration.POM (NodeConfiguration, ncProtocol) import Cardano.Node.Configuration.Socket import Cardano.Node.Protocol (SomeConsensusProtocol (..)) + import Cardano.Node.Startup + import Cardano.Slotting.Slot (EpochSize (..)) import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as WCT import Ouroboros.Consensus.Byron.Ledger.Conversions (fromByronEpochSlots, @@ -54,6 +56,7 @@ import Data.Text (Text, pack) import Data.Time (getCurrentTime) import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds) import Data.Version (showVersion) + import Network.Socket (SockAddr) import Paths_cardano_node (version) diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 3d92ba2c727..130198c5d46 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -51,6 +51,8 @@ import qualified Cardano.Node.STM as STM import Cardano.Node.Startup import Cardano.Node.TraceConstraints +import Cardano.Node.Tracing.Tracers.NodeVersion + import Cardano.Node.Tracing import Cardano.Protocol.TPraos.OCert (KESPeriod (..)) import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..), WithOrigin (..)) @@ -137,6 +139,7 @@ import qualified System.Metrics.Gauge as Gauge import qualified System.Metrics.Label as Label import qualified System.Remote.Monitoring as EKG + {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- needs different instances on ghc8 and on ghc9 @@ -172,6 +175,7 @@ nullTracersP2P = Tracers , nodeInfoTracer = nullTracer , nodeStartupInfoTracer = nullTracer , nodeStateTracer = nullTracer + , nodeVersionTracer = nullTracer , resourcesTracer = nullTracer , peersTracer = nullTracer } @@ -189,6 +193,7 @@ nullTracersNonP2P = Tracers , nodeInfoTracer = nullTracer , nodeStartupInfoTracer = nullTracer , nodeStateTracer = nullTracer + , nodeVersionTracer = nullTracer , resourcesTracer = nullTracer , peersTracer = nullTracer } @@ -350,6 +355,7 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect enable <> Tracer (\(ev :: StartupTrace blk) -> traceForgeEnabledMetric ekgDirect ev) , shutdownTracer = toLogObject' verb $ appendName "shutdown" tr + , nodeVersionTracer = Tracer (\(ev :: NodeVersionTrace) -> traceVersionMetric ekgDirect ev) -- The remaining tracers are completely unused by the legacy tracing: , nodeInfoTracer = nullTracer , nodeStartupInfoTracer = nullTracer @@ -363,13 +369,24 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect enable case mbEKGDirect of Just ekgDirect' -> case ev of - BlockForgingUpdate b -> sendEKGDirectInt ekgDirect' "forging_enabled" + BlockForgingUpdate b -> sendEKGDirectInt ekgDirect' "cardano.node.metrics.forging_enabled" (case b of EnabledBlockForging -> 1 :: Int DisabledBlockForging -> 0 :: Int NotEffective -> 0 :: Int) _ -> pure () Nothing -> pure () + traceVersionMetric :: Maybe EKGDirect -> NodeVersionTrace -> IO () + traceVersionMetric mbEKGDirect ev = do + case mbEKGDirect of + Just ekgDirect' -> + case ev of + NodeVersionTrace {} -> + sendEKGDirectPrometheusLabel + ekgDirect' + "cardano.node.metrics.cardano_build_info" + (getCardanoBuildInfo ev) + Nothing -> pure () diffusionTracers = Diffusion.Tracers { Diffusion.dtMuxTracer = muxTracer @@ -518,6 +535,7 @@ mkTracers _ _ _ _ _ enableP2P = , nodeInfoTracer = nullTracer , nodeStartupInfoTracer = nullTracer , nodeStateTracer = nullTracer + , nodeVersionTracer = nullTracer , resourcesTracer = nullTracer , peersTracer = nullTracer } @@ -672,6 +690,25 @@ sendEKGDirectDouble ekgDirect name val = do Label.set label (Text.pack (show val)) pure $ Map.insert name label registeredMap +sendEKGDirectPrometheusLabel :: EKGDirect -> Text -> [(Text,Text)] -> IO () +sendEKGDirectPrometheusLabel ekgDirect name labels = do + modifyMVar_ (ekgLabels ekgDirect) $ \registeredMap -> do + case Map.lookup name registeredMap of + Just label -> do + Label.set label (presentPrometheusM labels) + pure registeredMap + Nothing -> do + label <- EKG.getLabel name (ekgServer ekgDirect) + Label.set label (presentPrometheusM labels) + pure $ Map.insert name label registeredMap + where + presentPrometheusM :: [(Text, Text)] -> Text + presentPrometheusM = + label . map pair + where + label pairs = "{" <> Text.intercalate "," pairs <> "}" + pair (k, v) = k <> "=\"" <> v <> "\"" + -------------------------------------------------------------------------------- -- Consensus Tracers -------------------------------------------------------------------------------- diff --git a/nix/workbench/service/tracing.nix b/nix/workbench/service/tracing.nix index 1f661802d75..e2ff2b14b0d 100644 --- a/nix/workbench/service/tracing.nix +++ b/nix/workbench/service/tracing.nix @@ -86,6 +86,7 @@ let "TxSubmission.Remote".severity = "Notice"; "TxSubmission.TxInbound".severity = "Debug"; "TxSubmission.TxOutbound".severity = "Notice"; + "Version.NodeVersion".severity = "Info"; }; }; diff --git a/trace-dispatcher/CHANGELOG.md b/trace-dispatcher/CHANGELOG.md index 9ac2349604c..26987a038a5 100644 --- a/trace-dispatcher/CHANGELOG.md +++ b/trace-dispatcher/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for trace-dispatcher +## 2.5.7 + +* With a prometheus metric with key label pairs. The value will always be "1" + ## 2.5.2 -- Dec 2023 * ForHuman Color, Increased Consistency Checks, and Non-empty Inner Workspace Validation diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs index 08d42e7c22e..cbc3f88ac92 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/EKG.hs @@ -13,7 +13,8 @@ import Control.Concurrent.MVar import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Control.Tracer as T import qualified Data.Map.Strict as Map -import Data.Text (Text, pack) +import Data.Text (Text, intercalate, pack) + import qualified System.Metrics as Metrics import qualified System.Metrics.Counter as Counter import qualified System.Metrics.Gauge as Gauge @@ -61,6 +62,11 @@ ekgTracer storeOrServer = liftIO $ do (DoubleM name theDouble) = do label <- modifyMVar rgsLabels (setFunc Metrics.createLabel getLabel name) Label.set label ((pack . show) theDouble) + setIt _rgsGauges rgsLabels _rgsCounters _namespace + (PrometheusM name keyLabels) = do + label <- modifyMVar rgsLabels (setFunc Metrics.createLabel getLabel name) + Label.set label (presentPrometheusM keyLabels) + setIt _rgsGauges _rgsLabels rgsCounters _namespace (CounterM name mbInt) = do counter <- modifyMVar rgsCounters (setFunc Metrics.createCounter getCounter name) @@ -84,3 +90,11 @@ ekgTracer storeOrServer = liftIO $ do Right server -> creator2 name server let rgsMap' = Map.insert name gauge rgsMap pure (rgsMap', gauge) + +presentPrometheusM :: [(Text, Text)] -> Text +presentPrometheusM = + label . map pair + where + label pairs = "{" <> intercalate "," pairs <> "} 1" + pair (k, v) = k <> "=\"" <> v <> "\"" + diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 6bafffde9b2..3c722c0e95e 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -188,6 +188,15 @@ data Metric -- | A counter metric. -- Text is used to name the metric | CounterM Text (Maybe Int) + -- | A prometheus metric with key label pairs. + -- Text is used to name the metric + -- [(Text, Text)] is used to represent the key label pairs + -- The value of the metric will always be "1" + -- e.g. if you have a prometheus metric with the name "prometheus_metric" + -- and the key label pairs [("key1", "value1"), ("key2", "value2")] + -- the metric will be represented as "prometheus_metric{key1=\"value1\",key2=\"value2\"} 1" + + | PrometheusM Text [(Text, Text)] deriving (Show, Eq) @@ -195,6 +204,8 @@ getMetricName :: Metric -> Text getMetricName (IntM name _) = name getMetricName (DoubleM name _) = name getMetricName (CounterM name _) = name +getMetricName (PrometheusM name _) = name + -- | A helper function for creating an empty |Object|. emptyObject :: HM.HashMap Text a diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 2bfcfac29cf..340581c9aec 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: trace-dispatcher -version: 2.5.6 +version: 2.5.7 synopsis: Tracers for Cardano description: Package for development of simple and efficient tracers based on the arrow based contra-tracer package