locli-quick: queries on WB_REMOTE (WIP)

Author: mgmeier

Makefile

@@ -71,6 +71,10 @@ show-profile:                                    ## NAME=profile-name
 ps:                                              ## Plain-text list of profiles
 	@nix build .#workbench.profile-names-json --json | jq '.[0].outputs.out' -r | xargs jq '.[]' --raw-output
 
+locli-qq:
+	@test -n "${LOCLI_QQ}" || { echo 'locli-qq:  please specify query to run as LOCLI_QQ="...query..."' && exit 1; }
+	@nix run .#locli-quick -- testpipe ${LOCLI_QQ}
+
 ##
 ## Profile-based cluster shells (autogenerated targets)
 ##

bench/locli/app/locli-quick.hs

@@ -1,8 +1,9 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-{-# OPTIONS_GHC -Wno-unused-imports -Wno-redundant-constraints -Wno-unused-top-binds #-}
+{-# OPTIONS_GHC -Wno-unused-imports -Wno-redundant-constraints -Wwarn=unused-top-binds -Wwarn=partial-fields -Wno-orphans #-}
 
 import           Cardano.Api (ExceptT, SlotNo (..), runExceptT)
 
@@ -11,34 +12,44 @@ import           Cardano.Analysis.Reducer
 import           Cardano.Analysis.Reducer.Util
 import           Cardano.Unlog.BackendDB
 import           Cardano.Unlog.BackendFile (readRunLogsBare)
-import           Cardano.Unlog.LogObject (LogObject (..), RunLogs (..), rlLogs)
+import           Cardano.Unlog.LogObject (LogObject (..), RunLogs (..), hlLogs, rlLogs)
 import           Cardano.Unlog.LogObjectDB
 import           Cardano.Util hiding (toDouble)
 
 import           Prelude hiding (log, seq)
 
-import           Data.Bifunctor (first)
+import           Data.Bifunctor
+import qualified Data.ByteString as B
 import           Data.Either
 import           Data.Function (on)
 import           Data.List (find, isSuffixOf)
-import           Data.Map.Strict as Map (restrictKeys)
+import           Data.List.Extra (splitOn)
+import           Data.Map.Strict as Map (restrictKeys, (!))
+import           Data.Maybe
 import           Data.Reducer
 import qualified Data.Set as Set (fromList, null)
 import           Data.Word
-import           System.Environment (getArgs)
+import           Options.Applicative as Opt
+import           System.FilePath (splitDirectories, takeExtension)
 
 import           Database.Sqlite.Easy hiding (Text)
 import           Graphics.EasyPlot
 
 
 main :: IO ()
 main = do
-  getArgs >>= \case
-    db : _
-      | ".sqlite3"  `isSuffixOf` db -> runDB $ fromString db
-      | ".json"     `isSuffixOf` db -> runManifest db
-      | db == "testplot"            -> void testPlot
-    _ -> putStrLn "please specify DB file or log manifest, or 'testplot'"
+  cli <- parseCommandLine
+  -- print cli
+  case cli of
+    CMDTestPlot  -> void testPlot
+    CMDProcess m -> do
+      putStrLn $ "--> reading result blob from: " ++ show m
+    CMDQuery{..} -> case cInputs of
+      [db] | takeExtension db == ".sqlite3"
+        -> runDB $ fromString db
+      inputs
+        -> mapM (runManifest cNodes) (zip inputs [0 :: Int ..]) >>= runPlot
+    CMDTestPipe r -> testPipe r
 
 -- for testing the EasyPlot module
 testPlot :: IO Bool
@@ -56,36 +67,70 @@ testPlot =
         , File2D [Title "from file", Color Yellow] [] "_plot1.dat" Nothing
         ]
 
-runManifest :: FilePath -> IO ()
-runManifest logManifest = do
+testPipe :: Bool -> IO ()
+testPipe readMode
+  | readMode = do
+    inp <- B.getContents
+    putStrLn $ "--> does stdin match test buffer: " ++ show (inp == testBuffer)
+  | otherwise = B.putStr testBuffer
+  where
+    testBuffer = B.pack $ take 2048 $ cycle [0 .. 255]
+
+runManifest :: [String] -> (FilePath, Int) -> IO (Graph2D Double Double)
+runManifest targetNodes (logManifest, ix) = do
   rls <- withTimingInfo "quick-query" $
     -- runOnRun (LoadLogObjectsWith selectMempoolTxs) logManifest [] -- ["node-2", "node-12", "node-22"]
-    -- runOnRun LoadHeapData logManifest [] -- ["node-2", "node-12", "node-22"]
-    runOnRun LoadTimestamps logManifest [] -- ["node-2", "node-12", "node-22"]
+    runOnRun LoadHeapData logManifest [targetNode]
+    -- runOnRun LoadTimestamps logManifest [] -- ["node-2", "node-12", "node-22"]
 
   {-
   let
     perSlot :: RunLogs [ObjectsInSlot]
     perSlot = bySlotDomain `fmap` rls
 
-    red    = reduceRunLogs (TxsInMempoolPerSlot <-> Changes ((/=) `on` snd)) perSlot
+    red = reduceRunLogs (TxsInMempoolPerSlot <-> changes)) perSlot
   -}
 
   {-
+  now <- getCurrentTime
   let
-    perSlot :: RunLogs [BySlot Word64]
-    perSlot = bySlot
-                (either (const Nothing) Just)
-                (fromLeft undefined)
-                False
-              `fmap` rls
+    res = reduceRunLogs Silence{threshold = 1.2, startTime = now} rls
+  mapM_ print (rlLogs res)
   -}
 
-  now <- getCurrentTime
   let
-    res = reduceRunLogs Silence{threshold = 1.2, startTime = now} rls
+    target =  snd $ hlLogs $ rlHostLogs rls Map.! fromString targetNode
 
-  mapM_ print (rlLogs res)
+    bySlotValue :: [BySlot Word64]
+    bySlotValue = bySlot (either (const Nothing) Just) (fromLeft undefined) False target
+
+    res    = reduce ResourceMeasurePerSlot bySlotValue
+    bumps  = reduce changes res
+    gibibytes = map (second (\w -> fromIntegral w / 1073741824)) (toDouble bumps)
+
+    plotData = Data2D [Title targetTitle, Color targetColor, Style Steps] [] gibibytes
+  putStrLn $ "--> target node: " ++ targetNode
+  mapM_ print bumps
+  pure plotData
+
+  where
+    targetNode  = fromMaybe "node-10" $ listToMaybe targetNodes
+    targetColor = cycle [Red, Blue, Green, Yellow, Magenta, Cyan] !! ix
+    targetTitle = case splitDirectories logManifest of
+      "run" : runId : _ -> runId            -- workbench use
+      _                 -> logManifest      -- any other manual use
+
+runPlot :: Plot a => a -> IO ()
+runPlot plotData =
+   void $ plot' [preamble] term plotData
+  where
+    term = Terminal Qt "Heap size bumps" (Just (1440, 960))
+    preamble = Preamble
+      [ "set xlabel \"Slot\""
+      , "set ylabel \"Heap size (GiB)\""
+      , "set format y \"%'.2f\""
+      , "set ytics nomirror"
+      ]
 
 runOnRun :: forall l. LoadFromDB l => l -> FilePath -> [String] -> IO (RunLogs [LoadResult l])
 runOnRun loadFromDB logManifest onlyHosts =
@@ -122,12 +167,9 @@ runDB dbName = do
     res2   = reduce changes res1
 
   let
-    toDouble :: SlotNo -> Double
-    toDouble = fromIntegral . unSlotNo
-
-    term    = Terminal X11 "Txns in Mempool" (Just (1024, 768))
-    points1 = map (first toDouble) res1
-    points2 = map (first toDouble) res2
+    term    = Terminal X11 "Txns in Mempool" (Just (1280, 960))
+    points1 = toDouble res1
+    points2 = toDouble res2
 
   void $ plot' [] term (Data2D [Title "txn count per slot", Color Red, Style Linespoints] [] points1)
   void $ plot' [] term (Data2D [Title "txn count changes", Color Blue, Style Steps] [] points2)
@@ -139,6 +181,9 @@ selectMempoolTxs =
   ]
 
 
+toDouble :: [(SlotNo, a)] -> [(Double, a)]
+toDouble = map (first (fromIntegral . unSlotNo))
+
 {-
   This should eventually be part of a QuickQuery typeclass. This class is defined by:
   - a query + (possibly parametrizable) filter, making use of the LoadFromDB typeclass
@@ -150,6 +195,8 @@ selectMempoolTxs =
 
 data LoadHeapData = LoadHeapData
 
+
+-- TODO: use timestamp to infer slot numbers during startup
 instance LoadFromDB LoadHeapData where
   type instance LoadResult LoadHeapData = Either Word64 SlotNo
 
@@ -177,3 +224,94 @@ instance LoadFromDB LoadTimestamps where
   loadConvert _ _ = \case
     [at, slot] -> (fromSqlData at, fromSqlData slot)
     _ -> error "loadConvert(LoadTimestamps): expected 2 result columns"
+
+
+--
+-- command line parsing
+--
+
+data ProcessMode
+    = PassThru                                        -- ^ read result blob from stdin
+    | WriteBlob FilePath                              -- ^ read result blob from stdin and also write to file (to retain a local copy when blob is piped from remote)
+    | ReadBlob FilePath                               -- ^ read result blob from file
+
+instance Show ProcessMode where
+  show PassThru       = "<stdin>"
+  show (WriteBlob f)  = "<stdin> (will dump to: " ++ f ++ ")"
+  show (ReadBlob f)   = f
+
+data Command
+    = CMDTestPlot
+    | CMDQuery
+      { cQuery        :: ()                           -- ^ the query to run
+      , cInputs       :: [FilePath]                   -- ^ log manifests of all runs to query, or a single .sqlite3 DB
+      , cNodes        :: [String]                     -- ^ hosts to query (e.g. ["node-10", "node-12"]; empty: all hosts
+      , cDumpResult   :: Bool                         -- ^ dump result blob to stdout only; don't process
+      }
+    | CMDProcess
+      { cProcessMode  :: ProcessMode
+      }
+    | CMDTestPipe
+      { cReadMode     :: Bool
+      }
+    deriving Show
+
+parseCommandLine :: IO Command
+parseCommandLine
+  = post <$> Opt.customExecParser p opts
+  where
+    p     = Opt.prefs Opt.showHelpOnEmpty
+    opts  = Opt.info parserCommandLine Opt.fullDesc
+
+    -- post processing: if run paths were given, extend to log manifest path accoring to workbench default
+    post  = \case
+      cmd@CMDQuery{cInputs = ps} -> cmd {cInputs = map extend ps}
+      other                      -> other
+      where
+        extend f = f
+
+parserCommandLine :: Parser Command
+parserCommandLine = subparser $ mconcat
+  [ parserOp "qq"       "run a quick query"                 parserQuickQuery
+  , parserOp "proc"     "process a query result"            (CMDProcess <$> parserProcessMode)
+  , parserOp "testpipe" "test stdout/stdin piping a buffer" parserTestPipe
+  , parserOp "testplot" "test plotting with dummy data"     (pure CMDTestPlot)
+  ]
+  where
+    parserTestPipe = CMDTestPipe <$>
+      (flag' True (short 'r' <> help "read from stdin") <|> flag' False (short 'w' <> help "write to stdout"))
+
+    parserProcessMode =
+          WriteBlob <$> strOption (short 'w' <> metavar "FILE" <> help "read from stdin and also dump to file")
+      <|> ReadBlob  <$> strOption (short 'r' <> metavar "FILE" <> help "read from file")
+      <|> pure PassThru
+
+parserQuickQuery :: Parser Command
+parserQuickQuery =
+  CMDQuery
+    <$> pure ()
+    <*> parseRuns
+    <*> pure []
+    <*> switch (short 'd' <> long "dump-only" <> help "dump result blob to stdout only; don't process")
+  where
+    {-
+    parseScriptName =
+          strArgument (help "name of a known script"        <> metavar "NAME")
+      <|> strArgument (help "custom serialized script file" <> metavar "FILE" <> completer (bashCompleter "file"))
+    parseParamPath =
+      strOption $ long "param" <> metavar "JSON" <> completer (bashCompleter "file")
+        <> help "protocol parameter file; default: data/protocol-parameters-v10.json"
+    parseBudgetHint =
+      option auto $ long "hint" <> metavar "BUDGET"
+        <> help "Which budget does the script target? <Mem|Steps>"
+    -}
+    parseRuns =
+      option readCommaSepList $ long "run" <> short 'r' <> metavar "run(s)"
+        <> help "comma-separated list of run dirs or log manifest JSONs, or a single SQLite DB"
+
+readCommaSepList :: Opt.ReadM [String]
+readCommaSepList = Opt.maybeReader
+  ((\inp -> if null inp then Nothing else Just inp) . filter (not . null) . splitOn ",")
+
+parserOp :: String -> String -> Parser a -> Mod CommandFields a
+parserOp c descr p = command c $ info (p <**> helper) $ progDesc descr

bench/locli/locli.cabal

@@ -176,6 +176,7 @@ executable locli-quick
 
   other-modules:        Cardano.Analysis.Reducer
                         Cardano.Analysis.Reducer.Util
+                        Cardano.Analysis.Quick.Types
                         Data.Reducer
                         Graphics.EasyPlot
 
@@ -191,7 +192,10 @@ executable locli-quick
                       , containers
                       , directory
                       , extra
+                      , filepath
                       , process
+                      , optparse-applicative-fork
+                      , serialise
                       , split
                       , text
                       , text-short

bench/locli/src-quick/Cardano/Analysis/Quick/Types.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans -Wno-partial-fields #-}
+
+module Cardano.Analysis.Quick.Types
+       (module Cardano.Analysis.Quick.Types)
+       where
+
+import           Cardano.Analysis.API.Ground (Host (..), JsonLogfile (..), LogObjectSource (..))
+import           Cardano.Unlog.BackendDB (LoadRawResult (..))
+import           Cardano.Unlog.LogObject (HostLogs, RunLogs)
+import           Cardano.Unlog.LogObjectDB (SummaryDB (..))
+import           Cardano.Util (I)
+
+import           Codec.Serialise (Serialise (..))
+import           Data.Profile (ProfileEntry)
+import           Data.Text.Short (ShortText, fromShortByteString, toShortByteString)
+import           GHC.Generics (Generic)
+
+import           Database.Sqlite.Easy (SQLData)
+
+
+instance Serialise ShortText where
+  encode = encode . toShortByteString
+  decode = decode >>= maybe (fail "fromShortByteString: not a ShortText") pure . fromShortByteString
+
+deriving via ShortText instance Serialise Host
+deriving via FilePath  instance Serialise JsonLogfile
+deriving instance Serialise LogObjectSource
+
+deriving instance Generic SummaryDB
+deriving instance Serialise SummaryDB
+
+deriving instance Serialise SQLData
+
+deriving instance Generic LoadRawResult
+deriving instance Serialise LoadRawResult
+
+-- quick queries (and their result type) do not support encoding GHC profiling data
+instance {-# OVERLAPS #-} Serialise [ProfileEntry I] where
+  encode = mempty
+  decode = pure []
+
+deriving instance Serialise a => Serialise (HostLogs a)
+deriving instance Serialise a => Serialise (RunLogs a)
+
+{-
+data RemoteQueryMeta = QueryRemote
+  { qrmRunIds :: [String]
+  , qrmNodes  :: [Host]
+  , qrmQuery  :: ()
+  }
+-}
+
+data RemoteQueryResult
+  = RemoteQueryResult
+    { rqrQuery  :: ()
+    , rqrResult :: RunLogs LoadRawResult
+    }
+  | RemoteQueryError
+    { rqrError  :: String
+    }
+  deriving (Generic, Serialise)