Skip to content

Commit f05506e

Browse files
iohk-bors[bot]deepfirefmaste
authored
Merge #4694
4694: workbench: get rid of some unnecessary complications r=fmaste a=fmaste Clearer modules dependencies. The general idea is: > backendName -> useCabalRun -> backend > stateDir -> batchName -> profileName -> backend -> workbench -> runner For this: - Moved 'services-config' back to profiles and out of the backends - Moved the backend dependency out from 'all-profiles' (workbench) - Removed 'stateDir' from the backends Also: - Remove unused code and parameters (or repeated defaults) - Variable renames for clarity - Makefile fixes Co-authored-by: Kosyrev Serge <[email protected]> Co-authored-by: Federico Mastellone <[email protected]>
2 parents 63e5a49 + 2618910 commit f05506e

29 files changed

+499
-612
lines changed

Diff for: Makefile

+1-1
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ analyse: RUN := wb analyse std ${TAG}
5959
analyse: shell
6060

6161
list-profiles: ## List workbench profiles
62-
nix build .#workbench.profile-names-json --json | jq '.[0].outputs.out' -r | xargs jq .
62+
nix build .#all-profiles-json && cat result
6363
show-profile: ## NAME=profile-name
6464
@test -n "${NAME}" || { echo 'HELP: to specify profile to show, add NAME=profle-name' && exit 1; }
6565
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"

Diff for: bench/locli/src/Cardano/Analysis/API/Ground.hs

+13-5
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ import Data.Aeson.Types (toJSONKeyText)
1818
import Data.Attoparsec.Text qualified as Atto
1919
import Data.Attoparsec.Time qualified as Iso8601
2020
import Data.ByteString.Lazy.Char8 qualified as LBS
21+
import Data.Map.Strict qualified as Map
2122
import Data.Text qualified as T
2223
import Data.Text.Short qualified as SText
2324
import Data.Text.Short (ShortText, fromText, toText)
@@ -56,6 +57,10 @@ shortHash = toText . SText.take 6 . unHash
5657

5758
instance Show Hash where show = T.unpack . toText . unHash
5859

60+
instance ToJSONKey Host where
61+
toJSONKey = toJSONKeyText (toText . unHost)
62+
instance FromJSONKey Host where
63+
fromJSONKey = FromJSONKeyText (Host . fromText)
5964
instance ToJSONKey Hash where
6065
toJSONKey = toJSONKeyText (toText . unHash)
6166
instance FromJSONKey Hash where
@@ -66,6 +71,9 @@ newtype Count a = Count { unCount :: Int }
6671
deriving newtype (FromJSON, Num, ToJSON)
6772
deriving anyclass NFData
6873

74+
countMap :: Map.Map a b -> Count a
75+
countMap = Count . Map.size
76+
6977
countList :: (a -> Bool) -> [a] -> Count a
7078
countList f = Count . fromIntegral . count f
7179

@@ -121,11 +129,12 @@ newtype InputDir
121129
newtype JsonLogfile
122130
= JsonLogfile { unJsonLogfile :: FilePath }
123131
deriving (Show, Eq)
124-
deriving newtype (NFData)
132+
deriving newtype (FromJSON, ToJSON, NFData)
125133

126134
newtype JsonInputFile (a :: Type)
127135
= JsonInputFile { unJsonInputFile :: FilePath }
128136
deriving (Show, Eq)
137+
deriving newtype (FromJSON, ToJSON)
129138

130139
newtype JsonOutputFile (a :: Type)
131140
= JsonOutputFile { unJsonOutputFile :: FilePath }
@@ -314,10 +323,9 @@ dumpObjects ident xs (JsonOutputFile f) = liftIO $ do
314323
dumpAssociatedObjects :: ToJSON a => String -> [(JsonLogfile, a)] -> ExceptT Text IO ()
315324
dumpAssociatedObjects ident xs = liftIO $
316325
flip mapConcurrently_ xs $
317-
\(JsonLogfile f, x) -> do
318-
progress ident (Q f)
319-
withFile (replaceExtension f $ ident <> ".json") WriteMode $ \hnd ->
320-
LBS.hPutStrLn hnd $ encode x
326+
\(JsonLogfile f, x) ->
327+
withFile (replaceExtension f $ ident <> ".json") WriteMode $ \hnd ->
328+
LBS.hPutStrLn hnd $ encode x
321329

322330
readAssociatedObjects :: forall a.
323331
FromJSON a => String -> [JsonLogfile] -> ExceptT Text IO [(JsonLogfile, a)]

Diff for: bench/locli/src/Cardano/Analysis/API/Metrics.hs

+28-6
Original file line numberDiff line numberDiff line change
@@ -42,8 +42,10 @@ sumFieldsReport =
4242
, "delegators", "utxo"
4343
, "add_tx_size", "inputs_per_tx", "outputs_per_tx" , "tps", "tx_count"
4444
, "plutusScript"
45-
, "sumLogStreams", "sumLogObjectsTotal"
45+
, "sumHosts", "sumLogObjectsTotal"
4646
, "sumFilters"
47+
, "cdfLogLinesEmitted", "cdfLogObjectsEmitted", "cdfLogObjects"
48+
, "cdfRuntime", "cdfLogLineRate"
4749
, "ddRawCount.sumDomainTime", "ddFilteredCount.sumDomainTime", "dataDomainFilterRatio.sumDomainTime"
4850
, "ddRaw.sumStartSpread", "ddRaw.sumStopSpread"
4951
, "ddFiltered.sumStartSpread", "ddFiltered.sumStopSpread"
@@ -130,16 +132,36 @@ instance TimelineFields SummaryOne where
130132
"Plutus script"
131133
"Name of th Plutus script used for smart contract workload generation, if any"
132134

133-
<> fScalar "sumLogStreams" Wno Cnt (IInt $ unCount.sumLogStreams)
135+
<> fScalar "sumHosts" Wno Cnt (IInt $ unCount.sumHosts)
134136
"Machines"
135137
"Number of machines under analysis"
136138

137-
<> fScalar "sumLogObjectsTotal" Wno Cnt (IInt $ unCount.sumLogObjectsTotal)
138-
"Total log objects analysed"
139+
<> fScalar "sumFilters" Wno Cnt (IInt $ length.snd.sumFilters)
140+
"Number of filters applied"
139141
""
140142

141-
<> fScalar "sumFilters" Wno Cnt (IInt $ length.snd.sumFilters)
142-
"Number of filters applied"
143+
<> fScalar "cdfLogLinesEmitted" W6 Cnt (IFloat $ cdfAverageVal.cdfLogLinesEmitted)
144+
"Log text lines emitted per host"
145+
""
146+
147+
<> fScalar "cdfLogObjectsEmitted" W6 Cnt (IFloat $ cdfAverageVal.cdfLogObjectsEmitted)
148+
"Log objects emitted per host"
149+
""
150+
151+
<> fScalar "cdfLogObjects" W6 Cnt (IFloat $ cdfAverageVal.cdfLogObjects)
152+
"Log objects analysed per host"
153+
""
154+
155+
<> fScalar "cdfRuntime" W6 Sec (IFloat $ cdfAverageVal.cdfRuntime)
156+
"Host run time, s"
157+
""
158+
159+
<> fScalar "cdfLogLineRate" W6 Hz (IFloat $ cdfAverageVal.cdfLogLineRate)
160+
"Host log line rate, Hz"
161+
""
162+
163+
<> fScalar "sumLogObjectsTotal" Wno Cnt (IInt $ unCount.sumLogObjectsTotal)
164+
"Total log objects analysed"
143165
""
144166

145167
<> fScalar "ddRawCount.sumDomainTime" Wno Sec (IInt $ ddRawCount.sumDomainTime)

Diff for: bench/locli/src/Cardano/Analysis/API/Types.hs

+8-5
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ data Summary f where
3434
, sumGenesis :: !Genesis
3535
, sumGenesisSpec :: !GenesisSpec
3636
, sumGenerator :: !GeneratorProfile
37-
, sumLogStreams :: !(Count [LogObject])
37+
, sumHosts :: !(Count Host)
3838
, sumLogObjectsTotal :: !(Count LogObject)
3939
, sumFilters :: !([FilterName], [ChainFilter])
4040
, sumChainRejectionStats :: ![(ChainFilter, Int)]
@@ -44,17 +44,20 @@ data Summary f where
4444
, sumStopSpread :: !(DataDomain UTCTime)
4545
, sumDomainSlots :: !(DataDomain SlotNo)
4646
, sumDomainBlocks :: !(DataDomain BlockNo)
47-
, cdfLogObjects :: !(CDF f Int)
47+
, cdfLogLinesEmitted :: !(CDF f Int)
4848
, cdfLogObjectsEmitted :: !(CDF f Int)
49+
, cdfLogObjects :: !(CDF f Int)
50+
, cdfRuntime :: !(CDF f NominalDiffTime)
51+
, cdfLogLineRate :: !(CDF f Double)
4952
} -> Summary f
5053
deriving (Generic)
5154

5255
type SummaryOne = Summary I
5356
type MultiSummary = Summary (CDF I)
5457

55-
deriving instance (FromJSON (f Int), FromJSON (f Double)) => FromJSON (Summary f)
56-
deriving instance ( ToJSON (f Int), ToJSON (f Double)) => ToJSON (Summary f)
57-
deriving instance ( Show (f Int), Show (f Double)) => Show (Summary f)
58+
deriving instance (FromJSON (f NominalDiffTime), FromJSON (f Int), FromJSON (f Double)) => FromJSON (Summary f)
59+
deriving instance ( ToJSON (f NominalDiffTime), ToJSON (f Int), ToJSON (f Double)) => ToJSON (Summary f)
60+
deriving instance ( Show (f NominalDiffTime), Show (f Int), Show (f Double)) => Show (Summary f)
5861

5962
data BlockStats
6063
= BlockStats

Diff for: bench/locli/src/Cardano/Analysis/Summary.hs

+19-6
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ computeSummary ::
1818
-> Genesis
1919
-> GenesisSpec
2020
-> GeneratorProfile
21-
-> [(Count Cardano.Prelude.Text, [LogObject])]
21+
-> RunLogs [LogObject]
2222
-> ([FilterName], [ChainFilter])
2323
-> ClusterPerf
2424
-> BlockPropOne
@@ -29,14 +29,14 @@ computeSummary sumAnalysisTime
2929
sumGenesis
3030
sumGenesisSpec
3131
sumGenerator
32-
loCountsObjLists
32+
rl@RunLogs{..}
3333
sumFilters
3434
MachPerf{..}
3535
BlockProp{..}
3636
Chain{..}
3737
=
3838
Summary
39-
{ sumLogStreams = countListAll objLists
39+
{ sumHosts = countMap rlHostLogs
4040
, sumLogObjectsTotal = countListsAll objLists
4141
, sumBlocksRejected = countListAll cRejecta
4242
, sumDomainTime =
@@ -54,17 +54,30 @@ computeSummary sumAnalysisTime
5454
, sumDomainSlots = Prelude.head mpDomainSlots
5555
, sumDomainBlocks = Prelude.head bpDomainBlocks
5656
--
57-
, cdfLogObjects = cdf stdCentiles (length <$> objLists)
58-
, cdfLogObjectsEmitted = cdf stdCentiles (loCountsObjLists <&> unCount . fst)
57+
, cdfLogObjects = cdf stdCentiles (objLists <&> length)
58+
, cdfLogObjectsEmitted = cdf stdCentiles logObjectsEmitted
59+
, cdfLogLinesEmitted = cdf stdCentiles textLinesEmitted
60+
, cdfRuntime = cdf stdCentiles runtimes
5961
, ..
6062
}
6163
where
62-
objLists = loCountsObjLists <&> snd
64+
cdfLogLineRate = cdf stdCentiles lineRates
65+
66+
(,) logObjectsEmitted textLinesEmitted =
67+
rlHostLogs
68+
& Map.toList
69+
& fmap ((hlRawLogObjects &&& hlRawLines) . snd)
70+
& unzip
71+
objLists = rlLogs rl <&> snd
6372

6473
(,) minStartRaw maxStartRaw = (minimum &&& maximum) losFirsts
6574
(,) minStopRaw maxStopRaw = (minimum &&& maximum) losLasts
6675
losFirsts = objLists <&> loAt . Prelude.head
6776
losLasts = objLists <&> loAt . Prelude.last
77+
runtimes :: [NominalDiffTime]
78+
runtimes = zipWith diffUTCTime losLasts losFirsts
79+
lineRates = zipWith (/) (textLinesEmitted <&> fromIntegral)
80+
(runtimes <&> fromIntegral @Int . truncate)
6881

6982
(,) minStartFlt maxStartFlt = (timeOf *** timeOf) startMinMaxS
7083
(,) minStopFlt maxStopFlt = (timeOf *** timeOf) stopMinMaxS

Diff for: bench/locli/src/Cardano/Command.hs

+22-27
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ import Cardano.Prelude hiding (State)
66
import Data.Aeson qualified as Aeson
77
import Data.ByteString qualified as BS
88
import Data.ByteString.Lazy.Char8 qualified as LBS
9+
import Data.Map qualified as Map
910
import Data.Text (pack)
1011
import Data.Text qualified as T
1112
import Data.Text.Short (toText)
@@ -45,7 +46,7 @@ data ChainCommand
4546

4647
| MetaGenesis (JsonInputFile RunPartial) (JsonInputFile Genesis)
4748

48-
| Unlog [JsonLogfile] (Maybe HostDeduction) Bool [LOAnyType]
49+
| Unlog (JsonInputFile (RunLogs ())) Bool [LOAnyType]
4950
| DumpLogObjects
5051

5152
| BuildMachViews
@@ -107,11 +108,7 @@ parseChainCommand =
107108
subparser (mconcat [ commandGroup "Basic log objects"
108109
, op "unlog" "Read log files"
109110
(Unlog
110-
<$> some
111-
(optJsonLogfile "log" "JSON log stream")
112-
<*> optional
113-
(parseHostDeduction "host-from-log-filename"
114-
"Derive hostname from log filename: logs-HOSTNAME.*")
111+
<$> optJsonInputFile "run-logs" "Run log manifest (API/Types.hs:RunLogs)"
115112
<*> Opt.flag False True (Opt.long "lodecodeerror-ok"
116113
<> Opt.help "Allow non-EOF LODecodeError logobjects")
117114
<*> many
@@ -243,13 +240,6 @@ parseChainCommand =
243240
command c $ info (p <**> helper) $
244241
mconcat [ progDesc descr ]
245242

246-
parseHostDeduction :: String -> String -> Parser HostDeduction
247-
parseHostDeduction name desc =
248-
Opt.flag' HostFromLogfilename
249-
( Opt.long name
250-
<> Opt.help desc
251-
)
252-
253243
optLOAnyType :: String -> String -> Parser LOAnyType
254244
optLOAnyType opt desc =
255245
Opt.option Opt.auto
@@ -291,7 +281,7 @@ data State
291281
, sFilters :: ([FilterName], [ChainFilter])
292282
, sTags :: [Text]
293283
, sRun :: Maybe Run
294-
, sObjLists :: Maybe [(JsonLogfile, [LogObject])]
284+
, sRunLogs :: Maybe (RunLogs [LogObject])
295285
, sDomSlots :: Maybe (DataDomain SlotNo)
296286
-- propagation
297287
, sMachViews :: Maybe [(JsonLogfile, MachView)]
@@ -313,19 +303,18 @@ callComputeSummary :: State -> Either Text SummaryOne
313303
callComputeSummary =
314304
\case
315305
State{sRun = Nothing} -> err "a run"
316-
State{sObjLists = Nothing} -> err "logobjects"
317-
State{sObjLists = Just []} -> err "logobjects"
306+
State{sRunLogs = Nothing} -> err "logobjects"
318307
State{sClusterPerf = Nothing} -> err "cluster performance results"
319308
State{sBlockProp = Nothing} -> err "block propagation results"
320309
State{sChain = Nothing} -> err "chain"
321-
State{ sObjLists = Just (fmap snd -> objLists)
310+
State{ sRunLogs = Just runLogs
322311
, sClusterPerf = Just [clusterPerf]
323312
, sBlockProp = Just [blockProp']
324313
, sChain = Just chain
325314
, sRun = Just Run{..}
326315
, ..} -> Right $
327316
computeSummary sWhen metadata genesis genesisSpec generatorProfile
328-
(zip (Count <$> [0..]) objLists) sFilters
317+
runLogs sFilters
329318
clusterPerf blockProp' chain
330319
_ -> err "Impossible to get here."
331320
where
@@ -367,13 +356,19 @@ runChainCommand s
367356
pure s { sRun = Just run }
368357

369358
runChainCommand s
370-
c@(Unlog logs mHostDed okDErr okAny) = do
371-
progress "logs" (Q $ printf "parsing %d log files" $ length logs)
372-
los <- runLiftLogObjects logs mHostDed okDErr okAny
373-
& firstExceptT (CommandError c)
374-
pure s { sObjLists = Just los }
375-
376-
runChainCommand s@State{sObjLists=Just objs}
359+
c@(Unlog rlf okDErr okAny) = do
360+
progress "logs" (Q $ printf "reading run log manifest %s" $ unJsonInputFile rlf)
361+
runLogsBare <- Aeson.eitherDecode @(RunLogs ())
362+
<$> LBS.readFile (unJsonInputFile rlf)
363+
& newExceptT
364+
& firstExceptT (CommandError c . pack)
365+
progress "logs" (Q $ printf "parsing logs for %d hosts" $
366+
Map.size $ rlHostLogs runLogsBare)
367+
runLogs <- runLiftLogObjects runLogsBare okDErr okAny
368+
& firstExceptT (CommandError c)
369+
pure s { sRunLogs = Just runLogs }
370+
371+
runChainCommand s@State{sRunLogs=Just (rlLogs -> objs)}
377372
c@DumpLogObjects = do
378373
progress "logobjs" (Q $ printf "dumping %d logobject streams" $ length objs)
379374
dumpAssociatedObjectStreams "logobjs" objs & firstExceptT (CommandError c)
@@ -383,7 +378,7 @@ runChainCommand _ c@DumpLogObjects = missingCommandData c
383378

384379
-- runChainCommand s c@(ReadMachViews _ _) -- () -> [(JsonLogfile, MachView)]
385380

386-
runChainCommand s@State{sRun=Just run, sObjLists=Just objs}
381+
runChainCommand s@State{sRun=Just run, sRunLogs=Just (rlLogs -> objs)}
387382
BuildMachViews = do
388383
progress "machviews" (Q $ printf "building %d machviews" $ length objs)
389384
mvs <- buildMachViews run objs & liftIO
@@ -455,7 +450,7 @@ runChainCommand s@State{sRun=Just _run, sChain=Just Chain{..}}
455450
runChainCommand _ c@TimelineChain{} = missingCommandData c
456451
["run metadata & genesis", "chain"]
457452

458-
runChainCommand s@State{sRun=Just run, sObjLists=Just objs}
453+
runChainCommand s@State{sRun=Just run, sRunLogs=Just (rlLogs -> objs)}
459454
c@(CollectSlots ignores) = do
460455
let nonIgnored = flip filter objs $ (`notElem` ignores) . fst
461456
forM_ ignores $

Diff for: bench/locli/src/Cardano/Unlog/LogObject.hs

+41-11
Original file line numberDiff line numberDiff line change
@@ -36,18 +36,48 @@ import Data.Accum (zeroUTCTime)
3636

3737
type Text = ShortText
3838

39-
runLiftLogObjects :: [JsonLogfile] -> Maybe HostDeduction -> Bool -> [LOAnyType]
40-
-> ExceptT LText.Text IO [(JsonLogfile, [LogObject])]
41-
runLiftLogObjects fs (fmap hostDeduction -> mHostDed) okDErr anyOks = liftIO $ do
42-
forConcurrently fs
43-
(\f -> (f,) . fmap (setLOhost f mHostDed) <$> readLogObjectStream (unJsonLogfile f) okDErr anyOks)
44-
where
45-
setLOhost :: JsonLogfile -> Maybe (JsonLogfile -> Host) -> LogObject -> LogObject
46-
setLOhost _ Nothing lo = lo
47-
setLOhost lf (Just f) lo = lo { loHost = f lf }
39+
-- | Input data.
40+
data HostLogs a
41+
= HostLogs
42+
{ hlRawLogfiles :: [FilePath]
43+
, hlRawLines :: Int
44+
, hlRawSha256 :: Hash
45+
, hlRawTraceFreqs :: Map Text Int
46+
, hlLogs :: (JsonLogfile, a)
47+
, hlFilteredSha256 :: Hash
48+
}
49+
deriving (Generic, FromJSON, ToJSON)
4850

49-
-- joinT :: (IO a, IO b) -> IO (a, b)
50-
-- joinT (a, b) = (,) <$> a <*> b
51+
hlRawLogObjects :: HostLogs a -> Int
52+
hlRawLogObjects = sum . Map.elems . hlRawTraceFreqs
53+
54+
data RunLogs a
55+
= RunLogs
56+
{ rlHostLogs :: Map.Map Host (HostLogs a)
57+
, rlFilterKeys :: [Text]
58+
, rlFilterDate :: UTCTime
59+
}
60+
deriving (Generic, FromJSON, ToJSON)
61+
62+
rlLogs :: RunLogs a -> [(JsonLogfile, a)]
63+
rlLogs = fmap hlLogs . Map.elems . rlHostLogs
64+
65+
runLiftLogObjects :: RunLogs () -> Bool -> [LOAnyType]
66+
-> ExceptT LText.Text IO (RunLogs [LogObject])
67+
runLiftLogObjects rl@RunLogs{..} okDErr anyOks = liftIO $ do
68+
forConcurrently (Map.toList rlHostLogs)
69+
(uncurry readHostLogs)
70+
<&> \kvs -> rl { rlHostLogs = Map.fromList kvs }
71+
where
72+
readHostLogs :: Host -> HostLogs () -> IO (Host, HostLogs [LogObject])
73+
readHostLogs h hl@HostLogs{..} =
74+
readLogObjectStream (unJsonLogfile $ fst hlLogs) okDErr anyOks
75+
<&> (h,) . setLogs hl . fmap (setLOhost h)
76+
77+
setLogs :: HostLogs a -> b -> HostLogs b
78+
setLogs hl x = hl { hlLogs = (fst $ hlLogs hl, x) }
79+
setLOhost :: Host -> LogObject -> LogObject
80+
setLOhost h lo = lo { loHost = h }
5181

5282
readLogObjectStream :: FilePath -> Bool -> [LOAnyType] -> IO [LogObject]
5383
readLogObjectStream f okDErr anyOks =

0 commit comments

Comments
 (0)