From cea32c4180ed0c146fd69e7773cbc897d3f541c3 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge Date: Mon, 7 Nov 2022 07:20:42 +0800 Subject: [PATCH] locli & workbench: run summary collection --- bench/locli/src/Cardano/Analysis/API.hs | 16 +++- bench/locli/src/Cardano/Analysis/BlockProp.hs | 2 +- .../locli/src/Cardano/Analysis/ChainFilter.hs | 7 +- bench/locli/src/Cardano/Analysis/Ground.hs | 9 +- bench/locli/src/Cardano/Analysis/Run.hs | 8 +- bench/locli/src/Cardano/Command.hs | 92 +++++++++++++++++-- 6 files changed, 114 insertions(+), 20 deletions(-) diff --git a/bench/locli/src/Cardano/Analysis/API.hs b/bench/locli/src/Cardano/Analysis/API.hs index 6057327f479..9d82646cd7a 100644 --- a/bench/locli/src/Cardano/Analysis/API.hs +++ b/bench/locli/src/Cardano/Analysis/API.hs @@ -16,7 +16,7 @@ import Cardano.Prelude hiding (head) import Data.Aeson (ToJSON(..), FromJSON(..)) import Data.Text qualified as T import Data.Text.Short (toText) -import Data.Time.Clock (NominalDiffTime) +import Data.Time.Clock (NominalDiffTime, UTCTime) import Options.Applicative qualified as Opt import Text.Printf (PrintfArg) @@ -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 diff --git a/bench/locli/src/Cardano/Analysis/BlockProp.hs b/bench/locli/src/Cardano/Analysis/BlockProp.hs index c1d6fda1a78..e55e10730eb 100644 --- a/bench/locli/src/Cardano/Analysis/BlockProp.hs +++ b/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{..}-> diff --git a/bench/locli/src/Cardano/Analysis/ChainFilter.hs b/bench/locli/src/Cardano/Analysis/ChainFilter.hs index f48e9d2cfa3..2653c43baf6 100644 --- a/bench/locli/src/Cardano/Analysis/ChainFilter.hs +++ b/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; } diff --git a/bench/locli/src/Cardano/Analysis/Ground.hs b/bench/locli/src/Cardano/Analysis/Ground.hs index ad3c0400acc..020751c98f9 100644 --- a/bench/locli/src/Cardano/Analysis/Ground.hs +++ b/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 diff --git a/bench/locli/src/Cardano/Analysis/Run.hs b/bench/locli/src/Cardano/Analysis/Run.hs index bf6607997fd..bdb123d62fb 100644 --- a/bench/locli/src/Cardano/Analysis/Run.hs +++ b/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] diff --git a/bench/locli/src/Cardano/Command.hs b/bench/locli/src/Cardano/Command.hs index 1f229095f6b..167a19dc17a 100644 --- a/bench/locli/src/Cardano/Command.hs +++ b/bench/locli/src/Cardano/Command.hs @@ -1,4 +1,4 @@ -{-# 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) @@ -6,6 +6,7 @@ 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 =