{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.Node.Configuration.Logging
( LoggingLayer (..)
, EKGDirect(..)
, createLoggingLayer
, nodeBasicInfo
, shutdownLoggingLayer
, traceCounter
, Trace
, Configuration
, LoggerName
, Severity (..)
, mkLOMeta
, LOMeta (..)
, LOContent (..)
) where
import Cardano.Prelude hiding (trace)
import qualified Control.Concurrent as Conc
import qualified Control.Concurrent.Async as Async
import Control.Exception.Safe (MonadCatch)
import Control.Monad.Trans.Except.Extra (catchIOExceptT)
import "contra-tracer" Control.Tracer
import Data.List (nub)
import qualified Data.Map as Map
import Data.Text (pack)
import Data.Time.Clock (UTCTime, getCurrentTime)
import Data.Version (showVersion)
import System.Metrics.Counter (Counter)
import System.Metrics.Gauge (Gauge)
import System.Metrics.Label (Label)
import qualified System.Remote.Monitoring as EKG
import Cardano.BM.Backend.Aggregation (plugin)
import Cardano.BM.Backend.EKGView (plugin)
import Cardano.BM.Backend.Monitoring (plugin)
import Cardano.BM.Backend.Switchboard (Switchboard)
import qualified Cardano.BM.Backend.Switchboard as Switchboard
import Cardano.BM.Backend.TraceForwarder (plugin)
import Cardano.BM.Configuration (Configuration)
import qualified Cardano.BM.Configuration as Config
import qualified Cardano.BM.Configuration.Model as Config
import Cardano.BM.Data.Aggregated (Measurable (..))
import Cardano.BM.Data.Backend (Backend, BackendKind (..))
import Cardano.BM.Data.LogItem (LOContent (..), LOMeta (..), LoggerName)
import qualified Cardano.BM.Observer.Monadic as Monadic
import qualified Cardano.BM.Observer.STM as Stm
import Cardano.BM.Plugin (loadPlugin)
#if defined(SYSTEMD)
import Cardano.BM.Scribe.Systemd (plugin)
#endif
import Cardano.BM.Setup (setupTrace_, shutdown)
import Cardano.BM.Stats
import Cardano.BM.Stats.Resources
import qualified Cardano.BM.Trace as Trace
import Cardano.BM.Tracing
import qualified Cardano.Chain.Genesis as Gen
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as WCT
import Ouroboros.Consensus.Byron.Ledger.Conversions
import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Cardano.CanHardFork
import qualified Ouroboros.Consensus.Config as Consensus
import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
import Ouroboros.Consensus.HardFork.Combinator.Degenerate
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.Shelley.Ledger.Ledger
import Cardano.Api.Protocol.Types (BlockType (..), protocolInfo)
import Cardano.Git.Rev (gitRev)
import Cardano.Node.Configuration.POM (NodeConfiguration (..), ncProtocol)
import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
import Cardano.Node.Types
import Cardano.Slotting.Slot (EpochSize (..))
import Cardano.Tracing.Config (TraceOptions (..))
import Cardano.Tracing.OrphanInstances.Common ()
import Paths_cardano_node (version)
data LoggingLayer = LoggingLayer
{ LoggingLayer -> forall (m :: * -> *). MonadIO m => Trace m Text
llBasicTrace :: forall m. (MonadIO m) => Trace m Text
, LoggingLayer
-> forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogDebug :: forall m a. (MonadIO m, Show a) => Trace m a -> a -> m ()
, LoggingLayer
-> forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogInfo :: forall m a. (MonadIO m, Show a) => Trace m a -> a -> m ()
, LoggingLayer
-> forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogNotice :: forall m a. (MonadIO m, Show a) => Trace m a -> a -> m ()
, LoggingLayer
-> forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogWarning :: forall m a. (MonadIO m, Show a) => Trace m a -> a -> m ()
, LoggingLayer
-> forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogError :: forall m a. (MonadIO m, Show a) => Trace m a -> a -> m ()
, LoggingLayer
-> forall (m :: * -> *) a. Show a => Text -> Trace m a -> Trace m a
llAppendName :: forall m a. (Show a) => LoggerName -> Trace m a -> Trace m a
, LoggingLayer
-> forall a t.
Show a =>
Trace IO a -> Severity -> Text -> IO t -> IO t
llBracketMonadIO :: forall a t. (Show a) => Trace IO a -> Severity -> Text -> IO t -> IO t
, LoggingLayer
-> forall (m :: * -> *) a t.
(MonadCatch m, MonadIO m, Show a) =>
Trace m a -> Severity -> Text -> m t -> m t
llBracketMonadM
:: forall m a t. (MonadCatch m, MonadIO m, Show a)
=> Trace m a -> Severity -> Text -> m t -> m t
, LoggingLayer
-> forall (m :: * -> *) a t.
(MonadIO m, Show a) =>
Trace m a -> Severity -> Text -> m t -> m t
llBracketMonadX
:: forall m a t. (MonadIO m, Show a) => Trace m a -> Severity -> Text -> m t -> m t
, LoggingLayer
-> forall a t.
Show a =>
Trace IO a -> Severity -> Text -> STM t -> IO t
llBracketStmIO :: forall a t. (Show a) => Trace IO a -> Severity -> Text -> STM t -> IO t
, LoggingLayer
-> forall a t.
Show a =>
Trace IO a
-> Severity -> Text -> STM (t, [(LOMeta, LOContent a)]) -> IO t
llBracketStmLogIO
:: forall a t. (Show a)
=> Trace IO a -> Severity -> Text -> STM (t,[(LOMeta, LOContent a)]) -> IO t
, LoggingLayer -> Configuration
llConfiguration :: Configuration
, LoggingLayer -> Backend Text -> BackendKind -> IO ()
llAddBackend :: Backend Text -> BackendKind -> IO ()
, LoggingLayer -> Switchboard Text
llSwitchboard :: Switchboard Text
, LoggingLayer -> Maybe EKGDirect
llEKGDirect :: Maybe EKGDirect
}
data EKGDirect = EKGDirect
{ EKGDirect -> Server
ekgServer :: EKG.Server
, EKGDirect -> MVar (Map Text Gauge)
ekgGauges :: MVar (Map.Map Text Gauge)
, EKGDirect -> MVar (Map Text Label)
ekgLabels :: MVar (Map.Map Text Label)
, EKGDirect -> MVar (Map Text Counter)
ekgCounters :: MVar (Map.Map Text Counter)
}
loggingCLIConfiguration
:: Maybe FilePath
-> ExceptT ConfigError IO Configuration
loggingCLIConfiguration :: Maybe FilePath -> ExceptT ConfigError IO Configuration
loggingCLIConfiguration = ExceptT ConfigError IO Configuration
-> (FilePath -> ExceptT ConfigError IO Configuration)
-> Maybe FilePath
-> ExceptT ConfigError IO Configuration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExceptT ConfigError IO Configuration
emptyConfig FilePath -> ExceptT ConfigError IO Configuration
readConfig
where
readConfig :: FilePath -> ExceptT ConfigError IO Configuration
readConfig :: FilePath -> ExceptT ConfigError IO Configuration
readConfig FilePath
fp =
IO Configuration
-> (IOException -> ConfigError)
-> ExceptT ConfigError IO Configuration
forall (m :: * -> *) a x.
MonadIO m =>
IO a -> (IOException -> x) -> ExceptT x m a
catchIOExceptT (FilePath -> IO Configuration
Config.setup FilePath
fp) ((IOException -> ConfigError)
-> ExceptT ConfigError IO Configuration)
-> (IOException -> ConfigError)
-> ExceptT ConfigError IO Configuration
forall a b. (a -> b) -> a -> b
$ \(IOException
_ :: IOException) -> FilePath -> ConfigError
ConfigErrorFileNotFound FilePath
fp
emptyConfig :: ExceptT ConfigError IO Configuration
emptyConfig :: ExceptT ConfigError IO Configuration
emptyConfig = IO Configuration -> ExceptT ConfigError IO Configuration
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Configuration -> ExceptT ConfigError IO Configuration)
-> IO Configuration -> ExceptT ConfigError IO Configuration
forall a b. (a -> b) -> a -> b
$ do
Configuration
c <- IO Configuration
Config.empty
Configuration -> Severity -> IO ()
Config.setMinSeverity Configuration
c Severity
Info
Configuration -> IO Configuration
forall (f :: * -> *) a. Applicative f => a -> f a
pure Configuration
c
createLoggingLayer
:: Text
-> NodeConfiguration
-> SomeConsensusProtocol
-> ExceptT ConfigError IO LoggingLayer
createLoggingLayer :: Text
-> NodeConfiguration
-> SomeConsensusProtocol
-> ExceptT ConfigError IO LoggingLayer
createLoggingLayer Text
ver NodeConfiguration
nodeConfig' SomeConsensusProtocol
p = do
Configuration
logConfig <- Maybe FilePath -> ExceptT ConfigError IO Configuration
loggingCLIConfiguration (Maybe FilePath -> ExceptT ConfigError IO Configuration)
-> Maybe FilePath -> ExceptT ConfigError IO Configuration
forall a b. (a -> b) -> a -> b
$
if NodeConfiguration -> Bool
ncLoggingSwitch NodeConfiguration
nodeConfig'
then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (ConfigYamlFilePath -> FilePath)
-> ConfigYamlFilePath
-> Maybe FilePath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConfigYamlFilePath -> FilePath
unConfigPath (ConfigYamlFilePath -> Maybe FilePath)
-> ConfigYamlFilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ NodeConfiguration -> ConfigYamlFilePath
ncConfigFile NodeConfiguration
nodeConfig'
else Maybe FilePath
forall a. Maybe a
Nothing
IO () -> ExceptT ConfigError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ConfigError IO ())
-> IO () -> ExceptT ConfigError IO ()
forall a b. (a -> b) -> a -> b
$ do
Configuration -> Text -> Text -> IO ()
Config.setTextOption Configuration
logConfig Text
"appversion" Text
ver
Configuration -> Text -> Text -> IO ()
Config.setTextOption Configuration
logConfig Text
"appcommit" Text
gitRev
(Trace IO Text
baseTrace', Switchboard Text
switchBoard) <- IO (Trace IO Text, Switchboard Text)
-> ExceptT ConfigError IO (Trace IO Text, Switchboard Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Trace IO Text, Switchboard Text)
-> ExceptT ConfigError IO (Trace IO Text, Switchboard Text))
-> IO (Trace IO Text, Switchboard Text)
-> ExceptT ConfigError IO (Trace IO Text, Switchboard Text)
forall a b. (a -> b) -> a -> b
$ Configuration -> Text -> IO (Trace IO Text, Switchboard Text)
forall (m :: * -> *) a.
(MonadIO m, ToJSON a, FromJSON a, ToObject a) =>
Configuration -> Text -> m (Trace m a, Switchboard a)
setupTrace_ Configuration
logConfig Text
"cardano"
let loggingEnabled :: Bool
loggingEnabled :: Bool
loggingEnabled = NodeConfiguration -> Bool
ncLoggingSwitch NodeConfiguration
nodeConfig'
trace :: Trace IO Text
trace :: Trace IO Text
trace = if Bool
loggingEnabled
then Trace IO Text
baseTrace'
else Trace IO Text
forall (m :: * -> *) a. Applicative m => Tracer m a
Trace.nullTracer
Bool -> ExceptT ConfigError IO () -> ExceptT ConfigError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
loggingEnabled (ExceptT ConfigError IO () -> ExceptT ConfigError IO ())
-> ExceptT ConfigError IO () -> ExceptT ConfigError IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> ExceptT ConfigError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ConfigError IO ())
-> IO () -> ExceptT ConfigError IO ()
forall a b. (a -> b) -> a -> b
$
NodeConfiguration
-> Configuration -> Switchboard Text -> Trace IO Text -> IO ()
loggingPreInit NodeConfiguration
nodeConfig' Configuration
logConfig Switchboard Text
switchBoard Trace IO Text
trace
Maybe Server
mbEKGServer <- IO (Maybe Server) -> ExceptT ConfigError IO (Maybe Server)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Server) -> ExceptT ConfigError IO (Maybe Server))
-> IO (Maybe Server) -> ExceptT ConfigError IO (Maybe Server)
forall a b. (a -> b) -> a -> b
$ Switchboard Text -> IO (Maybe Server)
forall a. Switchboard a -> IO (Maybe Server)
Switchboard.getSbEKGServer Switchboard Text
switchBoard
Maybe EKGDirect
mbEkgDirect <- case Maybe Server
mbEKGServer of
Maybe Server
Nothing -> Maybe EKGDirect -> ExceptT ConfigError IO (Maybe EKGDirect)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe EKGDirect
forall a. Maybe a
Nothing
Just Server
sv -> do
MVar (Map Text Gauge)
refGauge <- IO (MVar (Map Text Gauge))
-> ExceptT ConfigError IO (MVar (Map Text Gauge))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (Map Text Gauge))
-> ExceptT ConfigError IO (MVar (Map Text Gauge)))
-> IO (MVar (Map Text Gauge))
-> ExceptT ConfigError IO (MVar (Map Text Gauge))
forall a b. (a -> b) -> a -> b
$ Map Text Gauge -> IO (MVar (Map Text Gauge))
forall a. a -> IO (MVar a)
newMVar Map Text Gauge
forall k a. Map k a
Map.empty
MVar (Map Text Label)
refLabel <- IO (MVar (Map Text Label))
-> ExceptT ConfigError IO (MVar (Map Text Label))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (Map Text Label))
-> ExceptT ConfigError IO (MVar (Map Text Label)))
-> IO (MVar (Map Text Label))
-> ExceptT ConfigError IO (MVar (Map Text Label))
forall a b. (a -> b) -> a -> b
$ Map Text Label -> IO (MVar (Map Text Label))
forall a. a -> IO (MVar a)
newMVar Map Text Label
forall k a. Map k a
Map.empty
MVar (Map Text Counter)
refCounter <- IO (MVar (Map Text Counter))
-> ExceptT ConfigError IO (MVar (Map Text Counter))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (Map Text Counter))
-> ExceptT ConfigError IO (MVar (Map Text Counter)))
-> IO (MVar (Map Text Counter))
-> ExceptT ConfigError IO (MVar (Map Text Counter))
forall a b. (a -> b) -> a -> b
$ Map Text Counter -> IO (MVar (Map Text Counter))
forall a. a -> IO (MVar a)
newMVar Map Text Counter
forall k a. Map k a
Map.empty
Maybe EKGDirect -> ExceptT ConfigError IO (Maybe EKGDirect)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EKGDirect -> ExceptT ConfigError IO (Maybe EKGDirect))
-> Maybe EKGDirect -> ExceptT ConfigError IO (Maybe EKGDirect)
forall a b. (a -> b) -> a -> b
$ EKGDirect -> Maybe EKGDirect
forall a. a -> Maybe a
Just EKGDirect :: Server
-> MVar (Map Text Gauge)
-> MVar (Map Text Label)
-> MVar (Map Text Counter)
-> EKGDirect
EKGDirect {
ekgServer :: Server
ekgServer = Server
sv
, ekgGauges :: MVar (Map Text Gauge)
ekgGauges = MVar (Map Text Gauge)
refGauge
, ekgLabels :: MVar (Map Text Label)
ekgLabels = MVar (Map Text Label)
refLabel
, ekgCounters :: MVar (Map Text Counter)
ekgCounters = MVar (Map Text Counter)
refCounter
}
LoggingLayer -> ExceptT ConfigError IO LoggingLayer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoggingLayer -> ExceptT ConfigError IO LoggingLayer)
-> LoggingLayer -> ExceptT ConfigError IO LoggingLayer
forall a b. (a -> b) -> a -> b
$ Configuration
-> Switchboard Text
-> Maybe EKGDirect
-> Trace IO Text
-> LoggingLayer
mkLogLayer Configuration
logConfig Switchboard Text
switchBoard Maybe EKGDirect
mbEkgDirect Trace IO Text
trace
where
loggingPreInit
:: NodeConfiguration
-> Configuration
-> Switchboard Text
-> Trace IO Text
-> IO ()
loggingPreInit :: NodeConfiguration
-> Configuration -> Switchboard Text -> Trace IO Text -> IO ()
loggingPreInit NodeConfiguration
nodeConfig Configuration
logConfig Switchboard Text
switchBoard Trace IO Text
trace = do
Configuration -> IO (Maybe Endpoint)
Config.getEKGBindAddr Configuration
logConfig IO (Maybe Endpoint) -> (Maybe Endpoint -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Endpoint
mbEndpoint ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Endpoint -> Bool
forall a. Maybe a -> Bool
isJust Maybe Endpoint
mbEndpoint) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Configuration
-> Trace IO Text -> Switchboard Text -> IO (Plugin Text)
forall (s :: * -> *) a.
(IsEffectuator s a, ToJSON a, FromJSON a) =>
Configuration -> Trace IO a -> s a -> IO (Plugin a)
Cardano.BM.Backend.EKGView.plugin Configuration
logConfig Trace IO Text
trace Switchboard Text
switchBoard
IO (Plugin Text) -> (Plugin Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Switchboard Text -> Plugin Text -> IO ()
forall a. Switchboard a -> Plugin a -> IO ()
loadPlugin Switchboard Text
switchBoard
Configuration -> IO (Maybe RemoteAddr)
Config.getForwardTo Configuration
logConfig IO (Maybe RemoteAddr) -> (Maybe RemoteAddr -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe RemoteAddr
forwardTo ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe RemoteAddr -> Bool
forall a. Maybe a -> Bool
isJust Maybe RemoteAddr
forwardTo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
UTCTime
nodeStartTime <- IO UTCTime
getCurrentTime
Configuration
-> Trace IO Text
-> Switchboard Text
-> Text
-> IO [LogObject Text]
-> IO (Plugin Text)
forall a (s :: * -> *).
(IsEffectuator s a, ToJSON a, FromJSON a) =>
Configuration
-> Trace IO a -> s a -> Text -> IO [LogObject a] -> IO (Plugin a)
Cardano.BM.Backend.TraceForwarder.plugin Configuration
logConfig
Trace IO Text
trace
Switchboard Text
switchBoard
Text
"forwarderMinSeverity"
(NodeConfiguration
-> SomeConsensusProtocol -> UTCTime -> IO [LogObject Text]
nodeBasicInfo NodeConfiguration
nodeConfig SomeConsensusProtocol
p UTCTime
nodeStartTime)
IO (Plugin Text) -> (Plugin Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Switchboard Text -> Plugin Text -> IO ()
forall a. Switchboard a -> Plugin a -> IO ()
loadPlugin Switchboard Text
switchBoard
let metricsLogger :: Text
metricsLogger = Text
"cardano.node.metrics"
errorsLoggers :: Text
errorsLoggers = Text
"cardano.node"
[Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text
metricsLogger, Text
errorsLoggers] ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
loggerName ->
Configuration -> Text -> IO [BackendKind]
Config.getBackends Configuration
logConfig Text
loggerName IO [BackendKind] -> ([BackendKind] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[BackendKind]
backends ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BackendKind
TraceForwarderBK BackendKind -> [BackendKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [BackendKind]
backends) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Configuration -> Text -> Maybe [BackendKind] -> IO ()
Config.setBackends Configuration
logConfig Text
loggerName (Maybe [BackendKind] -> IO ()) -> Maybe [BackendKind] -> IO ()
forall a b. (a -> b) -> a -> b
$ [BackendKind] -> Maybe [BackendKind]
forall a. a -> Maybe a
Just (BackendKind
TraceForwarderBK BackendKind -> [BackendKind] -> [BackendKind]
forall a. a -> [a] -> [a]
: [BackendKind]
backends)
Configuration
-> Trace IO Text -> Switchboard Text -> IO (Plugin Text)
forall (s :: * -> *) a.
(IsEffectuator s a, ToJSON a, FromJSON a) =>
Configuration -> Trace IO a -> s a -> IO (Plugin a)
Cardano.BM.Backend.Aggregation.plugin Configuration
logConfig Trace IO Text
trace Switchboard Text
switchBoard
IO (Plugin Text) -> (Plugin Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Switchboard Text -> Plugin Text -> IO ()
forall a. Switchboard a -> Plugin a -> IO ()
loadPlugin Switchboard Text
switchBoard
Configuration
-> Trace IO Text -> Switchboard Text -> IO (Plugin Text)
forall (s :: * -> *) a.
(IsEffectuator s a, ToJSON a, FromJSON a) =>
Configuration -> Trace IO a -> s a -> IO (Plugin a)
Cardano.BM.Backend.Monitoring.plugin Configuration
logConfig Trace IO Text
trace Switchboard Text
switchBoard
IO (Plugin Text) -> (Plugin Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Switchboard Text -> Plugin Text -> IO ()
forall a. Switchboard a -> Plugin a -> IO ()
loadPlugin Switchboard Text
switchBoard
#if defined(SYSTEMD)
Configuration
-> Trace IO Text -> Switchboard Text -> Text -> IO (Plugin Text)
forall (s :: * -> *) a.
(IsEffectuator s a, ToJSON a, FromJSON a) =>
Configuration -> Trace IO a -> s a -> Text -> IO (Plugin a)
Cardano.BM.Scribe.Systemd.plugin Configuration
logConfig Trace IO Text
trace Switchboard Text
switchBoard Text
"cardano"
IO (Plugin Text) -> (Plugin Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Switchboard Text -> Plugin Text -> IO ()
forall a. Switchboard a -> Plugin a -> IO ()
loadPlugin Switchboard Text
switchBoard
#endif
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NodeConfiguration -> Bool
ncLogMetrics NodeConfiguration
nodeConfig) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
TraceOptions -> Trace IO Text -> IO ()
startCapturingMetrics (NodeConfiguration -> TraceOptions
ncTraceConfig NodeConfiguration
nodeConfig) Trace IO Text
trace
mkLogLayer :: Configuration -> Switchboard Text -> Maybe EKGDirect -> Trace IO Text -> LoggingLayer
mkLogLayer :: Configuration
-> Switchboard Text
-> Maybe EKGDirect
-> Trace IO Text
-> LoggingLayer
mkLogLayer Configuration
logConfig Switchboard Text
switchBoard Maybe EKGDirect
mbEkgDirect Trace IO Text
trace =
LoggingLayer :: (forall (m :: * -> *). MonadIO m => Trace m Text)
-> (forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ())
-> (forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ())
-> (forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ())
-> (forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ())
-> (forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ())
-> (forall (m :: * -> *) a.
Show a =>
Text -> Trace m a -> Trace m a)
-> (forall a t.
Show a =>
Trace IO a -> Severity -> Text -> IO t -> IO t)
-> (forall (m :: * -> *) a t.
(MonadCatch m, MonadIO m, Show a) =>
Trace m a -> Severity -> Text -> m t -> m t)
-> (forall (m :: * -> *) a t.
(MonadIO m, Show a) =>
Trace m a -> Severity -> Text -> m t -> m t)
-> (forall a t.
Show a =>
Trace IO a -> Severity -> Text -> STM t -> IO t)
-> (forall a t.
Show a =>
Trace IO a
-> Severity -> Text -> STM (t, [(LOMeta, LOContent a)]) -> IO t)
-> Configuration
-> (Backend Text -> BackendKind -> IO ())
-> Switchboard Text
-> Maybe EKGDirect
-> LoggingLayer
LoggingLayer
{ llBasicTrace :: forall (m :: * -> *). MonadIO m => Trace m Text
llBasicTrace = (forall x. IO x -> m x)
-> Trace IO Text -> Tracer m (Text, LogObject Text)
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> Tracer m (Text, LogObject a) -> Tracer n (Text, LogObject a)
Trace.natTrace forall x. IO x -> m x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Trace IO Text
trace
, llLogDebug :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogDebug = forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
Trace.logDebug
, llLogInfo :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogInfo = forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
Trace.logInfo
, llLogNotice :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogNotice = forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
Trace.logNotice
, llLogWarning :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogWarning = forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
Trace.logWarning
, llLogError :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
llLogError = forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Trace m a -> a -> m ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
Trace.logError
, llAppendName :: forall (m :: * -> *) a. Show a => Text -> Trace m a -> Trace m a
llAppendName = forall (m :: * -> *) a. Show a => Text -> Trace m a -> Trace m a
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
Trace.appendName
, llBracketMonadIO :: forall a t.
Show a =>
Trace IO a -> Severity -> Text -> IO t -> IO t
llBracketMonadIO = Configuration -> Trace IO a -> Severity -> Text -> IO t -> IO t
forall a t.
Configuration -> Trace IO a -> Severity -> Text -> IO t -> IO t
Monadic.bracketObserveIO Configuration
logConfig
, llBracketMonadM :: forall (m :: * -> *) a t.
(MonadCatch m, MonadIO m, Show a) =>
Trace m a -> Severity -> Text -> m t -> m t
llBracketMonadM = Configuration -> Trace m a -> Severity -> Text -> m t -> m t
forall (m :: * -> *) a t.
(MonadCatch m, MonadIO m) =>
Configuration -> Trace m a -> Severity -> Text -> m t -> m t
Monadic.bracketObserveM Configuration
logConfig
, llBracketMonadX :: forall (m :: * -> *) a t.
(MonadIO m, Show a) =>
Trace m a -> Severity -> Text -> m t -> m t
llBracketMonadX = Configuration -> Trace m a -> Severity -> Text -> m t -> m t
forall (m :: * -> *) a t.
MonadIO m =>
Configuration -> Trace m a -> Severity -> Text -> m t -> m t
Monadic.bracketObserveX Configuration
logConfig
, llBracketStmIO :: forall a t.
Show a =>
Trace IO a -> Severity -> Text -> STM t -> IO t
llBracketStmIO = Configuration -> Trace IO a -> Severity -> Text -> STM t -> IO t
forall a t.
Configuration -> Trace IO a -> Severity -> Text -> STM t -> IO t
Stm.bracketObserveIO Configuration
logConfig
, llBracketStmLogIO :: forall a t.
Show a =>
Trace IO a
-> Severity -> Text -> STM (t, [(LOMeta, LOContent a)]) -> IO t
llBracketStmLogIO = Configuration
-> Trace IO a
-> Severity
-> Text
-> STM (t, [(LOMeta, LOContent a)])
-> IO t
forall a t.
Configuration
-> Trace IO a
-> Severity
-> Text
-> STM (t, [(LOMeta, LOContent a)])
-> IO t
Stm.bracketObserveLogIO Configuration
logConfig
, llConfiguration :: Configuration
llConfiguration = Configuration
logConfig
, llAddBackend :: Backend Text -> BackendKind -> IO ()
llAddBackend = Switchboard Text -> Backend Text -> BackendKind -> IO ()
forall a. Switchboard a -> Backend a -> BackendKind -> IO ()
Switchboard.addExternalBackend Switchboard Text
switchBoard
, llSwitchboard :: Switchboard Text
llSwitchboard = Switchboard Text
switchBoard
, llEKGDirect :: Maybe EKGDirect
llEKGDirect = Maybe EKGDirect
mbEkgDirect
}
startCapturingMetrics :: TraceOptions
-> Trace IO Text
-> IO ()
startCapturingMetrics :: TraceOptions -> Trace IO Text -> IO ()
startCapturingMetrics (TraceDispatcher TraceSelection
_) Trace IO Text
_tr = do
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
startCapturingMetrics TraceOptions
_ Trace IO Text
tr = do
IO (Async Any) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async Any) -> IO ())
-> (IO () -> IO (Async Any)) -> IO () -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO Any -> IO (Async Any)
forall a. IO a -> IO (Async a)
Async.async (IO Any -> IO (Async Any))
-> (IO () -> IO Any) -> IO () -> IO (Async Any)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO (Maybe ResourceStats)
readResourceStats
IO (Maybe ResourceStats) -> (Maybe ResourceStats -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> (ResourceStats -> IO ()) -> Maybe ResourceStats -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
(Trace IO Text -> ResourceStats -> IO ()
traceResourceStats
(Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"node" Trace IO Text
tr))
Int -> IO ()
Conc.threadDelay Int
1000000
traceResourceStats :: Trace IO Text -> ResourceStats -> IO ()
traceResourceStats :: Trace IO Text -> ResourceStats -> IO ()
traceResourceStats Trace IO Text
tr ResourceStats
rs = do
Tracer IO ResourceStats -> ResourceStats -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity -> Trace IO Text -> Tracer IO ResourceStats
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
NormalVerbosity (Trace IO Text -> Tracer IO ResourceStats)
-> Trace IO Text -> Tracer IO ResourceStats
forall a b. (a -> b) -> a -> b
$ Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"resources" Trace IO Text
tr) ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"Stat.cputicks" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rCentiCpu ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"Mem.resident" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rRSS ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"RTS.gcLiveBytes" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rLive ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"RTS.gcHeapBytes" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rHeap ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"RTS.gcMajorNum" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rGcsMajor ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"RTS.gcMinorNum" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rGcsMinor ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"RTS.gcticks" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rCentiGC ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"RTS.mutticks" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rCentiMut ResourceStats
rs
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"Stat.threads" Trace IO Text
tr (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceStats -> Word64
forall a. Resources a -> a
rThreads ResourceStats
rs
traceCounter
:: Text
-> Trace IO Text
-> Int
-> IO ()
traceCounter :: Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
logValueName Trace IO Text
tracer Int
aCounter = do
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Notice PrivacyAnnotation
Public
Trace IO Text -> (LOMeta, LOContent Text) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
Trace.traceNamedObject
(Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO Text
tracer)
(LOMeta
meta, Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
logValueName (Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aCounter))
shutdownLoggingLayer :: LoggingLayer -> IO ()
shutdownLoggingLayer :: LoggingLayer -> IO ()
shutdownLoggingLayer = Switchboard Text -> IO ()
forall a.
(ToJSON a, FromJSON a, ToObject a) =>
Switchboard a -> IO ()
shutdown (Switchboard Text -> IO ())
-> (LoggingLayer -> Switchboard Text) -> LoggingLayer -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LoggingLayer -> Switchboard Text
llSwitchboard
nodeBasicInfo :: NodeConfiguration
-> SomeConsensusProtocol
-> UTCTime
-> IO [LogObject Text]
nodeBasicInfo :: NodeConfiguration
-> SomeConsensusProtocol -> UTCTime -> IO [LogObject Text]
nodeBasicInfo NodeConfiguration
nc (SomeConsensusProtocol BlockType blk
whichP ProtocolInfoArgs IO blk
pForInfo) UTCTime
nodeStartTime' = do
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Notice PrivacyAnnotation
Public
let cfg :: TopLevelConfig blk
cfg = ProtocolInfo IO blk -> TopLevelConfig blk
forall (m :: * -> *) b. ProtocolInfo m b -> TopLevelConfig b
pInfoConfig (ProtocolInfo IO blk -> TopLevelConfig blk)
-> ProtocolInfo IO blk -> TopLevelConfig blk
forall a b. (a -> b) -> a -> b
$ ProtocolInfoArgs IO blk -> ProtocolInfo IO blk
forall (m :: * -> *) blk.
Protocol m blk =>
ProtocolInfoArgs m blk -> ProtocolInfo m blk
protocolInfo ProtocolInfoArgs IO blk
pForInfo
protocolDependentItems :: [(Text, Text)]
protocolDependentItems =
case BlockType blk
whichP of
BlockType blk
ByronBlockType ->
let DegenLedgerConfig PartialLedgerConfig ByronBlock
cfgByron = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
Consensus.configLedger TopLevelConfig blk
cfg
in TopLevelConfig blk -> ByronPartialLedgerConfig -> [(Text, Text)]
forall a b blk.
(IsString a, ConvertText FilePath b, ConfigSupportsNode blk) =>
TopLevelConfig blk -> ByronPartialLedgerConfig -> [(a, b)]
getGenesisValuesByron TopLevelConfig blk
cfg PartialLedgerConfig ByronBlock
ByronPartialLedgerConfig
cfgByron
BlockType blk
ShelleyBlockType ->
let DegenLedgerConfig PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) StandardShelley)
cfgShelley = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
Consensus.configLedger TopLevelConfig blk
cfg
in Text
-> ShelleyPartialLedgerConfig StandardShelley -> [(Text, Text)]
forall a b era.
(IsString a, ConvertText FilePath b, Semigroup a) =>
a -> ShelleyPartialLedgerConfig era -> [(a, b)]
getGenesisValues Text
"Shelley" PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) StandardShelley)
ShelleyPartialLedgerConfig StandardShelley
cfgShelley
BlockType blk
CardanoBlockType ->
let CardanoLedgerConfig PartialLedgerConfig ByronBlock
cfgByron PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) StandardShelley)
cfgShelley PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
cfgAllegra
PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
cfgMary PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
cfgAlonzo PartialLedgerConfig
(ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
cfgBabbage = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
Consensus.configLedger TopLevelConfig blk
cfg
in TopLevelConfig blk -> ByronPartialLedgerConfig -> [(Text, Text)]
forall a b blk.
(IsString a, ConvertText FilePath b, ConfigSupportsNode blk) =>
TopLevelConfig blk -> ByronPartialLedgerConfig -> [(a, b)]
getGenesisValuesByron TopLevelConfig blk
cfg PartialLedgerConfig ByronBlock
ByronPartialLedgerConfig
cfgByron
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text
-> ShelleyPartialLedgerConfig StandardShelley -> [(Text, Text)]
forall a b era.
(IsString a, ConvertText FilePath b, Semigroup a) =>
a -> ShelleyPartialLedgerConfig era -> [(a, b)]
getGenesisValues Text
"Shelley" PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) StandardShelley)
ShelleyPartialLedgerConfig StandardShelley
cfgShelley
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text
-> ShelleyPartialLedgerConfig (AllegraEra StandardCrypto)
-> [(Text, Text)]
forall a b era.
(IsString a, ConvertText FilePath b, Semigroup a) =>
a -> ShelleyPartialLedgerConfig era -> [(a, b)]
getGenesisValues Text
"Allegra" PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
ShelleyPartialLedgerConfig (AllegraEra StandardCrypto)
cfgAllegra
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text
-> ShelleyPartialLedgerConfig (MaryEra StandardCrypto)
-> [(Text, Text)]
forall a b era.
(IsString a, ConvertText FilePath b, Semigroup a) =>
a -> ShelleyPartialLedgerConfig era -> [(a, b)]
getGenesisValues Text
"Mary" PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
ShelleyPartialLedgerConfig (MaryEra StandardCrypto)
cfgMary
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text
-> ShelleyPartialLedgerConfig (AlonzoEra StandardCrypto)
-> [(Text, Text)]
forall a b era.
(IsString a, ConvertText FilePath b, Semigroup a) =>
a -> ShelleyPartialLedgerConfig era -> [(a, b)]
getGenesisValues Text
"Alonzo" PartialLedgerConfig
(ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
ShelleyPartialLedgerConfig (AlonzoEra StandardCrypto)
cfgAlonzo
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text
-> ShelleyPartialLedgerConfig (BabbageEra StandardCrypto)
-> [(Text, Text)]
forall a b era.
(IsString a, ConvertText FilePath b, Semigroup a) =>
a -> ShelleyPartialLedgerConfig era -> [(a, b)]
getGenesisValues Text
"Babbage" PartialLedgerConfig
(ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
ShelleyPartialLedgerConfig (BabbageEra StandardCrypto)
cfgBabbage
items :: [(Text, Text)]
items = [(Text, Text)] -> [(Text, Text)]
forall a. Eq a => [a] -> [a]
nub ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$
[ (Text
"protocol", FilePath -> Text
pack (FilePath -> Text) -> (Protocol -> FilePath) -> Protocol -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Protocol -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (Protocol -> Text) -> Protocol -> Text
forall a b. (a -> b) -> a -> b
$ NodeConfiguration -> Protocol
ncProtocol NodeConfiguration
nc)
, (Text
"version", FilePath -> Text
pack (FilePath -> Text) -> (Version -> FilePath) -> Version -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Version -> FilePath
showVersion (Version -> Text) -> Version -> Text
forall a b. (a -> b) -> a -> b
$ Version
version)
, (Text
"commit", Text
gitRev)
, (Text
"nodeStartTime", UTCTime -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show UTCTime
nodeStartTime')
] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
protocolDependentItems
logObjects :: [LogObject Text]
logObjects =
((Text, Text) -> LogObject Text)
-> [(Text, Text)] -> [LogObject Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Text
nm, Text
msg) -> Text -> LOMeta -> LOContent Text -> LogObject Text
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject (Text
"basicInfo." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm) LOMeta
meta (Text -> LOContent Text
forall a. a -> LOContent a
LogMessage Text
msg)) [(Text, Text)]
items
[LogObject Text] -> IO [LogObject Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [LogObject Text]
logObjects
where
getGenesisValuesByron :: TopLevelConfig blk -> ByronPartialLedgerConfig -> [(a, b)]
getGenesisValuesByron TopLevelConfig blk
cfg ByronPartialLedgerConfig
config =
let genesis :: LedgerConfig ByronBlock
genesis = ByronPartialLedgerConfig -> LedgerConfig ByronBlock
byronLedgerConfig ByronPartialLedgerConfig
config
in [ (a
"systemStartTime", UTCTime -> b
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (SystemStart -> UTCTime
WCT.getSystemStart (SystemStart -> UTCTime)
-> (BlockConfig blk -> SystemStart) -> BlockConfig blk -> UTCTime
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockConfig blk -> SystemStart
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> SystemStart
getSystemStart (BlockConfig blk -> UTCTime) -> BlockConfig blk -> UTCTime
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
Consensus.configBlock TopLevelConfig blk
cfg))
, (a
"slotLengthByron", NominalDiffTime -> b
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (SlotLength -> NominalDiffTime
WCT.getSlotLength (SlotLength -> NominalDiffTime)
-> (Natural -> SlotLength) -> Natural -> NominalDiffTime
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> SlotLength
fromByronSlotLength (Natural -> NominalDiffTime) -> Natural -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Config -> Natural
genesisSlotLength LedgerConfig ByronBlock
Config
genesis))
, (a
"epochLengthByron", Word64 -> b
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (EpochSize -> Word64
unEpochSize (EpochSize -> Word64)
-> (EpochSlots -> EpochSize) -> EpochSlots -> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochSlots -> EpochSize
fromByronEpochSlots (EpochSlots -> Word64) -> EpochSlots -> Word64
forall a b. (a -> b) -> a -> b
$ Config -> EpochSlots
Gen.configEpochSlots LedgerConfig ByronBlock
Config
genesis))
]
getGenesisValues :: a -> ShelleyPartialLedgerConfig era -> [(a, b)]
getGenesisValues a
era ShelleyPartialLedgerConfig era
config =
let genesis :: ShelleyGenesis era
genesis = ShelleyLedgerConfig era -> ShelleyGenesis era
forall era. ShelleyLedgerConfig era -> ShelleyGenesis era
shelleyLedgerGenesis (ShelleyLedgerConfig era -> ShelleyGenesis era)
-> ShelleyLedgerConfig era -> ShelleyGenesis era
forall a b. (a -> b) -> a -> b
$ ShelleyPartialLedgerConfig era -> ShelleyLedgerConfig era
forall era.
ShelleyPartialLedgerConfig era -> ShelleyLedgerConfig era
shelleyLedgerConfig ShelleyPartialLedgerConfig era
config
in [ (a
"systemStartTime", UTCTime -> b
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (ShelleyGenesis era -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
SL.sgSystemStart ShelleyGenesis era
genesis))
, (a
"slotLength" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
era, NominalDiffTime -> b
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (SlotLength -> NominalDiffTime
WCT.getSlotLength (SlotLength -> NominalDiffTime)
-> (NominalDiffTime -> SlotLength)
-> NominalDiffTime
-> NominalDiffTime
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NominalDiffTime -> SlotLength
WCT.mkSlotLength (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
SL.sgSlotLength ShelleyGenesis era
genesis))
, (a
"epochLength" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
era, Word64 -> b
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (EpochSize -> Word64
unEpochSize (EpochSize -> Word64)
-> (ShelleyGenesis era -> EpochSize)
-> ShelleyGenesis era
-> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyGenesis era -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
SL.sgEpochLength (ShelleyGenesis era -> Word64) -> ShelleyGenesis era -> Word64
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era
genesis))
, (a
"slotsPerKESPeriod" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
era, Word64 -> b
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgSlotsPerKESPeriod ShelleyGenesis era
genesis))
]