{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.Node.Configuration.Logging
( LoggingLayer (..)
, createLoggingLayer
, shutdownLoggingLayer
, Trace
, Configuration
, LoggerName
, Severity (..)
, mkLOMeta
, LOMeta (..)
, LOContent (..)
) where
import Cardano.Prelude hiding (trace)
import qualified Control.Concurrent.Async as Async
import Control.Exception.Safe (MonadCatch)
import Control.Monad.Trans.Except.Extra (catchIOExceptT)
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.Counters (readCounters)
import Cardano.BM.Data.Backend (Backend, BackendKind)
import Cardano.BM.Data.Counter
import Cardano.BM.Data.LogItem (LOContent (..), LOMeta (..), LoggerName,
PrivacyAnnotation (..), mkLOMeta)
import Cardano.BM.Data.Observable
import Cardano.BM.Data.Severity (Severity (..))
import Cardano.BM.Data.SubTrace
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.Trace (Trace, appendName, traceNamedObject)
import qualified Cardano.BM.Trace as Trace
import Cardano.Config.Git.Rev (gitRev)
import Cardano.Node.Configuration.POM (NodeConfiguration (..))
import Cardano.Node.Types
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
}
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
-> ExceptT ConfigError IO LoggingLayer
createLoggingLayer :: Text -> NodeConfiguration -> ExceptT ConfigError IO LoggingLayer
createLoggingLayer Text
ver NodeConfiguration
nodeConfig' = 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
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 -> Trace IO Text -> LoggingLayer
mkLogLayer Configuration
logConfig Switchboard Text
switchBoard 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
$
Configuration
-> Trace IO Text -> Switchboard Text -> Text -> IO (Plugin Text)
forall a (s :: * -> *).
(IsEffectuator s a, ToJSON a, FromJSON a) =>
Configuration -> Trace IO a -> s a -> Text -> IO (Plugin a)
Cardano.BM.Backend.TraceForwarder.plugin Configuration
logConfig Trace IO Text
trace Switchboard Text
switchBoard Text
"forwarderMinSeverity"
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.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
$
Trace IO Text -> IO ()
startCapturingMetrics Trace IO Text
trace
mkLogLayer :: Configuration -> Switchboard Text -> Trace IO Text -> LoggingLayer
mkLogLayer :: Configuration -> Switchboard Text -> Trace IO Text -> LoggingLayer
mkLogLayer Configuration
logConfig Switchboard Text
switchBoard 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
-> 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
}
startCapturingMetrics :: Trace IO Text -> IO ()
startCapturingMetrics :: Trace IO Text -> IO ()
startCapturingMetrics Trace IO Text
trace0 = do
let trace :: Trace IO Text
trace = Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"node-metrics" Trace IO Text
trace0
counters :: [ObservableInstance]
counters = [ObservableInstance
MemoryStats, ObservableInstance
ProcessStats, ObservableInstance
NetStats, ObservableInstance
IOStats, ObservableInstance
GhcRtsStats, ObservableInstance
SysStats]
Async Any
_ <- IO Any -> IO (Async Any)
forall a. IO a -> IO (Async a)
Async.async (IO Any -> IO (Async Any)) -> IO Any -> IO (Async Any)
forall a b. (a -> b) -> a -> b
$ IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ do
[Counter]
cts <- SubTrace -> IO [Counter]
readCounters ([ObservableInstance] -> SubTrace
ObservableTraceSelf [ObservableInstance]
counters)
Trace IO Text -> [Counter] -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> [Counter] -> m ()
traceCounters Trace IO Text
trace [Counter]
cts
Int -> IO ()
threadDelay Int
30000000
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
traceCounters :: forall m a. MonadIO m => Trace m a -> [Counter] -> m ()
traceCounters :: Trace m a -> [Counter] -> m ()
traceCounters Trace m a
_tr [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
traceCounters Trace m a
tr (c :: Counter
c@(Counter CounterType
_ct Text
cn Measurable
cv) : [Counter]
cs) = do
LOMeta
mle <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Notice PrivacyAnnotation
Confidential
Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace m a
tr (LOMeta
mle, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue (Counter -> Text
nameCounter Counter
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cn) Measurable
cv)
Trace m a -> [Counter] -> m ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> [Counter] -> m ()
traceCounters Trace m a
tr [Counter]
cs
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