locli & workbench: run summary collection

Author: deepfire

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

@@ -36,6 +36,20 @@ import Cardano.Util
 -- * API types
 --
 
+-- | Overall summary of all analyses.
+data Summary where
+  Summary ::
+    { sumWhen                :: !UTCTime
+    , sumLogStreams          :: !(Count [LogObject])
+    , sumLogObjects          :: !(Count LogObject)
+    , sumFilters             :: !([FilterName], [ChainFilter])
+    , sumChainRejectionStats :: ![(ChainFilter, Int)]
+    , sumBlocksRejected      :: !(Count BlockEvents)
+    , sumDomainSlots         :: !(DataDomain SlotNo)
+    , sumDomainBlocks        :: !(DataDomain BlockNo)
+    } -> Summary
+  deriving (Generic, FromJSON, ToJSON, Show)
+
 -- | Results of block propagation analysis.
 data BlockProp f
   = BlockProp

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

@@ -411,7 +411,7 @@ rebuildChain run@Run{genesis} flts fltNames xs@(fmap snd -> machViews) = do
                            & handleMiss "Δt Adopted (forger)"
           , bfChainDelta = bfeChainDelta
           }
-        , beForks = unsafeCoerceCount $ mkCount otherBlocks
+        , beForks = unsafeCoerceCount $ countOfList otherBlocks
         , beObservations =
             catMaybes $
             os <&> \ObserverEvents{..}->

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

@@ -25,12 +25,13 @@ newtype JsonFilterFile
   deriving (Show, Eq)
 
 newtype FilterName = FilterName { unFilterName :: Text }
+  deriving (Eq, FromJSON, Generic, NFData, Show, ToJSON)
 
 -- | Conditions for chain subsetting
 data ChainFilter
   = CBlock BlockCond
   | CSlot  SlotCond
-  deriving (FromJSON, Generic, NFData, Show, ToJSON)
+  deriving (Eq, FromJSON, Generic, NFData, Ord, Show, ToJSON)
 
 -- | Block classification -- primary for validity as subjects of analysis.
 data BlockCond
@@ -42,7 +43,7 @@ data BlockCond
   | BSizeLEq               Word64
   | BMinimumAdoptions      Word64 -- ^ At least this many adoptions
   | BNonNegatives                 -- ^ Non-negative timings only
-  deriving (FromJSON, Generic, NFData, Show, ToJSON)
+  deriving (Eq, FromJSON, Generic, NFData, Ord, Show, ToJSON)
 
 data SlotCond
   = SlotGEq         SlotNo
@@ -54,7 +55,7 @@ data SlotCond
   | EpSlotGEq       EpochSlot
   | EpSlotLEq       EpochSlot
   | SlotHasLeaders
-  deriving (FromJSON, Generic, NFData, Show, ToJSON)
+  deriving (Eq, FromJSON, Generic, NFData, Ord, Show, ToJSON)
 
 cfIsSlotCond, cfIsBlockCond :: ChainFilter -> Bool
 cfIsSlotCond  = \case { CSlot{}  -> True; _ -> False; }

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

@@ -55,11 +55,14 @@ instance FromJSONKey Hash where
 
 newtype Count a = Count { unCount :: Int }
   deriving (Eq, Generic, Ord, Show)
-  deriving newtype (FromJSON, ToJSON)
+  deriving newtype (FromJSON, Num, ToJSON)
   deriving anyclass NFData
 
-mkCount :: [a] -> Count a
-mkCount = Count . fromIntegral . length
+countOfList :: [a] -> Count a
+countOfList = Count . fromIntegral . length
+
+countOfLists :: [[a]] -> Count a
+countOfLists = Count . fromIntegral . sum . fmap length
 
 unsafeCoerceCount :: Count a -> Count b
 unsafeCoerceCount = Unsafe.unsafeCoerce

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

@@ -26,17 +26,17 @@ import Cardano.Util
 data Anchor
   = Anchor
   { aRuns    :: [Text]
-  , aFilters :: [FilterName]
+  , aFilters :: ([FilterName], [ChainFilter])
   , aSlots   :: Maybe (DataDomain SlotNo)
   , aBlocks  :: Maybe (DataDomain BlockNo)
   , aVersion :: Cardano.Analysis.Version.Version
   , aWhen    :: UTCTime
   }
 
-runAnchor :: Run -> UTCTime -> [FilterName] -> Maybe (DataDomain SlotNo) -> Maybe (DataDomain BlockNo) -> Anchor
+runAnchor :: Run -> UTCTime -> ([FilterName], [ChainFilter]) -> Maybe (DataDomain SlotNo) -> Maybe (DataDomain BlockNo) -> Anchor
 runAnchor Run{..} = tagsAnchor [tag metadata]
 
-tagsAnchor :: [Text] -> UTCTime -> [FilterName] -> Maybe (DataDomain SlotNo) -> Maybe (DataDomain BlockNo) -> Anchor
+tagsAnchor :: [Text] -> UTCTime -> ([FilterName], [ChainFilter]) -> Maybe (DataDomain SlotNo) -> Maybe (DataDomain BlockNo) -> Anchor
 tagsAnchor aRuns aWhen aFilters aSlots aBlocks =
   Anchor { aVersion = getVersion, .. }
 
@@ -52,7 +52,7 @@ renderAnchorRuns Anchor{..} = mconcat
 
 renderAnchorFiltersAndDomains :: Anchor -> Text
 renderAnchorFiltersAndDomains a@Anchor{..} = mconcat
-  [ "filters: ", case aFilters of
+  [ "filters: ", case fst aFilters of
                    [] -> "unfiltered"
                    xs -> T.intercalate ", " (unFilterName <$> xs)
   , renderAnchorDomains a]

bench/locli/src/Cardano/Command.hs

@@ -1,11 +1,12 @@
-{-# OPTIONS_GHC -fmax-pmcheck-models=15000 #-}
+{-# OPTIONS_GHC -fmax-pmcheck-models=25000 #-}
 module Cardano.Command (module Cardano.Command) where
 
 import Cardano.Prelude                  hiding (State, head)
 
 import Data.Aeson                       qualified as Aeson
 import Data.ByteString                  qualified as BS
 import Data.ByteString.Lazy.Char8       qualified as LBS
+import Data.Map.Strict                  qualified as Map
 import Data.Text                        (pack)
 import Data.Text                        qualified as T
 import Data.Text.Short                  (toText)
@@ -69,7 +70,6 @@ data ChainCommand
   |      ComputePropagation
   |       RenderPropagation RenderFormat TextOutputFile PropSubset
   |        ReadPropagations [JsonInputFile BlockPropOne]
-
   | ComputeMultiPropagation
   |  RenderMultiPropagation RenderFormat TextOutputFile PropSubset CDF2Aspect
 
@@ -79,10 +79,13 @@ data ChainCommand
   |      ComputeClusterPerf
   |       RenderClusterPerf RenderFormat TextOutputFile PerfSubset
   |        ReadClusterPerfs [JsonInputFile MultiClusterPerf]
-
   | ComputeMultiClusterPerf
   |  RenderMultiClusterPerf RenderFormat TextOutputFile PerfSubset CDF2Aspect
 
+  |      ComputeSummary
+  |       RenderSummary     RenderFormat TextOutputFile
+  |         ReadSummaries   [JsonInputFile Summary]
+
   |             Compare     InputDir (Maybe TextInputFile) TextOutputFile
                             [( JsonInputFile RunPartial
                              , JsonInputFile Genesis
@@ -212,7 +215,20 @@ parseChainCommand =
      (writerOpts RenderMultiClusterPerf "Render"
       <*> parsePerfSubset
       <*> parseCDF2Aspect)
+   ]) <|>
+
+   subparser (mconcat [ commandGroup "Analysis summary"
+   , op "compute-summary" "Compute run analysis summary"
+     (ComputeSummary & pure)
+   , op "render-summary" "Render run analysis summary"
+     (writerOpts RenderSummary "Render")
+   , op "read-summaries" "Read analysis summaries"
+     (ReadSummaries
+       <$> some
+       (optJsonInputFile     "summary"          "JSON block propagation input file"))
+   ]) <|>
 
+   subparser (mconcat [ commandGroup "Run comparison"
    , op "compare" "Generate a report comparing multiple runs"
      (Compare
        <$> optInputDir       "ede"      "Directory with EDE templates."
@@ -289,7 +305,7 @@ data State
   = State
   { -- common
     sWhen             :: UTCTime
-  , sFilters          :: [FilterName]
+  , sFilters          :: ([FilterName], [ChainFilter])
   , sTags             :: [Text]
   , sRun              :: Maybe Run
   , sObjLists         :: Maybe [(JsonLogfile, [LogObject])]
@@ -308,8 +324,46 @@ data State
   , sMachPerf         :: Maybe [(JsonLogfile, MachPerfOne)]
   , sClusterPerf      :: Maybe [ClusterPerf]
   , sMultiClusterPerf :: Maybe MultiClusterPerf
+    --
+  , sSummaries        :: Maybe [Summary]
   }
 
+computeSummary :: State -> Summary
+computeSummary =
+  \case
+    State{sRun           = Nothing} -> err "a run"
+    State{sObjLists      = Nothing} -> err "logobjects"
+    State{sObjLists      = Just []} -> err "logobjects"
+    State{sClusterPerf   = Nothing} -> err "cluster performance results"
+    State{sBlockProp     = Nothing} -> err "block propagation results"
+    State{sChainRejecta  = Nothing} -> err "chain rejects"
+    State{sDomSlots      = Nothing} -> err "a slot domain"
+    State{sDomBlocks     = Nothing} -> err "a block domain"
+    State{ sObjLists     = Just (fmap snd -> objLists)
+         -- , sClusterPerf  = Just clusterPerf
+         -- , sBlockProp    = Just blockProp
+         , sChainRejecta = Just chainRejecta
+         , sDomSlots     = Just sumDomainSlots
+         , sDomBlocks    = Just sumDomainBlocks
+         , ..} ->
+      Summary
+      { sumWhen                = sWhen
+      , sumFilters             = sFilters
+      , sumLogStreams          = countOfList  objLists
+      , sumLogObjects          = countOfLists objLists
+      , sumBlocksRejected      = countOfList chainRejecta
+      , ..
+      }
+     where
+       sumChainRejectionStats =
+         chainRejecta
+         <&> fmap fst . filter (not . snd) . beAcceptance
+          &  concat
+          &  foldr' (\k m -> Map.insertWith (+) k 1 m) Map.empty
+          &  Map.toList
+ where
+   err = error . ("Summary of a run requires " <>)
+
 sRunAnchor :: State -> Anchor
 sRunAnchor State{sRun = Just run, sFilters, sWhen, sDomSlots, sDomBlocks}
   = runAnchor run sWhen sFilters sDomSlots sDomBlocks
@@ -391,7 +445,7 @@ runChainCommand s@State{sRun=Just run, sMachViews=Just mvs}
          , sChainRejecta = Just chainRejecta
          , sDomSlots = Just domSlot
          , sDomBlocks = Just domBlock
-         , sFilters = fltNames
+         , sFilters = (fltNames, flts)
          }
   -- pure s { sChain = Just chain }
 runChainCommand _ c@RebuildChain{} = missingCommandData c
@@ -467,7 +521,7 @@ runChainCommand s@State{sRun=Just run, sSlotsRaw=Just slotsRaw}
       [ "All ", show $ maximum (length . snd <$> slotsRaw), " slots filtered out." ]
   pure s { sSlots = Just fltrd
          , sDomSlots = Just domSlots
-         , sFilters = fltNames
+         , sFilters = (fltNames, flts)
          }
 runChainCommand _ c@FilterSlots{} = missingCommandData c
   ["run metadata & genesis", "unfiltered slot stats"]
@@ -612,6 +666,28 @@ runChainCommand s@State{sMultiClusterPerf=Just (MultiClusterPerf perf)}
 runChainCommand _ c@RenderMultiClusterPerf{} = missingCommandData c
   ["multi-run cluster preformance stats"]
 
+runChainCommand s ComputeSummary = do
+  progress "summary" (Q "summarising a run")
+  pure s { sSummaries = Just [computeSummary s] }
+
+runChainCommand s@State{sSummaries = Just (_summary:_)} c@(RenderSummary fmt f) = do
+  progress "summary" (Q $ printf "rendering summary")
+  dumpText "summary" body (modeFilename f "" fmt)
+    & firstExceptT (CommandError c)
+  pure s
+ where body = [""] -- renderSummary summary
+runChainCommand _ c@RenderSummary{} = missingCommandData c
+  ["run summary"]
+
+runChainCommand s@State{}
+  c@(ReadSummaries fs) = do
+  progress "summaries" (Q $ printf "reading %d run summaries" $ length fs)
+  xs <- mapConcurrently (fmap (Aeson.eitherDecode @Summary) . LBS.readFile . unJsonInputFile) fs
+    & fmap sequence
+    & newExceptT
+    & firstExceptT (CommandError c . show)
+  pure s { sSummaries = Just xs }
+
 runChainCommand s c@(Compare ede mTmpl outf@(TextOutputFile outfp) runs) = do
   progress "report" (Q $ printf "rendering report for %d runs" $ length runs)
   xs :: [(ClusterPerf, BlockPropOne, Run)] <- forM runs $
@@ -666,11 +742,11 @@ runCommand (ChainCommand cs) = do
  where
    initialState :: UTCTime -> State
    initialState now =
-     State now [] []
+     State now ([], []) []
+           Nothing Nothing Nothing Nothing
            Nothing Nothing Nothing Nothing
            Nothing Nothing Nothing Nothing
            Nothing Nothing Nothing Nothing
-           Nothing Nothing Nothing
 
 opts :: ParserInfo Command
 opts =