Fix missing trace-forward messages

.gitignore

@@ -63,3 +63,5 @@ logs
 /example
 /.hlint.yaml
 /testnet
+
+.vscode/

Makefile

@@ -68,7 +68,7 @@ ps:                                              ## Plain-text list of profiles
 ##
 ## Profile-based cluster shells (autogenerated targets)
 ##
-PROFILES_BASE         := default plutus oldtracing
+PROFILES_BASE         := default plutus oldtracing idle tracer-only
 PROFILES_STARTSTOP    := startstop startstop-p2p startstop-plutus startstop-notracer startstop-oldtracing
 PROFILES_CI_TEST      := ci-test ci-test-p2p ci-test-plutus ci-test-notracer ci-test-dense10
 PROFILES_CI_BENCH     := ci-bench ci-bench-p2p ci-bench-plutus ci-bench-notracer

bench/tx-generator/tx-generator.cabal

@@ -12,6 +12,10 @@ cabal-version:         >= 1.10
 extra-source-files:    README.md
 data-files:            data/protocol-parameters.json
 
+common project-config
+  if os(windows)
+    buildable: False
+
 library
   hs-source-dirs:      src
   ghc-options:          -Wall
@@ -26,23 +30,23 @@ library
 
   exposed-modules:
                        Cardano.Benchmarking.Command
-                       Cardano.Benchmarking.Compiler                       
+                       Cardano.Benchmarking.Compiler
                        Cardano.Benchmarking.GeneratorTx
                        Cardano.Benchmarking.GeneratorTx.Genesis
                        Cardano.Benchmarking.GeneratorTx.NodeToNode
                        Cardano.Benchmarking.GeneratorTx.SizedMetadata
                        Cardano.Benchmarking.GeneratorTx.Submission
                        Cardano.Benchmarking.GeneratorTx.SubmissionClient
-                       Cardano.Benchmarking.LogTypes                       
+                       Cardano.Benchmarking.LogTypes
                        Cardano.Benchmarking.NixOptions
                        Cardano.Benchmarking.OuroborosImports
                        Cardano.Benchmarking.Script
                        Cardano.Benchmarking.Script.Action
                        Cardano.Benchmarking.Script.Aeson
                        Cardano.Benchmarking.Script.Core
                        Cardano.Benchmarking.Script.Env
-                       Cardano.Benchmarking.Script.NodeConfig                       
-                       Cardano.Benchmarking.Script.Selftest                       
+                       Cardano.Benchmarking.Script.NodeConfig
+                       Cardano.Benchmarking.Script.Selftest
                        Cardano.Benchmarking.Script.Setters
                        Cardano.Benchmarking.Script.Store
                        Cardano.Benchmarking.Script.Types
@@ -52,7 +56,7 @@ library
                        Cardano.Benchmarking.Version
                        Cardano.Benchmarking.Wallet
                        Cardano.Benchmarking.PlutusExample
-                       
+
                        Cardano.TxGenerator.Fund
                        Cardano.TxGenerator.FundQueue
                        Cardano.TxGenerator.PureExample

cardano-node-chairman/cardano-node-chairman.cabal

@@ -12,6 +12,10 @@ build-type:             Simple
 
 common base                         { build-depends: base                             >= 4.14       && < 4.15     }
 
+  if os(windows)
+    buildable: False
+
+
 common project-config
   default-language:     Haskell2010
   default-extensions:   NoImplicitPrelude

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

@@ -35,7 +35,8 @@ import           Cardano.Node.Tracing.Tracers.BlockReplayProgress
 import           Cardano.Node.Tracing.Tracers.ChainDB
 import           Cardano.Node.Tracing.Tracers.Consensus
 import           Cardano.Node.Tracing.Tracers.Diffusion
-import           Cardano.Node.Tracing.Tracers.ForgingThreadStats (docForgeStats, forgeThreadStats)
+import           Cardano.Node.Tracing.Tracers.ForgingThreadStats (
+                   docForgeStats, forgeThreadStats)
 import           Cardano.Node.Tracing.Tracers.KESInfo
 import           Cardano.Node.Tracing.Tracers.NodeToClient
 import           Cardano.Node.Tracing.Tracers.NodeToNode
@@ -49,7 +50,6 @@ import           Cardano.Node.Handlers.Shutdown (ShutdownTrace)
 import           Cardano.Node.Startup
 import           Cardano.Node.TraceConstraints
 
-
 import           Ouroboros.Consensus.Block.Forging
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime)
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..))
@@ -424,22 +424,19 @@ docTracers configFileName outputFileName _ _ _ = do
                 mkCardanoTracer'
                 trBase trForward mbTrEKG
                 ["Forge", "Stats"]
-                namesForForge
-                severityForge
+                namesForForge2
+                severityForge2
                 allPublic
                 forgeThreadStats
 
     configureTracers trConfig docForge [forgeTr, forgeThreadStatsTr]
     forgeTrDoc <- documentTracer trConfig forgeTr
-      (docForge :: Documented
-        (Either (Consensus.TraceForgeEvent blk)
-                TraceStartLeadershipCheckPlus))
+      (docForge :: Documented (Either (Consensus.TraceForgeEvent blk)
+                               TraceStartLeadershipCheckPlus))
 
     forgeThreadStatsTrDoc <- documentTracer trConfig forgeThreadStatsTr
-      (docForgeStats :: Documented
-        (Either
-           (Consensus.TraceForgeEvent blk)
-           TraceStartLeadershipCheckPlus))
+      (docForgeStats :: Documented (Either (Consensus.TraceForgeEvent blk)
+                               TraceStartLeadershipCheckPlus))
 
     blockchainTimeTr   <- mkCardanoTracer
                 trBase trForward mbTrEKG

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

@@ -23,7 +23,7 @@ import           Cardano.Node.Tracing.Tracers.BlockReplayProgress
 import           Cardano.Node.Tracing.Tracers.ChainDB
 import           Cardano.Node.Tracing.Tracers.Consensus
 import           Cardano.Node.Tracing.Tracers.Diffusion
-import           Cardano.Node.Tracing.Tracers.ForgingThreadStats (forgeThreadStats)
+import           Cardano.Node.Tracing.Tracers.ForgingThreadStats (docForgeStats, forgeThreadStats)
 import           Cardano.Node.Tracing.Tracers.KESInfo
 import           Cardano.Node.Tracing.Tracers.NodeToClient
 import           Cardano.Node.Tracing.Tracers.NodeToNode
@@ -352,11 +352,12 @@ mkConsensusTracers trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = d
     forgeThreadStatsTr <- mkCardanoTracer'
                 trBase trForward mbTrEKG
                 ["Forge", "Stats"]
-                namesForForge
-                severityForge
+                namesForForge2
+                severityForge2
                 allPublic
                 forgeThreadStats
-    configureTracers trConfig docForge [forgeTr, forgeThreadStatsTr]
+    configureTracers trConfig docForge [forgeTr]
+    configureTracers trConfig docForgeStats [forgeThreadStatsTr]
     blockchainTimeTr   <- mkCardanoTracer
                 trBase trForward mbTrEKG
                 ["BlockchainTime"]

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

@@ -60,6 +60,10 @@ module Cardano.Node.Tracing.Tracers.Consensus
   , namesForForge
   , docForge
 
+  , severityForge2
+  , namesForForge2
+  , docForge2
+
   , namesForBlockchainTime
   , severityBlockchainTime
   , docBlockchainTime
@@ -90,6 +94,7 @@ import           Cardano.Node.Tracing.Era.Shelley ()
 import           Cardano.Node.Tracing.Formatting ()
 import           Cardano.Node.Tracing.Render
 import           Cardano.Node.Tracing.Tracers.StartLeadershipCheck
+import           Cardano.Node.Tracing.Tracers.ForgingThreadStats(ForgingStats)
 import           Cardano.Prelude hiding (All, Show, show)
 
 import           Cardano.Protocol.TPraos.OCert (KESPeriod (..))
@@ -1095,7 +1100,14 @@ namesForForge'' TraceForgedInvalidBlock {}     = ["ForgedInvalidBlock"]
 namesForForge'' TraceAdoptedBlock {}           = ["AdoptedBlock"]
 
 namesForForge'''' :: TraceStartLeadershipCheckPlus -> [Text]
-namesForForge'''' TraceStartLeadershipCheckPlus{} = ["StartLeadershipCheckPlus"]
+namesForForge'''' TraceStartLeadershipCheckPlus{} = ["StartLeadershipCheck"]
+
+namesForForge2 :: ForgingStats -> [Text]
+namesForForge2 _ = ["StartLeadershipCheck"]
+
+severityForge2 :: ForgingStats -> SeverityS
+severityForge2 _ = Info
+
 
 instance ( tx ~ GenTx blk
          , ConvertRawHash blk
@@ -1544,7 +1556,7 @@ docForge' = Documented [
       "We adopted the block we produced, we also trace the transactions\
       \  that were adopted."
   , DocMsg
-      ["StartLeadershipCheckPlus"]
+      ["StartLeadershipCheck"]
       [ ("Forge.AboutToLeadSlotLast", "")
       , ("Forge.UtxoSize", "")
       , ("Forge.DelegMapSize", "")
@@ -1554,6 +1566,10 @@ docForge' = Documented [
 
   ]
 
+docForge2 :: Documented ForgingStats
+docForge2 = addDocumentedNamespace [] docForge'
+
+
 instance ( tx ~ GenTx blk
          , ConvertRawHash blk
          , GetHeader blk

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

@@ -69,10 +69,8 @@ instance LogFormatting ForgeThreadStats where
 emptyForgeThreadStats :: ForgeThreadStats
 emptyForgeThreadStats = ForgeThreadStats 0 0 0 0 0
 
-docForgeStats :: Documented
-  (Either
-      (Consensus.TraceForgeEvent blk)
-      TraceStartLeadershipCheckPlus)
+docForgeStats :: Documented (Either (Consensus.TraceForgeEvent blk)
+                               TraceStartLeadershipCheckPlus)
 docForgeStats = Documented [
     DocMsg
       []
@@ -85,7 +83,7 @@ docForgeStats = Documented [
       ,("Forge.SlotsMissed",
         "How many slots were missed in this node?")
       ,("Forge.LastSlot",
-        "")        
+        "")
       ]
       "nodeCannotForgeNum shows how many times this node could not forge.\
       \\nnodeIsLeaderNum shows how many times this node was leader.\
@@ -126,18 +124,22 @@ instance LogFormatting ForgingStats where
     , IntM "Forge.NodeIsLeaderNum"    (fromIntegral fsNodeIsLeaderNum)
     , IntM "Forge.BlocksForgedNum"    (fromIntegral fsBlocksForgedNum)
     , IntM "Forge.SlotsMissed"        (fromIntegral fsSlotsMissedNum)
-    ]   
+    ]
 
 emptyForgingStats :: ForgingStats
 emptyForgingStats = ForgingStats mempty 0 0 0 0
 
-forgeThreadStats :: Trace IO (Folding (ForgeTracerType blk) ForgingStats)
+forgeThreadStats :: Trace IO ForgingStats
   -> IO (Trace IO (ForgeTracerType blk))
-forgeThreadStats = foldMCondTraceM calculateThreadStats emptyForgingStats
-  (\case
-      Left Consensus.TraceStartLeadershipCheck{} -> True
-      Left _  -> False
-      Right _ -> True)
+forgeThreadStats tr =
+  let tr' = contramap unfold tr
+  in foldMCondTraceM calculateThreadStats emptyForgingStats
+      (\case
+          Left Consensus.TraceStartLeadershipCheck{} -> True
+          Left _ -> False
+          Right _  -> True
+          )
+      tr'
 
 calculateThreadStats :: MonadIO m
   => ForgingStats

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

@@ -33,7 +33,7 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Cardano.Node.Queries (LedgerQueries (..), NodeKernelData (..))
 import           Cardano.Slotting.Slot (fromWithOrigin)
 
-import           Cardano.Ledger.BaseTypes (StrictMaybe (..), fromSMaybe)
+import           Cardano.Ledger.BaseTypes (StrictMaybe (..))
 
 
 type ForgeTracerType blk = Either (TraceForgeEvent blk)
@@ -64,16 +64,15 @@ forgeTracerTransform nodeKern (Trace tr) = pure $ Trace $ T.arrow $ T.emit $
                          <*> nkQueryLedger (ledgerDelegMapSize . ledgerState) nk
                          <*> nkQueryChain fragmentChainDensity nk)
                     nodeKern
-        fromSMaybe
-           (T.traceWith tr (lc, Right (Left slc)))
-           (query <&>
-             \(utxoSize, delegMapSize, chainDensity) ->
+        case query of
+          SNothing -> T.traceWith tr (lc, Right (Left slc))
+          SJust (utxoSize, delegMapSize, chainDensity) ->
                 let msg = TraceStartLeadershipCheckPlus
                             slotNo
                             utxoSize
                             delegMapSize
                             (fromRational chainDensity)
-                in T.traceWith tr (lc, Right (Right msg)))
+                in T.traceWith tr (lc, Right (Right msg))
       (lc, Right a) ->
           T.traceWith tr (lc, Right a)
       (lc, Left control) ->

cardano-tracer/bench/cardano-tracer-bench.hs

@@ -17,6 +17,7 @@ import           Cardano.Tracer.Utils
 import           Cardano.Tracer.Configuration
 import           Cardano.Tracer.Environment
 import           Cardano.Tracer.Handlers.Logs.TraceObjects
+import           Cardano.Tracer.MetaTrace
 import           Cardano.Tracer.Types
 
 main :: IO ()
@@ -48,6 +49,8 @@ main = do
 
   rtViewPageOpened <- newTVarIO False
 
+  tr <- mkTracerTracer $ SeverityF $ Just Warning
+
   let te1 =
         TracerEnv
           { teConfig            = c1
@@ -65,6 +68,7 @@ main = do
           , teProtocolsBrake    = protocolsBrake
           , teRTViewPageOpened  = rtViewPageOpened
           , teRTViewStateDir    = Nothing
+          , teTracer            = tr
           }
       te2 =
         TracerEnv
@@ -83,6 +87,7 @@ main = do
           , teProtocolsBrake    = protocolsBrake
           , teRTViewPageOpened  = rtViewPageOpened
           , teRTViewStateDir    = Nothing
+          , teTracer            = tr
           }
 
   removePathForcibly root