Merge pull request IntersectMBO#5469 from input-output-hk/bench-master

workbench | tx-generator: updated reporting and tracing detail

bench/locli/src/Cardano/Analysis/API/Context.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Cardano.Analysis.API.Context (module Cardano.Analysis.API.Context) where
@@ -63,18 +65,47 @@ data PParams
   }
   deriving (Eq, Generic, Show, FromJSON, ToJSON, NFData)
 
+data PlutusParams
+  = PlutusParams
+  { ppType            :: Text
+  , ppScript          :: Text
+  }
+  deriving (Eq, Generic, Show, NFData)
+
+instance FromJSON PlutusParams where
+  parseJSON = withObject "PlutusParams" $ \v ->
+    PlutusParams
+      <$> v .: "type"
+      <*> v .: "script"
+
+instance ToJSON PlutusParams where
+  toJSON PlutusParams{..} =
+    object
+      [ "type"    .= ppType
+      , "script"  .= ppScript
+      ]
+
 data GeneratorProfile
   = GeneratorProfile
   { add_tx_size      :: Word64
   , inputs_per_tx    :: Word64
   , outputs_per_tx   :: Word64
   , tps              :: Double
   , tx_count         :: Word64
-  , plutusMode       :: Maybe Bool
-  , plutusLoopScript :: Maybe FilePath
+  , plutusMode       :: Maybe Bool            -- legacy format
+  , plutusAutoMode   :: Maybe Bool            -- legacy format
+  , plutus           :: Maybe PlutusParams
   }
   deriving (Eq, Generic, Show, FromJSON, ToJSON, NFData)
 
+plutusLoopScript :: GeneratorProfile -> Maybe Text
+plutusLoopScript GeneratorProfile{plutusMode, plutusAutoMode, plutus}
+  | Just True <- (&&) <$> plutusAutoMode <*> plutusMode
+    = Just "Loop"
+  | otherwise
+    = ppScript `fmap` plutus
+
+
 newtype Commit   = Commit  { unCommit  :: Text } deriving newtype (Eq, Show, FromJSON, ToJSON, NFData)
 newtype Branch   = Branch  { unBranch  :: Text } deriving newtype (Eq, Show, FromJSON, ToJSON, NFData)
 newtype Version  = Version { unVersion :: Text } deriving newtype (Eq, Show, FromJSON, ToJSON, NFData)

bench/locli/src/Cardano/Analysis/API/Metrics.hs

@@ -114,7 +114,7 @@ instance (KnownCDF f) => TimelineFields (Summary f)  where
       "Transaction count"
       "Number of transactions prepared for submission, but not necessarily submitted"
 
-   <> fScalar "plutusScript"           Wno Id  (IText  $ T.pack.fromMaybe "---".plutusLoopScript.sumWorkload)
+   <> fScalar "plutusScript"           Wno Id  (IText  $ fromMaybe "---".plutusLoopScript.sumWorkload)
       "Plutus script"
       "Name of th Plutus script used for smart contract workload generation, if any"
 

bench/locli/src/Cardano/Report.hs

@@ -18,7 +18,6 @@ import Data.Map.Strict      qualified as Map
 import Data.Text            qualified as T
 import Data.Text.Lazy       qualified as LT
 import Data.Time.Clock
-import System.FilePath as FS
 import System.Posix.User
 import System.Environment (lookupEnv)
 
@@ -32,15 +31,13 @@ import Cardano.Analysis.Summary
 
 
 newtype Author   = Author   { unAuthor   :: Text } deriving newtype (FromJSON, ToJSON)
-newtype Revision = Revision { unRevision :: Int }  deriving newtype (FromJSON, ToJSON)
 newtype ShortId  = ShortId  { unShortId  :: Text } deriving newtype (FromJSON, ToJSON)
 newtype Tag      = Tag      { unTag      :: Text } deriving newtype (FromJSON, ToJSON)
 
 data ReportMeta
   = ReportMeta
     { rmAuthor       :: !Author
     , rmDate         :: !Text
-    , rmRevision     :: !Revision
     , rmLocliVersion :: !LocliVersion
     , rmTarget       :: !Version
     , rmTag          :: !Tag
@@ -49,21 +46,19 @@ instance ToJSON ReportMeta where
   toJSON ReportMeta{..} = object
     [ "author"     .= rmAuthor
     , "date"       .= rmDate
-    , "revision"   .= rmRevision
     , "locli"      .= rmLocliVersion
     , "target"     .= rmTarget
     , "tag"        .= rmTag
     ]
 
-getReport :: [Metadata] -> Version -> Maybe Revision -> IO ReportMeta
-getReport metas _ver mrev = do
+getReport :: [Metadata] -> Version -> IO ReportMeta
+getReport metas _ver = do
   rmAuthor <- getGecosFullUsername
               `catch`
               \(_ :: SomeException) ->
                  getFallbackUserId
   rmDate <- getCurrentTime <&> T.take 16 . show
-  let rmRevision = fromMaybe (Revision 1) mrev
-      rmLocliVersion = getLocliVersion
+  let rmLocliVersion = getLocliVersion
       rmTarget = Version $ ident $ last metas
       rmTag = Tag $ multiRunTag Nothing metas
   pure ReportMeta{..}
@@ -84,12 +79,21 @@ data Workload
   = WValue
   | WPlutusLoopCountdown
   | WPlutusLoopSECP
+  | WPlutusUnknown
 
 instance ToJSON Workload where
   toJSON = \case
     WValue               -> "value-only"
     WPlutusLoopCountdown -> "Plutus countdown loop"
     WPlutusLoopSECP      -> "Plutus SECP loop"
+    WPlutusUnknown       -> "Plutus (other)"
+
+filenameInfix :: Workload -> Text
+filenameInfix = \case
+  WPlutusLoopCountdown  -> "plutus"
+  WPlutusLoopSECP       -> "plutus-secp"
+  WValue                -> "value-only"
+  _                     -> "unknown"
 
 data Section where
   STable ::
@@ -130,19 +134,19 @@ analysesReportSections mp bp =
 --
 
 liftTmplRun :: Summary a -> TmplRun
-liftTmplRun Summary{sumWorkload=GeneratorProfile{..}
+liftTmplRun Summary{sumWorkload=generatorProfile
                    ,sumMeta=meta@Metadata{..}} =
   TmplRun
   { trMeta      = meta
   , trManifest  = manifest & unsafeShortenManifest 5
   , trWorkload  =
-    case ( plutusMode       & fromMaybe False
-         , plutusLoopScript & fromMaybe "" & FS.takeFileName & FS.dropExtension ) of
-         (False, _)                       -> WValue
-         (True, "loop")                   -> WPlutusLoopCountdown
-         (True, "schnorr-secp256k1-loop") -> WPlutusLoopSECP
-         (_, scr) ->
-           error $ "Unknown Plutus script:  " <> scr
+    case plutusLoopScript generatorProfile of
+      Nothing                               -> WValue
+      Just script
+        | script == "Loop"                  -> WPlutusLoopCountdown
+        | script == "EcdsaSecp256k1Loop"    -> WPlutusLoopSECP
+        | script == "SchnorrSecp256k1Loop"  -> WPlutusLoopSECP
+        | otherwise                         -> WPlutusUnknown
   }
 
 data TmplRun
@@ -160,6 +164,7 @@ instance ToJSON TmplRun where
       , "branch"     .= componentBranch (getComponent "cardano-node" trManifest)
       , "ver"        .= ident trMeta
       , "rev"        .= unManifest trManifest
+      , "fileInfix"  .= filenameInfix trWorkload
       ]
 
 liftTmplSection :: Section -> TmplSection
@@ -211,7 +216,7 @@ generate :: InputDir -> Maybe TextInputFile
          -> (SomeSummary, ClusterPerf, SomeBlockProp) -> [(SomeSummary, ClusterPerf, SomeBlockProp)]
          -> IO (ByteString, ByteString, Text)
 generate (InputDir ede) mReport (SomeSummary summ, cp, SomeBlockProp bp) rest = do
-  ctx  <- getReport metas (last restTmpls & trManifest & getComponent "cardano-node" & ciVersion) Nothing
+  ctx  <- getReport metas (last restTmpls & trManifest & getComponent "cardano-node" & ciVersion)
   tmplRaw <- BS.readFile (maybe defaultReportPath unTextInputFile mReport)
   tmpl <- parseWith defaultSyntax (includeFile ede) "report" tmplRaw
   let tmplEnv           = mkTmplEnv ctx baseTmpl restTmpls

bench/tx-generator/src/Cardano/Benchmarking/Script.hs

@@ -12,6 +12,7 @@ import           Prelude
 import           Control.Concurrent (threadDelay)
 import           Control.Monad
 import           Control.Monad.IO.Class
+import           System.Mem (performGC)
 
 import           Ouroboros.Network.NodeToClient (IOManager)
 
@@ -24,22 +25,27 @@ import           Cardano.Benchmarking.Script.Types
 type Script = [Action]
 
 runScript :: Script -> IOManager -> IO (Either Error ())
-runScript script iom = runActionM execScript iom >>= \case
-  (Right a  , s ,  ()) -> do
-    cleanup s shutDownLogging
-    threadDelay 10_000_000
-    return $ Right a
-  (Left err , s  , ()) -> do
-    cleanup s (traceError (show err) >> shutDownLogging)
-    threadDelay 10_000_000
-    return $ Left err
- where
-  cleanup s a = void $ runActionMEnv s a iom
-  execScript = do
-    setProtocolParameters QueryLocalNode
-    forM_ script action
+runScript script iom = do
+  result <- go
+  performGC
+  threadDelay $ 150 * 1_000
+  return result
+  where
+    go = runActionM execScript iom >>= \case
+      (Right a  , s ,  ()) -> do
+        cleanup s shutDownLogging
+        return $ Right a
+      (Left err , s  , ()) -> do
+        cleanup s (traceError (show err) >> shutDownLogging)
+        return $ Left err
+      where
+        cleanup s a = void $ runActionMEnv s a iom
+
+        execScript = do
+          setProtocolParameters QueryLocalNode
+          forM_ script action
 
 shutDownLogging :: ActionM ()
 shutDownLogging = do
   traceError "QRT Last Message. LoggingLayer going to shutdown. 73 . . . ."
-  liftIO $ threadDelay (200 * 1_000)
+  liftIO $ threadDelay $ 350 * 1_000

bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -51,6 +52,15 @@ import           Cardano.Benchmarking.LogTypes
 import           Cardano.Benchmarking.Types
 import           Cardano.Benchmarking.Version as Version
 
+pattern TracerNameBench     :: Text
+pattern TracerNameBench     = "Benchmark"
+pattern TracerNameSubmit    :: Text
+pattern TracerNameSubmit    = "Submit"
+pattern TracerNameSubmitN2N :: Text
+pattern TracerNameSubmitN2N = "SubmitN2N"
+pattern TracerNameConnect   :: Text
+pattern TracerNameConnect   = "Connect"
+
 generatorTracer ::
      (LogFormatting a, MetaTrace a)
   => Text
@@ -97,10 +107,10 @@ initTxGenTracers mbForwarding = do
         configureTracers confState initialTraceConfig [tracer]
         pure tracer
 
-  benchTracer <- mkTracer "Benchmark" mbStdoutTracer mbForwardingTracer
-  n2nSubmitTracer <- mkTracer "SubmitN2N" mbStdoutTracer mbForwardingTracer
-  connectTracer <- mkTracer "Connect" mbStdoutTracer mbForwardingTracer
-  submitTracer <- mkTracer "Submit" mbStdoutTracer mbForwardingTracer
+  benchTracer     <- mkTracer TracerNameBench     mbStdoutTracer mbForwardingTracer
+  n2nSubmitTracer <- mkTracer TracerNameSubmitN2N mbStdoutTracer mbForwardingTracer
+  connectTracer   <- mkTracer TracerNameConnect   mbStdoutTracer mbForwardingTracer
+  submitTracer    <- mkTracer TracerNameSubmit    mbStdoutTracer mbForwardingTracer
 
   traceWith benchTracer (TraceTxGeneratorVersion Version.txGeneratorVersion)
 
@@ -159,10 +169,10 @@ initialTraceConfig :: TraceConfig
 initialTraceConfig = TraceConfig {
       tcOptions = Map.fromList
           [ ([], [configSilent])
-          , setMaxDetail "benchmark"
-          , (["submitN2N"], [configSilent])
-          , setMaxDetail "connect"
-          , setMaxDetail "submit"
+          , setMaxDetail TracerNameBench
+          , ([TracerNameSubmitN2N], [configSilent])
+          , setMaxDetail TracerNameConnect
+          , setMaxDetail TracerNameSubmit
           ]
     , tcForwarder = Just defaultForwarder
     , tcNodeName = Nothing

nix/workbench/ede/report.ede

@@ -9,10 +9,9 @@
 #+latex_header: \usepackage{setspace}
 #+latex_header: \onehalfspacing
 #+LATEX_COMPILER: xelatex
-#+EXPORT_FILE_NAME: {{ report.tag }}.{{ base.workload }}.pdf
+#+EXPORT_FILE_NAME: {{ report.tag }}.{{ base.fileInfix }}.pdf
 #+TITLE: {{ report.target }} against {{ base.ver }}
 #+SUBTITLE: {{ base.workload }} workload
-#+SUBTITLE: \break\small{revision} ={{ report.revision }}=
 #+AUTHOR: {{ report.author }}, Cardano Performance team
 #+DATE: {{ report.date }}
 
@@ -35,13 +34,10 @@ Hints:
 
 *** Manifest
 
-We compare {% for run in runs %}{%if !run.first%}{%if !run.last%}, {%else%} and {%endif%}{%endif%}{{ run.value.ver }}/{{ run.value.meta.era | toTitle }}{% endfor %} relative to ={{ base.ver }}=/{{ base.meta.era | toTitle }}, under {{ base.workload }} workload.
+We compare {% for run in runs %}{%if !run.first%}{%if !run.last%}, {%else%} and {%endif%}{%endif%}={{ run.value.ver }}= ({{ run.value.meta.era | toTitle }}){% endfor %} relative to ={{ base.ver }}= ({{ base.meta.era | toTitle }}), under {{ base.workload }} workload.
 
 {% include "table.ede" with table = summary %}
 
-***** Revision history
-      - rev 1, {{ report.date }}:  initial release
-
 *** Analysis
 {% for sec in analyses %}
 ***** {{ sec.value.title }}
@@ -65,9 +61,7 @@ We compare {% for run in runs %}{%if !run.first%}{%if !run.last%}, {%else%} and
 
 ***** End-to-end propagation
 
-...
-
-@Kevin Hammond, @neil, @jared.corduan, @Damian, @nfrisby, @Jasagredo, @marcin, @Javier Franco, @carlos.lopezdelara, @disasm
+1. ...
 
 * Appendix A: charts