{-# 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.Tracer (Tracer, nullTracer, showTracing)
import           Data.Text (Text)
import           Data.Time (UTCTime)

import           Ouroboros.Network.BlockFetch (FetchDecision,
                     TraceFetchClientState, TraceLabelPeer)
import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient)
import           Ouroboros.Network.TxSubmission.Inbound
                     (TraceTxSubmissionInbound)
import           Ouroboros.Network.TxSubmission.Outbound
                     (TraceTxSubmissionOutbound)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime
import           Ouroboros.Consensus.Forecast (OutsideForecastRange)
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Mempool.API

import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                     (TraceBlockFetchServerEvent)
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                     (InvalidBlockReason, TraceChainSyncClientEvent)
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
                     (TraceChainSyncServerEvent)
import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
                     (TraceLocalTxSubmissionServerEvent (..))

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

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

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 :: forall remotePeer localPeer blk (f :: * -> *).
f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> f (TraceChainSyncServerEvent blk)
-> f (TraceChainSyncServerEvent blk)
-> f [TraceLabelPeer
        remotePeer (FetchDecision [Point (Header blk)])]
-> f (TraceLabelPeer
        remotePeer (TraceFetchClientState (Header blk)))
-> f (TraceBlockFetchServerEvent blk)
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> f (TraceLocalTxSubmissionServerEvent blk)
-> f (TraceEventMempool blk)
-> f (TraceLabelCreds (TraceForgeEvent blk))
-> f (TraceBlockchainTimeEvent UTCTime)
-> f (TraceLabelCreds (ForgeStateInfo blk))
-> f (TraceKeepAliveClient remotePeer)
-> Tracers' remotePeer localPeer blk f
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 (TraceChainSyncServerEvent blk)
chainSyncServerHeaderTracer   = (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)
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 (TraceBlockFetchServerEvent blk)
blockFetchServerTracer        = (Tracers' remotePeer localPeer blk f
 -> f (TraceBlockFetchServerEvent blk))
-> f (TraceBlockFetchServerEvent blk)
forall a.
Semigroup a =>
(Tracers' remotePeer localPeer blk f -> a) -> a
f Tracers' remotePeer localPeer blk f
-> f (TraceBlockFetchServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (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
      }
    where
      f :: forall a. Semigroup a
        => (Tracers' remotePeer localPeer blk f -> a) -> a
      f :: (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 :: Tracers m remotePeer localPeer blk
nullTracers = Tracers :: forall remotePeer localPeer blk (f :: * -> *).
f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> f (TraceChainSyncServerEvent blk)
-> f (TraceChainSyncServerEvent blk)
-> f [TraceLabelPeer
        remotePeer (FetchDecision [Point (Header blk)])]
-> f (TraceLabelPeer
        remotePeer (TraceFetchClientState (Header blk)))
-> f (TraceBlockFetchServerEvent blk)
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> f (TraceLocalTxSubmissionServerEvent blk)
-> f (TraceEventMempool blk)
-> f (TraceLabelCreds (TraceForgeEvent blk))
-> f (TraceBlockchainTimeEvent UTCTime)
-> f (TraceLabelCreds (ForgeStateInfo blk))
-> f (TraceKeepAliveClient remotePeer)
-> Tracers' remotePeer localPeer blk f
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 (TraceChainSyncServerEvent blk)
chainSyncServerHeaderTracer   = Tracer m (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 (TraceBlockFetchServerEvent blk)
blockFetchServerTracer        = Tracer m (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
    }

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 :: Tracer m String -> Tracers m remotePeer localPeer blk
showTracers Tracer m String
tr = Tracers :: forall remotePeer localPeer blk (f :: * -> *).
f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> f (TraceChainSyncServerEvent blk)
-> f (TraceChainSyncServerEvent blk)
-> f [TraceLabelPeer
        remotePeer (FetchDecision [Point (Header blk)])]
-> f (TraceLabelPeer
        remotePeer (TraceFetchClientState (Header blk)))
-> f (TraceBlockFetchServerEvent blk)
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> f (TraceLocalTxSubmissionServerEvent blk)
-> f (TraceEventMempool blk)
-> f (TraceLabelCreds (TraceForgeEvent blk))
-> f (TraceBlockchainTimeEvent UTCTime)
-> f (TraceLabelCreds (ForgeStateInfo blk))
-> f (TraceKeepAliveClient remotePeer)
-> Tracers' remotePeer localPeer blk f
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 (TraceChainSyncServerEvent blk)
chainSyncServerHeaderTracer   = Tracer m String -> Tracer m (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 (TraceBlockFetchServerEvent blk)
blockFetchServerTracer        = Tracer m String -> Tracer m (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
    }

{-------------------------------------------------------------------------------
  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/input-output-hk/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/input-output-hk/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 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 (InvalidBlockReason 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
/= :: TraceLabelCreds a -> TraceLabelCreds a -> Bool
$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
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
showList :: [TraceLabelCreds a] -> ShowS
$cshowList :: forall a. Show a => [TraceLabelCreds a] -> ShowS
show :: TraceLabelCreds a -> String
$cshow :: forall a. Show a => TraceLabelCreds a -> String
showsPrec :: Int -> TraceLabelCreds a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TraceLabelCreds a -> ShowS
Show, a -> TraceLabelCreds b -> TraceLabelCreds a
(a -> b) -> TraceLabelCreds a -> TraceLabelCreds b
(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
<$ :: a -> TraceLabelCreds b -> TraceLabelCreds a
$c<$ :: forall a b. a -> TraceLabelCreds b -> TraceLabelCreds a
fmap :: (a -> b) -> TraceLabelCreds a -> TraceLabelCreds b
$cfmap :: forall a b. (a -> b) -> TraceLabelCreds a -> TraceLabelCreds b
Functor)