{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Node.Configuration.Logging
  ( LoggingLayer (..)
  , createLoggingLayer
  , shutdownLoggingLayer
  -- re-exports
  , 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

--------------------------------
-- Layer
--------------------------------

-- | The LoggingLayer interface that we can expose.
-- We want to do this since we want to be able to mock out any function tied to logging.
--
-- The good side of this is that _each function has it's own effects_
-- and that is ideal for tracking the functions effects and constraining
-- the user (programmer) of those function to use specific effects in them.
-- https://github.com/input-output-hk/cardano-sl/blob/develop/util/src/Pos/Util/Log/LogSafe.hs
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
  }

--------------------------------
-- Feature
--------------------------------

-- | Either parse a filepath into a logging 'Configuration',
--   or supply a mute 'Configuration'.
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

-- | Create logging feature for `cardano-node`
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'
    -- Re-interpret node config again, as logging 'Configuration':
    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

  -- These have to be set before the switchboard is set up.
  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
$
       -- Record node metrics, if configured
       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   -- 30 seconds
     () -> 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