Skip to content

Commit afb5c9c

Browse files
mgmeiermgmeier
committed
wb | locli: new DB persistence backend; GC tweaks; workbench integration
(squashed)
1 parent e746469 commit afb5c9c

File tree

17 files changed

+1183
-166
lines changed

17 files changed

+1183
-166
lines changed

‎bench/locli/CHANGELOG.md‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,12 @@
11
# Revision history for locli
22

3+
## 2.0 -- Dec 2024
4+
5+
* 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.
9+
310
## 1.36 -- Nov 2024
411

512
* Add `CHANGELOG.md` for `locli`

‎bench/locli/app/locli-quick.hs‎

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
import Cardano.Api (SlotNo (..))
2+
3+
import Cardano.Unlog.BackendDB
4+
import Cardano.Unlog.LogObject (LOBody (..), LogObject (..))
5+
import Cardano.Unlog.LogObjectDB
6+
import Cardano.Util
7+
8+
import Prelude hiding (log)
9+
10+
import Data.Bifunctor (second)
11+
import Data.List.Split (chop)
12+
import Data.Maybe
13+
import System.Environment (getArgs)
14+
15+
import Database.Sqlite.Easy hiding (Text)
16+
17+
18+
main :: IO ()
19+
main = do
20+
getArgs >>= \case
21+
[] -> putStrLn "please specify DB file"
22+
db : _ -> runDB $ fromString db
23+
24+
-- sample case:
25+
-- we want to know the txns in mempool for each slot
26+
27+
runDB :: ConnectionString -> IO ()
28+
runDB dbName = do
29+
(summary, res2) <-
30+
withTimingInfo "withDb/selectMempoolTxs" $
31+
withDb dbName $
32+
(,) <$> getSummary <*> run selectMempoolTxs
33+
34+
let logObjects = map (sqlToLogObject summary) res2
35+
36+
-- TODO: needs a reducer
37+
mapM_ (print . second safeLast) (bySlotDomain logObjects)
38+
where
39+
safeLast [] = []
40+
safeLast xs = [last xs]
41+
42+
bySlotDomain :: [LogObject] -> [(SlotNo, [LogObject])]
43+
bySlotDomain logObjs =
44+
case dropWhile (isNothing . newSlot) logObjs of
45+
[] -> []
46+
xs -> chop go xs
47+
where
48+
newSlot LogObject{loBody} = case loBody of { LOTraceStartLeadershipCheck s _ _ -> Just s; _ -> Nothing }
49+
50+
go (lo:los) = let (inSlot, rest) = span (isNothing . newSlot) los in ((fromJust $ newSlot lo, inSlot), rest)
51+
go [] = error "bySlotDomain/chop: empty list"
52+
53+
selectMempoolTxs :: SQL
54+
selectMempoolTxs = sqlOrdered
55+
[ sqlGetSlot
56+
, sqlGetTxns `sqlAppend` "WHERE cons='LOMempoolTxs'"
57+
]

‎bench/locli/locli.cabal‎

Lines changed: 31 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
cabal-version: 3.0
22

33
name: locli
4-
version: 1.36
4+
version: 2.0
55
synopsis: Cardano log analysis CLI
66
description: Cardano log analysis CLI.
77
category: Cardano,
@@ -89,7 +89,10 @@ library
8989
Cardano.Org
9090
Cardano.Render
9191

92+
Cardano.Unlog.BackendDB
93+
Cardano.Unlog.BackendFile
9294
Cardano.Unlog.LogObject
95+
Cardano.Unlog.LogObjectDB
9396
Cardano.Unlog.Resources
9497

9598
other-modules: Paths_locli
@@ -116,6 +119,7 @@ library
116119
, ouroboros-network-api ^>= 0.10
117120
, sop-core
118121
, split
122+
, sqlite-easy >= 1.1.0.1
119123
, statistics
120124
, strict-sop-core
121125
, text
@@ -136,7 +140,7 @@ executable locli
136140
main-is: locli.hs
137141
ghc-options: -threaded
138142
-rtsopts
139-
"-with-rtsopts=-T -N7 -A2m -qb -H64m"
143+
"-with-rtsopts=-T -N7 -A2m -c -H64m"
140144

141145
build-depends: aeson
142146
, cardano-prelude
@@ -147,6 +151,30 @@ executable locli
147151
, transformers
148152
, transformers-except
149153

154+
executable locli-quick
155+
import: project-config
156+
157+
hs-source-dirs: app
158+
main-is: locli-quick.hs
159+
ghc-options: -threaded
160+
-rtsopts
161+
"-with-rtsopts=-T -N7 -A2m -c -H64m"
162+
163+
build-depends: locli
164+
, aeson
165+
, async
166+
, bytestring
167+
, containers
168+
, cardano-api
169+
, extra
170+
, split
171+
, text
172+
, text-short
173+
, time
174+
, trace-resources
175+
, sqlite-easy >= 1.1.0.1
176+
, unordered-containers
177+
150178
test-suite test-locli
151179
import: project-config
152180

@@ -163,4 +191,5 @@ test-suite test-locli
163191
, text
164192

165193
other-modules: Test.Analysis.CDF
194+
Test.Unlog.LogObjectDB
166195
Test.Unlog.Org

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

Lines changed: 43 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
1-
{-# LANGUAGE PolyKinds #-}
21
{-# LANGUAGE DeriveAnyClass #-}
2+
{-# LANGUAGE DeriveDataTypeable #-}
33
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
4+
{-# LANGUAGE PolyKinds #-}
45
{-# OPTIONS_GHC -Wno-orphans #-}
56
module Cardano.Analysis.API.Ground
67
( module Cardano.Analysis.API.Ground
@@ -10,28 +11,28 @@ module Cardano.Analysis.API.Ground
1011
)
1112
where
1213

13-
import Prelude as P (show)
14-
import Cardano.Prelude hiding (head, toText)
15-
import Unsafe.Coerce qualified as Unsafe
14+
import Cardano.Prelude hiding (head, toText)
15+
import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..))
16+
import Cardano.Util
17+
import Ouroboros.Network.Block (BlockNo (..))
1618

17-
import Data.Aeson
18-
import Data.Aeson.Types (toJSONKeyText)
19-
import Data.ByteString.Lazy.Char8 qualified as LBS
20-
import Data.Map.Strict qualified as Map
21-
import Data.Text qualified as T
22-
import Data.Text.Short qualified as SText
23-
import Data.Text.Short (ShortText, fromText, toText)
24-
import Data.Time.Clock (UTCTime, NominalDiffTime)
25-
import Options.Applicative
26-
import Options.Applicative qualified as Opt
27-
import System.FilePath qualified as F
19+
import Prelude as P (show)
2820

29-
import Cardano.Slotting.Slot (EpochNo(..), SlotNo(..))
30-
import Ouroboros.Network.Block (BlockNo(..))
21+
import Data.Aeson
22+
import Data.Aeson.Types (toJSONKeyText)
23+
import qualified Data.ByteString.Lazy.Char8 as LBS
24+
import Data.CDF
25+
import Data.Data (Data)
26+
import Data.DataDomain
27+
import qualified Data.Map.Strict as Map
28+
import qualified Data.Text as T
29+
import Data.Text.Short (ShortText, fromText, toText)
30+
import qualified Data.Text.Short as SText
31+
import Data.Time.Clock (NominalDiffTime, UTCTime)
32+
import Options.Applicative as Opt
33+
import qualified System.FilePath as F
3134

32-
import Data.CDF
33-
import Data.DataDomain
34-
import Cardano.Util
35+
import qualified Unsafe.Coerce as Unsafe
3536

3637

3738
newtype FieldName = FieldName { unFieldName :: Text }
@@ -51,7 +52,7 @@ instance Show TId where
5152
show = ("TId " ++) . P.show . unTId
5253

5354
newtype Hash = Hash { unHash :: ShortText }
54-
deriving (Eq, Generic, Ord)
55+
deriving (Eq, Generic, Ord, Data)
5556
deriving newtype (FromJSON, ToJSON)
5657
deriving anyclass NFData
5758

@@ -154,6 +155,10 @@ newtype CsvOutputFile
154155
= CsvOutputFile { unCsvOutputFile :: FilePath }
155156
deriving (Show, Eq)
156157

158+
newtype SqliteOutputFile
159+
= SqliteOutputFile { unSqliteOutputFile :: FilePath }
160+
deriving (Show, Eq)
161+
157162
newtype OutputFile
158163
= OutputFile { unOutputFile :: FilePath }
159164
deriving (Show, Eq)
@@ -163,8 +168,11 @@ newtype OutputFile
163168
---
164169
deriving newtype instance Real BlockNo
165170
deriving newtype instance Divisible BlockNo
171+
deriving instance Data BlockNo
172+
166173
deriving newtype instance Real SlotNo
167174
deriving newtype instance Divisible SlotNo
175+
deriving instance Data SlotNo
168176

169177
---
170178
--- Readers
@@ -255,6 +263,14 @@ optCsvOutputFile optname desc =
255263
<> metavar "CSV-OUTFILE"
256264
<> help desc
257265

266+
optSqliteOutputFile :: String -> String -> Parser SqliteOutputFile
267+
optSqliteOutputFile optname desc =
268+
fmap SqliteOutputFile $
269+
Opt.option Opt.str
270+
$ long optname
271+
<> metavar "SQLITE-OUTFILE"
272+
<> help desc
273+
258274
optOutputFile :: String -> String -> Parser OutputFile
259275
optOutputFile optname desc =
260276
fmap OutputFile $
@@ -279,6 +295,12 @@ optWord optname desc def =
279295
<> metavar "INT"
280296
<> help desc
281297
<> value def
298+
299+
optString :: String -> String -> Parser String
300+
optString optname desc =
301+
Opt.option Opt.str $
302+
long optname <> metavar "STRING" <> Opt.help desc
303+
282304
-- /path/to/logs-HOSTNAME.some.ext -> HOSTNAME
283305
hostFromLogfilename :: JsonLogfile -> Host
284306
hostFromLogfilename (JsonLogfile f) =

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ timelineFromLogObjects run@Run{genesis} (f, xs') =
4747
$ foldl' (timelineStep run f) zeroTimelineAccum xs
4848
& (aRunScalars &&& reverse . aSlotStats)
4949
where
50-
xs = filter (not . (`textRefEquals` "DecodeError") . loKind) xs'
50+
xs = filter (not . ("DecodeError" `textRefEquals`) . loKind) xs'
5151

5252
firstRelevantLogObjectTime :: UTCTime
5353
firstRelevantLogObjectTime = loAt (head xs) `max` systemStart genesis

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

Lines changed: 43 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import Options.Applicative qualified as Opt
2121

2222
import System.Directory (doesFileExist)
2323
import System.FilePath
24+
import System.Mem qualified as Mem (performGC)
2425
import System.Posix.Files qualified as IO
2526

2627
import Cardano.Analysis.API
@@ -29,6 +30,8 @@ import Cardano.Analysis.MachPerf
2930
import Cardano.Analysis.Summary
3031
import Cardano.Render
3132
import Cardano.Report
33+
import Cardano.Unlog.BackendDB
34+
import Cardano.Unlog.BackendFile
3235
import Cardano.Unlog.LogObject
3336
import Cardano.Util hiding (head)
3437

@@ -50,9 +53,10 @@ data ChainCommand
5053
= ReadMetaGenesis (JsonInputFile RunPartial) (JsonInputFile Genesis)
5154
| WriteMetaGenesis TextOutputFile TextOutputFile
5255

53-
| Unlog (JsonInputFile (RunLogs ())) Bool (Maybe [LOAnyType])
56+
| Unlog (JsonInputFile (RunLogs ())) Bool (Maybe [LOAnyType])
5457
| DumpLogObjects
55-
58+
| PrepareDB String [TextInputFile] SqliteOutputFile
59+
| UnlogDB (JsonInputFile (RunLogs ()))
5660
| ValidateHashTimeline (JsonInputFile [LogObject])
5761

5862
| BuildMachViews
@@ -122,6 +126,15 @@ parseChainCommand =
122126
(some
123127
(optLOAnyType "ok-loany" "[MULTI] Allow a particular LOAnyType"))
124128
)
129+
, op "unlog-db" "Read logs from DBs"
130+
(UnlogDB
131+
<$> optJsonInputFile "run-logs" "Run log manifest (API/Types.hs:RunLogs)"
132+
)
133+
, op "prepare-db" "Prepare an SQLite DB from a host's log output"
134+
(PrepareDB
135+
<$> optString "mach" "host's machine name"
136+
<*> some (optTextInputFile "log" "[MULTI] host log file(s)")
137+
<*> optSqliteOutputFile "db" "DB output file")
125138
, op "dump-logobjects" "Dump lifted log object streams, alongside input files"
126139
(DumpLogObjects & pure)
127140
, op "hash-timeline" "Quickly validate timeline by hashes"
@@ -417,6 +430,19 @@ runChainCommand s
417430
& firstExceptT (CommandError c)
418431
pure s { sRunLogs = Just runLogs }
419432

433+
runChainCommand s
434+
c@(UnlogDB rlf) = do
435+
progress "logs" (Q $ printf "reading run log manifest %s" $ unJsonInputFile rlf)
436+
runLogsBare <- Aeson.eitherDecode @(RunLogs ())
437+
<$> LBS.readFile (unJsonInputFile rlf)
438+
& newExceptT
439+
& firstExceptT (CommandError c . pack)
440+
progress "logs" (Q $ printf "loading logs from DBs for %d hosts" $
441+
Map.size $ rlHostLogs runLogsBare)
442+
runLogs <- runLiftLogObjectsDB runLogsBare
443+
& firstExceptT (CommandError c)
444+
pure s { sRunLogs = Just runLogs }
445+
420446
runChainCommand s@State{sRunLogs=Just (rlLogs -> objs)}
421447
c@DumpLogObjects = do
422448
progress "logobjs" (Q $ printf "dumping %d logobject streams" $ length objs)
@@ -427,6 +453,13 @@ runChainCommand _ c@DumpLogObjects = missingCommandData c
427453

428454
-- runChainCommand s c@(ReadMachViews _ _) -- () -> [(JsonLogfile, MachView)]
429455

456+
runChainCommand s
457+
c@(PrepareDB machName inFiles outFile) = do
458+
progress "prepare-db" (Q $ printf "preparing DB %s from '%s' logs" (unSqliteOutputFile outFile) machName)
459+
prepareDB machName (map unTextInputFile inFiles) (unSqliteOutputFile outFile)
460+
& firstExceptT (CommandError c)
461+
pure s
462+
430463
runChainCommand s
431464
c@(ValidateHashTimeline timelineJson) = do
432465
progress "logs" (Q $ printf "validating hash timeline")
@@ -446,6 +479,7 @@ runChainCommand s
446479
runChainCommand s@State{sRun=Just run, sRunLogs=Just (rlLogs -> objs)}
447480
BuildMachViews = do
448481
progress "machviews" (Q $ printf "building %d machviews" $ length objs)
482+
performGC
449483
mvs <- buildMachViews run objs & liftIO
450484
pure s { sMachViews = Just mvs }
451485
runChainCommand _ c@BuildMachViews = missingCommandData c
@@ -520,7 +554,8 @@ runChainCommand s@State{sRun=Just run, sRunLogs=Just (rlLogs -> objs)}
520554
let nonIgnored = flip filter objs $ (`notElem` ignores) . fst
521555
forM_ ignores $
522556
progress "perf-ignored-log" . R . unJsonLogfile
523-
progress "slots" (Q $ printf "building slot %d timelines" $ length objs)
557+
progress "slots" (Q $ printf "building %d slot timelines" $ length objs)
558+
performGC
524559
(scalars, slotsRaw) <-
525560
fmap (mapAndUnzip redistribute) <$> collectSlotStats run nonIgnored
526561
& newExceptT
@@ -648,6 +683,7 @@ runChainCommand _ c@RenderMultiPropagation{} = missingCommandData c
648683
runChainCommand s@State{sRun=Just run, sSlots=Just slots}
649684
c@ComputeMachPerf = do
650685
progress "machperf" (Q $ printf "computing %d machine performances" $ length slots)
686+
performGC
651687
perf <- mapConcurrentlyPure (slotStatsMachPerf run) slots
652688
& fmap sequence
653689
& newExceptT
@@ -833,6 +869,10 @@ fromAnalysisError :: ChainCommand -> AnalysisCmdError -> CommandError
833869
fromAnalysisError c (AnalysisCmdError t) = CommandError c t
834870
fromAnalysisError c o = CommandError c (show o)
835871

872+
873+
performGC :: ExceptT CommandError IO ()
874+
performGC = liftIO Mem.performGC
875+
836876
runCommand :: Command -> ExceptT CommandError IO ()
837877

838878
runCommand (ChainCommand cs) = do

0 commit comments

Comments
 (0)