cardano-node: drop the TraceLabelCreds around TraceForgeEvent tra…

…cing

cardano-node/src/Cardano/Node/Tracing/Documentation.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -381,32 +382,34 @@ docTracers configFileName outputFileName _ _ _ = do
     mempoolTrDoc <- documentTracer trConfig mempoolTr
       (docMempool :: Documented (TraceEventMempool blk))
 
-    forgeTr    <- mkCardanoTracer
+    forgeTr <-  mkCardanoTracer
                 trBase trForward mbTrEKG
                 "Forge"
                 namesForForge
                 severityForge
                 allPublic
 
     -- TODO Tracers docforgeThreadStatsTr?
-    forgeThreadStatsTr <- mkCardanoTracer'
+    forgeThreadStatsTr <-
+                mkCardanoTracer'
                 trBase trForward mbTrEKG
                 "ForgeStats"
                 namesForForge
                 severityForge
                 allPublic
                 forgeThreadStats
+
     configureTracers trConfig docForge [forgeTr, forgeThreadStatsTr]
     forgeTrDoc <- documentTracer trConfig forgeTr
       (docForge :: Documented
-        (Either (Consensus.TraceLabelCreds (Consensus.TraceForgeEvent blk))
-                (Consensus.TraceLabelCreds TraceStartLeadershipCheckPlus)))
+        (Either (Consensus.TraceForgeEvent blk)
+                TraceStartLeadershipCheckPlus))
 
     forgeThreadStatsTrDoc <- documentTracer trConfig forgeThreadStatsTr
       (docForgeStats :: Documented
         (Either
-           (Consensus.TraceLabelCreds (Consensus.TraceForgeEvent blk))
-           (Consensus.TraceLabelCreds TraceStartLeadershipCheckPlus)))
+           (Consensus.TraceForgeEvent blk)
+           TraceStartLeadershipCheckPlus))
 
     blockchainTimeTr   <- mkCardanoTracer
                 trBase trForward mbTrEKG

cardano-node/src/Cardano/Node/Tracing/Tracers.hs

@@ -360,9 +360,9 @@ mkConsensusTracers trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = d
       , Consensus.mempoolTracer = Tracer $
           traceWith mempoolTr
       , Consensus.forgeTracer =
-          Tracer (traceWith (contramap Left forgeTr))
+          Tracer (\(Consensus.TraceLabelCreds _ x) -> traceWith (contramap Left forgeTr) x)
           <> -- TODO: add the forge-thread-stats as a datapoint
-          Tracer (traceWith (contramap Left forgeThreadStatsTr))
+          Tracer (\(Consensus.TraceLabelCreds _ x) -> traceWith (contramap Left forgeThreadStatsTr) x)
       , Consensus.blockchainTimeTracer = Tracer $
           traceWith blockchainTimeTr
       , Consensus.keepAliveClientTracer = Tracer $

cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs

@@ -910,59 +910,53 @@ docMempool' = Documented [
 
 severityForge :: ForgeTracerType blk -> SeverityS
 severityForge (Left t)  = severityForge' t
-severityForge (Right t) = severityForge''' t
-
-severityForge' :: TraceLabelCreds (TraceForgeEvent blk) -> SeverityS
-severityForge' (TraceLabelCreds _t e) = severityForge'' e
-
-severityForge'' :: TraceForgeEvent blk -> SeverityS
-severityForge'' TraceStartLeadershipCheck {}  = Info
-severityForge'' TraceSlotIsImmutable {}       = Error
-severityForge'' TraceBlockFromFuture {}       = Error
-severityForge'' TraceBlockContext {}          = Debug
-severityForge'' TraceNoLedgerState {}         = Error
-severityForge'' TraceLedgerState {}           = Debug
-severityForge'' TraceNoLedgerView {}          = Error
-severityForge'' TraceLedgerView {}            = Debug
-severityForge'' TraceForgeStateUpdateError {} = Error
-severityForge'' TraceNodeCannotForge {}       = Error
-severityForge'' TraceNodeNotLeader {}         = Info
-severityForge'' TraceNodeIsLeader {}          = Info
-severityForge'' TraceForgedBlock {}           = Info
-severityForge'' TraceDidntAdoptBlock {}       = Error
-severityForge'' TraceForgedInvalidBlock {}    = Error
-severityForge'' TraceAdoptedBlock {}          = Info
-
-severityForge''' :: TraceLabelCreds TraceStartLeadershipCheckPlus -> SeverityS
-severityForge''' _ = Info
+severityForge (Right t) = severityForge'' t
+
+severityForge' :: TraceForgeEvent blk -> SeverityS
+severityForge' TraceStartLeadershipCheck {}  = Info
+severityForge' TraceSlotIsImmutable {}       = Error
+severityForge' TraceBlockFromFuture {}       = Error
+severityForge' TraceBlockContext {}          = Debug
+severityForge' TraceNoLedgerState {}         = Error
+severityForge' TraceLedgerState {}           = Debug
+severityForge' TraceNoLedgerView {}          = Error
+severityForge' TraceLedgerView {}            = Debug
+severityForge' TraceForgeStateUpdateError {} = Error
+severityForge' TraceNodeCannotForge {}       = Error
+severityForge' TraceNodeNotLeader {}         = Info
+severityForge' TraceNodeIsLeader {}          = Info
+severityForge' TraceForgedBlock {}           = Info
+severityForge' TraceDidntAdoptBlock {}       = Error
+severityForge' TraceForgedInvalidBlock {}    = Error
+severityForge' TraceAdoptedBlock {}          = Info
+
+severityForge'' :: TraceStartLeadershipCheckPlus -> SeverityS
+severityForge'' _ = Info
 
 namesForForge :: ForgeTracerType blk -> [Text]
 namesForForge (Left t)  = namesForForge' t
-namesForForge (Right t) = namesForForge''' t
-
-namesForForge' :: TraceLabelCreds (TraceForgeEvent blk) -> [Text]
-namesForForge' (TraceLabelCreds _t e) = namesForForge'' e
-
-namesForForge'' :: TraceForgeEvent blk -> [Text]
-namesForForge'' TraceStartLeadershipCheck {}  = ["StartLeadershipCheck"]
-namesForForge'' TraceSlotIsImmutable {}       = ["SlotIsImmutable"]
-namesForForge'' TraceBlockFromFuture {}       = ["BlockFromFuture"]
-namesForForge'' TraceBlockContext {}          = ["BlockContext"]
-namesForForge'' TraceNoLedgerState {}         = ["NoLedgerState"]
-namesForForge'' TraceLedgerState {}           = ["LedgerState"]
-namesForForge'' TraceNoLedgerView {}          = ["NoLedgerView"]
-namesForForge'' TraceLedgerView {}            = ["LedgerView"]
-namesForForge'' TraceForgeStateUpdateError {} = ["ForgeStateUpdateError"]
-namesForForge'' TraceNodeCannotForge {}       = ["NodeCannotForge"]
-namesForForge'' TraceNodeNotLeader {}         = ["NodeNotLeader"]
-namesForForge'' TraceNodeIsLeader {}          = ["NodeIsLeader"]
-namesForForge'' TraceForgedBlock {}           = ["ForgedBlock"]
-namesForForge'' TraceDidntAdoptBlock {}       = ["DidntAdoptBlock"]
-namesForForge'' TraceForgedInvalidBlock {}    = ["ForgedInvalidBlock"]
-namesForForge'' TraceAdoptedBlock {}          = ["AdoptedBlock"]
-
-namesForForge''' :: TraceLabelCreds TraceStartLeadershipCheckPlus -> [Text]
-namesForForge''' (TraceLabelCreds _ TraceStartLeadershipCheckPlus {})  =
+namesForForge (Right t) = namesForForge'' t
+
+namesForForge' :: TraceForgeEvent blk -> [Text]
+namesForForge' TraceStartLeadershipCheck {}  = ["StartLeadershipCheck"]
+namesForForge' TraceSlotIsImmutable {}       = ["SlotIsImmutable"]
+namesForForge' TraceBlockFromFuture {}       = ["BlockFromFuture"]
+namesForForge' TraceBlockContext {}          = ["BlockContext"]
+namesForForge' TraceNoLedgerState {}         = ["NoLedgerState"]
+namesForForge' TraceLedgerState {}           = ["LedgerState"]
+namesForForge' TraceNoLedgerView {}          = ["NoLedgerView"]
+namesForForge' TraceLedgerView {}            = ["LedgerView"]
+namesForForge' TraceForgeStateUpdateError {} = ["ForgeStateUpdateError"]
+namesForForge' TraceNodeCannotForge {}       = ["NodeCannotForge"]
+namesForForge' TraceNodeNotLeader {}         = ["NodeNotLeader"]
+namesForForge' TraceNodeIsLeader {}          = ["NodeIsLeader"]
+namesForForge' TraceForgedBlock {}           = ["ForgedBlock"]
+namesForForge' TraceDidntAdoptBlock {}       = ["DidntAdoptBlock"]
+namesForForge' TraceForgedInvalidBlock {}    = ["ForgedInvalidBlock"]
+namesForForge' TraceAdoptedBlock {}          = ["AdoptedBlock"]
+
+namesForForge'' :: TraceStartLeadershipCheckPlus -> [Text]
+namesForForge'' TraceStartLeadershipCheckPlus{}  =
   ["StartLeadershipCheckPlus"]
 
 
@@ -1204,12 +1198,12 @@ instance ( tx ~ GenTx blk
 
 instance LogFormatting TraceStartLeadershipCheckPlus where
   forMachine _dtal TraceStartLeadershipCheckPlus {..} =
-        mconcat [ "kind" .= String "TraceStartLeadershipCheckPlus"
-                 , "slotNo" .= toJSON (unSlotNo tsSlotNo)
-                 , "utxoSize" .= Number (fromIntegral tsUtxoSize)
-                 , "delegMapSize" .= Number (fromIntegral tsUtxoSize)
-                 , "chainDensity" .= Number (fromRational (toRational tsChainDensity))
-                 ]
+        mconcat [ "kind" .= String "TraceStartLeadershipCheck"
+                , "slot" .= toJSON (unSlotNo tsSlotNo)
+                , "utxoSize" .= Number (fromIntegral tsUtxoSize)
+                , "delegMapSize" .= Number (fromIntegral tsUtxoSize)
+                , "chainDensity" .= Number (fromRational (toRational tsChainDensity))
+                ]
   forHuman TraceStartLeadershipCheckPlus {..} =
       "Checking for leadership in slot " <> showT (unSlotNo tsSlotNo)
       <> " utxoSize " <> showT tsUtxoSize
@@ -1219,12 +1213,12 @@ instance LogFormatting TraceStartLeadershipCheckPlus where
     [IntM "cardano.node.utxoSize" (fromIntegral tsUtxoSize),
      IntM "cardano.node.delegMapSize" (fromIntegral tsDelegMapSize)]
 
-docForge :: Documented (Either (TraceLabelCreds (TraceForgeEvent blk))
-                               (TraceLabelCreds TraceStartLeadershipCheckPlus))
+docForge :: Documented (Either (TraceForgeEvent blk)
+                               TraceStartLeadershipCheckPlus)
 docForge = addDocumentedNamespace [] docForge'
 
-docForge' :: Documented (Either (TraceLabelCreds (TraceForgeEvent blk))
-                               (TraceLabelCreds TraceStartLeadershipCheckPlus))
+docForge' :: Documented (Either (TraceForgeEvent blk)
+                               TraceStartLeadershipCheckPlus)
 docForge' = Documented [
     DocMsg
       ["StartLeadershipCheck"]

cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs

@@ -70,8 +70,8 @@ emptyForgeThreadStats = ForgeThreadStats 0 0 0 0 0
 
 docForgeStats :: Documented
   (Either
-      (Consensus.TraceLabelCreds (Consensus.TraceForgeEvent blk))
-      (Consensus.TraceLabelCreds TraceStartLeadershipCheckPlus))
+      (Consensus.TraceForgeEvent blk)
+      TraceStartLeadershipCheckPlus)
 docForgeStats = Documented [
     DocMsg
       ["ForgeStats"]
@@ -138,29 +138,29 @@ calculateThreadStats :: MonadIO m
   -> ForgeTracerType blk
   -> m ForgingStats
 calculateThreadStats stats _context
-    (Left (TraceLabelCreds _ TraceNodeCannotForge {})) = do
+    (Left TraceNodeCannotForge {}) = do
       mapThreadStats
         stats
         (\fts -> (fts { ftsNodeCannotForgeNum = ftsNodeCannotForgeNum fts + 1}
                       , Nothing))
         (\fs _ ->  (fs  { fsNodeCannotForgeNum  = fsNodeCannotForgeNum fs + 1 }))
 calculateThreadStats stats _context
-    (Left (TraceLabelCreds _ (TraceNodeIsLeader (SlotNo slot')))) = do
+    (Left (TraceNodeIsLeader (SlotNo slot'))) = do
       let slot = fromIntegral slot'
       mapThreadStats
         stats
         (\fts -> (fts { ftsNodeIsLeaderNum = ftsNodeIsLeaderNum fts + 1
                    , ftsLastSlot = slot}, Nothing))
         (\fs _ ->  (fs  { fsNodeIsLeaderNum  = fsNodeIsLeaderNum fs + 1 }))
 calculateThreadStats stats _context
-    (Left (TraceLabelCreds _ TraceForgedBlock {})) = do
+    (Left TraceForgedBlock {}) = do
       mapThreadStats
         stats
         (\fts -> (fts { ftsBlocksForgedNum = ftsBlocksForgedNum fts + 1}
                       , Nothing))
         (\fs _ ->  (fs  { fsBlocksForgedNum  = fsBlocksForgedNum fs + 1 }))
 calculateThreadStats stats _context
-    (Left (TraceLabelCreds _ (TraceNodeNotLeader (SlotNo slot')))) = do
+    (Left (TraceNodeNotLeader (SlotNo slot'))) = do
       let slot = fromIntegral slot'
       mapThreadStats
         stats

cardano-node/src/Cardano/Node/Tracing/Tracers/StartLeadershipCheck.hs

@@ -36,8 +36,8 @@ import           Cardano.Slotting.Slot (fromWithOrigin)
 import           Cardano.Ledger.BaseTypes (StrictMaybe (..), fromSMaybe)
 
 
-type ForgeTracerType blk = Either (TraceLabelCreds (TraceForgeEvent blk))
-                                  (TraceLabelCreds TraceStartLeadershipCheckPlus)
+type ForgeTracerType blk = Either (TraceForgeEvent blk)
+                                  TraceStartLeadershipCheckPlus
 
 data TraceStartLeadershipCheckPlus =
   TraceStartLeadershipCheckPlus {
@@ -73,7 +73,7 @@ forgeTracerTransform nodeKern (Trace tr) = pure $ Trace $ T.arrow $ T.emit $
                             utxoSize
                             delegMapSize
                             (fromRational chainDensity)
-                in T.traceWith tr (lc, Right (Right (TraceLabelCreds creds msg))))
+                in T.traceWith tr (lc, Right (Right msg)))
       (lc, Right a) ->
           T.traceWith tr (lc, Right a)
       (lc, Left control) ->