workbench: direct CDF dumps for gnuplot consumption

Makefile

@@ -3,7 +3,6 @@ help: ## Print documentation
 
 include lib.mk
 include nix.mk
-include legacy.mk
 
 PROJECT_NAME = cardano-node
 NUM_PROC     = $(nproc --all)
@@ -35,7 +34,7 @@ trace-documentation:
 ###
 ### Workbench
 ###
-CI_TARGETS := hlint ci-test-plutus-autonix
+CI_TARGETS := hlint workbench-ci-test
 ci:  ci-report ci-targets
 ci-report:
 	@echo -e "\033[34mGoals under test\033[0m:  \033[33m$(CI_TARGETS)\033[0m"
@@ -45,11 +44,14 @@ ci-targets:  $(CI_TARGETS)
 ## Base targets:
 ##
 shell:                                           ## Nix shell, (workbench from /nix/store), vars: PROFILE, CMD, RUN
-	nix-shell --max-jobs 8 --cores 0 --show-trace --argstr profileName ${PROFILE} ${ARGS} ${if ${CMD},--command "${CMD}"} ${if ${RUN},--run "${RUN}"}
+	nix-shell -A 'workbench-shell' --max-jobs 8 --cores 0 --show-trace --argstr profileName ${PROFILE} ${ARGS} ${if ${CMD},--command "${CMD}"} ${if ${RUN},--run "${RUN}"}
 shell-dev shell-prof shell-nix: shell
 shell-nix: ARGS += --arg 'workbenchDevMode' false ## Nix shell, (workbench from Nix store), vars: PROFILE, CMD, RUN
 shell-prof: ARGS += --arg 'profiled' true        ## Nix shell, everything Haskell built profiled
 
+analyse: RUN := wb analyse std ${TAG}
+analyse: shell
+
 list-profiles:                                   ## List workbench profiles
 	nix build .#workbench.profile-names-json --json | jq '.[0].outputs.out' -r | xargs jq .
 show-profile:                                    ## NAME=profile-name
@@ -84,9 +86,6 @@ SHELL_PROFILES += $(PROFILES_VENDOR)
 
 $(eval $(call define_profile_targets,$(SHELL_PROFILES)))
 
-workbench-ci-test:  $(foreach x,$(PROFILES_CI_TEST),${x}-autonix)
-workbench-ci-bench: $(foreach x,$(PROFILES_CI_BENCH),${x}-autonix)
-
 ###
 ### Misc
 ###
@@ -102,4 +101,4 @@ full-clean: clean
 cls:
 	echo -en "\ec"
 
-.PHONY: cabal-hashes clean cli cls cluster-profiles cluster-shell help node run-test shell shell-dev stylish-haskell $(SHELL_PROFILES) workbench-ci-test workbench-ci-bench
+.PHONY: cabal-hashes clean cli cls cluster-profiles help node run-test shell shell-dev stylish-haskell $(SHELL_PROFILES) workbench-ci-test

bench/locli/locli.cabal

@@ -33,6 +33,8 @@ common base
                        StandaloneDeriving
                        TupleSections
                        TypeApplications
+                       TypeFamilies
+                       TypeInType
                        ViewPatterns
 
   ghc-options:         -Wall
@@ -51,6 +53,7 @@ library
 
   exposed-modules:     Data.Accum
                        Data.CDF
+                       Data.DataDomain
 
                        Cardano.Command
                        Cardano.TopHandler
@@ -68,6 +71,7 @@ library
                        Cardano.Analysis.Version
 
                        Cardano.Unlog.LogObject
+                       Cardano.Unlog.Org
                        Cardano.Unlog.Render
                        Cardano.Unlog.Resources
 
@@ -96,6 +100,7 @@ library
                      , ouroboros-consensus
                      -- for Data.SOP.Strict:
                      , ouroboros-network
+                     , perf
                      , process
                      , quiet
                      , scientific
@@ -148,3 +153,4 @@ test-suite test-locli
                       , text
 
   other-modules:        Test.Analysis.CDF
+                        Test.Unlog.Org

bench/locli/src/Cardano/Analysis/BlockProp.hs

@@ -5,7 +5,7 @@
 {- HLINT ignore "Use head" -}
 {- HLINT ignore "Avoid lambda" -}
 module Cardano.Analysis.BlockProp
-  ( summariseBlockProps
+  ( summariseMultiBlockProp
   , MachView
   , buildMachViews
   , rebuildChain
@@ -54,9 +54,9 @@ import Cardano.Unlog.Resources
 import Cardano.Util
 
 
-summariseBlockProps :: [Centile] -> [BlockPropOne] -> Either CDFError BlockProps
-summariseBlockProps _ [] = error "Asked to summarise empty list of BlockPropOne"
-summariseBlockProps centiles bs@(headline:_) = do
+summariseMultiBlockProp :: [Centile] -> [BlockPropOne] -> Either CDFError MultiBlockProp
+summariseMultiBlockProp _ [] = error "Asked to summarise empty list of BlockPropOne"
+summariseMultiBlockProp centiles bs@(headline:_) = do
   bpForgerChecks           <- cdf2OfCDFs comb $ bs <&> bpForgerChecks
   bpForgerLeads            <- cdf2OfCDFs comb $ bs <&> bpForgerLeads
   bpForgerForges           <- cdf2OfCDFs comb $ bs <&> bpForgerForges
@@ -248,14 +248,19 @@ type MachBlockMap a
 
 data MachView
   = MachView
-  { mvBlocks  :: !(MachBlockMap UTCTime)
+  { mvHost    :: !Host
+  , mvBlocks  :: !(MachBlockMap UTCTime)
   , mvChecked :: Maybe UTCTime
   , mvLeading :: Maybe UTCTime
   }
   deriving (FromJSON, Generic, NFData, ToJSON)
 
-blockMapMaxBlock :: MachBlockMap a -> MachBlockEvents a
-blockMapMaxBlock = maximumBy ordBlockEv . Map.elems
+machViewMaxBlock :: MachView -> MachBlockEvents UTCTime
+machViewMaxBlock MachView{..} =
+  Map.elems mvBlocks
+  & \case
+       [] -> MBE $ BPError { eHost=mvHost, eBlock=Hash "Genesis", eLO=Nothing, eDesc=BPENoBlocks }
+       xs -> maximumBy ordBlockEv xs
 
 beForgedAt :: BlockEvents -> UTCTime
 beForgedAt BlockEvents{beForge=BlockForge{..}} =
@@ -273,7 +278,7 @@ rebuildChain run@Run{genesis} xs@(fmap snd -> machViews) = do
  where
    eventMaps      = mvBlocks <$> machViews
 
-   finalBlockEv   = maximumBy ordBlockEv $ blockMapMaxBlock <$> eventMaps
+   finalBlockEv   = maximumBy ordBlockEv $ machViewMaxBlock <$> machViews
 
    tipHash        = rewindChain eventMaps 1 (mbeBlock finalBlockEv)
    tipBlock       = getBlockForge eventMaps tipHash
@@ -369,7 +374,7 @@ rebuildChain run@Run{genesis} xs@(fmap snd -> machViews) = do
              <*> Just boeSending
              <*> Just boeErrorsCrit
              <*> Just boeErrorsSoft
-     , bePropagation  = cdf adoptionPcts adoptions
+     , bePropagation  = cdf adoptionCentiles adoptions
      , beOtherBlocks  = otherBlocks
      , beErrors =
          errs
@@ -455,7 +460,7 @@ blockProp run@Run{genesis} chain domSlot domBlock = do
     , bpPeerSends           = observerEventsCDF boSending            "sending"
     , bpPropagation         =
       [ (p', forgerEventsCDF (Just . unI . projectCDF' "bePropagation" p . bePropagation))
-      | p@(Centile p') <- adoptionPcts <> [Centile 1.0] ]
+      | p@(Centile p') <- adoptionCentiles <> [Centile 1.0] ]
     , bpSizes               = forgerEventsCDF   (Just . bfBlockSize . beForge)
     , bpVersion             = getVersion
     }
@@ -498,16 +503,15 @@ witherToDistrib distrify proj xs =
 
 -- | Given a single machine's log object stream, recover its block map.
 blockEventMapsFromLogObjects :: Run -> (JsonLogfile, [LogObject]) -> MachView
-blockEventMapsFromLogObjects run (f@(unJsonLogfile -> fp), xs) =
-  if Map.size (mvBlocks view) == 0
-  then error $ mconcat
-       ["No block events in ",fp," : ","LogObject count: ",show (length xs)]
-  else view
+blockEventMapsFromLogObjects run (f@(unJsonLogfile -> fp), []) =
+  error $ mconcat ["0 LogObjects in ", fp]
+blockEventMapsFromLogObjects run (f@(unJsonLogfile -> fp), xs@(x:_)) =
+  foldl' (blockPropMachEventsStep run f) initial xs
  where
-   view = foldl' (blockPropMachEventsStep run f) initial xs
    initial =
      MachView
-     { mvBlocks  = mempty
+     { mvHost    = loHost x
+     , mvBlocks  = mempty
      , mvChecked = Nothing
      , mvLeading = Nothing
      }

bench/locli/src/Cardano/Analysis/Ground.hs

@@ -3,6 +3,7 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Cardano.Analysis.Ground
   ( module Cardano.Analysis.Ground
+  , module Data.DataDomain
   , BlockNo (..), EpochNo (..), SlotNo (..)
   )
 where
@@ -25,6 +26,8 @@ import Quiet                            (Quiet (..))
 import Cardano.Slotting.Slot            (EpochNo(..), SlotNo(..))
 import Ouroboros.Network.Block          (BlockNo(..))
 
+import Data.DataDomain
+
 
 newtype TId = TId { unTId :: ShortText }
   deriving (Eq, Generic, Ord)
@@ -104,6 +107,14 @@ newtype JsonOutputFile
   = JsonOutputFile { unJsonOutputFile :: FilePath }
   deriving (Show, Eq)
 
+newtype GnuplotOutputFile
+  = GnuplotOutputFile { unGnuplotOutputFile :: FilePath }
+  deriving (Show, Eq)
+
+newtype OrgOutputFile
+  = OrgOutputFile { unOrgOutputFile :: FilePath }
+  deriving (Show, Eq)
+
 newtype TextOutputFile
   = TextOutputFile { unTextOutputFile :: FilePath }
   deriving (Show, Eq)
@@ -200,6 +211,14 @@ optJsonOutputFile optname desc =
       <> metavar "JSON-OUTFILE"
       <> help desc
 
+optGnuplotOutputFile :: String -> String -> Parser GnuplotOutputFile
+optGnuplotOutputFile optname desc =
+  fmap GnuplotOutputFile $
+    Opt.option Opt.str
+      $ long optname
+      <> metavar "CDF-OUTFILE"
+      <> help desc
+
 optTextOutputFile :: String -> String -> Parser TextOutputFile
 optTextOutputFile optname desc =
   fmap TextOutputFile $

bench/locli/src/Cardano/Analysis/MachPerf.hs

@@ -4,7 +4,7 @@
 {- HLINT ignore "Use head" -}
 module Cardano.Analysis.MachPerf (module Cardano.Analysis.MachPerf) where
 
-import Prelude (error, head, last)
+import Prelude (head, last)
 import Cardano.Prelude hiding (head)
 import Cardano.Prelude qualified as CP
 
@@ -26,14 +26,13 @@ import Cardano.Analysis.ChainFilter
 import Cardano.Analysis.Context
 import Cardano.Analysis.Ground
 import Cardano.Analysis.Run
-import Cardano.Analysis.Version
 import Cardano.Unlog.LogObject hiding (Text)
 import Cardano.Unlog.Resources
 
 
-summariseClusterPerfs :: [Centile] -> [ClusterPerf] -> Either CDFError ClusterPerfs
-summariseClusterPerfs _ [] = error "Asked to summarise empty list of MachPerfOne"
-summariseClusterPerfs centiles mps@(headline:_) = do
+summariseMultiClusterPerf :: [Centile] -> [ClusterPerf] -> Either CDFError MultiClusterPerf
+summariseMultiClusterPerf _ [] = error "Asked to summarise empty list of MachPerfOne"
+summariseMultiClusterPerf centiles mps@(headline:_) = do
   sMissCDF              <- cdf2OfCDFs comb $ mps <&> sMissCDF
   sLeadsCDF             <- cdf2OfCDFs comb $ mps <&> sLeadsCDF
   sUtxoCDF              <- cdf2OfCDFs comb $ mps <&> sUtxoCDF
@@ -50,7 +49,7 @@ summariseClusterPerfs centiles mps@(headline:_) = do
       [] -> Left CDFEmptyDataset
       (xs :: [CDF (CDF I) Word64]) -> cdf2OfCDFs comb xs :: Either CDFError (CDF (CDF I) Word64)
 
-  pure . ClusterPerfs $ MachPerf
+  pure . MultiClusterPerf $ MachPerf
     { sVersion          = sVersion headline
     , sDomainSlots      = dataDomainsMergeOuter $ mps <&> sDomainSlots
     , ..

bench/locli/src/Cardano/Analysis/Run.hs

@@ -1,7 +1,11 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-name-shadowing -Wno-orphans #-}
-module Cardano.Analysis.Run (module Cardano.Analysis.Run) where
+module Cardano.Analysis.Run
+  ( module Cardano.Analysis.Run
+  , module Cardano.Analysis.Version
+  )
+where
 
 import Cardano.Prelude
 
@@ -10,6 +14,8 @@ import Data.Aeson qualified as Aeson
 import Data.Aeson (FromJSON(..), Object, ToJSON(..), withObject, (.:), (.:?))
 import Data.ByteString.Lazy.Char8 qualified as LBS
 import Data.Text qualified as T
+import Data.Time.Clock hiding (secondsToNominalDiffTime)
+import Data.Time.Clock.POSIX
 
 import Cardano.Analysis.ChainFilter
 import Cardano.Analysis.Context
@@ -20,28 +26,61 @@ import Cardano.Util
 -- | Explain the poor human a little bit of what was going on:
 data Anchor
   = Anchor
-  { aRuns    :: ![Text]
-  , aFilters :: ![FilterName]
-  , aVersion :: !Version
+  { aRuns    :: [Text]
+  , aFilters :: [FilterName]
+  , aSlots   :: Maybe (DataDomain SlotNo)
+  , aBlocks  :: Maybe (DataDomain BlockNo)
+  , aVersion :: Version
+  , aWhen    :: UTCTime
   }
 
-runAnchor :: Run -> [FilterName] -> Anchor
+runAnchor :: Run -> UTCTime -> [FilterName] -> Maybe (DataDomain SlotNo) -> Maybe (DataDomain BlockNo) -> Anchor
 runAnchor Run{..} = tagsAnchor [tag metadata]
 
-tagsAnchor :: [Text] -> [FilterName] -> Anchor
-tagsAnchor aRuns aFilters =
+tagsAnchor :: [Text] -> UTCTime -> [FilterName] -> Maybe (DataDomain SlotNo) -> Maybe (DataDomain BlockNo) -> Anchor
+tagsAnchor aRuns aWhen aFilters aSlots aBlocks =
   Anchor { aVersion = getVersion, .. }
 
 renderAnchor :: Anchor -> Text
-renderAnchor Anchor{..} = mconcat
-  [ "runs: ",    T.intercalate ", " aRuns, ", "
-  , "filters: ", case aFilters of
+renderAnchor a = mconcat
+  [ "runs: ", renderAnchorRuns a, ", "
+  , renderAnchorNoRuns a
+  ]
+
+renderAnchorRuns :: Anchor -> Text
+renderAnchorRuns Anchor{..} = mconcat
+  [ T.intercalate ", " aRuns ]
+
+renderAnchorFiltersAndDomains :: Anchor -> Text
+renderAnchorFiltersAndDomains a@Anchor{..} = mconcat
+  [ "filters: ", case aFilters of
                    [] -> "unfiltered"
                    xs -> T.intercalate ", " (unFilterName <$> xs)
-  , ", "
+  , renderAnchorDomains a]
+
+renderAnchorDomains :: Anchor -> Text
+renderAnchorDomains Anchor{..} = mconcat $
+  maybe [] ((:[]) . renderDomain "slot"  (show . unSlotNo)) aSlots
+  <>
+  maybe [] ((:[]) . renderDomain "block" (show . unBlockNo)) aBlocks
+ where renderDomain :: Text -> (a -> Text) -> DataDomain a -> Text
+       renderDomain ty r DataDomain{..} = mconcat
+         [ ", ", ty
+         , " range: raw(", r ddRawFirst,      "-", r ddRawLast , ")"
+         ,   " filtered(", r ddFilteredFirst, "-", r ddFilteredLast, ")"
+         ]
+
+renderAnchorNoRuns :: Anchor -> Text
+renderAnchorNoRuns a@Anchor{..} = mconcat
+  [ renderAnchorFiltersAndDomains a
   , renderProgramAndVersion aVersion
+  , ", analysed at ", renderAnchorDate a
   ]
 
+-- Rounds time to seconds.
+renderAnchorDate :: Anchor -> Text
+renderAnchorDate = show . posixSecondsToUTCTime . secondsToNominalDiffTime . fromIntegral @Int . round . utcTimeToPOSIXSeconds . aWhen
+
 data AnalysisCmdError
   = AnalysisCmdError                         !Text
   | MissingRunContext