cardano-tracer: Eliminate cardano-node dependency.

IntersectMBO · Mar 3, 2025 · fcc7d97 · fcc7d97
1 parent 6d25d88
commit fcc7d97
Show file tree

Hide file tree

Showing 3 changed files with 124 additions and 114 deletions.
diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs
@@ -169,98 +169,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
-  -> SomeConsensusProtocol
-  -> TraceConfig
-  -> UTCTime
-  -> IO NodeInfo
-prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do
-  nodeName <- prepareNodeName
-  return $ NodeInfo
-    { niName            = nodeName
-    , niProtocol        = pack . show . ncProtocol $ nc
-    , niVersion         = pack . showVersion $ version
-    , niCommit          = $(gitRev)
-    , niStartTime       = nodeStartTime
-    , niSystemStartTime = systemStartTime
-    }
- where
-  cfg = pInfoConfig $ fst $ Api.protocolInfo @IO pForInfo
-
-  systemStartTime :: UTCTime
-  systemStartTime =
-    case whichP of
-      Api.ByronBlockType ->
-        getSystemStartByron
-      Api.ShelleyBlockType ->
-        let DegenLedgerConfig cfgShelley = configLedger cfg
-        in getSystemStartShelley cfgShelley
-      Api.CardanoBlockType ->
-        let CardanoLedgerConfig _ cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway = configLedger cfg
-        in minimum [ getSystemStartByron
-                   , getSystemStartShelley cfgShelley
-                   , getSystemStartShelley cfgAllegra
-                   , getSystemStartShelley cfgMary
-                   , getSystemStartShelley cfgAlonzo
-                   , getSystemStartShelley cfgBabbage
-                   , getSystemStartShelley cfgConway
-                   ]
-
-  getSystemStartByron = WCT.getSystemStart . getSystemStart . configBlock $ cfg
-  getSystemStartShelley = sgSystemStart . shelleyLedgerGenesis . shelleyLedgerConfig
-
-  prepareNodeName =
-    case tcNodeName tc of
-      Just aName -> return aName
-      Nothing -> do
-        -- The user didn't specify node's name in the configuration.
-        -- In this case we should form node's name as "host_port",
-        -- where 'host' is the machine's host name and 'port' is taken
-        -- from the '--port' CLI-parameter.
-
-        let suffix :: String
-            suffix
-              | SocketConfig{ncNodePortNumber = Last (Just port)} <- ncSocketConfig nc
-              = "_" <> show port
-              | otherwise
-              = ""
-
-        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 {

diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal
@@ -164,7 +164,7 @@ library
                       , bimap
                       , blaze-html
                       , bytestring
-                      , cardano-node
+                      -- , cardano-node
                       , cborg
                       , containers
                       , contra-tracer

diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs
@@ -52,12 +52,15 @@ module Cardano.Logging.Types (
   , unfold
   , TraceObject(..)
   , PreFormatted(..)
+  , NodeInfo(..)
+  -- , prepareNodeInfo
 ) where
 
 
 import           Ouroboros.Network.Util.ShowProxy (ShowProxy (..))
 
 import           Codec.Serialise (Serialise (..))
+import           Control.DeepSeq (NFData)
 import qualified Control.Tracer as T
 import qualified Data.Aeson as AE
 import qualified Data.Aeson.Encoding as AE
@@ -103,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"
@@ -197,7 +200,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
@@ -216,7 +219,7 @@ 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
+  deriving stock Show
 
 instance Semigroup (Documented a) where
   (<>) (Documented l) (Documented r) = Documented (l ++ r)
@@ -240,7 +243,7 @@ data LoggingContext = LoggingContext {
   , lcPrivacy   :: Maybe Privacy
   , lcDetails   :: Maybe DetailLevel
   }
-  deriving Show
+  deriving stock Show
 
 emptyLoggingContext :: LoggingContext
 emptyLoggingContext = LoggingContext [] [] Nothing Nothing Nothing
@@ -251,17 +254,18 @@ data DetailLevel =
     | DNormal
     | DDetailed
     | DMaximum
-  deriving (Show, Eq, Ord, Bounded, Enum, Generic, Serialise)
+  deriving stock (Eq, Ord, Show, Enum, Bounded, Generic, Serialise)
+  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
@@ -273,13 +277,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
@@ -338,7 +343,7 @@ data FormattedMessage =
     | FormattedMachine Text
     | FormattedMetrics [Metric]
     | FormattedForwarder TraceObject
-  deriving (Eq, Show)
+  deriving stock (Eq, Show)
 
 
 data PreFormatted a = PreFormatted {
@@ -362,15 +367,15 @@ data TraceObject = TraceObject {
   , toTimestamp :: !UTCTime
   , toHostname  :: !HostName
   , toThreadId  :: !Text
-} deriving (Eq, Show)
+} deriving stock (Eq, Show)
 
 -- |
 data BackendConfig =
     Forwarder
   | Stdout FormatLogging
   | EKGBackend
   | DatapointBackend
-  deriving (Eq, Ord, Show, Generic)
+  deriving stock (Eq, Ord, Show, Generic)
 
 instance AE.ToJSON BackendConfig where
   toJSON Forwarder  = AE.String "Forwarder"
@@ -394,7 +399,7 @@ data FormatLogging =
     HumanFormatColoured
   | HumanFormatUncoloured
   | MachineFormat
-  deriving (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show)
 
 -- Configuration options for individual namespace elements
 data ConfigOption =
@@ -408,11 +413,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"
@@ -424,14 +429,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
@@ -443,7 +449,8 @@ data TraceOptionForwarder = TraceOptionForwarder {
     tofConnQueueSize    :: Word
   , tofDisconnQueueSize :: Word
   , tofVerbosity        :: Verbosity
-} 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
@@ -496,8 +503,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 {
@@ -535,7 +541,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
@@ -561,3 +567,99 @@ instance Serialise LoggingContext
 instance Serialise TraceObject
 
 instance ShowProxy TraceObject
+
+--
+
+-- TODO: experimental
+
+data NodeInfo = NodeInfo
+  { niName            :: Text
+  , niProtocol        :: Text
+  , niVersion         :: Text
+  , niCommit          :: Text
+  , niStartTime       :: UTCTime
+  , niSystemStartTime :: UTCTime
+  } deriving (Eq, Generic, AE.ToJSON, AE.FromJSON, Show)
+    deriving anyclass NFData
+
+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
+--   -> SomeConsensusProtocol
+--   -> TraceConfig
+--   -> UTCTime
+--   -> IO NodeInfo
+-- prepareNodeInfo = undefined 
+-- prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do
+--   nodeName <- prepareNodeName
+--   return $ NodeInfo
+--     { niName            = nodeName
+--     , niProtocol        = pack . show . ncProtocol $ nc
+--     , niVersion         = pack . showVersion $ version
+--     , niCommit          = $(gitRev)
+--     , niStartTime       = nodeStartTime
+--     , niSystemStartTime = systemStartTime
+--     }
+--  where
+--   cfg = pInfoConfig $ fst $ Api.protocolInfo @IO pForInfo
+
+--   systemStartTime :: UTCTime
+--   systemStartTime =
+--     case whichP of
+--       Api.ByronBlockType ->
+--         getSystemStartByron
+--       Api.ShelleyBlockType ->
+--         let DegenLedgerConfig cfgShelley = configLedger cfg
+--         in getSystemStartShelley cfgShelley
+--       Api.CardanoBlockType ->
+--         let CardanoLedgerConfig _ cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway = configLedger cfg
+--         in minimum [ getSystemStartByron
+--                    , getSystemStartShelley cfgShelley
+--                    , getSystemStartShelley cfgAllegra
+--                    , getSystemStartShelley cfgMary
+--                    , getSystemStartShelley cfgAlonzo
+--                    , getSystemStartShelley cfgBabbage
+--                    , getSystemStartShelley cfgConway
+--                    ]
+
+--   getSystemStartByron = WCT.getSystemStart . getSystemStart . configBlock $ cfg
+--   getSystemStartShelley = sgSystemStart . shelleyLedgerGenesis . shelleyLedgerConfig
+
+--   prepareNodeName =
+--     case tcNodeName tc of
+--       Just aName -> return aName
+--       Nothing -> do
+--         -- The user didn't specify node's name in the configuration.
+--         -- In this case we should form node's name as "host_port",
+--         -- where 'host' is the machine's host name and 'port' is taken
+--         -- from the '--port' CLI-parameter.
+
+--         let suffix :: String
+--             suffix
+--               | SocketConfig{ncNodePortNumber = Last (Just port)} <- ncSocketConfig nc
+--               = "_" <> show port
+--               | otherwise
+--               = ""
+
+--         hostName <- getHostName
+--         return (pack (hostName <> suffix))
+