Skip to content

Commit 538e8ca

Browse files
mgmeiermgmeier
authored
Merge pull request #6054 from IntersectMBO/mkarg/experimental/locli-db
bench | locli: new DB persistence backend for analysis data
2 parents e746469 + d6fc781 commit 538e8ca

File tree

21 files changed

+1298
-284
lines changed

21 files changed

+1298
-284
lines changed

‎bench/locli/CHANGELOG.md‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,14 @@
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+
* 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
11+
312
## 1.36 -- Nov 2024
413

514
* 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: 34 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,
@@ -50,6 +50,9 @@ common project-config
5050
-Wcompat
5151
-Wno-all-missed-specialisations
5252

53+
if impl(ghc >= 9.8)
54+
ghc-options: -Wno-x-partial
55+
5356
build-depends: base >= 4.14 && < 5,
5457

5558
if os(windows)
@@ -89,7 +92,10 @@ library
8992
Cardano.Org
9093
Cardano.Render
9194

95+
Cardano.Unlog.BackendDB
96+
Cardano.Unlog.BackendFile
9297
Cardano.Unlog.LogObject
98+
Cardano.Unlog.LogObjectDB
9399
Cardano.Unlog.Resources
94100

95101
other-modules: Paths_locli
@@ -116,6 +122,7 @@ library
116122
, ouroboros-network-api ^>= 0.10
117123
, sop-core
118124
, split
125+
, sqlite-easy >= 1.1.0.1
119126
, statistics
120127
, strict-sop-core
121128
, text
@@ -136,7 +143,7 @@ executable locli
136143
main-is: locli.hs
137144
ghc-options: -threaded
138145
-rtsopts
139-
"-with-rtsopts=-T -N7 -A2m -qb -H64m"
146+
"-with-rtsopts=-T -N7 -A2m -c -H64m"
140147

141148
build-depends: aeson
142149
, cardano-prelude
@@ -147,6 +154,30 @@ executable locli
147154
, transformers
148155
, transformers-except
149156

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

@@ -163,4 +194,5 @@ test-suite test-locli
163194
, text
164195

165196
other-modules: Test.Analysis.CDF
197+
Test.Unlog.LogObjectDB
166198
Test.Unlog.Org

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

Lines changed: 85 additions & 29 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,17 +155,50 @@ 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)
160165

166+
data LogObjectSource =
167+
LogObjectSourceJSON JsonLogfile
168+
| LogObjectSourceSQLite FilePath
169+
| LogObjectSourceOther FilePath
170+
deriving (Show, Eq, Generic, NFData)
171+
172+
logObjectSourceFile :: LogObjectSource -> FilePath
173+
logObjectSourceFile = \case
174+
LogObjectSourceJSON j -> unJsonLogfile j
175+
LogObjectSourceSQLite f -> f
176+
LogObjectSourceOther f -> f
177+
178+
toLogObjectSource :: FilePath -> LogObjectSource
179+
toLogObjectSource fp
180+
| ext == ".sqlite" || ext == ".sqlite3" = LogObjectSourceSQLite fp
181+
| ext == ".json" = LogObjectSourceJSON (JsonLogfile fp)
182+
| otherwise = LogObjectSourceOther fp
183+
where
184+
ext = map toLower $ F.takeExtension fp
185+
186+
instance FromJSON LogObjectSource where
187+
parseJSON = withText "LogObjectSource" (pure . toLogObjectSource . T.unpack)
188+
189+
instance ToJSON LogObjectSource where
190+
toJSON = toJSON . logObjectSourceFile
191+
161192
---
162193
--- Orphans
163194
---
164195
deriving newtype instance Real BlockNo
165196
deriving newtype instance Divisible BlockNo
197+
deriving instance Data BlockNo
198+
166199
deriving newtype instance Real SlotNo
167200
deriving newtype instance Divisible SlotNo
201+
deriving instance Data SlotNo
168202

169203
---
170204
--- Readers
@@ -202,6 +236,14 @@ optJsonLogfile optname desc =
202236
<> metavar "JSONLOGFILE"
203237
<> help desc
204238

239+
optLogObjectSource :: String -> String -> Parser LogObjectSource
240+
optLogObjectSource optname desc =
241+
fmap toLogObjectSource $
242+
Opt.option Opt.str
243+
$ long optname
244+
<> metavar "JSONLOGFILE|SQLITE3LOGFILE"
245+
<> help desc
246+
205247
argJsonLogfile :: Parser JsonLogfile
206248
argJsonLogfile =
207249
JsonLogfile <$>
@@ -255,6 +297,14 @@ optCsvOutputFile optname desc =
255297
<> metavar "CSV-OUTFILE"
256298
<> help desc
257299

300+
optSqliteOutputFile :: String -> String -> Parser SqliteOutputFile
301+
optSqliteOutputFile optname desc =
302+
fmap SqliteOutputFile $
303+
Opt.option Opt.str
304+
$ long optname
305+
<> metavar "SQLITE-OUTFILE"
306+
<> help desc
307+
258308
optOutputFile :: String -> String -> Parser OutputFile
259309
optOutputFile optname desc =
260310
fmap OutputFile $
@@ -279,6 +329,12 @@ optWord optname desc def =
279329
<> metavar "INT"
280330
<> help desc
281331
<> value def
332+
333+
optString :: String -> String -> Parser String
334+
optString optname desc =
335+
Opt.option Opt.str $
336+
long optname <> metavar "STRING" <> Opt.help desc
337+
282338
-- /path/to/logs-HOSTNAME.some.ext -> HOSTNAME
283339
hostFromLogfilename :: JsonLogfile -> Host
284340
hostFromLogfilename (JsonLogfile f) =
@@ -302,26 +358,26 @@ dumpObjects ident xs (JsonOutputFile f) = liftIO $ do
302358
withFile f WriteMode $ \hnd -> do
303359
forM_ xs $ LBS.hPutStrLn hnd . encode
304360

305-
dumpAssociatedObjects :: ToJSON a => String -> [(JsonLogfile, a)] -> ExceptT Text IO ()
361+
dumpAssociatedObjects :: ToJSON a => String -> [(LogObjectSource, a)] -> ExceptT Text IO ()
306362
dumpAssociatedObjects ident xs = liftIO $
307363
flip mapConcurrently_ xs $
308-
\(JsonLogfile f, x) ->
364+
\(logObjectSourceFile -> f, x) ->
309365
withFile (replaceExtension f $ ident <> ".json") WriteMode $ \hnd ->
310366
LBS.hPutStrLn hnd $ encode x
311367

312368
readAssociatedObjects :: forall a.
313-
FromJSON a => String -> [JsonLogfile] -> ExceptT Text IO [(JsonLogfile, a)]
369+
FromJSON a => String -> [JsonLogfile] -> ExceptT Text IO [(LogObjectSource, a)]
314370
readAssociatedObjects ident fs = firstExceptT T.pack . newExceptT . fmap (mapM sequence) $
315371
flip mapConcurrently fs $
316372
\jf@(JsonLogfile f) -> do
317373
x <- eitherDecode @a <$> LBS.readFile (replaceExtension f $ ident <> ".json")
318374
progress ident (Q f)
319-
pure (jf, x)
375+
pure (LogObjectSourceJSON jf, x)
320376

321-
dumpAssociatedObjectStreams :: ToJSON a => String -> [(JsonLogfile, [a])] -> ExceptT Text IO ()
377+
dumpAssociatedObjectStreams :: ToJSON a => String -> [(LogObjectSource, [a])] -> ExceptT Text IO ()
322378
dumpAssociatedObjectStreams ident xss = liftIO $
323379
flip mapConcurrently_ xss $
324-
\(JsonLogfile f, xs) -> do
380+
\(logObjectSourceFile -> f, xs) -> do
325381
withFile (replaceExtension f $ ident <> ".json") WriteMode $ \hnd -> do
326382
forM_ xs $ LBS.hPutStrLn hnd . encode
327383

@@ -331,9 +387,9 @@ dumpText ident xs (TextOutputFile f) = liftIO $ do
331387
withFile f WriteMode $ \hnd -> do
332388
forM_ xs $ hPutStrLn hnd
333389

334-
dumpAssociatedTextStreams :: String -> [(JsonLogfile, [Text])] -> ExceptT Text IO ()
390+
dumpAssociatedTextStreams :: String -> [(LogObjectSource, [Text])] -> ExceptT Text IO ()
335391
dumpAssociatedTextStreams ident xss = liftIO $
336392
flip mapConcurrently_ xss $
337-
\(JsonLogfile f, xs) -> do
393+
\(logObjectSourceFile -> f, xs) -> do
338394
withFile (replaceExtension f $ ident <> ".txt") WriteMode $ \hnd -> do
339395
forM_ xs $ hPutStrLn hnd

0 commit comments

Comments
 (0)