bench: analysis improvements

Makefile

@@ -77,6 +77,7 @@ PROFILES_BASE         := default plutus plutus-secp-ecdsa plutus-secp-schnorr ol
 PROFILES_STARTSTOP    := startstop startstop-p2p startstop-plutus startstop-notracer startstop-oldtracing
 PROFILES_CI_TEST      := ci-test ci-test-p2p ci-test-plutus ci-test-notracer ci-test-dense10 aws-test
 PROFILES_CI_BENCH     := ci-bench ci-bench-p2p ci-bench-plutus ci-bench-plutus-secp-ecdsa ci-bench-plutus-secp-schnorr ci-bench-notracer
+PROFILES_TRACE_BENCH  := trace-bench trace-bench-notracer trace-bench-oldtracing
 PROFILES_PLUTUSCALL   := plutuscall-loop-plain plutuscall-secp-ecdsa-plain plutuscall-secp-schnorr-plain
 PROFILES_PLUTUSCALL   += plutuscall-loop-half plutuscall-secp-ecdsa-half plutuscall-secp-schnorr-half
 PROFILES_PLUTUSCALL   += plutuscall-loop-double plutuscall-secp-ecdsa-double plutuscall-secp-schnorr-double
@@ -93,6 +94,7 @@ SHELL_PROFILES += $(PROFILES_BASE)
 SHELL_PROFILES += $(PROFILES_STARTSTOP)
 SHELL_PROFILES += $(PROFILES_CI_TEST)
 SHELL_PROFILES += $(PROFILES_CI_BENCH)
+SHELL_PROFILES += $(PROFILES_TRACE_BENCH)
 SHELL_PROFILES += $(PROFILES_PLUTUSCALL)
 SHELL_PROFILES += $(PROFILES_MODEL)
 SHELL_PROFILES += $(PROFILES_10)

bench/locli/locli.cabal

@@ -138,6 +138,7 @@ library
                       , unordered-containers
                       , utf8-string
                       , vector
+                      , witherable
                       , cardano-strict-containers ^>= 0.1
 
 executable locli

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

@@ -19,7 +19,7 @@ data GenesisSpec
   { delegators          :: Word64
   , utxo                :: Word64
   }
-  deriving (Generic, Show, ToJSON, FromJSON)
+  deriving (Eq, Generic, Show, ToJSON, FromJSON, NFData)
 
 -- | Partial 'Cardano.Ledger.Shelley.Genesis.ShelleyGenesis'
 data Genesis
@@ -34,15 +34,26 @@ data Genesis
   , maxKESEvolutions   :: Word64
   , securityParam      :: Word64
   }
-  deriving (Generic, Show, FromJSON, ToJSON)
+  deriving (Generic, Show, FromJSON, ToJSON, NFData)
+
+genesesSameButTimeP :: Genesis -> Genesis -> Bool
+genesesSameButTimeP l r =
+  ((==) `on` activeSlotsCoeff) l r &&
+  ((==) `on` protocolParams) l r &&
+  ((==) `on` networkMagic) l r &&
+  ((==) `on` epochLength) l r &&
+  ((==) `on` slotsPerKESPeriod) l r &&
+  ((==) `on` slotLength) l r &&
+  ((==) `on` maxKESEvolutions) l r &&
+  ((==) `on` securityParam) l r
 
 -- | Partial 'Cardano.Ledger.Shelley.PParams.PParams'
 data PParams
   = PParams
   { maxTxSize         :: Word64
   , maxBlockBodySize  :: Word64
   }
-  deriving (Generic, Show, FromJSON, ToJSON)
+  deriving (Eq, Generic, Show, FromJSON, ToJSON, NFData)
 
 data GeneratorProfile
   = GeneratorProfile
@@ -54,11 +65,11 @@ data GeneratorProfile
   , plutusMode       :: Maybe Bool
   , plutusLoopScript :: Maybe FilePath
   }
-  deriving (Generic, Show, FromJSON, ToJSON)
+  deriving (Eq, Generic, Show, FromJSON, ToJSON, NFData)
 
-newtype Commit   = Commit  { unCommit  :: Text } deriving newtype (Show, FromJSON, ToJSON)
-newtype Branch   = Branch  { unBranch  :: Text } deriving newtype (Show, FromJSON, ToJSON)
-newtype Version  = Version { unVersion :: Text } deriving newtype (Show, FromJSON, ToJSON)
+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)
 
 unsafeShortenCommit :: Int -> Commit -> Commit
 unsafeShortenCommit n (Commit c) = Commit (T.take n c)
@@ -76,7 +87,7 @@ data Manifest
     , mBase          :: !Commit
     , mPrelude       :: !Commit
     }
-  deriving (Generic, Show)
+  deriving (Eq, Generic, NFData, Show)
 
 unsafeShortenManifest :: Int -> Manifest -> Manifest
 unsafeShortenManifest n m@Manifest{..} =
@@ -126,4 +137,4 @@ data Metadata
   , era       :: Text
   , manifest  :: Manifest
   }
-  deriving (Generic, Show, FromJSON, ToJSON)
+  deriving (Generic, NFData, Show, FromJSON, ToJSON)

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

@@ -31,6 +31,7 @@ import System.FilePath                  qualified as F
 import Cardano.Slotting.Slot            (EpochNo(..), SlotNo(..))
 import Ouroboros.Network.Block          (BlockNo(..))
 
+import Data.CDF
 import Data.DataDomain
 import Cardano.Util
 
@@ -68,7 +69,7 @@ instance FromJSONKey Hash where
 
 newtype Count a = Count { unCount :: Int }
   deriving (Eq, Generic, Ord, Show)
-  deriving newtype (FromJSON, Num, ToJSON)
+  deriving newtype (Divisible, FromJSON, Num, Real, ToJSON)
   deriving anyclass NFData
 
 countMap :: Map.Map a b -> Count a
@@ -164,6 +165,14 @@ newtype OutputFile
   = OutputFile { unOutputFile :: FilePath }
   deriving (Show, Eq)
 
+---
+--- Orphans
+---
+deriving newtype instance Real      BlockNo
+deriving newtype instance Divisible BlockNo
+deriving newtype instance Real      SlotNo
+deriving newtype instance Divisible SlotNo
+
 ---
 --- Readers
 ---

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

@@ -52,8 +52,8 @@ sumFieldsReport =
   , "ddFiltered.sumStartSpread", "ddFiltered.sumStopSpread"
   , "sumDomainSlots", "sumDomainBlocks", "sumBlocksRejected" ]
 
-instance TimelineFields SummaryOne where
-  data TimelineComments SummaryOne
+instance (KnownCDF f) => TimelineFields (Summary f)  where
+  data TimelineComments (Summary f)
     deriving Show
 
   timelineFields =
@@ -66,8 +66,8 @@ instance TimelineFields SummaryOne where
       "Date of cluster genesis systemStart"
 
    <> fScalar "time.systemStart"       W8  Tim (ITime $ systemStart.sumGenesis)
-      "Cluster system start date"
-      "Date of cluster genesis systemStart"
+      "Cluster system start time"
+      "Time-of-day portion of cluster genesis systemStart"
 
    <> fScalar   "batch"                Wno Id  (IText $                   batch.sumMeta)
       "Run batch"
@@ -109,31 +109,33 @@ instance TimelineFields SummaryOne where
       "Starting UTxO set size"
       "Extra UTxO set size at the beginning of the benchmark"
 
-   <> fScalar "add_tx_size"            W6  B   (IWord64 $      add_tx_size.sumGenerator)
+   <> fScalar "add_tx_size"            W6  B   (IWord64 $      add_tx_size.sumWorkload
+                                                               )
       "Extra tx payload"
       ""
 
-   <> fScalar "inputs_per_tx"          W3  Cnt (IWord64 $    inputs_per_tx.sumGenerator)
+   <> fScalar "inputs_per_tx"          W3  Cnt (IWord64 $    inputs_per_tx.sumWorkload)
       "Tx inputs"
       ""
 
-   <> fScalar "outputs_per_tx"         W3  Cnt (IWord64 $   outputs_per_tx.sumGenerator)
+   <> fScalar "outputs_per_tx"         W3  Cnt (IWord64 $   outputs_per_tx.sumWorkload)
       "Tx Outputs"
       ""
 
-   <> fScalar "tps"                    W7  Hz  (IFloat $               tps.sumGenerator)
+   <> fScalar "tps"                    W7  Hz  (IFloat $               tps.sumWorkload)
       "TPS"
       "Offered load, transactions per second"
 
-   <> fScalar "tx_count"               W12 Cnt (IWord64 $         tx_count.sumGenerator)
+   <> fScalar "tx_count"               W12 Cnt (IWord64 $         tx_count.sumWorkload)
       "Transaction count"
       "Number of transactions prepared for submission, but not necessarily submitted"
 
-   <> fScalar "plutusScript"           Wno Id  (IText  $ T.pack.fromMaybe "---".plutusLoopScript.sumGenerator)
+   <> fScalar "plutusScript"           Wno Id  (IText  $ T.pack.fromMaybe "---".plutusLoopScript.sumWorkload)
       "Plutus script"
       "Name of th Plutus script used for smart contract workload generation, if any"
 
-   <> fScalar "sumHosts"               W4  Cnt (IInt   $   unCount.sumHosts)
+   <> fScalar "sumHosts"               W4  Cnt
+        (IInt $ unCount.arityProj cdfMedian.sumHosts)
       "Machines"
       "Number of machines under analysis"
 
@@ -161,47 +163,47 @@ instance TimelineFields SummaryOne where
       "Host log line rate, Hz"
       ""
 
-   <> fScalar "sumLogObjectsTotal"     W12 Cnt (IInt   $ unCount.sumLogObjectsTotal)
+   <> fScalar "sumLogObjectsTotal"     W12 Cnt (IInt   $ unCount.arityProj cdfMedian.sumLogObjectsTotal)
       "Total log objects analysed"
       ""
 
-   <> fScalar "ddRawCount.sumDomainTime"      W12 Sec (IInt   $       ddRawCount.sumDomainTime)
+   <> fScalar "ddRawCount.sumDomainTime"      W12 Sec (IInt $ arityProj cdfMedian.ddRawCount.sumDomainTime)
       "Run time, s"
       ""
 
-   <> fScalar "ddFilteredCount.sumDomainTime" W12 Sec (IInt   $  ddFilteredCount.sumDomainTime)
+   <> fScalar "ddFilteredCount.sumDomainTime" W12 Sec (IInt $ arityProj cdfMedian.ddFilteredCount.sumDomainTime)
       "Analysed run duration, s"
       ""
 
-   <> fScalar "dataDomainFilterRatio.sumDomainTime" W4 Rto (IFloat $ dataDomainFilterRatio.sumDomainTime)
+   <> fScalar "dataDomainFilterRatio.sumDomainTime" W4 Rto (IFloat $ dataDomainFilterRatio (arityProj cdfMedian).sumDomainTime)
       "Run time efficiency"
       ""
 
-   <> fScalar "ddRaw.sumStartSpread"      W9 Sec (IDeltaT$ intvDurationSec.ddRaw.sumStartSpread)
+   <> fScalar "ddRaw.sumStartSpread"      W9 Sec (IDeltaT$ intvDurationSec.fmap (fromRUTCTime . arityProj cdfMedian).ddRaw.sumStartSpread)
       "Node start spread, s"
       ""
 
-   <> fScalar "ddRaw.sumStopSpread"       W9 Sec (IDeltaT$ intvDurationSec.ddRaw.sumStopSpread)
+   <> fScalar "ddRaw.sumStopSpread"       W9 Sec (IDeltaT$ intvDurationSec.fmap (fromRUTCTime . arityProj cdfMedian).ddRaw.sumStopSpread)
       "Node stop spread, s"
       ""
 
-   <> fScalar "ddFiltered.sumStartSpread" W9 Sec (IDeltaT$ maybe 0 intvDurationSec.ddFiltered.sumStartSpread)
+   <> fScalar "ddFiltered.sumStartSpread" W9 Sec (IDeltaT$ maybe 0 (intvDurationSec.fmap (fromRUTCTime . arityProj cdfMedian)).ddFiltered.sumStartSpread)
       "Perf analysis start spread, s"
       ""
 
-   <> fScalar "ddFiltered.sumStopSpread"  W9 Sec (IDeltaT$ maybe 0 intvDurationSec.ddFiltered.sumStopSpread)
+   <> fScalar "ddFiltered.sumStopSpread"  W9 Sec (IDeltaT$ maybe 0 (intvDurationSec.fmap (fromRUTCTime . arityProj cdfMedian)).ddFiltered.sumStopSpread)
       "Perf analysis stop spread, s"
       ""
 
-   <> fScalar "sumDomainSlots"         W12 Slo (IInt   $ ddFilteredCount.sumDomainSlots)
+   <> fScalar "sumDomainSlots"         W12 Slo (IInt  $ floor.arityProj cdfMedian.cdfAverage.ddFilteredCount.sumDomainSlots)
       "Slots analysed"
       ""
 
-   <> fScalar "sumDomainBlocks"        W10 Blk (IInt  $ ddFilteredCount.sumDomainBlocks)
+   <> fScalar "sumDomainBlocks"        W10 Blk (IInt  $ arityProj cdfMedian.ddFilteredCount.sumDomainBlocks)
       "Blocks analysed"
       ""
 
-   <> fScalar "sumBlocksRejected"      W10 Cnt (IInt  $     unCount . sumBlocksRejected)
+   <> fScalar "sumBlocksRejected"      W10 Cnt (IInt  $ unCount.arityProj cdfMedian.sumBlocksRejected)
       "Blocks rejected"
       ""
   -- fieldJSONOverlay f = (:[]) . tryOverlayFieldDescription f
@@ -632,17 +634,17 @@ instance TimelineFields (SlotStats NominalDiffTime) where
 
 -- * Instances, depending on the metrics' instances:
 --
-instance (ToJSON (f NominalDiffTime), ToJSON (f Int), ToJSON (f Double), ToJSON (f (Count BlockEvents)), ToJSON (f (DataDomain SlotNo)), ToJSON (f (DataDomain BlockNo))) => ToJSON (BlockProp f) where
-  toJSON x = AE.genericToJSON AE.defaultOptions x
-             & \case
-                 Object o -> Object $ processFieldOverlays x o
-                 _ -> error "Heh, serialised BlockProp to a non-Object."
-
-instance (ToJSON (a Double), ToJSON (a Int), ToJSON (a NominalDiffTime), ToJSON (a (DataDomain UTCTime)), ToJSON (a Word64), ToJSON (a (DataDomain SlotNo)), ToJSON (a (DataDomain BlockNo))) => ToJSON (MachPerf a) where
-  toJSON x = AE.genericToJSON AE.defaultOptions x
-             & \case
-                 Object o -> Object $ processFieldOverlays x o
-                 _ -> error "Heh, serialised BlockProp to a non-Object."
+-- instance (ToJSON (f NominalDiffTime), ToJSON (f Int), ToJSON (f Double), ToJSON (f (Count BlockEvents)), ToJSON (f (DataDomain f SlotNo)), ToJSON (f (DataDomain BlockNo))) => ToJSON (BlockProp f) where
+--   toJSON x = AE.genericToJSON AE.defaultOptions x
+--              & \case
+--                  Object o -> Object $ processFieldOverlays x o
+--                  _ -> error "Heh, serialised BlockProp to a non-Object."
+
+-- instance (ToJSON (a Double), ToJSON (a Int), ToJSON (a NominalDiffTime), ToJSON (a (DataDomain UTCTime)), ToJSON (a Word64), ToJSON (a (DataDomain SlotNo)), ToJSON (a (DataDomain BlockNo))) => ToJSON (MachPerf a) where
+--   toJSON x = AE.genericToJSON AE.defaultOptions x
+--              & \case
+--                  Object o -> Object $ processFieldOverlays x o
+--                  _ -> error "Heh, serialised BlockProp to a non-Object."
 
 deriving newtype instance ToJSON MultiClusterPerf
 

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

@@ -7,11 +7,13 @@ import Cardano.Prelude
 
 import Control.Monad (fail)
 import Data.Aeson qualified as Aeson
+import Data.Aeson ((.=))
 
 import Cardano.Util
 import Cardano.Analysis.API.ChainFilter
 import Cardano.Analysis.API.Context
 import Cardano.Analysis.API.Ground
+import Cardano.Analysis.API.Types
 
 data AnalysisCmdError
   = AnalysisCmdError                                   !Text
@@ -58,6 +60,29 @@ instance FromJSON RunPartial where
         genesis  = ()
     pure Run{..}
 
+-- | Given a Summary object,
+--   produce a JSON file readable by the above RunPartial FromJSON instance.
+--   Keep in sync.  Better still, automate it so it's not necessary.
+summaryMetaJson :: Summary f -> Value
+summaryMetaJson Summary{sumMeta=Metadata{..}, ..} =
+  object [ "meta" .= meta ]
+ where meta =
+         object $
+         -- keep in sync with 'data Metadata'
+         [ "tag"       .= tag
+         , "batch"     .= batch
+         , "profile"   .= profile
+         , "era"       .= era
+         , "manifest"  .= manifest
+         ] <>
+         -- keep in sync with the above instance
+         [ "profile_content" .=
+           object
+           [ "generator" .= toJSON sumWorkload
+           , "genesis"   .= toJSON sumGenesisSpec
+           ]
+         ]
+
 readRun :: JsonInputFile Genesis -> JsonInputFile RunPartial -> ExceptT AnalysisCmdError IO Run
 readRun shelleyGenesis runmeta = do
   runPartial <- readJsonData runmeta        (RunMetaParseError runmeta)