Merge pull request #846 from input-output-hk/nhenin/benchmark-era-fix

Can select `conway` or `babbage` to benchmark the runtime

marlowe-benchmark/ReadMe.md

@@ -24,6 +24,8 @@ Available options:
   --version                Show version
   --host HOST              Host for Marlowe proxy service.
   --port PORT              Port for Marlowe proxy service.
+  --babbage-era            Read and write Babbage transactions
+  --conway-era             Read and write Conway transactions
   --config FILE            Path to the benchmark configuration file.
   --node-socket-path FILE  Path to the Cardano node socket.
   --network-magic INTEGER  The Cardano network magic number.
@@ -82,6 +84,7 @@ The output is lines of JSON, with one report per benchmarking client.
 marlowe-benchmark \
   --node-socket-path node.socket \
   --network-magic 1 \
+  --babbage-era
   --address addr_test1vq9prvx8ufwutkwxx9cmmuuajaqmjqwujqlp9d8pvg6gupczgtm9j \
   --signing-key-file faucet.skey \
 ```
@@ -130,6 +133,7 @@ Tools like `jq` and `dasel` can convert the output to CSV files.
 marlowe-benchmark \
   --node-socket-path node.socket \
   --network-magic 1 \
+  --babbage-era
   --address addr_test1vq9prvx8ufwutkwxx9cmmuuajaqmjqwujqlp9d8pvg6gupczgtm9j \
   --signing-key-file faucet.skey \
   --out-file results.json

marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark.hs

@@ -4,6 +4,8 @@
 module Language.Marlowe.Runtime.Benchmark (
   -- * Benchmarking
   BenchmarkConfig (..),
+  LifecycleBenchmarkContext (..),
+  Faucet (..),
   measure,
 ) where
 
@@ -31,6 +33,19 @@ import qualified Language.Marlowe.Runtime.Benchmark.Lifecycle as Lifecycle (meas
 import qualified Language.Marlowe.Runtime.Benchmark.Query as Query (measure)
 import qualified Language.Marlowe.Runtime.Benchmark.Sync as Sync (measure)
 
+data Faucet = Faucet
+  { address :: Address
+  , privateKey :: C.SigningKey C.PaymentExtendedKey
+  }
+  deriving (Show)
+
+data LifecycleBenchmarkContext = LifecycleBenchmarkContext
+  { nodeSocketPath :: C.SocketPath
+  , networkId :: C.NetworkId
+  , faucet :: Faucet
+  }
+  deriving (Show)
+
 -- | Benchmark configuration.
 data BenchmarkConfig = BenchmarkConfig
   { headerSyncParallelism :: Int
@@ -84,10 +99,11 @@ instance Default BenchmarkConfig where
 measure
   :: (C.IsShelleyBasedEra era)
   => BenchmarkConfig
-  -> Maybe (C.SocketPath, C.BabbageEraOnwards era, C.NetworkId, Address, C.SigningKey C.PaymentExtendedKey)
+  -> C.BabbageEraOnwards era
+  -> Maybe LifecycleBenchmarkContext
   -> Maybe FilePath
   -> MarloweT IO ()
-measure BenchmarkConfig{..} faucet out =
+measure BenchmarkConfig{..} eraOnwards lifecycleBenchmarkContextMaybe out =
   do
     liftIO $
       maybe
@@ -130,10 +146,18 @@ measure BenchmarkConfig{..} faucet out =
               [ Query.measure 1 1 queryPageSize label [query] >>= report
               | (label, query) <- M.toList complexQueries
               ]
-    when (isJust faucet && lifecycleParallelism > 0) $
+    when (isJust lifecycleBenchmarkContextMaybe && lifecycleParallelism > 0) $
       do
-        Just (node, era, network, faucetAddress, faucetKey) <- pure faucet
+        Just (LifecycleBenchmarkContext{..}) <- pure lifecycleBenchmarkContextMaybe
         liftIO $ hPutStrLn stderr . ("Lifecycle: " <>) . show =<< getCurrentTime
-        lifecycleResults <- Lifecycle.measure node era network lifecycleParallelism faucetAddress faucetKey lifecycleContracts
+        lifecycleResults <-
+          Lifecycle.measure
+            nodeSocketPath
+            eraOnwards
+            networkId
+            lifecycleParallelism
+            (address faucet)
+            (privateKey faucet)
+            lifecycleContracts
         report lifecycleResults
     liftIO $ hPutStrLn stderr . ("Done: " <>) . show =<< getCurrentTime

marlowe-benchmark/app/Main.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+
 -- | Execute Benchmarks.
 module Main (
   -- * Entry point
@@ -10,12 +13,12 @@ import Cardano.Api (
   deserialiseAddress,
   readFileTextEnvelope,
  )
-import Control.Applicative ((<|>))
+import Control.Applicative (asum, (<|>))
 import Control.Monad ((<=<))
 import Data.Text (Text)
 import Data.Version (showVersion)
 import Data.Yaml (decodeFileEither)
-import Language.Marlowe.Runtime.Benchmark (measure)
+import Language.Marlowe.Runtime.Benchmark (BenchmarkConfig, Faucet (..), LifecycleBenchmarkContext (..), measure)
 import Language.Marlowe.Runtime.Cardano.Api (fromCardanoAddressAny)
 import Language.Marlowe.Runtime.Client (connectToMarloweRuntime)
 import Paths_marlowe_benchmark (version)
@@ -24,76 +27,158 @@ import qualified Cardano.Api as C
 import qualified Language.Marlowe.Runtime.Benchmark.Query.Generate as Generate (queries)
 import qualified Options.Applicative as O
 
--- | Execute the benchmarks.
-main :: IO ()
-main =
-  do
-    Command{..} <- O.execParser commandParser
-    config' <-
-      case config of
-        Nothing -> pure Generate.queries
-        Just config'' -> either (error . show) id <$> decodeFileEither config''
-    faucet' <-
-      case faucet of
-        Just Faucet{..} ->
-          do
-            address' <-
-              maybe (error "Failed to parse faucet address.") (pure . fromCardanoAddressAny) $
-                deserialiseAddress AsAddressAny address
-            key' <-
-              either (error . show) pure
-                <=< readFileTextEnvelope (AsSigningKey AsPaymentExtendedKey)
-                $ File key
-            pure $ Just (C.File node, C.BabbageEraOnwardsConway, magic, address', key')
-        Nothing -> pure Nothing
-    connectToMarloweRuntime host (fromIntegral port) $ measure config' faucet' out
-
 data Command = Command
-  { host :: String
-  , port :: Int
-  , config :: Maybe FilePath
-  , faucet :: Maybe Faucet
-  , out :: Maybe FilePath
+  { runtimeHostname :: String
+  , runtimePort :: Int
+  , eraOnwards :: EitherBabbageOrConwayEra
+  , configFilePathMaybe :: Maybe FilePath
+  , lifecycleBenchmarkConfigurationMaybe :: Maybe LifecycleBenchmarkConfiguration
+  , outputFile :: Maybe FilePath
   }
   deriving (Show)
 
-data Faucet = Faucet
+data FaucetConfiguration = FaucetConfiguration
+  { address :: Text
+  , privateKey :: FilePath
+  }
+  deriving (Show)
+
+data LifecycleBenchmarkConfiguration = LifecycleBenchmarkConfiguration
   { node :: FilePath
-  , magic :: C.NetworkId
-  , address :: Text
-  , key :: FilePath
+  , networkId :: C.NetworkId
+  , faucet :: FaucetConfiguration
   }
   deriving (Show)
 
+newtype EitherBabbageOrConwayEra
+  = EitherBabbageOrConwayEra (Either (C.BabbageEraOnwards C.BabbageEra) (C.BabbageEraOnwards C.ConwayEra))
+
+instance Show EitherBabbageOrConwayEra where
+  show (EitherBabbageOrConwayEra (Left _)) = "BabbageEra"
+  show (EitherBabbageOrConwayEra (Right _)) = "ConwayEra"
+
+-- | Execute the benchmarks.
+main :: IO ()
+main =
+  do
+    Command{..} <- O.execParser commandParser
+    readingContext <- getReadingBenchmarkConfigurationOrDefault configFilePathMaybe
+    lifecycleBenchmarkContextMaybe <- getLifecycleBenchmarkContext lifecycleBenchmarkConfigurationMaybe
+    case eraOnwards of
+      EitherBabbageOrConwayEra eraOnwards' ->
+        case eraOnwards' of
+          Left era -> pure (measure readingContext era lifecycleBenchmarkContextMaybe outputFile)
+          Right era -> pure (measure readingContext era lifecycleBenchmarkContextMaybe outputFile)
+      >>= connectToMarloweRuntime runtimeHostname (fromIntegral runtimePort)
+  where
+    getReadingBenchmarkConfigurationOrDefault :: Maybe FilePath -> IO BenchmarkConfig
+    getReadingBenchmarkConfigurationOrDefault Nothing = pure Generate.queries
+    getReadingBenchmarkConfigurationOrDefault (Just configFilePath) = either (error . show) id <$> decodeFileEither configFilePath
+
+    getLifecycleBenchmarkContext
+      :: Maybe LifecycleBenchmarkConfiguration
+      -> IO (Maybe LifecycleBenchmarkContext)
+    getLifecycleBenchmarkContext Nothing = pure Nothing
+    getLifecycleBenchmarkContext (Just LifecycleBenchmarkConfiguration{faucet = faucetConfig, ..}) =
+      do
+        let nodeSocketPath = C.File node
+        faucetContext <- getFaucetContext faucetConfig
+        pure . Just $
+          LifecycleBenchmarkContext
+            { nodeSocketPath = nodeSocketPath
+            , networkId = networkId
+            , faucet = faucetContext
+            }
+
+getFaucetContext :: FaucetConfiguration -> IO Faucet
+getFaucetContext FaucetConfiguration{..} =
+  do
+    address' <-
+      maybe (error "Failed to parse faucet address.") (pure . fromCardanoAddressAny) $
+        deserialiseAddress AsAddressAny address
+    key' <-
+      either (error . show) pure
+        <=< readFileTextEnvelope (AsSigningKey AsPaymentExtendedKey)
+        $ File privateKey
+    pure Faucet{address = address', privateKey = key'}
+
 commandParser :: O.ParserInfo Command
 commandParser =
-  let commandOptions =
-        Command
-          <$> O.strOption
-            (O.long "host" <> O.value "localhost" <> O.showDefault <> O.metavar "HOST" <> O.help "Host for Marlowe proxy service.")
-          <*> O.option
-            O.auto
-            (O.long "port" <> O.value 3700 <> O.showDefault <> O.metavar "PORT" <> O.help "Port for Marlowe proxy service.")
-          <*> (O.optional . O.strOption) (O.long "config" <> O.metavar "FILE" <> O.help "Path to the benchmark configuration file.")
-          <*> ( O.optional $
-                  Faucet
-                    <$> O.strOption (O.long "node-socket-path" <> O.metavar "FILE" <> O.help "Path to the Cardano node socket.")
-                    <*> ( O.flag' C.Mainnet (O.long "mainnet" <> O.help "Execute on the Cardano mainnet.")
-                            <|> ( C.Testnet . C.NetworkMagic . toEnum
-                                    <$> O.option O.auto (O.long "testnet-magic" <> O.metavar "INTEGER" <> O.help "Execute on a Cardano testnet.")
-                                )
-                        )
-                    <*> O.strOption (O.long "address" <> O.metavar "ADDRESS" <> O.help "Faucet address.")
-                    <*> O.strOption (O.long "signing-key-file" <> O.metavar "FILE" <> O.help "Path to faucet signing key file.")
-              )
-          <*> (O.optional . O.strOption)
-            (O.long "out-file" <> O.metavar "FILE" <> O.help "Path to the output file for benchmark results.")
-   in O.info
-        ( O.helper
-            <*> (O.infoOption ("marlowe-benchmark " <> showVersion version) $ O.long "version" <> O.help "Show version")
-            <*> commandOptions
-        )
-        ( O.fullDesc
-            <> O.progDesc "This command-line tool executes benchmarks for Marlowe Runtime."
-            <> O.header "marlowe-benchmark : execute Marlowe Runtime benchmarks"
-        )
+  O.info
+    ( O.helper
+        <*> showVersionP
+        <*> commandP
+    )
+    ( O.fullDesc
+        <> O.progDesc "This command-line tool executes benchmarks for Marlowe Runtime."
+        <> O.header "marlowe-benchmark : execute Marlowe Runtime benchmarks"
+    )
+  where
+    commandP :: O.Parser Command
+    commandP =
+      Command
+        <$> runtimeHostnameP
+        <*> runtimePortP
+        <*> eraP
+        <*> configFilePathMaybeP
+        <*> lifecycleBenchmarkConfigurationMaybeP
+        <*> outputFileP
+
+    eraP :: O.Parser EitherBabbageOrConwayEra
+    eraP =
+      asum
+        [ O.flag'
+            (EitherBabbageOrConwayEra $ Left C.BabbageEraOnwardsBabbage)
+            ( O.long "babbage-era"
+                <> O.help "Specify the Babbage era (default)"
+            )
+        , O.flag'
+            (EitherBabbageOrConwayEra $ Right C.BabbageEraOnwardsConway)
+            ( O.long "conway-era"
+                <> O.help "Specify the Conway era"
+            )
+        , pure (EitherBabbageOrConwayEra $ Left C.BabbageEraOnwardsBabbage)
+        ]
+    showVersionP :: O.Parser (a -> a)
+    showVersionP = O.infoOption ("marlowe-benchmark " <> showVersion version) $ O.long "version" <> O.help "Show version"
+
+    runtimeHostnameP :: O.Parser String
+    runtimeHostnameP =
+      O.strOption
+        (O.long "host" <> O.value "localhost" <> O.showDefault <> O.metavar "HOST" <> O.help "Host for Marlowe proxy service.")
+
+    runtimePortP :: O.Parser Int
+    runtimePortP =
+      O.option
+        O.auto
+        (O.long "port" <> O.value 3700 <> O.showDefault <> O.metavar "PORT" <> O.help "Port for Marlowe proxy service.")
+
+    configFilePathMaybeP :: O.Parser (Maybe FilePath)
+    configFilePathMaybeP = O.optional (O.strOption (O.long "config" <> O.metavar "FILE" <> O.help "Path to the benchmark configuration file."))
+
+    lifecycleBenchmarkConfigurationMaybeP :: O.Parser (Maybe LifecycleBenchmarkConfiguration)
+    lifecycleBenchmarkConfigurationMaybeP = O.optional $ LifecycleBenchmarkConfiguration <$> nodeP <*> magicP <*> faucetP
+      where
+        nodeP :: O.Parser FilePath
+        nodeP = O.strOption (O.long "node-socket-path" <> O.metavar "FILE" <> O.help "Path to the Cardano node socket.")
+
+        magicP :: O.Parser C.NetworkId
+        magicP =
+          O.flag' C.Mainnet (O.long "mainnet" <> O.help "Execute on the Cardano mainnet.")
+            <|> ( C.Testnet . C.NetworkMagic . toEnum
+                    <$> O.option O.auto (O.long "testnet-magic" <> O.metavar "INTEGER" <> O.help "Execute on a Cardano testnet.")
+                )
+
+        faucetP :: O.Parser FaucetConfiguration
+        faucetP = FaucetConfiguration <$> addressP <*> privateKeyP
+          where
+            addressP :: O.Parser Text
+            addressP = O.strOption (O.long "address" <> O.metavar "ADDRESS" <> O.help "Faucet address.")
+
+            privateKeyP :: O.Parser FilePath
+            privateKeyP = O.strOption (O.long "signing-key-file" <> O.metavar "FILE" <> O.help "Path to faucet signing key file.")
+
+    outputFileP :: O.Parser (Maybe FilePath)
+    outputFileP =
+      O.optional
+        (O.strOption (O.long "out-file" <> O.metavar "FILE" <> O.help "Path to the output file for benchmark results."))

marlowe-benchmark/example/ReadMe.md

@@ -23,7 +23,7 @@ The following tools must be on the `PATH`:
 To begin, select the network you want to benchmark (`sanchonet`, `preview`, `preprod`) and fetch the network configuration files.
 
 ```bash
-NETWORK_NAME=sanchonet ## Select the one you want to benchmark {sanchonet, preview, preprod, mainnet}
+NETWORK_NAME=preprod ## Select the one you want to benchmark {sanchonet, preview, preprod, mainnet}
 cd $NETWORK_NAME
 rm -rf config
 mkdir -p config

marlowe-benchmark/example/mainnet/environment

@@ -13,3 +13,4 @@ export SYNC_RESULT_FILE=sync-results.tsv
 export BENCHMARK_PODSTAT_FILE=benchmark-podstats.json
 export BENCHMARK_RESULT_FILE=benchmark-results.json
 export DISK_FILE=disk.tsv
+export ERA=babbage # babbage or conway

marlowe-benchmark/example/measure-benchmark.sh

@@ -4,6 +4,7 @@ set -eo pipefail
 
 echo "PODNAME=$PODNAME"
 echo "NETWORK=$NETWORK"
+echo "ERA=$ERA"
 echo "BENCHMARK_CONFIG=$BENCHMARK_CONFIG"
 echo "MARLOWE_RT_HOST=$MARLOWE_RT_HOST"
 echo "MARLOWE_RT_PORT=$MARLOWE_RT_PORT"
@@ -46,6 +47,7 @@ trap 'kill $STATS_PID' EXIT
 marlowe-benchmark \
   --host "$MARLOWE_RT_HOST" \
   --port "$MARLOWE_RT_PORT" \
+  "--$ERA-era" \
   --config "$BENCHMARK_CONFIG" \
   --node-socket-path "$CARDANO_NODE_SOCKET_PATH" \
   "${MAGIC[@]}" \

marlowe-benchmark/example/preprod/environment

@@ -13,3 +13,4 @@ export SYNC_RESULT_FILE=sync-results.tsv
 export BENCHMARK_PODSTAT_FILE=benchmark-podstats.json
 export BENCHMARK_RESULT_FILE=benchmark-results.json
 export DISK_FILE=disk.tsv
+export ERA=babbage # babbage or conway

marlowe-benchmark/example/preview/environment

@@ -13,3 +13,4 @@ export SYNC_RESULT_FILE=sync-results.tsv
 export BENCHMARK_PODSTAT_FILE=benchmark-podstats.json
 export BENCHMARK_RESULT_FILE=benchmark-results.json
 export DISK_FILE=disk.tsv
+export ERA=babbage # babbage or conway

marlowe-benchmark/example/sanchonet/environment

@@ -11,3 +11,4 @@ export SYNC_RESULT_FILE=sync-results.tsv
 export BENCHMARK_PODSTAT_FILE=benchmark-podstats.json
 export BENCHMARK_RESULT_FILE=benchmark-results.json
 export DISK_FILE=disk.tsv
+export ERA=conway # babbage or conway