diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index 3aa1532b216..fa4369bdfa1 100644 --- 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/CHANGELOG.md b/cardano-tracer/CHANGELOG.md index 7ecad637a02..1ba54c9db31 100644 --- a/cardano-tracer/CHANGELOG.md +++ b/cardano-tracer/CHANGELOG.md @@ -1,5 +1,9 @@ # ChangeLog +## 0.3.2 (February 24, 2025) + +* Introduce symbolic links. + ## 0.3.1 (January 22, 2025) * Fix race condition when querying `NodeInfo` data point, occasionally resulting in fallback `NodeName`s instead of proper ones. diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 1896fd4396c..6d7e06bf995 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: cardano-tracer -version: 0.3.1 +version: 0.3.2 synopsis: A service for logging and monitoring over Cardano nodes description: A service for logging and monitoring over Cardano nodes. category: Cardano, @@ -164,7 +164,7 @@ library , bimap , blaze-html , bytestring - , cardano-node + -- , cardano-node , cborg , containers , contra-tracer diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/File.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/File.hs index 5390c9837ab..f8998d6278b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/File.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/File.hs @@ -7,7 +7,7 @@ module Cardano.Tracer.Handlers.Logs.File import Cardano.Logging (TraceObject (..)) import Cardano.Tracer.Configuration -import Cardano.Tracer.Handlers.Logs.Utils +import Cardano.Tracer.Handlers.Logs.Utils (createEmptyLogRotationAndSymlink) import Cardano.Tracer.Types import Cardano.Tracer.Utils (nl, readRegistry) @@ -57,7 +57,7 @@ writeTraceObjectsToFile registry loggingParams@LoggingParams{logRoot, logFormat} let subDirForLogs :: FilePath subDirForLogs = rootDirAbs T.unpack nodeName - createEmptyLogRotation currentLogLock key registry subDirForLogs + createEmptyLogRotationAndSymlink currentLogLock key registry subDirForLogs handles <- readRegistry registry let handle = fst (fromJust (Map.lookup key handles)) BS8.hPutStr handle preparedLines diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs index 4e63baf87ed..d801e9588b8 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs @@ -7,8 +7,7 @@ module Cardano.Tracer.Handlers.Logs.Rotator import Cardano.Tracer.Configuration import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.Logs.Utils (createOrUpdateEmptyLog, getTimeStampFromLog, - isItLog) +import Cardano.Tracer.Handlers.Logs.Utils import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey, NodeName) import Cardano.Tracer.Utils (showProblemIfAny, readRegistry) @@ -134,7 +133,7 @@ checkIfCurrentLogIsFull -> IO () checkIfCurrentLogIsFull currentLogLock handle key registry maxSizeInBytes subDirForLogs = whenM logIsFull do - createOrUpdateEmptyLog currentLogLock key registry subDirForLogs + createEmptyLogRotationAndUpdateSymlink currentLogLock key registry subDirForLogs where logIsFull :: IO Bool diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Utils.hs index fcc732f70b1..b099c27c86e 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Utils.hs @@ -2,7 +2,8 @@ module Cardano.Tracer.Handlers.Logs.Utils ( createOrUpdateEmptyLog - , createEmptyLogRotation + , createEmptyLogRotationAndSymlink + , createEmptyLogRotationAndUpdateSymlink , getTimeStampFromLog , isItLog , logExtension @@ -11,18 +12,21 @@ module Cardano.Tracer.Handlers.Logs.Utils ) where import Cardano.Tracer.Configuration (LogFormat (..), LoggingParams (..)) -import Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey) +import Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey, HandleRegistryMap) import Cardano.Tracer.Utils (modifyRegistry_) +import Control.Monad.Extra (whenM) +-- import Control.Concurrent.MVar (MVar) -- newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar_) import Control.Concurrent.Extra (Lock, withLock) import Data.Foldable (for_) import qualified Data.Map as Map import Data.Maybe (isJust) +-- import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime) import Data.Time.Clock.System (getSystemTime, systemToUTCTime) import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM) -import System.Directory (createDirectoryIfMissing) +import System.Directory (createDirectoryIfMissing, createFileLink, doesFileExist, renamePath, removeFile) import System.FilePath (takeBaseName, takeExtension, takeFileName, (<.>), ()) import System.IO (IOMode (WriteMode), hClose, openFile) @@ -35,7 +39,11 @@ logExtension ForMachine = ".json" -- | An example of the valid log name: 'node-2021-11-29T09-55-04.json'. isItLog :: LogFormat -> FilePath -> Bool -isItLog format pathToLog = hasProperPrefix && hasTimestamp && hasProperExt +isItLog format pathToLog = and + [ hasProperPrefix + , hasTimestamp + , hasProperExt + ] where fileName = takeFileName pathToLog hasProperPrefix = T.pack logPrefix `T.isPrefixOf` T.pack fileName @@ -47,38 +55,83 @@ isItLog format pathToLog = hasProperPrefix && hasTimestamp && hasProperExt maybeTimestamp = T.drop (length logPrefix) . T.pack . takeBaseName $ fileName -createEmptyLogRotation +symLinkName :: LogFormat -> FilePath +symLinkName format = "node" <.> logExtension format + +symLinkNameTmp :: LogFormat -> FilePath +symLinkNameTmp format = symLinkName format <.> "tmp" + +createEmptyLogRotationAndSymlink :: Lock -> HandleRegistryKey -> HandleRegistry -> FilePath -> IO () -createEmptyLogRotation currentLogLock key registry subDirForLogs = do +createEmptyLogRotationAndSymlink currentLogLock key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do -- The root directory (as a parent for subDirForLogs) will be created as well if needed. - createDirectoryIfMissing True subDirForLogs - createOrUpdateEmptyLog currentLogLock key registry subDirForLogs + withLock currentLogLock do + newLog <- createOrUpdateEmptyLog key registry subDirForLogs + let + symLink :: FilePath + symLink = subDirForLogs symLinkName format --- | Create an empty log file (with the current timestamp in the name). -createOrUpdateEmptyLog :: Lock -> HandleRegistryKey -> HandleRegistry -> FilePath -> IO () -createOrUpdateEmptyLog currentLogLock key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do + appendFile "/tmp/mylog" ("one: symlink: " ++ symLink ++ "\n\n") + whenM (doesFileExist symLink) do + appendFile "/tmp/mylog" ("one: symlink exists, rm: " ++ symLink ++ "\n\n") + removeFile symLink + createFileLink newLog symLink + appendFile "/tmp/mylog" ("one: createFileLink newLog (" ++ newLog ++ ") symLink (" ++ symLink ++ ")\n\n") + +createEmptyLogRotationAndUpdateSymlink + :: Lock + -> HandleRegistryKey + -> HandleRegistry + -> FilePath + -> IO () +createEmptyLogRotationAndUpdateSymlink currentLogLock key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do + -- The root directory (as a parent for subDirForLogs) will be created as well if needed. + createDirectoryIfMissing True subDirForLogs withLock currentLogLock do - ts <- formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime - let pathToLog = subDirForLogs logPrefix <> ts <.> logExtension format + newLog <- createOrUpdateEmptyLog key registry subDirForLogs + let + symLink, tmpLink :: FilePath + symLink = subDirForLogs symLinkName format + tmpLink = subDirForLogs symLinkNameTmp format + appendFile "/tmp/mylog" ("two: symlink: " ++ symLink ++ "\n\n") + appendFile "/tmp/mylog" ("two: tmplink: " ++ tmpLink ++ "\n") + whenM (doesFileExist tmpLink) do + appendFile "/tmp/mylog" ("two: tmplink exists, rm: " ++ tmpLink ++ "\n\n") + removeFile tmpLink + createFileLink newLog tmpLink + appendFile "/tmp/mylog" ("two: createFileLink newLog (" ++ newLog ++ ") tmpLink (" ++ tmpLink ++ ")\n\n") + renamePath tmpLink symLink + appendFile "/tmp/mylog" ("two: renamePath tmpLink (" ++ tmpLink ++ ") symLink (" ++ symLink ++ ")\n\n") - modifyRegistry_ registry \handles -> do +-- | Create an empty log file (with the current timestamp in the name). +createOrUpdateEmptyLog :: HandleRegistryKey -> HandleRegistry -> FilePath -> IO FilePath +createOrUpdateEmptyLog key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do + formattedTime :: String <- + formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime + let + pathToLog :: FilePath + pathToLog = subDirForLogs logPrefix <> formattedTime <.> logExtension format + modifyRegistry_ registry \(handles :: HandleRegistryMap) -> do - for_ @Maybe (Map.lookup key handles) \(handle, _filePath) -> - hClose handle + for_ @Maybe (Map.lookup key handles) \(handle, _filePath) -> + hClose handle - newHandle <- openFile pathToLog WriteMode - let newMap = Map.insert key (newHandle, pathToLog) handles - pure newMap + newHandle <- openFile pathToLog WriteMode + let newMap :: HandleRegistryMap + newMap = Map.insert key (newHandle, pathToLog) handles + pure newMap + pure pathToLog getTimeStampFromLog :: FilePath -> Maybe UTCTime -getTimeStampFromLog pathToLog = - parseTimeM True defaultTimeLocale timeStampFormat timeStamp - where +getTimeStampFromLog pathToLog = let + timeStamp :: String timeStamp = drop (length logPrefix) . takeBaseName . takeFileName $ pathToLog + in + parseTimeM True defaultTimeLocale timeStampFormat timeStamp timeStampFormat :: String timeStampFormat = "%Y-%m-%dT%H-%M-%S" diff --git a/cardano-tracer/src/Cardano/Tracer/Types.hs b/cardano-tracer/src/Cardano/Tracer/Types.hs index 312958649c0..f017a277e57 100644 --- a/cardano-tracer/src/Cardano/Tracer/Types.hs +++ b/cardano-tracer/src/Cardano/Tracer/Types.hs @@ -11,6 +11,7 @@ module Cardano.Tracer.Types , ProtocolsBrake , Registry (..) , HandleRegistry + , HandleRegistryMap , HandleRegistryKey ) where @@ -65,8 +66,11 @@ type ProtocolsBrake = TVar Bool type Registry :: Type -> Type -> Type newtype Registry a b = Registry { getRegistry :: MVar (Map a b) } +type HandleRegistry :: Type +type HandleRegistry = Registry HandleRegistryKey (Handle, FilePath) + type HandleRegistryKey :: Type type HandleRegistryKey = (NodeName, LoggingParams) -type HandleRegistry :: Type -type HandleRegistry = Registry HandleRegistryKey (Handle, FilePath) +type HandleRegistryMap :: Type +type HandleRegistryMap = Map HandleRegistryKey (Handle, FilePath) diff --git a/cardano-tracer/src/Cardano/Tracer/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Utils.hs index e4c0af37525..25449eec882 100644 --- a/cardano-tracer/src/Cardano/Tracer/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Utils.hs @@ -35,6 +35,7 @@ module Cardano.Tracer.Utils , lookupRegistry , elemsRegistry , clearRegistry + , modifyRegistry , modifyRegistry_ , readRegistry , getProcessId @@ -60,7 +61,7 @@ import Control.Applicative (liftA2, liftA3) import Control.Concurrent (killThread, mkWeakThreadId, myThreadId) import Control.Concurrent.Async (Concurrently(..)) import Control.Concurrent.Extra (Lock) -import Control.Concurrent.MVar (newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar_) +import Control.Concurrent.MVar (newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar, modifyMVar_) import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TVar (modifyTVar', stateTVar, readTVarIO, newTVarIO) import Control.Exception (SomeAsyncException (..), SomeException, finally, fromException, @@ -302,6 +303,9 @@ clearRegistry registry@(Registry mvar) = do void do swapMVar mvar Map.empty +modifyRegistry :: Registry a b -> (Map.Map a b -> IO (Map.Map a b, res)) -> IO res +modifyRegistry (Registry registry) = modifyMVar registry + modifyRegistry_ :: Registry a b -> (Map.Map a b -> IO (Map.Map a b)) -> IO () modifyRegistry_ (Registry registry) = modifyMVar_ registry diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 086613cb073..c312a1605c1 100644 --- 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,7 +367,7 @@ data TraceObject = TraceObject { , toTimestamp :: !UTCTime , toHostname :: !HostName , toThreadId :: !Text -} deriving (Eq, Show) +} deriving stock (Eq, Show) -- | data BackendConfig = @@ -370,7 +375,7 @@ data BackendConfig = | 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)) +