From 0208725b3e644b66ca60fe3a54feb33326970542 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Baldur=20Bl=C3=B6ndal?= Date: Wed, 19 Mar 2025 04:42:07 +0000 Subject: [PATCH 1/4] cardano-tracer: Eliminate cardano-node dependency. --- .../src/Cardano/Benchmarking/Tracer.hs | 1 + cabal.project | 1 + cardano-node/ChangeLog.md | 4 + cardano-node/cardano-node.cabal | 4 +- cardano-node/src/Cardano/Node/Startup.hs | 88 ++++--------------- .../src/Cardano/Node/Tracing/Documentation.hs | 3 +- .../src/Cardano/Node/Tracing/NodeInfo.hs | 27 ++++++ .../Cardano/Node/Tracing/NodeStartupInfo.hs | 26 ++++++ .../src/Cardano/Node/Tracing/Peers.hs | 23 +---- .../src/Cardano/Node/Tracing/Tracers.hs | 3 +- .../src/Cardano/Node/Tracing/Tracers/Peer.hs | 29 +++--- cardano-tracer/CHANGELOG.md | 5 ++ cardano-tracer/cardano-tracer.cabal | 58 ++++++------ .../src/Cardano/Tracer/Configuration.hs | 3 +- .../Handlers/RTView/Update/EraSettings.hs | 2 +- .../Tracer/Handlers/RTView/Update/NodeInfo.hs | 2 +- .../Handlers/RTView/Update/NodeState.hs | 44 ++++++++-- .../Tracer/Handlers/RTView/Update/Peers.hs | 2 +- cardano-tracer/src/Cardano/Tracer/Run.hs | 3 +- cardano-tracer/src/Cardano/Tracer/Utils.hs | 2 +- trace-dispatcher/CHANGELOG.md | 5 ++ trace-dispatcher/src/Cardano/Logging/Types.hs | 68 +++++++------- .../src/Cardano/Logging/Types/NodeInfo.hs | 27 ++++++ .../src/Cardano/Logging/Types/NodePeers.hs | 22 +++++ .../Cardano/Logging/Types/NodeStartupInfo.hs | 30 +++++++ trace-dispatcher/trace-dispatcher.cabal | 3 + 26 files changed, 296 insertions(+), 189 deletions(-) create mode 100644 cardano-node/src/Cardano/Node/Tracing/NodeInfo.hs create mode 100644 cardano-node/src/Cardano/Node/Tracing/NodeStartupInfo.hs create mode 100644 trace-dispatcher/src/Cardano/Logging/Types/NodeInfo.hs create mode 100644 trace-dispatcher/src/Cardano/Logging/Types/NodePeers.hs create mode 100644 trace-dispatcher/src/Cardano/Logging/Types/NodeStartupInfo.hs diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index ef5d9929751..cdcaff58863 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -33,6 +33,7 @@ import Cardano.Benchmarking.Types import Cardano.Benchmarking.Version as Version import Cardano.Logging import Cardano.Node.Startup +import Cardano.Node.Tracing.NodeInfo () -- MetaTrace NodeInfo import Ouroboros.Network.IOManager (IOManager) import Control.Monad (forM, guard) diff --git a/cabal.project b/cabal.project index 35af620d187..8f713a3d26e 100644 --- a/cabal.project +++ b/cabal.project @@ -60,6 +60,7 @@ package plutus-scripts-bench allow-newer: , katip:Win32 , ekg-wai:time + , data-default -- IMPORTANT -- Do NOT add more source-repository-package stanzas here unless they are strictly diff --git a/cardano-node/ChangeLog.md b/cardano-node/ChangeLog.md index e75c604a5f8..b95c0b58644 100644 --- a/cardano-node/ChangeLog.md +++ b/cardano-node/ChangeLog.md @@ -2,6 +2,10 @@ ## Next version +- Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` from + `cardano-tracer:Cardano.Node.Startup`to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`, and `NodePeers` from + `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`. + - Add a new configuration field for fork-policy. - Optionally support lightweight checkpointing. diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 5ff4ea57334..f437770ca89 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -94,14 +94,16 @@ library Cardano.Node.TraceConstraints Cardano.Node.Tracing Cardano.Node.Tracing.API - Cardano.Node.Tracing.Consistency Cardano.Node.Tracing.Compat + Cardano.Node.Tracing.Consistency Cardano.Node.Tracing.DefaultTraceConfig Cardano.Node.Tracing.Documentation Cardano.Node.Tracing.Era.Byron Cardano.Node.Tracing.Era.HardFork Cardano.Node.Tracing.Era.Shelley Cardano.Node.Tracing.Formatting + Cardano.Node.Tracing.NodeInfo + Cardano.Node.Tracing.NodeStartupInfo Cardano.Node.Tracing.Peers Cardano.Node.Tracing.Render Cardano.Node.Tracing.StateRep diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index 83299493ce4..2effe07a9e9 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -8,13 +9,19 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} -module Cardano.Node.Startup where +module Cardano.Node.Startup + ( module Cardano.Node.Startup + , module Cardano.Logging.Types.NodeInfo + , module Cardano.Logging.Types.NodeStartupInfo + ) where import qualified Cardano.Api as Api import Cardano.Git.Rev (gitRev) import Cardano.Ledger.Shelley.Genesis (sgSystemStart) import Cardano.Logging +import Cardano.Logging.Types.NodeInfo (NodeInfo (..)) +import Cardano.Logging.Types.NodeStartupInfo (NodeStartupInfo (..)) import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) import Cardano.Node.Configuration.POM (NodeConfiguration (..), ncProtocol) import Cardano.Node.Configuration.Socket @@ -43,15 +50,12 @@ import Ouroboros.Network.Subscription.Ip (IPSubscriptionTarget (..)) import Prelude -import Control.DeepSeq (NFData) -import Data.Aeson (FromJSON, ToJSON) import Data.Map.Strict (Map) import Data.Monoid (Last (..)) import Data.Text (Text, pack) import Data.Time.Clock (NominalDiffTime, UTCTime) import Data.Version (showVersion) import Data.Word (Word64) -import GHC.Generics (Generic) import Network.HostName (getHostName) import qualified Network.Socket as Socket @@ -132,13 +136,15 @@ data StartupTrace blk = | LedgerPeerSnapshotLoaded (WithOrigin SlotNo) | MovedTopLevelOption String -data EnabledBlockForging = EnabledBlockForging - | DisabledBlockForging - | NotEffective - -- ^ one needs to send `SIGHUP` after consensus - -- initialised itself (especially after replying all - -- blocks). - deriving (Eq, Show) +data EnabledBlockForging + = EnabledBlockForging + | DisabledBlockForging + | NotEffective + -- ^ one needs to send `SIGHUP` after consensus + -- initialised itself (especially after replying all + -- blocks). + deriving stock + (Eq, Show) data BasicInfoCommon = BasicInfoCommon { biConfigPath :: FilePath @@ -170,37 +176,6 @@ data BasicInfoNetwork = BasicInfoNetwork { , niIpProducers :: IPSubscriptionTarget } -data NodeInfo = NodeInfo - { niName :: Text - , niProtocol :: Text - , niVersion :: Text - , niCommit :: Text - , niStartTime :: UTCTime - , niSystemStartTime :: UTCTime - } deriving (Eq, Generic, ToJSON, FromJSON, Show) - -deriving instance (NFData NodeInfo) - -instance MetaTrace NodeInfo where - namespaceFor NodeInfo {} = - Namespace [] ["NodeInfo"] - severityFor (Namespace _ ["NodeInfo"]) _ = - Just Info - severityFor _ns _ = - Nothing - documentFor (Namespace _ ["NodeInfo"]) = Just - "Basic information about this node collected at startup\ - \\n\ - \\n _niName_: Name of the node. \ - \\n _niProtocol_: Protocol which this nodes uses. \ - \\n _niVersion_: Software version which this node is using. \ - \\n _niStartTime_: Start time of this node. \ - \\n _niSystemStartTime_: How long did the start of the node took." - documentFor _ns = - Nothing - allNamespaces = [ Namespace [] ["NodeInfo"]] - - -- | Prepare basic info about the node. This info will be sent to 'cardano-tracer'. prepareNodeInfo :: NodeConfiguration @@ -261,32 +236,3 @@ prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do hostName <- getHostName return (pack (hostName <> suffix)) - --- | This information is taken from 'BasicInfoShelleyBased'. It is required for --- 'cardano-tracer' service (particularly, for RTView). -data NodeStartupInfo = NodeStartupInfo { - suiEra :: Text - , suiSlotLength :: NominalDiffTime - , suiEpochLength :: Word64 - , suiSlotsPerKESPeriod :: Word64 - } deriving (Eq, Generic, ToJSON, FromJSON, Show) - -deriving instance (NFData NodeStartupInfo) - -instance MetaTrace NodeStartupInfo where - namespaceFor NodeStartupInfo {} = - Namespace [] ["NodeStartupInfo"] - severityFor (Namespace _ ["NodeStartupInfo"]) _ = - Just Info - severityFor _ns _ = - Nothing - documentFor (Namespace _ ["NodeStartupInfo"]) = Just - "Startup information about this node, required for RTView\ - \\n\ - \\n _suiEra_: Name of the current era. \ - \\n _suiSlotLength_: Slot length, in seconds. \ - \\n _suiEpochLength_: Epoch length, in slots. \ - \\n _suiSlotsPerKESPeriod_: KES period length, in slots." - documentFor _ns = - Nothing - allNamespaces = [ Namespace [] ["NodeStartupInfo"]] diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index 558220ae554..7ac4a9feeaa 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -18,7 +18,7 @@ module Cardano.Node.Tracing.Documentation , docTracersFirstPhase ) where - +import Cardano.Node.Tracing.NodeStartupInfo () -- MetaTrace NodeVersionTrace import Cardano.Logging as Logging import Cardano.Logging.Resources import Cardano.Logging.Resources.Types () @@ -28,6 +28,7 @@ import Cardano.Node.Startup import Cardano.Node.TraceConstraints import Cardano.Node.Tracing.DefaultTraceConfig (defaultCardanoConfig) import Cardano.Node.Tracing.Formatting () +import Cardano.Node.Tracing.NodeInfo () import qualified Cardano.Node.Tracing.StateRep as SR import Cardano.Node.Tracing.Tracers.BlockReplayProgress import Cardano.Node.Tracing.Tracers.ChainDB diff --git a/cardano-node/src/Cardano/Node/Tracing/NodeInfo.hs b/cardano-node/src/Cardano/Node/Tracing/NodeInfo.hs new file mode 100644 index 00000000000..0c071af4066 --- /dev/null +++ b/cardano-node/src/Cardano/Node/Tracing/NodeInfo.hs @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Node.Tracing.NodeInfo + ( NodeInfo (..) + ) where + +import Cardano.Logging.Types.NodeInfo (NodeInfo (..)) +import Cardano.Logging.Types (MetaTrace(..), Namespace (..), SeverityS (..)) + +instance MetaTrace NodeInfo where + namespaceFor NodeInfo {} = + Namespace [] ["NodeInfo"] + severityFor (Namespace _ ["NodeInfo"]) _ = + Just Info + severityFor _ns _ = + Nothing + documentFor (Namespace _ ["NodeInfo"]) = Just + "Basic information about this node collected at startup\ + \\n\ + \\n _niName_: Name of the node. \ + \\n _niProtocol_: Protocol which this nodes uses. \ + \\n _niVersion_: Software version which this node is using. \ + \\n _niStartTime_: Start time of this node. \ + \\n _niSystemStartTime_: How long did the start of the node took." + documentFor _ns = + Nothing + allNamespaces = [ Namespace [] ["NodeInfo"]] diff --git a/cardano-node/src/Cardano/Node/Tracing/NodeStartupInfo.hs b/cardano-node/src/Cardano/Node/Tracing/NodeStartupInfo.hs new file mode 100644 index 00000000000..1f1aad0b35c --- /dev/null +++ b/cardano-node/src/Cardano/Node/Tracing/NodeStartupInfo.hs @@ -0,0 +1,26 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Node.Tracing.NodeStartupInfo + ( NodeStartupInfo (..) + ) where + +import Cardano.Logging.Types.NodeStartupInfo (NodeStartupInfo (..)) +import Cardano.Logging.Types (MetaTrace(..), Namespace (..), SeverityS (..)) + +instance MetaTrace NodeStartupInfo where + namespaceFor NodeStartupInfo {} = + Namespace [] ["NodeStartupInfo"] + severityFor (Namespace _ ["NodeStartupInfo"]) _ = + Just Info + severityFor _ns _ = + Nothing + documentFor (Namespace _ ["NodeStartupInfo"]) = Just + "Startup information about this node, required for RTView\ + \\n\ + \\n _suiEra_: Name of the current era. \ + \\n _suiSlotLength_: Slot length, in seconds. \ + \\n _suiEpochLength_: Epoch length, in slots. \ + \\n _suiSlotsPerKESPeriod_: KES period length, in slots." + documentFor _ns = + Nothing + allNamespaces = [ Namespace [] ["NodeStartupInfo"]] diff --git a/cardano-node/src/Cardano/Node/Tracing/Peers.hs b/cardano-node/src/Cardano/Node/Tracing/Peers.hs index 2d71f268123..5afe6810fc6 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Peers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Peers.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Cardano.Node.Tracing.Peers ( NodePeers (..) @@ -9,24 +7,7 @@ module Cardano.Node.Tracing.Peers import Cardano.Logging import Cardano.Node.Tracing.Tracers.Peer (PeerT, ppPeer) - -import Control.DeepSeq (NFData) -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -type PeerInfoPP = Text -- The result of 'ppPeer' function. - --- | This type contains an information about current peers of the node. --- It will be asked by external applications as a DataPoint. -newtype NodePeers = NodePeers [PeerInfoPP] - -deriving instance Generic NodePeers -deriving instance NFData NodePeers - -instance ToJSON NodePeers -instance FromJSON NodePeers - +import Cardano.Logging.Types.NodePeers (NodePeers(..)) instance MetaTrace NodePeers where namespaceFor NodePeers {} = diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index fe3c0412b1f..5bf699af32d 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -24,7 +24,7 @@ import Cardano.Node.TraceConstraints import Cardano.Node.Tracing import Cardano.Node.Tracing.Consistency (checkNodeTraceConfiguration') import Cardano.Node.Tracing.Formatting () -import Cardano.Node.Tracing.Peers +import Cardano.Node.Tracing.Peers (traceNodePeers) import qualified Cardano.Node.Tracing.StateRep as SR import Cardano.Node.Tracing.Tracers.BlockReplayProgress import Cardano.Node.Tracing.Tracers.ChainDB @@ -37,7 +37,6 @@ 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 () import Cardano.Node.Tracing.Tracers.Shutdown () import Cardano.Node.Tracing.Tracers.Startup () import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs index e751a067f3e..9d5f9d76160 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs @@ -68,32 +68,27 @@ startPeerTracer tracer nodeKernel delayMilliseconds = do traceWith tracer peers threadDelay (delayMilliseconds * 1000) - data PeerT blk = PeerT RemoteConnectionId (Net.AnchoredFragment (Header blk)) (PeerFetchStatus (Header blk)) (PeerFetchInFlight (Header blk)) - ppPeer :: PeerT blk -> Text ppPeer (PeerT cid _af status inflight) = Text.pack $ printf "%-15s %-8s %s" (ppCid cid) (ppStatus status) (ppInFlight inflight) -ppCid :: RemoteConnectionId -> String -ppCid = takeWhile (/= ':') . show . remoteAddress + where + ppCid :: RemoteConnectionId -> String + ppCid = takeWhile (/= ':') . show . remoteAddress -ppInFlight :: PeerFetchInFlight header -> String -ppInFlight f = printf - "%5s %3d %5d %6d" - (ppMaxSlotNo $ peerFetchMaxSlotNo f) - (peerFetchReqsInFlight f) - (Set.size $ peerFetchBlocksInFlight f) - (peerFetchBytesInFlight f) - -ppMaxSlotNo :: Net.MaxSlotNo -> String -ppMaxSlotNo Net.NoMaxSlotNo = "???" -ppMaxSlotNo (Net.MaxSlotNo x) = show (unSlotNo x) + ppInFlight :: PeerFetchInFlight header -> String + ppInFlight f = printf + "%5s %3d %5d %6d" + (ppMaxSlotNo $ peerFetchMaxSlotNo f) + (peerFetchReqsInFlight f) + (Set.size $ peerFetchBlocksInFlight f) + (peerFetchBytesInFlight f) ppStatus :: PeerFetchStatus header -> String ppStatus = \case @@ -103,6 +98,10 @@ ppStatus = \case PeerFetchStatusBusy -> "fetching" PeerFetchStatusReady {} -> "ready" +ppMaxSlotNo :: Net.MaxSlotNo -> String +ppMaxSlotNo Net.NoMaxSlotNo = "???" +ppMaxSlotNo (Net.MaxSlotNo x) = show (unSlotNo x) + getCurrentPeers :: NodeKernelData blk -> IO [PeerT blk] diff --git a/cardano-tracer/CHANGELOG.md b/cardano-tracer/CHANGELOG.md index 1368b9067d1..03045c71fae 100644 --- a/cardano-tracer/CHANGELOG.md +++ b/cardano-tracer/CHANGELOG.md @@ -1,5 +1,10 @@ # ChangeLog +## 0.3.3 (April, 2025) +* Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` from + `cardano-tracer:Cardano.Node.Startup`to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`, and `NodePeers` from + `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`. + ## 0.3.2 (March 2025) * When requesting forwarded metrics, ask for delta to previous request only. New config option `ekgRequestFull` defaults to `false`; set to `true` to revert this behavior. diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index d2d45aa500f..2900c5ca717 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -164,14 +164,13 @@ library if (flag(systemd) && os(linux)) || flag(rtview) build-depends: unordered-containers - build-depends: aeson + build-depends: aeson >= 2.1.0.0 , async , auto-update , bimap , blaze-html , bytestring - , cardano-node - , cborg + , cborg ^>= 0.2.4 , containers , contra-tracer , directory @@ -182,21 +181,22 @@ library , filepath , http-types , mime-mail - , network-mux + , network-mux >= 0.5 , optparse-applicative , ouroboros-network ^>= 0.20 - , ouroboros-network-api + , ouroboros-network-api ^>= 0.13 , ouroboros-network-framework , signal , slugify , smtp-mail ^>= 0.5 - , stm + , stm <2.5.2 || >=2.5.3 , string-qq , text , time - , trace-dispatcher - , trace-forward - , trace-resources + , trace-dispatcher ^>= 2.8.1 + , trace-forward ^>= 2.2.10 + , trace-resources ^>= 0.2.3 + , unordered-containers , wai ^>= 3.2 , warp ^>= 3.4 , yaml @@ -250,13 +250,13 @@ library demo-forwarder-lib , filepath , generic-data , network-mux - , optparse-applicative-fork - , ouroboros-network-api + , optparse-applicative-fork >= 0.18.1 + , ouroboros-network-api ^>= 0.12 , ouroboros-network-framework , tasty-quickcheck , time - , trace-dispatcher - , trace-forward + , trace-dispatcher ^>= 2.8.1 + , trace-forward ^>= 2.2.10 , vector , vector-algorithms , QuickCheck @@ -293,12 +293,12 @@ library demo-acceptor-lib , extra , filepath , generic-data - , optparse-applicative-fork - , ouroboros-network-api - , stm + , optparse-applicative-fork >= 0.18.1 + , ouroboros-network-api ^>= 0.12 + , stm <2.5.2 || >=2.5.3 , text , tasty-quickcheck - , trace-forward + , trace-forward ^>= 2.2.10 , vector , vector-algorithms , QuickCheck @@ -352,16 +352,16 @@ test-suite cardano-tracer-test , filepath , generic-data , network-mux - , optparse-applicative-fork - , ouroboros-network-api + , optparse-applicative-fork >= 0.18.1 + , ouroboros-network-api ^>= 0.12 , ouroboros-network-framework - , stm + , stm <2.5.2 || >=2.5.3 , tasty , tasty-quickcheck , text , time - , trace-dispatcher - , trace-forward + , trace-dispatcher ^>= 2.8.1 + , trace-forward ^>= 2.2.10 , unix-compat , vector , vector-algorithms @@ -411,9 +411,9 @@ test-suite cardano-tracer-test-ext , generic-data , Glob , network-mux - , optparse-applicative-fork - , ouroboros-network - , ouroboros-network-api + , optparse-applicative-fork >= 0.18.1 + , ouroboros-network ^>= 0.19.0.3 + , ouroboros-network-api ^>= 0.12 , ouroboros-network-framework , process , QuickCheck @@ -421,8 +421,8 @@ test-suite cardano-tracer-test-ext , tasty-quickcheck , text , time - , trace-dispatcher - , trace-forward + , trace-dispatcher ^>= 2.8.1 + , trace-forward ^>= 2.2.10 , unix-compat , vector , vector-algorithms @@ -440,7 +440,7 @@ benchmark cardano-tracer-bench main-is: cardano-tracer-bench.hs if flag(rtview) - build-depends: stm + build-depends: stm <2.5.2 || >=2.5.3 build-depends: cardano-tracer , criterion , directory @@ -448,7 +448,7 @@ benchmark cardano-tracer-bench , extra , filepath , time - , trace-dispatcher + , trace-dispatcher ^>= 2.8.1 ghc-options: -threaded -rtsopts diff --git a/cardano-tracer/src/Cardano/Tracer/Configuration.hs b/cardano-tracer/src/Cardano/Tracer/Configuration.hs index edeb4ee7449..ebfa3518837 100644 --- a/cardano-tracer/src/Cardano/Tracer/Configuration.hs +++ b/cardano-tracer/src/Cardano/Tracer/Configuration.hs @@ -77,7 +77,8 @@ instance FromJSON RotationParams where rpFrequencySecs <- o .: "rpFrequencySecs" rpLogLimitBytes <- o .: "rpLogLimitBytes" rpMaxAgeMinutes <- o .: "rpMaxAgeMinutes" - <|> o .: "rpMaxAgeHours" <&> (* 60) + <|> (o .: "rpMaxAgeHours" <&> (* 60)) + <|> pure (24 * 60) rpKeepFilesNum <- o .: "rpKeepFilesNum" pure RotationParams{..} diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/EraSettings.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/EraSettings.hs index 14707c26161..b66d6417284 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/EraSettings.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/EraSettings.hs @@ -6,7 +6,7 @@ module Cardano.Tracer.Handlers.RTView.Update.EraSettings ( runEraSettingsUpdater ) where -import Cardano.Node.Startup (NodeStartupInfo (..)) +import Cardano.Logging.Types.NodeStartupInfo (NodeStartupInfo (..)) import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.EraSettings import Cardano.Tracer.Handlers.Utils diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs index 7f979972f93..4ff141a47e1 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs @@ -5,7 +5,7 @@ module Cardano.Tracer.Handlers.RTView.Update.NodeInfo ( askNSetNodeInfo ) where -import Cardano.Node.Startup (NodeInfo (..)) +import Cardano.Logging.Types.NodeInfo (NodeInfo (..)) import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.Displayed import Cardano.Tracer.Handlers.RTView.UI.Utils diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs index d9548824d84..949c9884331 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs @@ -3,10 +3,13 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cardano.Tracer.Handlers.RTView.Update.NodeState - ( askNSetNodeState + ( NodeStateWrapper (..) + , askNSetNodeState ) where -import Cardano.Node.Tracing.StateRep +-- import Cardano.Node.Tracing.StateRep +import Data.Aeson +import Data.Aeson.Types (Parser) import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.Displayed import Cardano.Tracer.Handlers.RTView.UI.Utils @@ -15,7 +18,7 @@ import Cardano.Tracer.Handlers.RTView.Utils import Cardano.Tracer.Types import Control.Monad.Extra (whenJustM) -import Data.Text (pack) +import Data.Text (Text, pack) import Text.Printf (printf) import Graphics.UI.Threepenny.Core (UI, liftIO) @@ -28,16 +31,43 @@ askNSetNodeState -> UI () askNSetNodeState tracerEnv displayed = forConnectedUI_ tracerEnv $ \nodeId -> - whenJustM (liftIO $ askDataPoint teDPRequestors teCurrentDPLock nodeId "NodeState") $ \(ns :: NodeState) -> - case ns of - NodeAddBlock (AddedToCurrentChain _ _ syncPct) -> setSyncProgress nodeId syncPct - _ -> return () + whenJustM (liftIO $ askDataPoint teDPRequestors teCurrentDPLock nodeId "NodeState") \(NodeStateWrapper syncPct) -> + setSyncProgress nodeId syncPct where TracerEnv{teDPRequestors, teCurrentDPLock} = tracerEnv + setSyncProgress :: NodeId -> Double -> UI () setSyncProgress nodeId@(NodeId anId) syncPct = do let nodeSyncProgressElId = anId <> "__node-sync-progress" if syncPct < 100.0 then setDisplayedValue nodeId displayed nodeSyncProgressElId $ pack (printf "%.2f" syncPct) <> " %" else setTextAndClasses nodeSyncProgressElId "100 %" "rt-view-percent-done" + +-- | This is to avoid creating a dependency on `cardano-node's `NodeState'. +-- +-- Before: Pattern matching on `NodeState' to access a single Double: +-- +-- @ +-- NodeAddBlock (AddedToCurrentChain _ _ syncPct) -> setSyncProgress nodeId syncPct +-- _ -> return () +-- @ +-- +-- Now: We pattern match on a newtype wrapper for a `Double' and parse +-- it from a JSON object if it matches the serialization of +-- `NodeAddBlock (AddedToCurrentChain _ _ syncPct)'. +-- +-- @ +-- \(NodeStateWrapper syncPct) -> setSyncProgress nodeId syncPct +-- @ +newtype NodeStateWrapper = NodeStateWrapper + { getNodeStateWrapper :: Double } + +instance FromJSON NodeStateWrapper where + parseJSON :: Value -> Parser NodeStateWrapper + parseJSON = withObject "NodeState" \obj -> do + -- Check if this is a NodeAddBlock constructor, verify that it's + -- AddedToCurrentChain and extract the Double. + "NodeAddBlock" :: Text <- obj .: "tag" + [_, _, double] <- obj .: "contents" + pure (NodeStateWrapper double) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Peers.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Peers.hs index def88eff97f..20495d16ac5 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Peers.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Peers.hs @@ -12,7 +12,7 @@ module Cardano.Tracer.Handlers.RTView.Update.Peers ) where import Cardano.Logging (showT) -import Cardano.Node.Tracing.Peers +import Cardano.Logging.Types.NodePeers (NodePeers(..)) import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.Peers import Cardano.Tracer.Handlers.RTView.UI.HTML.Node.Peers diff --git a/cardano-tracer/src/Cardano/Tracer/Run.hs b/cardano-tracer/src/Cardano/Tracer/Run.hs index 9b41127d0e3..b1a83bbb5f1 100644 --- a/cardano-tracer/src/Cardano/Tracer/Run.hs +++ b/cardano-tracer/src/Cardano/Tracer/Run.hs @@ -111,8 +111,7 @@ doRunCardanoTracer config rtViewStateDir tr protocolsBrake dpRequestors = do traceWith tr TracerInitEventQueues #if RTVIEW - eventsQueues <- initEventsQueues rtViewStateDir connectedNodesNames dpRequestors currentDPLock - + eventsQueues <- initEventsQueues tr rtViewStateDir connectedNodesNames dpRequestors currentDPLock rtViewPageOpened <- newTVarIO False #endif diff --git a/cardano-tracer/src/Cardano/Tracer/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Utils.hs index fe80b7c9de9..8129b5ea350 100644 --- a/cardano-tracer/src/Cardano/Tracer/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Utils.hs @@ -39,7 +39,7 @@ module Cardano.Tracer.Utils , sequenceConcurrently_ ) where -import Cardano.Node.Startup (NodeInfo (..)) +import Cardano.Logging.Types.NodeInfo (NodeInfo(..)) import Cardano.Tracer.Configuration import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Utils diff --git a/trace-dispatcher/CHANGELOG.md b/trace-dispatcher/CHANGELOG.md index cf8a8667888..763946f08d7 100644 --- a/trace-dispatcher/CHANGELOG.md +++ b/trace-dispatcher/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for trace-dispatcher +## 2.9.1 (April, 2025) +* Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` from + `cardano-tracer:Cardano.Node.Startup`to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`, and `NodePeers` from + `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`. + ## 2.9 -- Mar 2025 * New `PrometheusSimple` backend which runs a simple TCP server for direct exposition of metrics, without forwarding. diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 89f733c0fc2..9424e848c05 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -105,7 +106,7 @@ instance Monad m => Monoid (Trace m a) where data Namespace a = Namespace { nsPrefix :: [Text] , nsInner :: [Text]} - deriving Eq + deriving stock Eq instance Show (Namespace a) where show (Namespace [] []) = "emptyNS" @@ -210,7 +211,7 @@ data Metric -- the metric will be represented as "prometheus_metric{key1=\"value1\",key2=\"value2\"} 1" | PrometheusM Text [(Text, Text)] - deriving (Show, Eq) + deriving stock (Eq, Show) getMetricName :: Metric -> Text @@ -229,10 +230,8 @@ emptyObject = HM.empty -- important to provide a complete list, as the prototypes are used as well for configuration. -- If you don't want to add an item for documentation enter an empty text. newtype Documented a = Documented {undoc :: [DocMsg a]} - deriving Show - -instance Semigroup (Documented a) where - (<>) (Documented l) (Documented r) = Documented (l ++ r) + deriving stock Show + deriving newtype Semigroup -- | Document a message by giving a prototype, its most special name in the namespace -- and a comment in markdown format @@ -253,7 +252,10 @@ data LoggingContext = LoggingContext { , lcPrivacy :: Maybe Privacy , lcDetails :: Maybe DetailLevel } - deriving Show + deriving stock + (Show, Generic) + deriving anyclass + Serialise emptyLoggingContext :: LoggingContext emptyLoggingContext = LoggingContext [] [] Nothing Nothing Nothing @@ -264,17 +266,18 @@ data DetailLevel = | DNormal | DDetailed | DMaximum - deriving (Show, Eq, Ord, Bounded, Enum, Generic, Serialise) + deriving stock (Eq, Ord, Show, Enum, Bounded, Generic) + deriving anyclass (Serialise, AE.FromJSON) instance AE.ToJSON DetailLevel where toEncoding = AE.genericToEncoding AE.defaultOptions -instance AE.FromJSON DetailLevel -- | Privacy of a message. Default is Public data Privacy = Confidential -- ^ confidential information - handle with care | Public -- ^ can be public. - deriving (Show, Eq, Ord, Bounded, Enum, Generic, Serialise) + deriving stock (Eq, Ord, Show, Enum, Bounded, Generic) + deriving anyclass Serialise -- | Severity of a message data SeverityS @@ -286,13 +289,14 @@ data SeverityS | Critical -- ^ Severe situations | Alert -- ^ Take immediate action | Emergency -- ^ System is unusable - deriving (Show, Eq, Ord, Bounded, Enum, Read, AE.ToJSON, AE.FromJSON, Generic, Serialise) + deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Generic) + deriving anyclass (AE.ToJSON, AE.FromJSON, Serialise) -- | Severity for a filter -- Nothing means don't show anything (Silence) -- Nothing level means show messages with severity >= level newtype SeverityF = SeverityF (Maybe SeverityS) - deriving (Eq) + deriving stock Eq instance Enum SeverityF where toEnum 8 = SeverityF Nothing @@ -351,7 +355,7 @@ data FormattedMessage = | FormattedMachine Text | FormattedMetrics [Metric] | FormattedForwarder TraceObject - deriving (Eq, Show) + deriving stock (Eq, Show) data PreFormatted = PreFormatted { @@ -373,7 +377,11 @@ data TraceObject = TraceObject { , toTimestamp :: !UTCTime , toHostname :: !Text , toThreadId :: !Text -} deriving (Eq, Show) +} deriving stock + (Eq, Show, Generic) + -- ^ Instances for 'TraceObject' to forward it using 'trace-forward' library. + deriving anyclass + (Serialise, ShowProxy) -- | data BackendConfig = @@ -382,7 +390,7 @@ data BackendConfig = | EKGBackend | DatapointBackend | PrometheusSimple Bool (Maybe HostName) PortNumber -- boolean: drop suffixes like "_int" in exposition; default: False - deriving (Eq, Ord, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) instance AE.ToJSON BackendConfig where toJSON Forwarder = AE.String "Forwarder" @@ -428,7 +436,7 @@ data FormatLogging = HumanFormatColoured | HumanFormatUncoloured | MachineFormat - deriving (Eq, Ord, Show) + deriving stock (Eq, Ord, Show) -- Configuration options for individual namespace elements data ConfigOption = @@ -442,11 +450,11 @@ data ConfigOption = -- | Construct a limiter with limiting to the Double, -- which represents frequency in number of messages per second | ConfLimiter {maxFrequency :: Double} - deriving (Eq, Ord, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) newtype ForwarderAddr = LocalSocket FilePath - deriving (Eq, Ord, Show) + deriving stock (Eq, Ord, Show) instance AE.FromJSON ForwarderAddr where parseJSON = AE.withObject "ForwarderAddr" $ \o -> LocalSocket <$> o AE..: "filePath" @@ -458,14 +466,15 @@ data ForwarderMode = -- | Forwarder works as a server: it accepts network connection from -- 'cardano-tracer' and/or another Haskell acceptor application. | Responder - deriving (Eq, Ord, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) data Verbosity = -- | Maximum verbosity for all tracers in the forwarding protocols. Maximum -- | Minimum verbosity, the forwarding will work as silently as possible. | Minimum - deriving (Eq, Ord, Show, Generic, AE.ToJSON) + deriving stock (Eq, Ord, Show, Generic) + deriving anyclass AE.ToJSON instance AE.FromJSON Verbosity where parseJSON (AE.String "Maximum") = pure Maximum @@ -478,7 +487,8 @@ data TraceOptionForwarder = TraceOptionForwarder { , tofDisconnQueueSize :: Word , tofVerbosity :: Verbosity , tofMaxReconnectDelay :: Word -} deriving (Eq, Generic, Ord, Show, AE.ToJSON) +} deriving stock (Eq, Ord, Show, Generic) + deriving anyclass AE.ToJSON -- A word regarding queue sizes: -- In case of a missing forwarding service consumer, traces messages will be @@ -533,8 +543,7 @@ data TraceConfig = TraceConfig { -- | Optional resource trace frequency in milliseconds. , tcResourceFrequency :: Maybe Int } - deriving (Eq, Ord, Show) - + deriving stock (Eq, Ord, Show) emptyTraceConfig :: TraceConfig emptyTraceConfig = TraceConfig { @@ -572,7 +581,7 @@ data LogDoc = LogDoc { , ldFiltered :: ![SeverityF] , ldLimiter :: ![(Text, Double)] , ldSilent :: Bool -} deriving(Eq, Show) +} deriving stock (Eq, Show) emptyLogDoc :: Text -> [(Text, Text)] -> LogDoc emptyLogDoc d m = LogDoc d (Map.fromList m) [] Nothing Nothing Nothing [] [] [] [] False @@ -587,14 +596,3 @@ instance LogFormatting b => LogFormatting (Folding a b) where forMachine v (Folding b) = forMachine v b forHuman (Folding b) = forHuman b asMetrics (Folding b) = asMetrics b - ---------------------------------------------------------------------------- --- Instances for 'TraceObject' to forward it using 'trace-forward' library. - -deriving instance Generic LoggingContext -deriving instance Generic TraceObject - -instance Serialise LoggingContext -instance Serialise TraceObject - -instance ShowProxy TraceObject diff --git a/trace-dispatcher/src/Cardano/Logging/Types/NodeInfo.hs b/trace-dispatcher/src/Cardano/Logging/Types/NodeInfo.hs new file mode 100644 index 00000000000..df38d875792 --- /dev/null +++ b/trace-dispatcher/src/Cardano/Logging/Types/NodeInfo.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# Language DerivingStrategies #-} +{-# Language DeriveAnyClass #-} + +module Cardano.Logging.Types.NodeInfo + ( NodeInfo (..) + ) + where + +import Control.DeepSeq (NFData) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) + +-- | NodeInfo + +data NodeInfo = NodeInfo + { niName :: Text + , niProtocol :: Text + , niVersion :: Text + , niCommit :: Text + , niStartTime :: UTCTime + , niSystemStartTime :: UTCTime + } + deriving stock (Eq, Show, Generic) + deriving anyclass (NFData, ToJSON, FromJSON) diff --git a/trace-dispatcher/src/Cardano/Logging/Types/NodePeers.hs b/trace-dispatcher/src/Cardano/Logging/Types/NodePeers.hs new file mode 100644 index 00000000000..336a58b5ab9 --- /dev/null +++ b/trace-dispatcher/src/Cardano/Logging/Types/NodePeers.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} + +module Cardano.Logging.Types.NodePeers + ( NodePeers (..) + , PeerInfoPP + ) + where + +import Control.DeepSeq (NFData) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +type PeerInfoPP = Text -- The result of 'ppPeer' function. + +-- | This type contains an information about current peers of the node. +-- It will be asked by external applications as a DataPoint. +newtype NodePeers = NodePeers [PeerInfoPP] + deriving stock Generic + deriving anyclass (NFData, ToJSON, FromJSON) diff --git a/trace-dispatcher/src/Cardano/Logging/Types/NodeStartupInfo.hs b/trace-dispatcher/src/Cardano/Logging/Types/NodeStartupInfo.hs new file mode 100644 index 00000000000..59f5dc249ad --- /dev/null +++ b/trace-dispatcher/src/Cardano/Logging/Types/NodeStartupInfo.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# Language DerivingStrategies #-} +{-# Language DeriveAnyClass #-} + +module Cardano.Logging.Types.NodeStartupInfo + ( NodeStartupInfo (..) + ) + where + +import Control.DeepSeq (NFData) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import Data.Time (NominalDiffTime) +import Data.Word (Word64) +import GHC.Generics (Generic) + +-- | NodeStartupInfo + +-- | This information is taken from 'BasicInfoShelleyBased'. It is required for +-- 'cardano-tracer' service (particularly, for RTView). +data NodeStartupInfo = NodeStartupInfo + { suiEra :: Text + , suiSlotLength :: NominalDiffTime + , suiEpochLength :: Word64 + , suiSlotsPerKESPeriod :: Word64 + } + deriving stock + (Eq, Show, Generic) + deriving anyclass + (NFData, ToJSON, FromJSON) diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 790b4d58866..d728272b0cb 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -42,6 +42,9 @@ library Cardano.Logging.Tracer.Forward Cardano.Logging.Tracer.Composed Cardano.Logging.Types + Cardano.Logging.Types.NodeInfo + Cardano.Logging.Types.NodePeers + Cardano.Logging.Types.NodeStartupInfo Cardano.Logging.Utils Cardano.Logging.Version Control.Tracer.Arrow From 8dc2cbe3b67ef21fa78320e81fd21aa95a7b9932 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Baldur=20Bl=C3=B6ndal?= Date: Thu, 3 Apr 2025 08:58:04 +0100 Subject: [PATCH 2/4] cardano-tracer: Hide mkTimer module, change STM to IORef. --- cardano-tracer/cardano-tracer.cabal | 4 +- .../Tracer/Handlers/Notifications/Timer.hs | 139 ++++++++++++------ .../Tracer/Handlers/Notifications/Utils.hs | 2 +- trace-dispatcher/src/Cardano/Logging/Types.hs | 2 +- 4 files changed, 96 insertions(+), 51 deletions(-) diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 2900c5ca717..61767134154 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -129,7 +129,6 @@ library Cardano.Tracer.Handlers.Notifications.Email Cardano.Tracer.Handlers.Notifications.Send Cardano.Tracer.Handlers.Notifications.Settings - Cardano.Tracer.Handlers.Notifications.Timer Cardano.Tracer.Handlers.Notifications.Types Cardano.Tracer.Handlers.Notifications.Utils @@ -147,7 +146,8 @@ library Cardano.Tracer.Types Cardano.Tracer.Utils - other-modules: Paths_cardano_tracer + other-modules: Cardano.Tracer.Handlers.Notifications.Timer + Paths_cardano_tracer autogen-modules: Paths_cardano_tracer if flag(rtview) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs index e8ec1bf19f2..afee0141313 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs @@ -1,68 +1,113 @@ -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE StrictData #-} module Cardano.Tracer.Handlers.Notifications.Timer ( PeriodInSec - , Timer + , Timer(..) , mkTimer - , setCallPeriod - , startTimer - , stopTimer + , mkTimerStderr + , mkTimerStderrDieOnFailure + , mkTimerDieOnFailure ) where -import Control.Concurrent (forkIO) -import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO) -import Control.Monad (forever, void) +import "trace-dispatcher" Cardano.Logging.Types (Trace(..)) +import Cardano.Tracer.MetaTrace (TracerTrace(TracerError), traceWith, stderrShowTracer) +import Control.Concurrent (forkIO, myThreadId, killThread) +import Control.Exception import Control.Monad.Extra (whenM) +import Data.IORef (newIORef, readIORef, modifyIORef') +import Data.Kind (Type) import Data.Word (Word32) +import qualified Data.Text as Text (pack) +import GHC.Conc (threadStatus, ThreadStatus (ThreadRunning)) import System.Time.Extra (sleep) +type PeriodInSec :: Type type PeriodInSec = Word32 +checkPeriod :: PeriodInSec +checkPeriod = 1 + +traceOnly :: Trace IO TracerTrace -> String -> IO () +traceOnly tracer = + traceWith tracer . TracerError . Text.pack + +type Timer :: Type data Timer = Timer - { tCallPeriod :: !(TVar PeriodInSec) - , tElapsedTime :: !(TVar PeriodInSec) - , tIsRunning :: !(TVar Bool) + { threadAlive :: !(IO Bool) + , threadKill :: !(IO ()) + , setCallPeriod :: !(PeriodInSec -> IO ()) + , startTimer :: !(IO ()) + , stopTimer :: !(IO ()) } mkTimer + :: Trace IO TracerTrace + -> IO () + -> Bool + -> PeriodInSec + -> IO Timer +mkTimer = mkTimerOnFailure (pure ()) + +mkTimerStderr + :: IO () + -> Bool + -> PeriodInSec + -> IO Timer +mkTimerStderr = mkTimer stderrShowTracer + +mkTimerStderrDieOnFailure + :: IO () + -> Bool + -> PeriodInSec + -> IO Timer +mkTimerStderrDieOnFailure = mkTimerDieOnFailure stderrShowTracer + +mkTimerDieOnFailure + :: Trace IO TracerTrace + -> IO () + -> Bool + -> PeriodInSec + -> IO Timer +mkTimerDieOnFailure = mkTimerOnFailure (killThread =<< myThreadId) + +mkTimerOnFailure :: IO () + -> Trace IO TracerTrace + -> IO () -> Bool -> PeriodInSec -> IO Timer -mkTimer ioAction state callPeriodInS = do - callPeriod <- newTVarIO callPeriodInS - elapsedTime <- newTVarIO 0 - isRunning <- newTVarIO state - - void . forkIO $ forever $ do - sleep $ fromIntegral checkPeriod - whenM (readTVarIO isRunning) $ do - period <- readTVarIO callPeriod - elapsed <- readTVarIO elapsedTime - if elapsed < period - then - -- Ok, just continue to wait. - atomically $ modifyTVar' elapsedTime $ \current -> current + checkPeriod - else do - -- Done, we are ready to call the action. - ioAction - -- Reset elapsed time. - atomically $ modifyTVar' elapsedTime . const $ 0 - - return $ - Timer - { tCallPeriod = callPeriod - , tElapsedTime = elapsedTime - , tIsRunning = isRunning - } - where - checkPeriod :: PeriodInSec - checkPeriod = 1 - -startTimer, stopTimer :: Timer -> IO () -startTimer Timer{tIsRunning} = atomically $ modifyTVar' tIsRunning . const $ True -stopTimer Timer{tIsRunning} = atomically $ modifyTVar' tIsRunning . const $ False - -setCallPeriod :: Timer -> PeriodInSec -> IO () -setCallPeriod Timer{tCallPeriod} p = atomically $ modifyTVar' tCallPeriod . const $ p +mkTimerOnFailure onFailure tracer io state callPeriod_sec = do + callPeriod <- newIORef callPeriod_sec + elapsedTime <- newIORef 0 + isRunning <- newIORef state + + let wait :: IO () = modifyIORef' elapsedTime (+ checkPeriod) + let reset :: IO () = modifyIORef' elapsedTime (const 0) + let tryIO :: IO () = try @SomeException io >>= \case + Left exception -> do + traceOnly tracer (displayException exception) + onFailure + _ -> reset + + let run :: IO () + run = do + sleep (fromIntegral checkPeriod) + whenM (readIORef isRunning) do + period <- readIORef callPeriod + elapsed <- readIORef elapsedTime + if elapsed < period then wait else tryIO + run + + threadId <- forkIO run + + pure Timer + { threadAlive = (== ThreadRunning) <$> threadStatus threadId + , threadKill = killThread threadId + , setCallPeriod = modifyIORef' callPeriod . const + , startTimer = modifyIORef' isRunning (const True) + , stopTimer = modifyIORef' isRunning (const False) + } diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs index aee4e91a755..03f9175148b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs @@ -41,7 +41,7 @@ initEventsQueues tracer rtvSD nodesNames dpReqs curDPLock = do lastTime <- newTVarIO nullTime let mkEventQueue ident (evsS, evsP) = do evsQ <- newTBQueueIO 2000 - evsT <- mkTimer + evsT <- mkTimer tracer (makeAndSendNotification tracer emailSettings nodesNames dpReqs curDPLock lastTime evsQ) evsS evsP pure (ident, (evsQ, evsT)) diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 9424e848c05..378890dbda1 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -82,7 +82,7 @@ import Network.Socket (PortNumber) -- | The Trace carries the underlying tracer Tracer from the contra-tracer package. -- It adds a 'LoggingContext' and maybe a 'TraceControl' to every message. newtype Trace m a = Trace - {unpackTrace :: T.Tracer m (LoggingContext, Either TraceControl a)} + {unpackTrace :: T.Tracer m (LoggingContext, Either TraceControl a)} -- | Contramap lifted to Trace instance Monad m => T.Contravariant (Trace m) where From d462eaa8bb8f0981ebdd7e192e1134db415a85c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Baldur=20Bl=C3=B6ndal?= Date: Mon, 7 Apr 2025 13:54:19 +0100 Subject: [PATCH 3/4] cardano-tracer: Make `rpMaxAgeMinutes` optional. --- cardano-tracer/src/Cardano/Tracer/Configuration.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/cardano-tracer/src/Cardano/Tracer/Configuration.hs b/cardano-tracer/src/Cardano/Tracer/Configuration.hs index ebfa3518837..e307120918b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Configuration.hs +++ b/cardano-tracer/src/Cardano/Tracer/Configuration.hs @@ -72,12 +72,19 @@ data RotationParams = RotationParams deriving stock (Eq, Generic, Show) deriving anyclass ToJSON +-- | Some fields are defaulted: +-- +-- `rpFrequencySecs` defaults to 1 minute. +-- +-- Max age for `RotationParams` can be specified in `rpMaxAgeMinutes` +-- or `rpMaxAgeHours`: otherwise defaulting to 24 hours. instance FromJSON RotationParams where parseJSON = withObject "RotationParams" \o -> do rpFrequencySecs <- o .: "rpFrequencySecs" + <|> pure 60 rpLogLimitBytes <- o .: "rpLogLimitBytes" rpMaxAgeMinutes <- o .: "rpMaxAgeMinutes" - <|> (o .: "rpMaxAgeHours" <&> (* 60)) + <|> o .: "rpMaxAgeHours" <&> (* 60) <|> pure (24 * 60) rpKeepFilesNum <- o .: "rpKeepFilesNum" pure RotationParams{..} From fe833d0498a134ba41be1d90c2ba86cad03b17c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Baldur=20Bl=C3=B6ndal?= Date: Tue, 29 Apr 2025 10:26:53 +0100 Subject: [PATCH 4/4] Fixed trailing whitespace. --- cardano-node/ChangeLog.md | 7 ++++--- cardano-node/src/Cardano/Node/Startup.hs | 4 ++-- cardano-tracer/CHANGELOG.md | 8 ++++--- cardano-tracer/cardano-tracer.cabal | 21 +++++++++---------- .../src/Cardano/Tracer/Configuration.hs | 10 ++++----- .../Tracer/Handlers/Notifications/Timer.hs | 7 +++---- .../Handlers/RTView/Update/NodeState.hs | 15 ++++++++----- trace-dispatcher/CHANGELOG.md | 7 ++++--- trace-dispatcher/src/Cardano/Logging/Types.hs | 6 +++--- .../Cardano/Logging/Types/NodeStartupInfo.hs | 4 ++-- 10 files changed, 48 insertions(+), 41 deletions(-) diff --git a/cardano-node/ChangeLog.md b/cardano-node/ChangeLog.md index b95c0b58644..01e76cac5ab 100644 --- a/cardano-node/ChangeLog.md +++ b/cardano-node/ChangeLog.md @@ -2,9 +2,10 @@ ## Next version -- Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` from - `cardano-tracer:Cardano.Node.Startup`to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`, and `NodePeers` from - `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`. +* Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` + (from `cardano-tracer:Cardano.Node.Startup` to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`), `NodePeers` + (from `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`), and + `NodeStartupInfo` (from `cardano-tracer:Cardano.Node.Startup` to `cardano-node:Cardano.Node.Tracing.NodeStartupInfo.hs`). - Add a new configuration field for fork-policy. diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index 2effe07a9e9..f76332ada13 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -136,14 +136,14 @@ data StartupTrace blk = | LedgerPeerSnapshotLoaded (WithOrigin SlotNo) | MovedTopLevelOption String -data EnabledBlockForging +data EnabledBlockForging = EnabledBlockForging | DisabledBlockForging | NotEffective -- ^ one needs to send `SIGHUP` after consensus -- initialised itself (especially after replying all -- blocks). - deriving stock + deriving stock (Eq, Show) data BasicInfoCommon = BasicInfoCommon { diff --git a/cardano-tracer/CHANGELOG.md b/cardano-tracer/CHANGELOG.md index 03045c71fae..3d7f2425d42 100644 --- a/cardano-tracer/CHANGELOG.md +++ b/cardano-tracer/CHANGELOG.md @@ -1,9 +1,11 @@ # ChangeLog ## 0.3.3 (April, 2025) -* Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` from - `cardano-tracer:Cardano.Node.Startup`to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`, and `NodePeers` from - `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`. +* Redesigned `Cardano.Tracer.Handlers.Notifications.Timer` interface with IO-actions instead of TVars. +* Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` + (from `cardano-tracer:Cardano.Node.Startup` to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`), `NodePeers` + (from `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`), and + `NodeStartupInfo` (from `cardano-tracer:Cardano.Node.Startup` to `cardano-node:Cardano.Node.Tracing.NodeStartupInfo.hs`). ## 0.3.2 (March 2025) diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 61767134154..72269ef80cc 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -193,10 +193,9 @@ library , string-qq , text , time - , trace-dispatcher ^>= 2.8.1 + , trace-dispatcher ^>= 2.9 , trace-forward ^>= 2.2.10 , trace-resources ^>= 0.2.3 - , unordered-containers , wai ^>= 3.2 , warp ^>= 3.4 , yaml @@ -251,11 +250,11 @@ library demo-forwarder-lib , generic-data , network-mux , optparse-applicative-fork >= 0.18.1 - , ouroboros-network-api ^>= 0.12 + , ouroboros-network-api ^>= 0.13 , ouroboros-network-framework , tasty-quickcheck , time - , trace-dispatcher ^>= 2.8.1 + , trace-dispatcher ^>= 2.9 , trace-forward ^>= 2.2.10 , vector , vector-algorithms @@ -294,7 +293,7 @@ library demo-acceptor-lib , filepath , generic-data , optparse-applicative-fork >= 0.18.1 - , ouroboros-network-api ^>= 0.12 + , ouroboros-network-api ^>= 0.13 , stm <2.5.2 || >=2.5.3 , text , tasty-quickcheck @@ -353,14 +352,14 @@ test-suite cardano-tracer-test , generic-data , network-mux , optparse-applicative-fork >= 0.18.1 - , ouroboros-network-api ^>= 0.12 + , ouroboros-network-api ^>= 0.13 , ouroboros-network-framework , stm <2.5.2 || >=2.5.3 , tasty , tasty-quickcheck , text , time - , trace-dispatcher ^>= 2.8.1 + , trace-dispatcher ^>= 2.9 , trace-forward ^>= 2.2.10 , unix-compat , vector @@ -412,8 +411,8 @@ test-suite cardano-tracer-test-ext , Glob , network-mux , optparse-applicative-fork >= 0.18.1 - , ouroboros-network ^>= 0.19.0.3 - , ouroboros-network-api ^>= 0.12 + , ouroboros-network ^>= 0.20 + , ouroboros-network-api ^>= 0.13 , ouroboros-network-framework , process , QuickCheck @@ -421,7 +420,7 @@ test-suite cardano-tracer-test-ext , tasty-quickcheck , text , time - , trace-dispatcher ^>= 2.8.1 + , trace-dispatcher ^>= 2.9 , trace-forward ^>= 2.2.10 , unix-compat , vector @@ -448,7 +447,7 @@ benchmark cardano-tracer-bench , extra , filepath , time - , trace-dispatcher ^>= 2.8.1 + , trace-dispatcher ^>= 2.9 ghc-options: -threaded -rtsopts diff --git a/cardano-tracer/src/Cardano/Tracer/Configuration.hs b/cardano-tracer/src/Cardano/Tracer/Configuration.hs index e307120918b..213f47038db 100644 --- a/cardano-tracer/src/Cardano/Tracer/Configuration.hs +++ b/cardano-tracer/src/Cardano/Tracer/Configuration.hs @@ -72,10 +72,10 @@ data RotationParams = RotationParams deriving stock (Eq, Generic, Show) deriving anyclass ToJSON --- | Some fields are defaulted: --- --- `rpFrequencySecs` defaults to 1 minute. --- +-- | Some fields are defaulted: +-- +-- `rpFrequencySecs` defaults to 1 minute. +-- -- Max age for `RotationParams` can be specified in `rpMaxAgeMinutes` -- or `rpMaxAgeHours`: otherwise defaulting to 24 hours. instance FromJSON RotationParams where @@ -84,7 +84,7 @@ instance FromJSON RotationParams where <|> pure 60 rpLogLimitBytes <- o .: "rpLogLimitBytes" rpMaxAgeMinutes <- o .: "rpMaxAgeMinutes" - <|> o .: "rpMaxAgeHours" <&> (* 60) + <|> (o .: "rpMaxAgeHours" <&> (* 60)) <|> pure (24 * 60) rpKeepFilesNum <- o .: "rpKeepFilesNum" pure RotationParams{..} diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs index afee0141313..7369e6b7c67 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs @@ -30,7 +30,7 @@ checkPeriod :: PeriodInSec checkPeriod = 1 traceOnly :: Trace IO TracerTrace -> String -> IO () -traceOnly tracer = +traceOnly tracer = traceWith tracer . TracerError . Text.pack type Timer :: Type @@ -48,7 +48,7 @@ mkTimer -> Bool -> PeriodInSec -> IO Timer -mkTimer = mkTimerOnFailure (pure ()) +mkTimer = mkTimerOnFailure (pure ()) mkTimerStderr :: IO () @@ -89,7 +89,7 @@ mkTimerOnFailure onFailure tracer io state callPeriod_sec = do let tryIO :: IO () = try @SomeException io >>= \case Left exception -> do traceOnly tracer (displayException exception) - onFailure + onFailure _ -> reset let run :: IO () @@ -110,4 +110,3 @@ mkTimerOnFailure onFailure tracer io state callPeriod_sec = do , startTimer = modifyIORef' isRunning (const True) , stopTimer = modifyIORef' isRunning (const False) } - diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs index 949c9884331..81c8ef247e2 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs @@ -7,7 +7,6 @@ module Cardano.Tracer.Handlers.RTView.Update.NodeState , askNSetNodeState ) where --- import Cardano.Node.Tracing.StateRep import Data.Aeson import Data.Aeson.Types (Parser) import Cardano.Tracer.Environment @@ -18,7 +17,7 @@ import Cardano.Tracer.Handlers.RTView.Utils import Cardano.Tracer.Types import Control.Monad.Extra (whenJustM) -import Data.Text (Text, pack) +import Data.Text (Text, pack, unpack) import Text.Printf (printf) import Graphics.UI.Threepenny.Core (UI, liftIO) @@ -68,6 +67,12 @@ instance FromJSON NodeStateWrapper where parseJSON = withObject "NodeState" \obj -> do -- Check if this is a NodeAddBlock constructor, verify that it's -- AddedToCurrentChain and extract the Double. - "NodeAddBlock" :: Text <- obj .: "tag" - [_, _, double] <- obj .: "contents" - pure (NodeStateWrapper double) + tag :: Text <- obj .: "tag" + unless (tag == "NodeAddBlock") do + fail ("parseJSON @NodeStateWrapper: Expected tag 'NodeAddBlock', but got: " ++ unpack tag) + contents <- obj .: "contents" + withArray "contents" \arr -> do + unless (V.length arr == 3) do + fail ("parseJSON @NodeStateWrapper: Expected contents array of length 3, but got: " ++ show arr) + double <- parseJSON (arr V.! 2) + pure (NodeStateWrapper double) diff --git a/trace-dispatcher/CHANGELOG.md b/trace-dispatcher/CHANGELOG.md index 763946f08d7..27271b633df 100644 --- a/trace-dispatcher/CHANGELOG.md +++ b/trace-dispatcher/CHANGELOG.md @@ -1,9 +1,10 @@ # Revision history for trace-dispatcher ## 2.9.1 (April, 2025) -* Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` from - `cardano-tracer:Cardano.Node.Startup`to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`, and `NodePeers` from - `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`. +* Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` + (from `cardano-tracer:Cardano.Node.Startup` to `trace-dispatcher:Cardano.Logging.Types.NodeInfo`), `NodePeers` + (from `cardano-node:Cardano.Node.Tracing.Peers` to `trace-dispatcher:Cardano.Logging.Types.NodePeers`), and + `NodeStartupInfo` (from `cardano-tracer:Cardano.Node.Startup` to `cardano-node:Cardano.Node.Tracing.NodeStartupInfo.hs`). ## 2.9 -- Mar 2025 diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 378890dbda1..b50a79c776c 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -2,9 +2,9 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-partial-fields #-} @@ -252,7 +252,7 @@ data LoggingContext = LoggingContext { , lcPrivacy :: Maybe Privacy , lcDetails :: Maybe DetailLevel } - deriving stock + deriving stock (Show, Generic) deriving anyclass Serialise @@ -377,7 +377,7 @@ data TraceObject = TraceObject { , toTimestamp :: !UTCTime , toHostname :: !Text , toThreadId :: !Text -} deriving stock +} deriving stock (Eq, Show, Generic) -- ^ Instances for 'TraceObject' to forward it using 'trace-forward' library. deriving anyclass diff --git a/trace-dispatcher/src/Cardano/Logging/Types/NodeStartupInfo.hs b/trace-dispatcher/src/Cardano/Logging/Types/NodeStartupInfo.hs index 59f5dc249ad..9ea7d1b4bbb 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types/NodeStartupInfo.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types/NodeStartupInfo.hs @@ -23,8 +23,8 @@ data NodeStartupInfo = NodeStartupInfo , suiSlotLength :: NominalDiffTime , suiEpochLength :: Word64 , suiSlotsPerKESPeriod :: Word64 - } - deriving stock + } + deriving stock (Eq, Show, Generic) deriving anyclass (NFData, ToJSON, FromJSON)