Merge pull request #4694 from input-output-hk/bench-master

workbench: get rid of some unnecessary complications

Makefile

@@ -59,7 +59,7 @@ 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 .
+	nix build .#all-profiles-json && cat result
 show-profile:                                    ## NAME=profile-name
 	@test -n "${NAME}" || { echo 'HELP:  to specify profile to show, add NAME=profle-name' && exit 1; }
 	nix build .#all-profiles-json --json --option substitute false | jq '.[0].outputs.out' -r | xargs jq ".\"${NAME}\" | if . == null then error(\"\n###\n### Error:  unknown profile: ${NAME}  Please consult:  make list-profiles\n###\") else . end"

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

@@ -18,6 +18,7 @@ import Data.Aeson.Types                 (toJSONKeyText)
 import Data.Attoparsec.Text             qualified as Atto
 import Data.Attoparsec.Time             qualified as Iso8601
 import Data.ByteString.Lazy.Char8       qualified as LBS
+import Data.Map.Strict                  qualified as Map
 import Data.Text                        qualified as T
 import Data.Text.Short                  qualified as SText
 import Data.Text.Short                  (ShortText, fromText, toText)
@@ -56,6 +57,10 @@ shortHash = toText . SText.take 6 . unHash
 
 instance Show Hash where show = T.unpack . toText . unHash
 
+instance ToJSONKey Host where
+  toJSONKey = toJSONKeyText (toText . unHost)
+instance FromJSONKey Host where
+  fromJSONKey = FromJSONKeyText (Host . fromText)
 instance ToJSONKey Hash where
   toJSONKey = toJSONKeyText (toText . unHash)
 instance FromJSONKey Hash where
@@ -66,6 +71,9 @@ newtype Count a = Count { unCount :: Int }
   deriving newtype (FromJSON, Num, ToJSON)
   deriving anyclass NFData
 
+countMap :: Map.Map a b -> Count a
+countMap = Count . Map.size
+
 countList :: (a -> Bool) -> [a] -> Count a
 countList f = Count . fromIntegral . count f
 
@@ -121,11 +129,12 @@ newtype InputDir
 newtype JsonLogfile
   = JsonLogfile { unJsonLogfile :: FilePath }
   deriving (Show, Eq)
-  deriving newtype (NFData)
+  deriving newtype (FromJSON, ToJSON, NFData)
 
 newtype JsonInputFile (a :: Type)
   = JsonInputFile { unJsonInputFile :: FilePath }
   deriving (Show, Eq)
+  deriving newtype (FromJSON, ToJSON)
 
 newtype JsonOutputFile (a :: Type)
   = JsonOutputFile { unJsonOutputFile :: FilePath }
@@ -314,10 +323,9 @@ dumpObjects ident xs (JsonOutputFile f) = liftIO $ do
 dumpAssociatedObjects :: ToJSON a => String -> [(JsonLogfile, a)] -> ExceptT Text IO ()
 dumpAssociatedObjects ident xs = liftIO $
   flip mapConcurrently_ xs $
-    \(JsonLogfile f, x) -> do
-        progress ident (Q f)
-        withFile (replaceExtension f $ ident <> ".json") WriteMode $ \hnd ->
-          LBS.hPutStrLn hnd $ encode x
+    \(JsonLogfile f, x) ->
+      withFile (replaceExtension f $ ident <> ".json") WriteMode $ \hnd ->
+        LBS.hPutStrLn hnd $ encode x
 
 readAssociatedObjects :: forall a.
   FromJSON a => String -> [JsonLogfile] -> ExceptT Text IO [(JsonLogfile, a)]

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

@@ -42,8 +42,10 @@ sumFieldsReport =
   , "delegators", "utxo"
   , "add_tx_size", "inputs_per_tx", "outputs_per_tx" , "tps", "tx_count"
   , "plutusScript"
-  , "sumLogStreams", "sumLogObjectsTotal"
+  , "sumHosts", "sumLogObjectsTotal"
   , "sumFilters"
+  , "cdfLogLinesEmitted", "cdfLogObjectsEmitted", "cdfLogObjects"
+  , "cdfRuntime", "cdfLogLineRate"
   , "ddRawCount.sumDomainTime", "ddFilteredCount.sumDomainTime", "dataDomainFilterRatio.sumDomainTime"
   , "ddRaw.sumStartSpread", "ddRaw.sumStopSpread"
   , "ddFiltered.sumStartSpread", "ddFiltered.sumStopSpread"
@@ -130,16 +132,36 @@ instance TimelineFields SummaryOne where
       "Plutus script"
       "Name of th Plutus script used for smart contract workload generation, if any"
 
-   <> fScalar "sumLogStreams"          Wno Cnt (IInt   $          unCount.sumLogStreams)
+   <> fScalar "sumHosts"               Wno Cnt (IInt   $   unCount.sumHosts)
       "Machines"
       "Number of machines under analysis"
 
-   <> fScalar "sumLogObjectsTotal"     Wno Cnt (IInt   $     unCount.sumLogObjectsTotal)
-      "Total log objects analysed"
+   <> fScalar "sumFilters"             Wno Cnt (IInt   $   length.snd.sumFilters)
+      "Number of filters applied"
       ""
 
-   <> fScalar "sumFilters"             Wno Cnt (IInt   $          length.snd.sumFilters)
-      "Number of filters applied"
+   <> fScalar "cdfLogLinesEmitted"     W6  Cnt (IFloat $ cdfAverageVal.cdfLogLinesEmitted)
+      "Log text lines emitted per host"
+      ""
+
+   <> fScalar "cdfLogObjectsEmitted"   W6  Cnt (IFloat $ cdfAverageVal.cdfLogObjectsEmitted)
+      "Log objects emitted per host"
+      ""
+
+   <> fScalar "cdfLogObjects"          W6  Cnt (IFloat $ cdfAverageVal.cdfLogObjects)
+      "Log objects analysed per host"
+      ""
+
+   <> fScalar "cdfRuntime"             W6  Sec (IFloat $ cdfAverageVal.cdfRuntime)
+      "Host run time, s"
+      ""
+
+   <> fScalar "cdfLogLineRate"         W6  Hz (IFloat $ cdfAverageVal.cdfLogLineRate)
+      "Host log line rate, Hz"
+      ""
+
+   <> fScalar "sumLogObjectsTotal"     Wno Cnt (IInt   $ unCount.sumLogObjectsTotal)
+      "Total log objects analysed"
       ""
 
    <> fScalar "ddRawCount.sumDomainTime"      Wno Sec (IInt   $       ddRawCount.sumDomainTime)

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

@@ -34,7 +34,7 @@ data Summary f where
     , sumGenesis             :: !Genesis
     , sumGenesisSpec         :: !GenesisSpec
     , sumGenerator           :: !GeneratorProfile
-    , sumLogStreams          :: !(Count [LogObject])
+    , sumHosts               :: !(Count Host)
     , sumLogObjectsTotal     :: !(Count LogObject)
     , sumFilters             :: !([FilterName], [ChainFilter])
     , sumChainRejectionStats :: ![(ChainFilter, Int)]
@@ -44,17 +44,20 @@ data Summary f where
     , sumStopSpread          :: !(DataDomain UTCTime)
     , sumDomainSlots         :: !(DataDomain SlotNo)
     , sumDomainBlocks        :: !(DataDomain BlockNo)
-    , cdfLogObjects          :: !(CDF f Int)
+    , cdfLogLinesEmitted     :: !(CDF f Int)
     , cdfLogObjectsEmitted   :: !(CDF f Int)
+    , cdfLogObjects          :: !(CDF f Int)
+    , cdfRuntime             :: !(CDF f NominalDiffTime)
+    , cdfLogLineRate         :: !(CDF f Double)
     } -> Summary f
   deriving (Generic)
 
 type SummaryOne   = Summary I
 type MultiSummary = Summary (CDF I)
 
-deriving instance (FromJSON (f Int), FromJSON (f Double)) => FromJSON (Summary f)
-deriving instance (  ToJSON (f Int),   ToJSON (f Double)) =>   ToJSON (Summary f)
-deriving instance (    Show (f Int),     Show (f Double)) =>     Show (Summary f)
+deriving instance (FromJSON (f NominalDiffTime), FromJSON (f Int), FromJSON (f Double)) => FromJSON (Summary f)
+deriving instance (  ToJSON (f NominalDiffTime),   ToJSON (f Int),   ToJSON (f Double)) =>   ToJSON (Summary f)
+deriving instance (    Show (f NominalDiffTime),     Show (f Int),     Show (f Double)) =>     Show (Summary f)
 
 data BlockStats
   = BlockStats

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

@@ -18,7 +18,7 @@ computeSummary ::
   -> Genesis
   -> GenesisSpec
   -> GeneratorProfile
-  -> [(Count Cardano.Prelude.Text, [LogObject])]
+  -> RunLogs [LogObject]
   -> ([FilterName], [ChainFilter])
   -> ClusterPerf
   -> BlockPropOne
@@ -29,14 +29,14 @@ computeSummary sumAnalysisTime
                sumGenesis
                sumGenesisSpec
                sumGenerator
-               loCountsObjLists
+               rl@RunLogs{..}
                sumFilters
                MachPerf{..}
                BlockProp{..}
                Chain{..}
   =
   Summary
-  { sumLogStreams      = countListAll  objLists
+  { sumHosts           = countMap rlHostLogs
   , sumLogObjectsTotal = countListsAll objLists
   , sumBlocksRejected  = countListAll cRejecta
   , sumDomainTime      =
@@ -54,17 +54,30 @@ computeSummary sumAnalysisTime
   , sumDomainSlots     = Prelude.head mpDomainSlots
   , sumDomainBlocks    = Prelude.head bpDomainBlocks
   --
-  , cdfLogObjects        = cdf stdCentiles           (length <$> objLists)
-  , cdfLogObjectsEmitted = cdf stdCentiles (loCountsObjLists <&> unCount . fst)
+  , cdfLogObjects        = cdf stdCentiles (objLists <&> length)
+  , cdfLogObjectsEmitted = cdf stdCentiles logObjectsEmitted
+  , cdfLogLinesEmitted   = cdf stdCentiles textLinesEmitted
+  , cdfRuntime           = cdf stdCentiles runtimes
   , ..
   }
  where
-   objLists = loCountsObjLists <&> snd
+   cdfLogLineRate       = cdf stdCentiles lineRates
+
+   (,) logObjectsEmitted textLinesEmitted =
+     rlHostLogs
+     & Map.toList
+     & fmap ((hlRawLogObjects &&& hlRawLines) . snd)
+     & unzip
+   objLists = rlLogs rl <&> snd
 
    (,) minStartRaw maxStartRaw = (minimum &&& maximum) losFirsts
    (,) minStopRaw  maxStopRaw  = (minimum &&& maximum) losLasts
    losFirsts  = objLists <&> loAt . Prelude.head
    losLasts   = objLists <&> loAt . Prelude.last
+   runtimes :: [NominalDiffTime]
+   runtimes   = zipWith diffUTCTime losLasts losFirsts
+   lineRates  = zipWith (/) (textLinesEmitted <&> fromIntegral)
+                            (runtimes <&> fromIntegral @Int . truncate)
 
    (,) minStartFlt maxStartFlt = (timeOf *** timeOf) startMinMaxS
    (,) minStopFlt  maxStopFlt  = (timeOf *** timeOf) stopMinMaxS

bench/locli/src/Cardano/Command.hs

@@ -6,6 +6,7 @@ import Cardano.Prelude          hiding (State)
 import Data.Aeson                       qualified as Aeson
 import Data.ByteString                  qualified as BS
 import Data.ByteString.Lazy.Char8       qualified as LBS
+import Data.Map                         qualified as Map
 import Data.Text                        (pack)
 import Data.Text                        qualified as T
 import Data.Text.Short                  (toText)
@@ -45,7 +46,7 @@ data ChainCommand
 
   |        MetaGenesis      (JsonInputFile RunPartial) (JsonInputFile Genesis)
 
-  |        Unlog            [JsonLogfile] (Maybe HostDeduction) Bool [LOAnyType]
+  |        Unlog            (JsonInputFile (RunLogs ())) Bool [LOAnyType]
   |        DumpLogObjects
 
   |        BuildMachViews
@@ -107,11 +108,7 @@ parseChainCommand =
   subparser (mconcat [ commandGroup "Basic log objects"
    , op "unlog" "Read log files"
      (Unlog
-       <$> some
-           (optJsonLogfile    "log"             "JSON log stream")
-       <*> optional
-           (parseHostDeduction "host-from-log-filename"
-                                                "Derive hostname from log filename: logs-HOSTNAME.*")
+       <$> optJsonInputFile    "run-logs"       "Run log manifest (API/Types.hs:RunLogs)"
        <*> Opt.flag False True (Opt.long "lodecodeerror-ok"
                                     <> Opt.help "Allow non-EOF LODecodeError logobjects")
        <*> many
@@ -243,13 +240,6 @@ parseChainCommand =
      command c $ info (p <**> helper) $
        mconcat [ progDesc descr ]
 
-   parseHostDeduction :: String -> String -> Parser HostDeduction
-   parseHostDeduction name desc =
-     Opt.flag' HostFromLogfilename
-     (  Opt.long name
-     <> Opt.help desc
-     )
-
    optLOAnyType :: String -> String -> Parser LOAnyType
    optLOAnyType opt desc =
      Opt.option Opt.auto
@@ -291,7 +281,7 @@ data State
   , sFilters          :: ([FilterName], [ChainFilter])
   , sTags             :: [Text]
   , sRun              :: Maybe Run
-  , sObjLists         :: Maybe [(JsonLogfile, [LogObject])]
+  , sRunLogs          :: Maybe (RunLogs [LogObject])
   , sDomSlots         :: Maybe (DataDomain SlotNo)
     -- propagation
   , sMachViews        :: Maybe [(JsonLogfile, MachView)]
@@ -313,19 +303,18 @@ callComputeSummary :: State -> Either Text SummaryOne
 callComputeSummary =
   \case
     State{sRun           = Nothing} -> err "a run"
-    State{sObjLists      = Nothing} -> err "logobjects"
-    State{sObjLists      = Just []} -> err "logobjects"
+    State{sRunLogs       = Nothing} -> err "logobjects"
     State{sClusterPerf   = Nothing} -> err "cluster performance results"
     State{sBlockProp     = Nothing} -> err "block propagation results"
     State{sChain         = Nothing} -> err "chain"
-    State{ sObjLists     = Just (fmap snd -> objLists)
+    State{ sRunLogs      = Just runLogs
          , sClusterPerf  = Just [clusterPerf]
          , sBlockProp    = Just [blockProp']
          , sChain        = Just chain
          , sRun          = Just Run{..}
          , ..} -> Right $
       computeSummary sWhen metadata genesis genesisSpec generatorProfile
-                     (zip (Count <$> [0..]) objLists) sFilters
+                     runLogs sFilters
                      clusterPerf blockProp' chain
     _ -> err "Impossible to get here."
  where
@@ -367,13 +356,19 @@ runChainCommand s
   pure s { sRun = Just run }
 
 runChainCommand s
-  c@(Unlog logs mHostDed okDErr okAny) = do
-  progress "logs" (Q $ printf "parsing %d log files" $ length logs)
-  los <- runLiftLogObjects logs mHostDed okDErr okAny
-         & firstExceptT (CommandError c)
-  pure s { sObjLists = Just los }
-
-runChainCommand s@State{sObjLists=Just objs}
+  c@(Unlog rlf okDErr okAny) = do
+  progress "logs" (Q $ printf "reading run log manifest %s" $ unJsonInputFile rlf)
+  runLogsBare <- Aeson.eitherDecode @(RunLogs ())
+                 <$> LBS.readFile (unJsonInputFile rlf)
+                 & newExceptT
+                 & firstExceptT (CommandError c . pack)
+  progress "logs" (Q $ printf "parsing logs for %d hosts" $
+                   Map.size $ rlHostLogs runLogsBare)
+  runLogs <- runLiftLogObjects runLogsBare okDErr okAny
+             & firstExceptT (CommandError c)
+  pure s { sRunLogs = Just runLogs }
+
+runChainCommand s@State{sRunLogs=Just (rlLogs -> objs)}
   c@DumpLogObjects = do
   progress "logobjs" (Q $ printf "dumping %d logobject streams" $ length objs)
   dumpAssociatedObjectStreams "logobjs" objs & firstExceptT (CommandError c)
@@ -383,7 +378,7 @@ runChainCommand _ c@DumpLogObjects = missingCommandData c
 
 -- runChainCommand s c@(ReadMachViews _ _)    -- () -> [(JsonLogfile, MachView)]
 
-runChainCommand s@State{sRun=Just run, sObjLists=Just objs}
+runChainCommand s@State{sRun=Just run, sRunLogs=Just (rlLogs -> objs)}
   BuildMachViews = do
   progress "machviews" (Q $ printf "building %d machviews" $ length objs)
   mvs <- buildMachViews run objs & liftIO
@@ -455,7 +450,7 @@ runChainCommand s@State{sRun=Just _run, sChain=Just Chain{..}}
 runChainCommand _ c@TimelineChain{} = missingCommandData c
   ["run metadata & genesis", "chain"]
 
-runChainCommand s@State{sRun=Just run, sObjLists=Just objs}
+runChainCommand s@State{sRun=Just run, sRunLogs=Just (rlLogs -> objs)}
   c@(CollectSlots ignores) = do
   let nonIgnored = flip filter objs $ (`notElem` ignores) . fst
   forM_ ignores $

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

@@ -36,18 +36,48 @@ import           Data.Accum (zeroUTCTime)
 
 type Text = ShortText
 
-runLiftLogObjects :: [JsonLogfile] -> Maybe HostDeduction -> Bool -> [LOAnyType]
-                  -> ExceptT LText.Text IO [(JsonLogfile, [LogObject])]
-runLiftLogObjects fs (fmap hostDeduction -> mHostDed) okDErr anyOks = liftIO $ do
-  forConcurrently fs
-    (\f -> (f,) . fmap (setLOhost f mHostDed) <$> readLogObjectStream (unJsonLogfile f) okDErr anyOks)
- where
-   setLOhost :: JsonLogfile -> Maybe (JsonLogfile -> Host) -> LogObject -> LogObject
-   setLOhost _   Nothing lo = lo
-   setLOhost lf (Just f) lo = lo { loHost = f lf }
+-- | Input data.
+data HostLogs a
+  = HostLogs
+    { hlRawLogfiles    :: [FilePath]
+    , hlRawLines       :: Int
+    , hlRawSha256      :: Hash
+    , hlRawTraceFreqs  :: Map Text Int
+    , hlLogs           :: (JsonLogfile, a)
+    , hlFilteredSha256 :: Hash
+    }
+  deriving (Generic, FromJSON, ToJSON)
 
-   -- joinT :: (IO a, IO b) -> IO (a, b)
-   -- joinT (a, b) = (,) <$> a <*> b
+hlRawLogObjects :: HostLogs a -> Int
+hlRawLogObjects = sum . Map.elems . hlRawTraceFreqs
+
+data RunLogs a
+  = RunLogs
+    { rlHostLogs   :: Map.Map Host (HostLogs a)
+    , rlFilterKeys :: [Text]
+    , rlFilterDate :: UTCTime
+    }
+  deriving (Generic, FromJSON, ToJSON)
+
+rlLogs :: RunLogs a -> [(JsonLogfile, a)]
+rlLogs = fmap hlLogs . Map.elems . rlHostLogs
+
+runLiftLogObjects :: RunLogs () -> Bool -> [LOAnyType]
+                  -> ExceptT LText.Text IO (RunLogs [LogObject])
+runLiftLogObjects rl@RunLogs{..} okDErr anyOks = liftIO $ do
+  forConcurrently (Map.toList rlHostLogs)
+    (uncurry readHostLogs)
+    <&> \kvs -> rl { rlHostLogs = Map.fromList kvs }
+ where
+   readHostLogs :: Host -> HostLogs () -> IO (Host, HostLogs [LogObject])
+   readHostLogs h hl@HostLogs{..} =
+     readLogObjectStream (unJsonLogfile $ fst hlLogs) okDErr anyOks
+     <&> (h,) . setLogs hl . fmap (setLOhost h)
+
+   setLogs :: HostLogs a -> b -> HostLogs b
+   setLogs hl x = hl { hlLogs = (fst $ hlLogs hl, x) }
+   setLOhost :: Host -> LogObject -> LogObject
+   setLOhost h lo = lo { loHost = h }
 
 readLogObjectStream :: FilePath -> Bool -> [LOAnyType] -> IO [LogObject]
 readLogObjectStream f okDErr anyOks =