{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Node.Tracers (
    -- * All tracers of a node bundled together
    Tracers
  , Tracers' (..)
  , nullTracers
  , showTracers
    -- * Specific tracers
  , TraceForgeEvent (..)
  , TraceLabelCreds (..)
  ) where

import           Control.Exception (SomeException)
import           Control.Tracer (Tracer, nullTracer, showTracing)
import           Data.Text (Text)
import           Data.Time (UTCTime)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime
import           Ouroboros.Consensus.Forecast (OutsideForecastRange)
import           Ouroboros.Consensus.Genesis.Governor (TraceGDDEvent)
import           Ouroboros.Consensus.Ledger.Extended (ExtValidationError)
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Mempool (MempoolSize, TraceEventMempool)
import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                     (TraceBlockFetchServerEvent)
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                     (TraceChainSyncClientEvent)
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
                     (TraceChainSyncServerEvent)
import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
                     (TraceLocalTxSubmissionServerEvent (..))
import           Ouroboros.Consensus.Node.GSM (TraceGsmEvent)
import           Ouroboros.Network.Block (Tip)
import           Ouroboros.Network.BlockFetch (FetchDecision,
                     TraceFetchClientState, TraceLabelPeer)
import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient)
import           Ouroboros.Network.TxSubmission.Inbound
                     (TraceTxSubmissionInbound)
import           Ouroboros.Network.TxSubmission.Outbound
                     (TraceTxSubmissionOutbound)

{-------------------------------------------------------------------------------
  All tracers of a node bundled together
-------------------------------------------------------------------------------}

data Tracers' remotePeer localPeer blk f = Tracers
  { forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
chainSyncClientTracer         :: f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
chainSyncServerHeaderTracer   :: f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceChainSyncServerEvent blk)
chainSyncServerBlockTracer    :: f (TraceChainSyncServerEvent blk)
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f [TraceLabelPeer
        remotePeer (FetchDecision [Point (Header blk)])]
blockFetchDecisionTracer      :: f [TraceLabelPeer remotePeer (FetchDecision [Point (Header blk)])]
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceFetchClientState (Header blk)))
blockFetchClientTracer        :: f (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
blockFetchServerTracer        :: f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
txInboundTracer               :: f (TraceLabelPeer remotePeer (TraceTxSubmissionInbound  (GenTxId blk) (GenTx blk)))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
txOutboundTracer              :: f (TraceLabelPeer remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLocalTxSubmissionServerEvent blk)
localTxSubmissionServerTracer :: f (TraceLocalTxSubmissionServerEvent blk)
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f (TraceEventMempool blk)
mempoolTracer                 :: f (TraceEventMempool blk)
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelCreds (TraceForgeEvent blk))
forgeTracer                   :: f (TraceLabelCreds (TraceForgeEvent blk))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceBlockchainTimeEvent UTCTime)
blockchainTimeTracer          :: f (TraceBlockchainTimeEvent UTCTime)
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoTracer          :: f (TraceLabelCreds (ForgeStateInfo blk))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceKeepAliveClient remotePeer)
keepAliveClientTracer         :: f (TraceKeepAliveClient remotePeer)
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f SanityCheckIssue
consensusSanityCheckTracer    :: f SanityCheckIssue
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f SomeException
consensusErrorTracer          :: f SomeException
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f (TraceGsmEvent (Tip blk))
gsmTracer                     :: f (TraceGsmEvent (Tip blk))
  , forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceGDDEvent remotePeer blk)
gddTracer                     :: f (TraceGDDEvent remotePeer blk)
  }

instance (forall a. Semigroup (f a))
      => Semigroup (Tracers' remotePeer localPeer blk f) where
  Tracers' remotePeer localPeer blk f
l <> :: Tracers' remotePeer localPeer blk f
-> Tracers' remotePeer localPeer blk f
-> Tracers' remotePeer localPeer blk f
<> Tracers' remotePeer localPeer blk f
r = Tracers
      { chainSyncClientTracer :: f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
chainSyncClientTracer         = (Tracers' remotePeer localPeer blk f
 -> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk)))
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
chainSyncClientTracer
      , chainSyncServerHeaderTracer :: f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
chainSyncServerHeaderTracer   = (Tracers' remotePeer localPeer blk f
 -> f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk)))
-> f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
chainSyncServerHeaderTracer
      , chainSyncServerBlockTracer :: f (TraceChainSyncServerEvent blk)
chainSyncServerBlockTracer    = (Tracers' remotePeer localPeer blk f
 -> f (TraceChainSyncServerEvent blk))
-> f (TraceChainSyncServerEvent blk)
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceChainSyncServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceChainSyncServerEvent blk)
chainSyncServerBlockTracer
      , blockFetchDecisionTracer :: f [TraceLabelPeer remotePeer (FetchDecision [Point (Header blk)])]
blockFetchDecisionTracer      = (Tracers' remotePeer localPeer blk f
 -> f [TraceLabelPeer
         remotePeer (FetchDecision [Point (Header blk)])])
-> f [TraceLabelPeer
        remotePeer (FetchDecision [Point (Header blk)])]
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f [TraceLabelPeer
        remotePeer (FetchDecision [Point (Header blk)])]
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f [TraceLabelPeer
        remotePeer (FetchDecision [Point (Header blk)])]
blockFetchDecisionTracer
      , blockFetchClientTracer :: f (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
blockFetchClientTracer        = (Tracers' remotePeer localPeer blk f
 -> f (TraceLabelPeer
         remotePeer (TraceFetchClientState (Header blk))))
-> f (TraceLabelPeer
        remotePeer (TraceFetchClientState (Header blk)))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceFetchClientState (Header blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceFetchClientState (Header blk)))
blockFetchClientTracer
      , blockFetchServerTracer :: f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
blockFetchServerTracer        = (Tracers' remotePeer localPeer blk f
 -> f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk)))
-> f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
blockFetchServerTracer
      , txInboundTracer :: f (TraceLabelPeer
     remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
txInboundTracer               = (Tracers' remotePeer localPeer blk f
 -> f (TraceLabelPeer
         remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
txInboundTracer
      , txOutboundTracer :: f (TraceLabelPeer
     remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
txOutboundTracer              = (Tracers' remotePeer localPeer blk f
 -> f (TraceLabelPeer
         remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))))
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
txOutboundTracer
      , localTxSubmissionServerTracer :: f (TraceLocalTxSubmissionServerEvent blk)
localTxSubmissionServerTracer = (Tracers' remotePeer localPeer blk f
 -> f (TraceLocalTxSubmissionServerEvent blk))
-> f (TraceLocalTxSubmissionServerEvent blk)
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLocalTxSubmissionServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLocalTxSubmissionServerEvent blk)
localTxSubmissionServerTracer
      , mempoolTracer :: f (TraceEventMempool blk)
mempoolTracer                 = (Tracers' remotePeer localPeer blk f -> f (TraceEventMempool blk))
-> f (TraceEventMempool blk)
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f -> f (TraceEventMempool blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f (TraceEventMempool blk)
mempoolTracer
      , forgeTracer :: f (TraceLabelCreds (TraceForgeEvent blk))
forgeTracer                   = (Tracers' remotePeer localPeer blk f
 -> f (TraceLabelCreds (TraceForgeEvent blk)))
-> f (TraceLabelCreds (TraceForgeEvent blk))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLabelCreds (TraceForgeEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelCreds (TraceForgeEvent blk))
forgeTracer
      , blockchainTimeTracer :: f (TraceBlockchainTimeEvent UTCTime)
blockchainTimeTracer          = (Tracers' remotePeer localPeer blk f
 -> f (TraceBlockchainTimeEvent UTCTime))
-> f (TraceBlockchainTimeEvent UTCTime)
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceBlockchainTimeEvent UTCTime)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceBlockchainTimeEvent UTCTime)
blockchainTimeTracer
      , forgeStateInfoTracer :: f (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoTracer          = (Tracers' remotePeer localPeer blk f
 -> f (TraceLabelCreds (ForgeStateInfo blk)))
-> f (TraceLabelCreds (ForgeStateInfo blk))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceLabelCreds (ForgeStateInfo blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoTracer
      , keepAliveClientTracer :: f (TraceKeepAliveClient remotePeer)
keepAliveClientTracer         = (Tracers' remotePeer localPeer blk f
 -> f (TraceKeepAliveClient remotePeer))
-> f (TraceKeepAliveClient remotePeer)
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceKeepAliveClient remotePeer)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceKeepAliveClient remotePeer)
keepAliveClientTracer
      , consensusSanityCheckTracer :: f SanityCheckIssue
consensusSanityCheckTracer    = (Tracers' remotePeer localPeer blk f -> f SanityCheckIssue)
-> f SanityCheckIssue
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f -> f SanityCheckIssue
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f SanityCheckIssue
consensusSanityCheckTracer
      , consensusErrorTracer :: f SomeException
consensusErrorTracer          = (Tracers' remotePeer localPeer blk f -> f SomeException)
-> f SomeException
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f -> f SomeException
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f SomeException
consensusErrorTracer
      , gsmTracer :: f (TraceGsmEvent (Tip blk))
gsmTracer                     = (Tracers' remotePeer localPeer blk f
 -> f (TraceGsmEvent (Tip blk)))
-> f (TraceGsmEvent (Tip blk))
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f -> f (TraceGsmEvent (Tip blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f (TraceGsmEvent (Tip blk))
gsmTracer
      , gddTracer :: f (TraceGDDEvent remotePeer blk)
gddTracer                     = (Tracers' remotePeer localPeer blk f
 -> f (TraceGDDEvent remotePeer blk))
-> f (TraceGDDEvent remotePeer blk)
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceGDDEvent remotePeer blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceGDDEvent remotePeer blk)
gddTracer
      }
    where
      f :: forall a. Semigroup a
        => (Tracers' remotePeer localPeer blk f -> a) -> a
      f :: forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f -> a
prj = Tracers' remotePeer localPeer blk f -> a
prj Tracers' remotePeer localPeer blk f
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Tracers' remotePeer localPeer blk f -> a
prj Tracers' remotePeer localPeer blk f
r

-- | A record of 'Tracer's for the node.
type Tracers m remotePeer localPeer blk =
     Tracers'  remotePeer localPeer blk (Tracer m)

-- | Use a 'nullTracer' for each of the 'Tracer's in 'Tracers'
nullTracers :: Monad m => Tracers m remotePeer localPeer blk
nullTracers :: forall (m :: * -> *) remotePeer localPeer blk.
Monad m =>
Tracers m remotePeer localPeer blk
nullTracers = Tracers
    { chainSyncClientTracer :: Tracer
  m (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
chainSyncClientTracer         = Tracer
  m (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , chainSyncServerHeaderTracer :: Tracer
  m (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
chainSyncServerHeaderTracer   = Tracer
  m (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , chainSyncServerBlockTracer :: Tracer m (TraceChainSyncServerEvent blk)
chainSyncServerBlockTracer    = Tracer m (TraceChainSyncServerEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , blockFetchDecisionTracer :: Tracer
  m [TraceLabelPeer remotePeer (FetchDecision [Point (Header blk)])]
blockFetchDecisionTracer      = Tracer
  m [TraceLabelPeer remotePeer (FetchDecision [Point (Header blk)])]
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , blockFetchClientTracer :: Tracer
  m (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
blockFetchClientTracer        = Tracer
  m (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , blockFetchServerTracer :: Tracer
  m (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
blockFetchServerTracer        = Tracer
  m (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , txInboundTracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
txInboundTracer               = Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , txOutboundTracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
txOutboundTracer              = Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , localTxSubmissionServerTracer :: Tracer m (TraceLocalTxSubmissionServerEvent blk)
localTxSubmissionServerTracer = Tracer m (TraceLocalTxSubmissionServerEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , mempoolTracer :: Tracer m (TraceEventMempool blk)
mempoolTracer                 = Tracer m (TraceEventMempool blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , forgeTracer :: Tracer m (TraceLabelCreds (TraceForgeEvent blk))
forgeTracer                   = Tracer m (TraceLabelCreds (TraceForgeEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , blockchainTimeTracer :: Tracer m (TraceBlockchainTimeEvent UTCTime)
blockchainTimeTracer          = Tracer m (TraceBlockchainTimeEvent UTCTime)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , forgeStateInfoTracer :: Tracer m (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoTracer          = Tracer m (TraceLabelCreds (ForgeStateInfo blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , keepAliveClientTracer :: Tracer m (TraceKeepAliveClient remotePeer)
keepAliveClientTracer         = Tracer m (TraceKeepAliveClient remotePeer)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , consensusSanityCheckTracer :: Tracer m SanityCheckIssue
consensusSanityCheckTracer    = Tracer m SanityCheckIssue
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , consensusErrorTracer :: Tracer m SomeException
consensusErrorTracer          = Tracer m SomeException
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , gsmTracer :: Tracer m (TraceGsmEvent (Tip blk))
gsmTracer                     = Tracer m (TraceGsmEvent (Tip blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , gddTracer :: Tracer m (TraceGDDEvent remotePeer blk)
gddTracer                     = Tracer m (TraceGDDEvent remotePeer blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    }

showTracers :: ( Show blk
               , Show (GenTx blk)
               , Show (Validated (GenTx blk))
               , Show (GenTxId blk)
               , Show (ApplyTxErr blk)
               , Show (Header blk)
               , Show (ForgeStateInfo blk)
               , Show (ForgeStateUpdateError blk)
               , Show (CannotForge blk)
               , Show remotePeer
               , LedgerSupportsProtocol blk
               )
            => Tracer m String -> Tracers m remotePeer localPeer blk
showTracers :: forall blk remotePeer (m :: * -> *) localPeer.
(Show blk, Show (GenTx blk), Show (Validated (GenTx blk)),
 Show (GenTxId blk), Show (ApplyTxErr blk), Show (Header blk),
 Show (ForgeStateInfo blk), Show (ForgeStateUpdateError blk),
 Show (CannotForge blk), Show remotePeer,
 LedgerSupportsProtocol blk) =>
Tracer m String -> Tracers m remotePeer localPeer blk
showTracers Tracer m String
tr = Tracers
    { chainSyncClientTracer :: Tracer
  m (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
chainSyncClientTracer         = Tracer m String
-> Tracer
     m (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , chainSyncServerHeaderTracer :: Tracer
  m (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
chainSyncServerHeaderTracer   = Tracer m String
-> Tracer
     m (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , chainSyncServerBlockTracer :: Tracer m (TraceChainSyncServerEvent blk)
chainSyncServerBlockTracer    = Tracer m String -> Tracer m (TraceChainSyncServerEvent blk)
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , blockFetchDecisionTracer :: Tracer
  m [TraceLabelPeer remotePeer (FetchDecision [Point (Header blk)])]
blockFetchDecisionTracer      = Tracer m String
-> Tracer
     m [TraceLabelPeer remotePeer (FetchDecision [Point (Header blk)])]
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , blockFetchClientTracer :: Tracer
  m (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
blockFetchClientTracer        = Tracer m String
-> Tracer
     m (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , blockFetchServerTracer :: Tracer
  m (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
blockFetchServerTracer        = Tracer m String
-> Tracer
     m (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , txInboundTracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
txInboundTracer               = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , txOutboundTracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
txOutboundTracer              = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , localTxSubmissionServerTracer :: Tracer m (TraceLocalTxSubmissionServerEvent blk)
localTxSubmissionServerTracer = Tracer m String -> Tracer m (TraceLocalTxSubmissionServerEvent blk)
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , mempoolTracer :: Tracer m (TraceEventMempool blk)
mempoolTracer                 = Tracer m String -> Tracer m (TraceEventMempool blk)
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , forgeTracer :: Tracer m (TraceLabelCreds (TraceForgeEvent blk))
forgeTracer                   = Tracer m String -> Tracer m (TraceLabelCreds (TraceForgeEvent blk))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , blockchainTimeTracer :: Tracer m (TraceBlockchainTimeEvent UTCTime)
blockchainTimeTracer          = Tracer m String -> Tracer m (TraceBlockchainTimeEvent UTCTime)
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , forgeStateInfoTracer :: Tracer m (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoTracer          = Tracer m String -> Tracer m (TraceLabelCreds (ForgeStateInfo blk))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , keepAliveClientTracer :: Tracer m (TraceKeepAliveClient remotePeer)
keepAliveClientTracer         = Tracer m String -> Tracer m (TraceKeepAliveClient remotePeer)
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , consensusSanityCheckTracer :: Tracer m SanityCheckIssue
consensusSanityCheckTracer    = Tracer m String -> Tracer m SanityCheckIssue
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , consensusErrorTracer :: Tracer m SomeException
consensusErrorTracer          = Tracer m String -> Tracer m SomeException
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , gsmTracer :: Tracer m (TraceGsmEvent (Tip blk))
gsmTracer                     = Tracer m String -> Tracer m (TraceGsmEvent (Tip blk))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , gddTracer :: Tracer m (TraceGDDEvent remotePeer blk)
gddTracer                     = Tracer m String -> Tracer m (TraceGDDEvent remotePeer blk)
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    }

{-------------------------------------------------------------------------------
  Specific tracers
-------------------------------------------------------------------------------}

-- | Trace the forging of a block as a slot leader.
--
-- The flow of trace events here can be visualized as follows:
--
-- > TraceStartLeadershipCheck
-- >          |
-- >          +--- TraceSlotIsImmutable (leadership check failed)
-- >          |
-- >          +--- TraceBlockFromFuture (leadership check failed)
-- >          |
-- >  TraceBlockContext
-- >          |
-- >          +--- TraceNoLedgerState (leadership check failed)
-- >          |
-- >   TraceLedgerState
-- >          |
-- >          +--- TraceNoLedgerView (leadership check failed)
-- >          |
-- >   TraceLedgerView
-- >          |
-- >          +--- TraceForgeStateUpdateError (leadership check failed)
-- >          |
-- >          +--- TraceNodeCannotForge (leadership check failed)
-- >          |
-- >          +--- TraceNodeNotLeader
-- >          |
-- >   TraceNodeIsLeader
-- >          |
-- >    TraceForgedBlock
-- >          |
-- >          +--- TraceDidntAdoptBlock
-- >          |
-- >          +--- TraceForgedInvalidBlock
-- >          |
-- >  TraceAdoptedBlock
data TraceForgeEvent blk
    -- | Start of the leadership check
    --
    -- We record the current slot number.
  = TraceStartLeadershipCheck SlotNo

    -- | Leadership check failed: the tip of the ImmutableDB inhabits the
    -- current slot
    --
    -- This might happen in two cases.
    --
    --  1. the clock moved backwards, on restart we ignored everything from the
    --     VolatileDB since it's all in the future, and now the tip of the
    --     ImmutableDB points to a block produced in the same slot we're trying
    --     to produce a block in
    --
    --  2. k = 0 and we already adopted a block from another leader of the same
    --     slot.
    --
    -- We record both the current slot number as well as the tip of the
    -- ImmutableDB.
    --
    -- See also <https://github.com/IntersectMBO/ouroboros-network/issues/1462>
  | TraceSlotIsImmutable SlotNo (Point blk) BlockNo

    -- | Leadership check failed: the current chain contains a block from a slot
    -- /after/ the current slot
    --
    -- This can only happen if the system is under heavy load.
    --
    -- We record both the current slot number as well as the slot number of the
    -- block at the tip of the chain.
    --
    -- See also <https://github.com/IntersectMBO/ouroboros-network/issues/1462>
  | TraceBlockFromFuture SlotNo SlotNo

    -- | We found out to which block we are going to connect the block we are about
    -- to forge.
    --
    -- We record the current slot number, the block number of the block to
    -- connect to and its point.
    --
    -- Note that block number of the block we will try to forge is one more than
    -- the recorded block number.
  | TraceBlockContext SlotNo BlockNo (Point blk)

    -- | Leadership check failed: we were unable to get the ledger state for the
    -- point of the block we want to connect to
    --
    -- This can happen if after choosing which block to connect to the node
    -- switched to a different fork. We expect this to happen only rather
    -- rarely, so this certainly merits a warning; if it happens a lot, that
    -- merits an investigation.
    --
    -- We record both the current slot number as well as the point of the block
    -- we attempt to connect the new block to (that we requested the ledger
    -- state for).
  | TraceNoLedgerState SlotNo (Point blk)

    -- | We obtained a ledger state for the point of the block we want to
    -- connect to
    --
    -- We record both the current slot number as well as the point of the block
    -- we attempt to connect the new block to (that we requested the ledger
    -- state for).
  | TraceLedgerState SlotNo (Point blk)

    -- | Leadership check failed: we were unable to get the ledger view for the
    -- current slot number
    --
    -- This will only happen if there are many missing blocks between the tip of
    -- our chain and the current slot.
    --
    -- We record also the failure returned by 'forecastFor'.
  | TraceNoLedgerView SlotNo OutsideForecastRange

    -- | We obtained a ledger view for the current slot number
    --
    -- We record the current slot number.
  | TraceLedgerView SlotNo

    -- | Updating the forge state failed.
    --
    -- For example, the KES key could not be evolved anymore.
    --
    -- We record the error returned by 'updateForgeState'.
  | TraceForgeStateUpdateError SlotNo (ForgeStateUpdateError blk)

    -- | We did the leadership check and concluded that we should lead and forge
    -- a block, but cannot.
    --
    -- This should only happen rarely and should be logged with warning severity.
    --
    -- Records why we cannot forge a block.
  | TraceNodeCannotForge SlotNo (CannotForge blk)

    -- | We did the leadership check and concluded we are not the leader
    --
    -- We record the current slot number
  | TraceNodeNotLeader SlotNo

    -- | We did the leadership check and concluded we /are/ the leader
    --
    -- The node will soon forge; it is about to read its transactions from the
    -- Mempool. This will be followed by TraceForgedBlock.
  | TraceNodeIsLeader SlotNo

    -- | We ticked the ledger state for the slot of the to-be-forged block.
    --
    -- We record the current slot number and the point of the block we attempt
    -- to connect the new block to.
  | TraceForgeTickedLedgerState SlotNo (Point blk)

    -- | We acquired a mempool snapshot.
    --
    -- We record the the point of the state we are starting from (ie the point
    -- from 'TraceLedgerState') and point the mempool had most last synced wrt.
  | TraceForgingMempoolSnapshot SlotNo (Point blk) (ChainHash blk) SlotNo

    -- | We forged a block
    --
    -- We record the current slot number, the point of the predecessor, the block
    -- itself, and the total size of the mempool snapshot at the time we produced
    -- the block (which may be significantly larger than the block, due to
    -- maximum block size)
    --
    -- This will be followed by one of three messages:
    --
    -- * TraceAdoptedBlock (normally)
    -- * TraceDidntAdoptBlock (rarely)
    -- * TraceForgedInvalidBlock (hopefully never -- this would indicate a bug)
  | TraceForgedBlock SlotNo (Point blk) blk MempoolSize

    -- | We did not adopt the block we produced, but the block was valid. We
    -- must have adopted a block that another leader of the same slot produced
    -- before we got the chance of adopting our own block. This is very rare,
    -- this warrants a warning.
  | TraceDidntAdoptBlock SlotNo blk

    -- | We did not adopt the block we produced, because the adoption thread
    -- died.  Most likely because of an async exception.
  | TraceAdoptionThreadDied SlotNo blk

    -- | We forged a block that is invalid according to the ledger in the
    -- ChainDB. This means there is an inconsistency between the mempool
    -- validation and the ledger validation. This is a serious error!
  | TraceForgedInvalidBlock SlotNo blk (ExtValidationError blk)

    -- | We adopted the block we produced, we also trace the transactions
    -- that were adopted.
  | TraceAdoptedBlock SlotNo blk [Validated (GenTx blk)]

deriving instance ( LedgerSupportsProtocol blk
                  , Eq blk
                  , Eq (Validated (GenTx blk))
                  , Eq (ForgeStateUpdateError blk)
                  , Eq (CannotForge blk)
                  ) => Eq (TraceForgeEvent blk)
deriving instance ( LedgerSupportsProtocol blk
                  , Show blk
                  , Show (Validated (GenTx blk))
                  , Show (ForgeStateUpdateError blk)
                  , Show (CannotForge blk)
                  ) => Show (TraceForgeEvent blk)

-- | Label a forge-related trace event with the label associated with its
-- credentials.
--
-- This is useful when a node is running with multiple sets of credentials.
data TraceLabelCreds a = TraceLabelCreds Text a
  deriving (TraceLabelCreds a -> TraceLabelCreds a -> Bool
(TraceLabelCreds a -> TraceLabelCreds a -> Bool)
-> (TraceLabelCreds a -> TraceLabelCreds a -> Bool)
-> Eq (TraceLabelCreds a)
forall a. Eq a => TraceLabelCreds a -> TraceLabelCreds a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TraceLabelCreds a -> TraceLabelCreds a -> Bool
== :: TraceLabelCreds a -> TraceLabelCreds a -> Bool
$c/= :: forall a. Eq a => TraceLabelCreds a -> TraceLabelCreds a -> Bool
/= :: TraceLabelCreds a -> TraceLabelCreds a -> Bool
Eq, Int -> TraceLabelCreds a -> ShowS
[TraceLabelCreds a] -> ShowS
TraceLabelCreds a -> String
(Int -> TraceLabelCreds a -> ShowS)
-> (TraceLabelCreds a -> String)
-> ([TraceLabelCreds a] -> ShowS)
-> Show (TraceLabelCreds a)
forall a. Show a => Int -> TraceLabelCreds a -> ShowS
forall a. Show a => [TraceLabelCreds a] -> ShowS
forall a. Show a => TraceLabelCreds a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TraceLabelCreds a -> ShowS
showsPrec :: Int -> TraceLabelCreds a -> ShowS
$cshow :: forall a. Show a => TraceLabelCreds a -> String
show :: TraceLabelCreds a -> String
$cshowList :: forall a. Show a => [TraceLabelCreds a] -> ShowS
showList :: [TraceLabelCreds a] -> ShowS
Show, (forall a b. (a -> b) -> TraceLabelCreds a -> TraceLabelCreds b)
-> (forall a b. a -> TraceLabelCreds b -> TraceLabelCreds a)
-> Functor TraceLabelCreds
forall a b. a -> TraceLabelCreds b -> TraceLabelCreds a
forall a b. (a -> b) -> TraceLabelCreds a -> TraceLabelCreds b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TraceLabelCreds a -> TraceLabelCreds b
fmap :: forall a b. (a -> b) -> TraceLabelCreds a -> TraceLabelCreds b
$c<$ :: forall a b. a -> TraceLabelCreds b -> TraceLabelCreds a
<$ :: forall a b. a -> TraceLabelCreds b -> TraceLabelCreds a
Functor)