Skip to content

Commit d500fd1

Browse files
mgmeiermgmeier
committed
locli: LogObjectSource for input from different backends; comments
1 parent afb5c9c commit d500fd1

File tree

9 files changed

+128
-82
lines changed

9 files changed

+128
-82
lines changed

‎bench/locli/CHANGELOG.md

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,11 @@
33
## 2.0 -- Dec 2024
44

55
* New database (DB) persistence backend for log objects using serverless SQLite DBs
6-
* New CLI commands `prepare-db` and `unlog-db` to create and read from that persistence layer respectively
7-
* Tweak GC to mitigate high RAM requirements
8-
* New executable `locli-quick` which aims to be a development testbed for (upcoming) DB-backed quick queries.
6+
* Refactor current file persistence backend into its own module
7+
* New CLI commands `prepare-db` and `unlog-db` to create and read from DB persistence backend respectively
8+
* New sum type `LogObjectSource` to represent input from different backends (file or DB)
9+
* Tweak GC to mitigate high RAM requirements (for perf cluster analyses only)
10+
* New executable `locli-quick` which aims to be a development testbed for (upcoming) DB-backed quick queries
911

1012
## 1.36 -- Nov 2024
1113

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

Lines changed: 43 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE DeriveAnyClass #-}
22
{-# LANGUAGE DeriveDataTypeable #-}
33
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
4+
{-# LANGUAGE MultiWayIf #-}
45
{-# LANGUAGE PolyKinds #-}
56
{-# OPTIONS_GHC -Wno-orphans #-}
67
module Cardano.Analysis.API.Ground
@@ -163,6 +164,32 @@ newtype OutputFile
163164
= OutputFile { unOutputFile :: FilePath }
164165
deriving (Show, Eq)
165166

167+
data LogObjectSource =
168+
LogObjectSourceJSON JsonLogfile
169+
| LogObjectSourceSQLite FilePath
170+
| LogObjectSourceOther FilePath
171+
deriving (Show, Eq, Generic, NFData)
172+
173+
logObjectSourceFile :: LogObjectSource -> FilePath
174+
logObjectSourceFile = \case
175+
LogObjectSourceJSON j -> unJsonLogfile j
176+
LogObjectSourceSQLite f -> f
177+
LogObjectSourceOther f -> f
178+
179+
toLogObjectSource :: FilePath -> LogObjectSource
180+
toLogObjectSource fp
181+
| ext == ".sqlite" || ext == ".sqlite3" = LogObjectSourceSQLite fp
182+
| ext == ".json" = LogObjectSourceJSON (JsonLogfile fp)
183+
| otherwise = LogObjectSourceOther fp
184+
where
185+
ext = map toLower $ F.takeExtension fp
186+
187+
instance FromJSON LogObjectSource where
188+
parseJSON = withText "LogObjectSource" (pure . toLogObjectSource . T.unpack)
189+
190+
instance ToJSON LogObjectSource where
191+
toJSON = toJSON . logObjectSourceFile
192+
166193
---
167194
--- Orphans
168195
---
@@ -210,6 +237,14 @@ optJsonLogfile optname desc =
210237
<> metavar "JSONLOGFILE"
211238
<> help desc
212239

240+
optLogObjectSource :: String -> String -> Parser LogObjectSource
241+
optLogObjectSource optname desc =
242+
fmap toLogObjectSource $
243+
Opt.option Opt.str
244+
$ long optname
245+
<> metavar "JSONLOGFILE|SQLITE3LOGFILE"
246+
<> help desc
247+
213248
argJsonLogfile :: Parser JsonLogfile
214249
argJsonLogfile =
215250
JsonLogfile <$>
@@ -324,26 +359,26 @@ dumpObjects ident xs (JsonOutputFile f) = liftIO $ do
324359
withFile f WriteMode $ \hnd -> do
325360
forM_ xs $ LBS.hPutStrLn hnd . encode
326361

327-
dumpAssociatedObjects :: ToJSON a => String -> [(JsonLogfile, a)] -> ExceptT Text IO ()
362+
dumpAssociatedObjects :: ToJSON a => String -> [(LogObjectSource, a)] -> ExceptT Text IO ()
328363
dumpAssociatedObjects ident xs = liftIO $
329364
flip mapConcurrently_ xs $
330-
\(JsonLogfile f, x) ->
365+
\(logObjectSourceFile -> f, x) ->
331366
withFile (replaceExtension f $ ident <> ".json") WriteMode $ \hnd ->
332367
LBS.hPutStrLn hnd $ encode x
333368

334369
readAssociatedObjects :: forall a.
335-
FromJSON a => String -> [JsonLogfile] -> ExceptT Text IO [(JsonLogfile, a)]
370+
FromJSON a => String -> [JsonLogfile] -> ExceptT Text IO [(LogObjectSource, a)]
336371
readAssociatedObjects ident fs = firstExceptT T.pack . newExceptT . fmap (mapM sequence) $
337372
flip mapConcurrently fs $
338373
\jf@(JsonLogfile f) -> do
339374
x <- eitherDecode @a <$> LBS.readFile (replaceExtension f $ ident <> ".json")
340375
progress ident (Q f)
341-
pure (jf, x)
376+
pure (LogObjectSourceJSON jf, x)
342377

343-
dumpAssociatedObjectStreams :: ToJSON a => String -> [(JsonLogfile, [a])] -> ExceptT Text IO ()
378+
dumpAssociatedObjectStreams :: ToJSON a => String -> [(LogObjectSource, [a])] -> ExceptT Text IO ()
344379
dumpAssociatedObjectStreams ident xss = liftIO $
345380
flip mapConcurrently_ xss $
346-
\(JsonLogfile f, xs) -> do
381+
\(logObjectSourceFile -> f, xs) -> do
347382
withFile (replaceExtension f $ ident <> ".json") WriteMode $ \hnd -> do
348383
forM_ xs $ LBS.hPutStrLn hnd . encode
349384

@@ -353,9 +388,9 @@ dumpText ident xs (TextOutputFile f) = liftIO $ do
353388
withFile f WriteMode $ \hnd -> do
354389
forM_ xs $ hPutStrLn hnd
355390

356-
dumpAssociatedTextStreams :: String -> [(JsonLogfile, [Text])] -> ExceptT Text IO ()
391+
dumpAssociatedTextStreams :: String -> [(LogObjectSource, [Text])] -> ExceptT Text IO ()
357392
dumpAssociatedTextStreams ident xss = liftIO $
358393
flip mapConcurrently_ xss $
359-
\(JsonLogfile f, xs) -> do
394+
\(logObjectSourceFile -> f, xs) -> do
360395
withFile (replaceExtension f $ ident <> ".txt") WriteMode $ \hnd -> do
361396
forM_ xs $ hPutStrLn hnd

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

Lines changed: 17 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
#endif
88

99
{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-name-shadowing #-}
10-
{-# OPTIONS_GHC -Wno-unused-imports -Wno-partial-fields -Wno-unused-matches -Wno-deprecations -Wno-unused-local-binds -Wno-incomplete-record-updates #-}
10+
{-# OPTIONS_GHC -Wno-unused-imports -Wno-partial-fields -Wno-unused-matches -Wno-incomplete-record-updates #-}
1111

1212
{- HLINT ignore "Avoid lambda" -}
1313
{- HLINT ignore "Eta reduce" -}
@@ -293,13 +293,13 @@ beForgedAt :: BlockEvents -> UTCTime
293293
beForgedAt BlockEvents{beForge=BlockForge{..}} =
294294
bfForged `afterSlot` bfSlotStart
295295

296-
buildMachViews :: Run -> [(JsonLogfile, [LogObject])] -> IO [(JsonLogfile, MachView)]
296+
buildMachViews :: Run -> [(LogObjectSource, [LogObject])] -> IO [(LogObjectSource, MachView)]
297297
buildMachViews run = mapConcurrentlyPure (fst &&& blockEventMapsFromLogObjects run)
298298

299299
blockEventsAcceptance :: Genesis -> [ChainFilter] -> BlockEvents -> [(ChainFilter, Bool)]
300300
blockEventsAcceptance genesis flts be = flts <&> (id &&& testBlockEvents genesis be)
301301

302-
rebuildChain :: Run -> [ChainFilter] -> [FilterName] -> [(JsonLogfile, MachView)] -> Chain
302+
rebuildChain :: Run -> [ChainFilter] -> [FilterName] -> [(LogObjectSource, MachView)] -> Chain
303303
rebuildChain run@Run{genesis} flts fltNames xs@(fmap snd -> machViews) =
304304
Chain
305305
{ cDomSlots = DataDomain
@@ -320,8 +320,8 @@ rebuildChain run@Run{genesis} flts fltNames xs@(fmap snd -> machViews) =
320320
doRebuildChain (fmap deltifyEvents <$> eventMaps) tipHash
321321
(accepta, cRejecta) = partition (all snd . beAcceptance) cMainChain
322322

323-
blkSets :: (Set Hash, Set Hash)
324-
blkSets@(acceptaBlocks, rejectaBlocks) =
323+
acceptaBlocks, rejectaBlocks :: Set Hash
324+
(acceptaBlocks, rejectaBlocks) =
325325
both (Set.fromList . fmap beBlock) (accepta, cRejecta)
326326
mvBlockStats :: MachView -> HostBlockStats
327327
mvBlockStats (fmap bfeBlock . mvForges -> fs) = HostBlockStats {..}
@@ -346,7 +346,7 @@ rebuildChain run@Run{genesis} flts fltNames xs@(fmap snd -> machViews) =
346346
finalBlockNo = mbeBlockNo finalBlockEv
347347

348348
tipHash = rewindChain eventMaps finalBlockNo 1 (mbeBlock finalBlockEv)
349-
tipBlock = getBlockForge eventMaps finalBlockNo tipHash
349+
_tipBlock = getBlockForge eventMaps finalBlockNo tipHash
350350

351351
computeChainBlockGaps :: [BlockEvents] -> [BlockEvents]
352352
computeChainBlockGaps [] = error "computeChainBlockGaps on an empty chain"
@@ -376,11 +376,12 @@ rebuildChain run@Run{genesis} flts fltNames xs@(fmap snd -> machViews) =
376376
])
377377
& mapMbe id (error "Silly invariant failed.") (error "Silly invariant failed.")
378378

379-
adoptionMap :: [Map Hash UTCTime]
380-
adoptionMap = Map.mapMaybe (lazySMaybe . mbeAdopted) <$> eventMaps
379+
adoptionMap :: [Map Hash UTCTime]
380+
adoptionMap = Map.mapMaybe (lazySMaybe . mbeAdopted) <$> eventMaps
381381

382-
heightHostMap :: (Map BlockNo (Set Hash), Map Host (Set Hash))
383-
heightHostMap@(heightMap, hostMap)
382+
heightMap :: Map BlockNo (Set Hash)
383+
_hostMap :: Map Host (Set Hash)
384+
(heightMap, _hostMap)
384385
= foldr (\MachView{..} (accHeight, accHost) ->
385386
(,)
386387
(Map.foldr
@@ -589,11 +590,6 @@ blockProp run@Run{genesis} Chain{..} = do
589590
& filter (not . isNaN))
590591
}
591592
where
592-
ne :: String -> [a] -> [a]
593-
ne desc = \case
594-
[] -> error desc
595-
xs -> xs
596-
597593
hostBlockStats = Map.elems cHostBlockStats
598594

599595
boFetchedCum :: BlockObservation -> NominalDiffTime
@@ -629,10 +625,10 @@ blockProp run@Run{genesis} Chain{..} = do
629625
cdfZ percs $ concatMap f cbes
630626

631627
-- | Given a single machine's log object stream, recover its block map.
632-
blockEventMapsFromLogObjects :: Run -> (JsonLogfile, [LogObject]) -> MachView
633-
blockEventMapsFromLogObjects run (f@(unJsonLogfile -> fp), []) =
634-
error $ mconcat ["0 LogObjects in ", fp]
635-
blockEventMapsFromLogObjects run (f@(unJsonLogfile -> fp), xs@(x:_)) =
628+
blockEventMapsFromLogObjects :: Run -> (LogObjectSource, [LogObject]) -> MachView
629+
blockEventMapsFromLogObjects run (f, []) =
630+
error $ mconcat ["0 LogObjects in ", logObjectSourceFile f]
631+
blockEventMapsFromLogObjects run (f, xs@(x:_)) =
636632
foldl' (blockPropMachEventsStep run f) initial xs
637633
where
638634
initial =
@@ -648,8 +644,8 @@ blockEventMapsFromLogObjects run (f@(unJsonLogfile -> fp), xs@(x:_)) =
648644
, mvMemSnap = SNothing
649645
}
650646

651-
blockPropMachEventsStep :: Run -> JsonLogfile -> MachView -> LogObject -> MachView
652-
blockPropMachEventsStep run@Run{genesis} (JsonLogfile fp) mv@MachView{..} lo = case lo of
647+
blockPropMachEventsStep :: Run -> LogObjectSource -> MachView -> LogObject -> MachView
648+
blockPropMachEventsStep run@Run{genesis} _ mv@MachView{..} lo = case lo of
653649
-- 0. Notice (observer only)
654650
LogObject{loAt, loHost, loBody=LOChainSyncClientSeenHeader{loBlock,loBlockNo,loSlotNo}} ->
655651
let mbe0 = getBlock loBlock

‎bench/locli/src/Cardano/Analysis/MachPerf.hs

Lines changed: 15 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
{-# OPTIONS_GHC -Wno-x-partial #-}
77
#endif
88

9-
{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-name-shadowing -Wno-orphans #-}
9+
{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-name-shadowing #-}
1010
{- HLINT ignore "Use head" -}
1111
{- HLINT ignore "Evaluate" -}
1212

@@ -33,15 +33,15 @@ import Cardano.Unlog.Resources
3333

3434
-- * 1. Collect SlotStats & RunScalars:
3535
--
36-
collectSlotStats :: Run -> [(JsonLogfile, [LogObject])]
37-
-> IO (Either Text [(JsonLogfile, (RunScalars, [SlotStats UTCTime]))])
36+
collectSlotStats :: Run -> [(LogObjectSource, [LogObject])]
37+
-> IO (Either Text [(LogObjectSource, (RunScalars, [SlotStats UTCTime]))])
3838
collectSlotStats run = fmap sequence <$> mapConcurrentlyPure (timelineFromLogObjects run)
3939

4040

41-
timelineFromLogObjects :: Run -> (JsonLogfile, [LogObject])
42-
-> Either Text (JsonLogfile, (RunScalars, [SlotStats UTCTime]))
43-
timelineFromLogObjects _ (JsonLogfile f, []) =
44-
Left $ "timelineFromLogObjects: zero logobjects from " <> pack f
41+
timelineFromLogObjects :: Run -> (LogObjectSource, [LogObject])
42+
-> Either Text (LogObjectSource, (RunScalars, [SlotStats UTCTime]))
43+
timelineFromLogObjects _ (f, []) =
44+
Left $ "timelineFromLogObjects: zero logobjects from " <> pack (logObjectSourceFile f)
4545
timelineFromLogObjects run@Run{genesis} (f, xs') =
4646
Right . (f,)
4747
$ foldl' (timelineStep run f) zeroTimelineAccum xs
@@ -107,7 +107,7 @@ timelineFromLogObjects run@Run{genesis} (f, xs') =
107107
, slLogObjects = []
108108
}
109109

110-
timelineStep :: Run -> JsonLogfile -> TimelineAccum -> LogObject -> TimelineAccum
110+
timelineStep :: Run -> LogObjectSource -> TimelineAccum -> LogObject -> TimelineAccum
111111
timelineStep Run{genesis} f accum@TimelineAccum{aSlotStats=cur:_, ..} lo =
112112
-- 1. skip pre-historic events not subject to performance analysis;
113113
-- Potentially _collapsingly huge_, depending on what portion of logs you get.
@@ -152,7 +152,7 @@ timelineStep Run{genesis} f accum@TimelineAccum{aSlotStats=cur:_, ..} lo =
152152
[ desc, " for a future slot=", show slot
153153
, " cur=", show (slSlot cur)
154154
, " host=", unpack . toText $ unHost host
155-
, " file=", unJsonLogfile f
155+
, " file=", logObjectSourceFile f
156156
]
157157
else forExistingSlot slot acc x
158158
in
@@ -467,14 +467,14 @@ runSlotFilters ::
467467
NFData a =>
468468
Run
469469
-> [ChainFilter]
470-
-> [(JsonLogfile, [SlotStats a])]
471-
-> IO (DataDomain I SlotNo, [(JsonLogfile, [SlotStats a])])
470+
-> [(LogObjectSource, [SlotStats a])]
471+
-> IO (DataDomain I SlotNo, [(LogObjectSource, [SlotStats a])])
472472
runSlotFilters Run{genesis} flts slots =
473473
mapConcurrentlyPure (fmap $ filterSlotStats flts) slots
474474
<&> \filtered ->
475475
(,) (domain filtered) filtered
476476
where
477-
domain :: [(JsonLogfile, [SlotStats a])] -> DataDomain I SlotNo
477+
domain :: [(LogObjectSource, [SlotStats a])] -> DataDomain I SlotNo
478478
domain filtered = mkDataDomain
479479
((CP.head samplePre <&> slSlot) & fromMaybe 0)
480480
((lastMay samplePre <&> slSlot) & fromMaybe 0)
@@ -567,9 +567,9 @@ slotStatsSummary Run{genesis=Genesis{epochLength}} slots =
567567

568568
-- * 4. Summarise SlotStats & SlotStatsSummary into MachPerf:
569569
--
570-
slotStatsMachPerf :: Run -> (JsonLogfile, [SlotStats NominalDiffTime]) -> Either Text (JsonLogfile, MachPerfOne)
571-
slotStatsMachPerf _ (JsonLogfile f, []) =
572-
Left $ "slotStatsMachPerf: zero filtered slots from " <> pack f
570+
slotStatsMachPerf :: Run -> (LogObjectSource, [SlotStats NominalDiffTime]) -> Either Text (LogObjectSource, MachPerfOne)
571+
slotStatsMachPerf _ (f, []) =
572+
Left $ "slotStatsMachPerf: zero filtered slots from " <> pack (logObjectSourceFile f)
573573
slotStatsMachPerf run (f, slots) =
574574
Right . (f,) $ MachPerf
575575
{ mpVersion = getLocliVersion

‎bench/locli/src/Cardano/Command.hs

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ data ChainCommand
6868
| ReadChain (JsonInputFile [BlockEvents])
6969
| TimelineChain RenderConfig TextOutputFile [TimelineComments BlockEvents]
7070

71-
| CollectSlots [JsonLogfile]
71+
| CollectSlots [LogObjectSource]
7272
| DumpSlotsRaw
7373
| FilterSlots [JsonFilterFile] [ChainFilter]
7474
| DumpSlots
@@ -177,7 +177,7 @@ parseChainCommand =
177177
, op "collect-slots" "Collect per-slot performance stats"
178178
(CollectSlots
179179
<$> many
180-
(optJsonLogfile "ignore-log" "Omit data from listed log files from perf statistics"))
180+
(optLogObjectSource "ignore-log" "Omit data from listed log sources from perf statistics"))
181181
, op "dump-slots-raw" "Dump unfiltered slot stats JSON streams, alongside input files"
182182
(DumpSlotsRaw & pure)
183183
, op "filter-slots" "Filter per-slot performance stats"
@@ -342,15 +342,15 @@ data State
342342
, sRunLogs :: Maybe (RunLogs [LogObject])
343343
, sDomSlots :: Maybe (DataDomain I SlotNo)
344344
-- propagation
345-
, sMachViews :: Maybe [(JsonLogfile, MachView)]
345+
, sMachViews :: Maybe [(LogObjectSource, MachView)]
346346
, sChain :: Maybe Chain
347347
, sBlockProp :: Maybe [BlockPropOne]
348348
, sMultiBlockProp :: Maybe MultiBlockProp
349349
-- performance
350-
, sSlotsRaw :: Maybe [(JsonLogfile, [SlotStats NominalDiffTime])]
351-
, sScalars :: Maybe [(JsonLogfile, RunScalars)]
352-
, sSlots :: Maybe [(JsonLogfile, [SlotStats NominalDiffTime])]
353-
, sMachPerf :: Maybe [(JsonLogfile, MachPerfOne)]
350+
, sSlotsRaw :: Maybe [(LogObjectSource, [SlotStats NominalDiffTime])]
351+
, sScalars :: Maybe [(LogObjectSource, RunScalars)]
352+
, sSlots :: Maybe [(LogObjectSource, [SlotStats NominalDiffTime])]
353+
, sMachPerf :: Maybe [(LogObjectSource, MachPerfOne)]
354354
, sClusterPerf :: Maybe [ClusterPerf]
355355
, sMultiClusterPerf :: Maybe MultiClusterPerf
356356
--
@@ -553,7 +553,7 @@ runChainCommand s@State{sRun=Just run, sRunLogs=Just (rlLogs -> objs)}
553553
c@(CollectSlots ignores) = do
554554
let nonIgnored = flip filter objs $ (`notElem` ignores) . fst
555555
forM_ ignores $
556-
progress "perf-ignored-log" . R . unJsonLogfile
556+
progress "perf-ignored-log" . R . logObjectSourceFile
557557
progress "slots" (Q $ printf "building %d slot timelines" $ length objs)
558558
performGC
559559
(scalars, slotsRaw) <-

0 commit comments

Comments
 (0)