locli & workbench: CDF exports & various cleanups

Author: deepfire

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

@@ -59,8 +59,8 @@ deriving instance (Show     (f NominalDiffTime), Show     (f Int)) => Show     (
 deriving instance (FromJSON (f NominalDiffTime), FromJSON (f Int)) => FromJSON (BlockProp f)
 deriving instance (ToJSON   (f NominalDiffTime), ToJSON   (f Int)) => ToJSON   (BlockProp f)
 
-type BlockPropOne = BlockProp I
-type BlockProps   = BlockProp (CDF I)
+type BlockPropOne   = BlockProp I
+type MultiBlockProp = BlockProp (CDF I)
 
 -- | All events related to a block.
 data BlockEvents
@@ -215,8 +215,8 @@ type    ClusterPerf  = MachPerf (CDF I)
 
 -- | Bunch'a bunches'a machine performances.
 --   Same as above, since we collapse [CDF I] into CDF I -- just with more statistical confidence.
-newtype ClusterPerfs
-  = ClusterPerfs { unClusterPerfs :: ClusterPerf }
+newtype MultiClusterPerf
+  = MultiClusterPerf { unMultiClusterPerf :: ClusterPerf }
   deriving newtype (ToJSON, FromJSON)
 
 deriving newtype instance FromJSON a => FromJSON (I a)
@@ -306,17 +306,27 @@ testSlotStats g SlotStats{..} = \case
 --
 -- * Timeline rendering instances
 --
-bpFieldsForger :: Field DSelect p a -> Bool
-bpFieldsForger Field{fId} = elem fId
+bpFieldSelectForger :: Field DSelect p a -> Bool
+bpFieldSelectForger Field{fId} = elem fId
   [ "fChecked", "fLeading", "fForged", "fAdopted", "fAnnounced", "fSendStart" ]
 
-bpFieldsPeers :: Field DSelect p a -> Bool
-bpFieldsPeers Field{fId} = elem fId
-  [ "noticedVal", "requestedVal", "fetchedVal", "pAdoptedVal", "pAnnouncedVal", "pSendStartVal" ]
+bpFieldSelectPeers :: Field DSelect p a -> Bool
+bpFieldSelectPeers Field{fId} = elem fId
+  [ "pNoticed", "pRequested", "pFetched", "pAdopted", "pAnnounced", "pSendStart" ]
 
-bpFieldsPropagation :: Field DSelect p a -> Bool
-bpFieldsPropagation Field{fHead2} = elem fHead2
-  [ "0.50", "0.80", "0.90", "0.92", "0.94", "0.96", "0.98", "1.00" ]
+bpFieldSelectPropagation :: Field DSelect p a -> Bool
+bpFieldSelectPropagation Field{fHead2} = elem fHead2 adoptionPctsRendered
+
+renderAdoptionCentile :: Centile -> Text
+renderAdoptionCentile = T.pack . printf "prop%0.2f" . unCentile
+
+adoptionPctsRendered :: [Text]
+adoptionPctsRendered = adoptionPcts <&> T.drop 4 . renderAdoptionCentile
+
+adoptionPcts :: [Centile]
+adoptionPcts =
+  [ Centile 0.5, Centile 0.8, Centile 0.9
+  , Centile 0.92, Centile 0.94, Centile 0.96, Centile 0.98, Centile 1.0 ]
 
 instance RenderCDFs BlockProp p where
   rdFields =
@@ -334,27 +344,24 @@ instance RenderCDFs BlockProp p where
     , Field 5 0 "pAnnounced"    (p!!4) "Annou"  $ DDeltaT bpPeerAnnouncements
     , Field 5 0 "pSendStart"    (p!!5) "Send"   $ DDeltaT bpPeerSends
     ] ++
-    [ Field 5 0 (printf "prop%.02f" ps & T.pack)
+    [ Field 5 0 (renderAdoptionCentile ct)
                                 (r!!i)
-            (T.take 4 $ T.pack $ printf "%.04f" ps)
-            (DDeltaT ((\(ps', d) ->
-                         if ps' == ps then d
-                         else error $ printf "Centile mismatch: [%d]: exp=%f act=%f" i ps ps')
+                                       (T.take 4 $ T.pack $ printf "%.04f" centi)
+            (DDeltaT ((\(centi', d) ->
+                         if centi' == centi then d
+                         else error $ printf "Centile mismatch: [%d]: exp=%f act=%f"
+                                             i centi centi')
                       . fromMaybe
-                        (error $ printf "No centile %d/%f in bpPropagation." i ps)
+                        (error $ printf "No centile %d/%f in bpPropagation." i centi)
                       . flip atMay i . bpPropagation))
-    | (i, Centile ps) <- zip [0::Int ..] (adoptionPcts <> [Centile 1.0]) ] ++
+    | (i, ct@(Centile centi)) <- zip [0::Int ..] adoptionPcts ] ++
     [ Field 9 0 "sizes"         "Size"  "bytes" $ DInt    bpSizes
     ]
    where
      f = nChunksEachOf 6    7 "--- Forger event Δt: ---"
      p = nChunksEachOf 6    6 "--- Peer event Δt: ---"
      r = nChunksEachOf aLen 6 "Slot-rel. Δt to adoption centile:"
-     aLen = length adoptionPcts + 1 -- +1 is for the implied 1.0 centile
-
-adoptionPcts :: [Centile]
-adoptionPcts =
-  [ Centile 0.5, Centile 0.8, Centile 0.9, Centile 0.92, Centile 0.94, Centile 0.96, Centile 0.98 ]
+     aLen = length adoptionPcts
 
 instance RenderTimeline BlockEvents where
   rtFields _ =
@@ -382,7 +389,7 @@ instance RenderTimeline BlockEvents where
     , Field 5 0 "pSendStartVal" (p!!5) "Send"   $ IDeltaT (af' boSending   . valids)
     , Field 5 0 "pPropag0.5"    (r!!0) "0.5"    $ IDeltaT (percSpec 0.5  . bePropagation)
     , Field 5 0 "pPropag0.96"   (r!!1) "0.96"   $ IDeltaT (percSpec 0.96 . bePropagation)
-    , Field 5 0 "pPropag1.0"    (r!!2) "1.0"    $ IDeltaT (percSpec 1.0  . bePropagation)
+    , Field 5 0 "pPropag1.0"    (r!!2) "1.0"    $ IDeltaT (snd . cdfRange . bePropagation)
     , Field 5 0 "errors"        "all"  "errs"   $ IInt    (length . beErrors)
     , Field 3 0 "missAdopt"     (m!!0) "ado"    $ IInt    (count (bpeIsMissing Adopt) . beErrors)
     , Field 3 0 "missAnnou"     (m!!1) "ann"    $ IInt    (count (bpeIsMissing Announce) . beErrors)

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

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

@@ -104,6 +104,10 @@ newtype JsonOutputFile
   = JsonOutputFile { unJsonOutputFile :: FilePath }
   deriving (Show, Eq)
 
+newtype CDFOutputFile
+  = CDFOutputFile { unCDFOutputFile :: FilePath }
+  deriving (Show, Eq)
+
 newtype TextOutputFile
   = TextOutputFile { unTextOutputFile :: FilePath }
   deriving (Show, Eq)
@@ -200,6 +204,14 @@ optJsonOutputFile optname desc =
       <> metavar "JSON-OUTFILE"
       <> help desc
 
+optCDFOutputFile :: String -> String -> Parser CDFOutputFile
+optCDFOutputFile optname desc =
+  fmap CDFOutputFile $
+    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

@@ -31,9 +31,9 @@ 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 +50,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

@@ -10,6 +10,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
+import Data.Time.Clock.POSIX
 
 import Cardano.Analysis.ChainFilter
 import Cardano.Analysis.Context
@@ -20,16 +22,17 @@ 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]
+  , aVersion :: Version
+  , aWhen    :: UTCTime
   }
 
-runAnchor :: Run -> [FilterName] -> Anchor
+runAnchor :: Run -> UTCTime -> [FilterName] -> Anchor
 runAnchor Run{..} = tagsAnchor [tag metadata]
 
-tagsAnchor :: [Text] -> [FilterName] -> Anchor
-tagsAnchor aRuns aFilters =
+tagsAnchor :: [Text] -> UTCTime -> [FilterName] -> Anchor
+tagsAnchor aRuns aWhen aFilters =
   Anchor { aVersion = getVersion, .. }
 
 renderAnchor :: Anchor -> Text
@@ -40,6 +43,8 @@ renderAnchor Anchor{..} = mconcat
                    xs -> T.intercalate ", " (unFilterName <$> xs)
   , ", "
   , renderProgramAndVersion aVersion
+  , ", analysed at "
+  , show (posixSecondsToUTCTime . utcTimeToPOSIXSeconds $ aWhen) -- Round to seconds.
   ]
 
 data AnalysisCmdError