locli: support new tracing

bench/locli/src/Cardano/Command.hs

@@ -43,7 +43,10 @@ parseChainCommand =
   subparser (mconcat [ commandGroup "Common data:  logobject keys, run metafile & genesis"
    , op "list-logobject-keys" "List logobject keys that analyses care about"
      (ListLogobjectKeys
-       <$> optTextOutputFile  "keys"            "Text file to write logobject keys to")
+       <$> optTextOutputFile  "keys"           "Text file to write logobject keys to")
+   , op "list-logobject-keys-legacy" "List legacy logobject keys that analyses care about"
+     (ListLogobjectKeysLegacy
+       <$> optTextOutputFile  "keys-legacy"     "Text file to write logobject keys to")
    , op "meta-genesis" "Machine performance timeline"
      (MetaGenesis
        <$> optJsonRunMetafile "run-metafile"    "The meta.json file from the benchmark run"
@@ -167,6 +170,8 @@ parseChainCommand =
 data ChainCommand
   = ListLogobjectKeys
       TextOutputFile
+  | ListLogobjectKeysLegacy
+      TextOutputFile
 
   | MetaGenesis         -- () -> Run
       JsonRunMetafile
@@ -252,6 +257,11 @@ runChainCommand s
   dumpText "logobject-keys" (toText <$> logObjectStreamInterpreterKeys) f
     & firstExceptT (CommandError c)
   pure s
+runChainCommand s
+  c@(ListLogobjectKeysLegacy f) = do
+  dumpText "logobject-keys-legacy" (toText <$> logObjectStreamInterpreterKeysLegacy) f
+    & firstExceptT (CommandError c)
+  pure s
 
 runChainCommand s
   c@(MetaGenesis runMeta shelleyGenesis) = do

bench/locli/src/Cardano/Unlog/LogObject.hs

@@ -26,6 +26,7 @@ import Data.Text.Short (ShortText, fromText, toText)
 import Data.Time.Clock (NominalDiffTime, UTCTime)
 import Data.Map qualified as Map
 import Data.Vector (Vector)
+import Data.Vector qualified as V
 
 import Cardano.Logging.Resources.Types
 
@@ -54,14 +55,15 @@ readLogObjectStream :: FilePath -> IO [LogObject]
 readLogObjectStream f =
   LBS.readFile f
     <&>
-    fmap (either (LogObject zeroUTCTime "DecodeError" "" (TId "0") . LODecodeError)
+    fmap (either (LogObject zeroUTCTime "Cardano.Analysis.DecodeError" "DecodeError" "" (TId "0") . LODecodeError)
                  id
           . AE.eitherDecode)
     . LBS.split (fromIntegral $ fromEnum '\n')
 
 data LogObject
   = LogObject
     { loAt   :: !UTCTime
+    , loNS   :: !Text
     , loKind :: !Text
     , loHost :: !Host
     , loTid  :: !TId
@@ -82,45 +84,47 @@ deriving instance NFData a => NFData (Resources a)
 -- LogObject stream interpretation
 --
 
-interpreters :: Map Text (Object -> Parser LOBody)
-interpreters = Map.fromList
-  [ (,) "TraceStartLeadershipCheck" $
+type ACouple t = (t, t)
+
+interpreters :: ACouple (Map Text (Object -> Parser LOBody))
+interpreters = (Map.fromList *** Map.fromList) . unzip . fmap ent $
+  [ (,,) "TraceStartLeadershipCheck" "Cardano.Node.Forge.StartLeadershipCheck" $
     \v -> LOTraceStartLeadershipCheck
             <$> v .: "slot"
             <*> (v .:? "utxoSize"     <&> fromMaybe 0)
             <*> (v .:? "chainDensity" <&> fromMaybe 0)
 
-  , (,) "TraceBlockContext" $
+  , (,,) "TraceBlockContext" "Cardano.Node.Forge.BlockContext" $
     \v -> LOBlockContext
             <$> v .: "tipBlockNo"
 
-  , (,) "TraceNodeIsLeader" $
+  , (,,) "TraceNodeIsLeader" "Cardano.Node.Forge.NodeIsLeader" $
     \v -> LOTraceLeadershipDecided
             <$> v .: "slot"
             <*> pure True
 
-  , (,) "TraceNodeNotLeader" $
+  , (,,) "TraceNodeNotLeader" "Cardano.Node.Forge.NodeNotLeader" $
     \v -> LOTraceLeadershipDecided
             <$> v .: "slot"
             <*> pure False
 
-  , (,) "TraceMempoolAddedTx" $
+  , (,,) "TraceMempoolAddedTx" "Cardano.Node.Mempool.AddedTx" $
     \v -> do
       x :: Object <- v .: "mempoolSize"
       LOMempoolTxs <$> x .: "numTxs"
 
-  , (,) "TraceMempoolRemoveTxs" $
+  , (,,) "TraceMempoolRemoveTxs" "Cardano.Node.Mempool.RemoveTxs" $
     \v -> do
       x :: Object <- v .: "mempoolSize"
       LOMempoolTxs <$> x .: "numTxs"
 
-  , (,) "TraceMempoolRejectedTx" $
+  , (,,) "TraceMempoolRejectedTx" "Cardano.Node.Mempool.RejectedTx" $
     \_ -> pure LOMempoolRejectedTx
 
-  , (,) "TraceLedgerEvent.TookSnapshot" $
+  , (,,) "TraceLedgerEvent.TookSnapshot" "Cardano.Node.LedgerEvent.TookSnapshot" $
     \_ -> pure LOLedgerTookSnapshot
 
-  , (,) "TraceBenchTxSubSummary" $
+  , (,,) "TraceBenchTxSubSummary" "TraceBenchTxSubSummary" $
     \v -> do
        x :: Object <- v .: "summary"
        LOGeneratorSummary
@@ -130,73 +134,77 @@ interpreters = Map.fromList
          <*> x .: "ssElapsed"
          <*> x .: "ssThreadwiseTps"
 
-  , (,) "TraceBenchTxSubServAck" $
+  , (,,) "TraceBenchTxSubServAck" "TraceBenchTxSubServAck" $
     \v -> LOTxsAcked <$> v .: "txIds"
 
-  , (,) "Resources" $
+  , (,,) "Resources" "Cardano.Node.Resources" $
     \v -> LOResources <$> parsePartialResourceStates (Object v)
 
-  , (,) "TraceTxSubmissionCollected" $
+  , (,,) "TraceTxSubmissionCollected" "TraceTxSubmissionCollected" $
     \v -> LOTxsCollected
             <$> v .: "count"
 
-  , (,) "TraceTxSubmissionProcessed" $
+  , (,,) "TraceTxSubmissionProcessed" "TraceTxSubmissionProcessed" $
     \v -> LOTxsProcessed
             <$> v .: "accepted"
             <*> v .: "rejected"
 
-  , (,) "TraceForgedBlock" $
+  , (,,) "TraceForgedBlock" "Cardano.Node.Forge.ForgedBlock" $
     \v -> LOBlockForged
             <$> v .: "block"
             <*> v .: "blockPrev"
             <*> v .: "blockNo"
             <*> v .: "slot"
-  , (,) "TraceAddBlockEvent.AddedToCurrentChain" $
+  , (,,) "TraceAddBlockEvent.AddedToCurrentChain" "Cardano.Node.ChainDB.AddBlockEvent.AddedToCurrentChain" $
     \v -> LOBlockAddedToCurrentChain
             <$> ((v .: "newtip")     <&> hashFromPoint)
             <*> pure Nothing
             <*> (v .:? "chainLengthDelta"
                 -- Compat for node versions 1.27 and older:
                  <&> fromMaybe 1)
   -- TODO: we should clarify the distinction between the two cases (^ and v).
-  , (,) "TraceAdoptedBlock" $
+  , (,,) "TraceAdoptedBlock" "Cardano.Node.Forge.AdoptedBlock" $
     \v -> LOBlockAddedToCurrentChain
             <$> v .: "blockHash"
             <*> ((v .: "blockSize") <&> Just)
             <*> pure 1
-  , (,) "ChainSyncServerEvent.TraceChainSyncServerRead.AddBlock" $
+  , (,,) "ChainSyncServerEvent.TraceChainSyncServerRead.AddBlock" "Cardano.Node.ChainSyncServerHeader.ChainSyncServerEvent.ServerRead.AddBlock" $
     \v -> LOChainSyncServerSendHeader
             <$> v .: "block"
             <*> v .: "blockNo"
             <*> v .: "slot"
-  , (,) "ChainSyncServerEvent.TraceChainSyncServerReadBlocked.AddBlock" $
+  , (,,) "ChainSyncServerEvent.TraceChainSyncServerReadBlocked.AddBlock" "Cardano.Node.ChainSyncServerHeader.ChainSyncServerEvent.ServerReadBlocked.AddBlock" $
     \v -> LOChainSyncServerSendHeader
             <$> v .: "block"
             <*> v .: "blockNo"
             <*> v .: "slot"
   -- v, but not ^ -- how is that possible?
-  , (,) "TraceBlockFetchServerSendBlock" $
+  , (,,) "TraceBlockFetchServerSendBlock" "Cardano.Node.BlockFetchServer.SendBlock" $
     \v -> LOBlockFetchServerSending
             <$> v .: "block"
-  , (,) "SendFetchRequest" $
+  , (,,) "SendFetchRequest" "Cardano.Node.BlockFetchClient.SendFetchRequest" $
     \v -> LOBlockFetchClientRequested
             <$> v .: "head"
             <*> v .: "length"
-  , (,) "ChainSyncClientEvent.TraceDownloadedHeader" $
+  , (,,) "ChainSyncClientEvent.TraceDownloadedHeader" "Cardano.Node.ChainSyncClient.ChainSyncClientEvent.DownloadedHeader" $
     \v -> LOChainSyncClientSeenHeader
             <$> v .: "block"
             <*> v .: "blockNo"
             <*> v .: "slot"
-  , (,) "CompletedBlockFetch" $
+  , (,,) "CompletedBlockFetch" "Cardano.Node.BlockFetchClient.CompletedBlockFetch" $
     \v -> LOBlockFetchClientCompletedFetch
             <$> v .: "block"
   ]
  where
    hashFromPoint :: LText.Text -> Hash
    hashFromPoint = Hash . fromText . Prelude.head . LText.splitOn "@"
 
-logObjectStreamInterpreterKeys :: [Text]
-logObjectStreamInterpreterKeys = Map.keys interpreters
+   ent :: (a,b,c) -> ((a,c), (b,c))
+   ent (a,b,c) = ((a,c), (b,c))
+
+logObjectStreamInterpreterKeysLegacy, logObjectStreamInterpreterKeys :: [Text]
+logObjectStreamInterpreterKeysLegacy = Map.keys (fst interpreters)
+logObjectStreamInterpreterKeys       = Map.keys (snd interpreters)
 
 data LOBody
   = LOTraceStartLeadershipCheck !SlotNo !Word64 !Float
@@ -253,12 +261,20 @@ instance FromJSON LogObject where
     body :: Object <- v .: "data"
     -- XXX:  fix node causing the need for this workaround
     (,) unwrapped kind <- unwrap "credentials" "val" body
+    nsVorNs :: Value <- v .: "ns"
+    let ns = case nsVorNs of
+               Array (V.toList -> [String ns']) -> fromText ns'
+               String ns' -> fromText ns'
+               x -> error $
+                 "The 'ns' field must be either a string, or a singleton-String vector, was: " <> show x
     LogObject
       <$> v .: "at"
+      <*> pure ns
       <*> pure kind
       <*> v .: "host"
       <*> v .: "thread"
-      <*> case Map.lookup kind interpreters of
+      <*> case Map.lookup ns   (snd interpreters) <|>
+               Map.lookup kind (fst interpreters) of
             Just interp -> interp unwrapped
             Nothing -> pure $ LOAny unwrapped
    where

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

@@ -258,16 +258,20 @@ namesForChainSyncServerEvent :: TraceChainSyncServerEvent blk -> [Text]
 namesForChainSyncServerEvent ev =
     "ChainSyncServerEvent" : namesForChainSyncServerEvent' ev
 
+nameChainUpdate :: ChainUpdate block a -> Text
+nameChainUpdate = \case
+  AddBlock{} -> "AddBlock"
+  RollBack{} -> "RollBack"
 
 namesForChainSyncServerEvent' :: TraceChainSyncServerEvent blk -> [Text]
-namesForChainSyncServerEvent' TraceChainSyncServerRead        {} =
-      ["ServerRead"]
-namesForChainSyncServerEvent' TraceChainSyncServerReadBlocked {} =
-      ["ServerReadBlocked"]
-namesForChainSyncServerEvent' TraceChainSyncRollForward       {} =
-      ["RollForward"]
-namesForChainSyncServerEvent' TraceChainSyncRollBackward      {} =
-      ["RollBackward"]
+namesForChainSyncServerEvent' (TraceChainSyncServerRead        _ x) =
+  ["ServerRead", nameChainUpdate x]
+namesForChainSyncServerEvent' (TraceChainSyncServerReadBlocked _ x) =
+  ["ServerReadBlocked", nameChainUpdate x]
+namesForChainSyncServerEvent' TraceChainSyncRollForward{} =
+  ["RollForward"]
+namesForChainSyncServerEvent' TraceChainSyncRollBackward{} =
+  ["RollBackward"]
 
 instance ConvertRawHash blk
       => LogFormatting (TraceChainSyncServerEvent blk) where

nix/workbench/analyse.sh

@@ -14,14 +14,16 @@ EOF
 }
 
 analyse() {
-local dump_logobjects= preflt_jq= filters=() aws=
-local dump_logobjects= dump_slots_raw= dump_slots= dump_chain_raw= dump_chain= dump_mach_views=
+local filters=() aws=
+local dump_logobjects= dump_machviews= dump_chain_raw= dump_chain= dump_slots_raw= dump_slots=
 while test $# -gt 0
 do case "$1" in
-       --dump-logobjects )  dump_logobjects='true';;
-       --prefilter-jq )     preflt_jq='true';;
-       --filters )          analysis_set_filters "base,$2"; shift;;
-       --no-filters )       analysis_set_filters "";;
+       --dump-logobjects | -lo )  dump_logobjects='true';;
+       --dump-machviews  | -mw )  dump_machviews='true';;
+       --dump-chain-raw  | -cr )  dump_chain_raw='true';;
+       --dump-chain      | -c )   dump_chain='true';;
+       --filters )                analysis_set_filters "base,$2"; shift;;
+       --no-filters )             analysis_set_filters "";;
        * ) break;; esac; shift; done
 
 if curl --connect-timeout 0.5 http://169.254.169.254/latest/meta-data >/dev/null 2>&1
@@ -35,7 +37,7 @@ else locli_rts_args=()
      echo "{ \"aws\": false }"
 fi
 
-local op=${1:-$(usage_analyse)}; shift
+local op=${1:-standard}; if test $# != 0; then shift; fi
 
 case "$op" in
     # 'read-mach-views' "${logs[@]/#/--log }"
@@ -67,7 +69,7 @@ case "$op" in
                  'dump-logobjects'; fi)
 
                'build-mach-views'
-               $(if test -n "$dump_mach_views"; then echo \
+               $(if test -n "$dump_machviews"; then echo \
                  'dump-mach-views'; fi)
 
                'build-chain'
@@ -152,7 +154,10 @@ case "$op" in
 
         ## 0. ask locli what it cares about
         local keyfile="$adir"/substring-keys
-        locli 'list-logobject-keys' --keys "$keyfile"
+        case $(jq '.node.tracing_backend // "iohk-monitoring"' --raw-output $dir/profile.json) in
+             trace-dispatcher ) locli 'list-logobject-keys'        --keys        "$keyfile";;
+             iohk-monitoring  ) locli 'list-logobject-keys-legacy' --keys-legacy "$keyfile";;
+        esac
 
         ## 1. unless already done, filter logs according to locli's requirements
         local logdirs=($(ls -d "$dir"/node-*/ 2>/dev/null))
@@ -173,11 +178,7 @@ case "$op" in
            if test -z "$logfiles"
            then msg "no logs in $d, skipping.."; fi
            local output="$adir"/logs-$(basename "$d").flt.json
-           grep -hFf "$keyfile" $logfiles |
-               if test "$preflt_jq" = 'true'
-               then jq "${jq_args[@]}" --arg dirHostname "$(basename "$d")"
-               else cat
-               fi > "$output" &
+           grep -hFf "$keyfile" $logfiles > "$output" &
         done
 
         wait;;

nix/workbench/wb

@@ -96,6 +96,8 @@ start()
     local verbose=
     local manifest="{}"
     local iterations=1
+    local no_retry_failed_runs=t
+    local analyse_args=()
     local analyse=yes analysis_can_fail=
 
     local run_args=()
@@ -105,7 +107,7 @@ start()
     do case "$1" in
         --batch-name )                   batch_name=$2;   shift;;
         --profile-name )                 profile_name=$2; shift;;
-        --iterations | --times | --iter | -n ) iterations=$2; shift;;
+        --iterations | --times | --iter | -n ) iterations=$2; no_retry_failed_runs=; shift;;
         --cache-dir )                    setenvjqstr 'cacheDir' $2; shift;;
         --base-port )                    setenvjq    'basePort' $2; shift;;
 
@@ -115,8 +117,12 @@ start()
 
         --idle )                         run_start_args+=($1);;
         --scenario | -s )                run_start_args+=($1 $2); shift;;
+
         --no-analysis )                  analyse=;;
-        --analysis-can-fail | -f )       analysis_can_fail=t;;
+        --analysis-can-fail | -af )      analysis_can_fail=t;;
+        --dump-logobjects | -lo )        analyse_args+=($1);;
+        --dump-machviews  | -mw )        analyse_args+=($1);;
+        --filters )                      analyse_args+=($1 $2); shift;;
 
         --cabal-mode | --cabal )         cabal_mode=t;;
         --supervisor | --backend-supervisor )
@@ -158,8 +164,8 @@ start()
 
        progress "top-level | analysis" "processing logs of $(with_color white $tag)"
        local tag=$(run current-tag)
-       analyse std $tag ||
-           if test -n "$analysis_can_fail"
+       analyse ${analyse_args[@]} std $tag ||
+           if test -n "$analysis_can_fail" -a -z "$no_retry_failed_runs"
            then progress "run | analysis" "log processing failed, but --analysis-can-fail prevents failure:  $(with_color red $tag)"
                 iterations=$((iterations + 1))
            else fail "analysis failed:  $tag"