{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Tracing.Startup where

import           Prelude
import           Data.Text (Text)

import           Cardano.Logging (LogFormatting (..))
import           Cardano.Node.Startup
import           Cardano.Node.Tracing.Compat
import           Cardano.Node.Tracing.Tracers.Startup
import           Cardano.Tracing.OrphanInstances.Network ()

import           Cardano.BM.Tracing (HasPrivacyAnnotation (..),
                   HasSeverityAnnotation (..), Severity (..), ToObject (..),
                   Transformable (..))
import           Cardano.BM.Data.Tracer (HasTextFormatter (..),
                   trStructuredText)

import           Ouroboros.Consensus.Node.NetworkProtocolVersion
                   (BlockNodeToClientVersion, BlockNodeToNodeVersion)


instance HasSeverityAnnotation (StartupTrace blk) where
    getSeverityAnnotation :: StartupTrace blk -> Severity
getSeverityAnnotation (StartupSocketConfigError SocketConfigError
_) = Severity
Error
    getSeverityAnnotation (NetworkConfigUpdateError Text
_) = Severity
Error
    getSeverityAnnotation StartupTrace blk
NetworkConfigUpdateUnsupported = Severity
Warning
    getSeverityAnnotation StartupTrace blk
P2PWarning = Severity
Warning
    getSeverityAnnotation StartupTrace blk
P2PWarningDevelopementNetworkProtocols = Severity
Warning
    getSeverityAnnotation WarningDevelopmentNetworkProtocols {} = Severity
Warning
    getSeverityAnnotation StartupTrace blk
_ = Severity
Info

instance HasPrivacyAnnotation (StartupTrace blk)

instance ( Show (BlockNodeToNodeVersion blk)
         , Show (BlockNodeToClientVersion blk)
         )
      => Transformable Text IO (StartupTrace blk) where
  trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO (StartupTrace blk)
trTransformer = TracingVerbosity -> Trace IO Text -> Tracer IO (StartupTrace blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText

instance ( Show (BlockNodeToNodeVersion blk)
         , Show (BlockNodeToClientVersion blk)
         )
        => HasTextFormatter (StartupTrace blk) where
  formatText :: StartupTrace blk -> Object -> Text
formatText StartupTrace blk
a Object
_ = StartupTrace blk -> Text
forall blk.
(Show (BlockNodeToNodeVersion blk),
 Show (BlockNodeToClientVersion blk)) =>
StartupTrace blk -> Text
ppStartupInfoTrace StartupTrace blk
a

instance ( Show (BlockNodeToNodeVersion blk)
         , Show (BlockNodeToClientVersion blk)
         )
        => ToObject (StartupTrace blk) where
  toObject :: TracingVerbosity -> StartupTrace blk -> Object
toObject TracingVerbosity
verb = DetailLevel -> StartupTrace blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine (TracingVerbosity -> DetailLevel
toDetailLevel TracingVerbosity
verb)