diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 17df79bb981..64b818ecb1a 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -201,7 +201,7 @@ jobs: options: '-o $(pwd)/../docs/static/ledger-bench.html' - package: hydra-cluster bench: bench-e2e - options: '--scaling-factor 1' + options: '--scaling-factor 1 --output-directory $(pwd)/../docs/benchmarks' - package: plutus-merkle-tree bench: on-chain-cost options: '--output-directory $(pwd)/../docs/benchmarks' @@ -403,4 +403,3 @@ jobs: with: name: docs-unstable path: docs/public - diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index 3f839533a3d..835ba71937c 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -27,7 +27,7 @@ import qualified Data.Map as Map import Data.Scientific (Scientific) import Data.Set ((\\)) import qualified Data.Set as Set -import Data.Time (UTCTime (UTCTime), nominalDiffTimeToSeconds, utctDayTime) +import Data.Time (UTCTime (UTCTime), utctDayTime) import Hydra.Cardano.Api (Tx, TxId, UTxO, getVerificationKey) import Hydra.Chain.CardanoClient (awaitTransaction, submitTransaction) import Hydra.Cluster.Faucet (FaucetLog, Marked (Fuel), publishHydraScriptsAs, seedFromFaucet) @@ -70,75 +70,82 @@ data Event = Event , validAt :: Maybe UTCTime , confirmedAt :: Maybe UTCTime } - deriving (Generic, Eq, Show, ToJSON) - -bench :: DiffTime -> FilePath -> Dataset -> Word64 -> Spec -bench timeoutSeconds workDir dataset@Dataset{clientDatasets} clusterSize = - specify ("Load test on " <> show clusterSize <> " local nodes in " <> workDir) $ do - withFile (workDir "test.log") ReadWriteMode $ \hdl -> - withTracerOutputTo hdl "Test" $ \tracer -> - failAfter timeoutSeconds $ do - putTextLn "Starting benchmark" - let cardanoKeys = map (\ClientDataset{signingKey} -> (getVerificationKey signingKey, signingKey)) clientDatasets - let hydraKeys = generateSigningKey . show <$> [1 .. toInteger (length cardanoKeys)] - let parties = Set.fromList (deriveParty <$> hydraKeys) - withOSStats workDir $ - withCardanoNodeDevnet (contramap FromCardanoNode tracer) workDir $ \node@RunningNode{nodeSocket} -> do - putTextLn "Seeding network" - hydraScriptsTxId <- seedNetwork node dataset (contramap FromFaucet tracer) - let contestationPeriod = UnsafeContestationPeriod 10 - withHydraCluster tracer workDir nodeSocket 0 cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \(leader :| followers) -> do - let clients = leader : followers - waitForNodesConnected tracer clients - - putTextLn "Initializing Head" - send leader $ input "Init" [] - headId <- - waitForAllMatch (fromIntegral $ 10 * clusterSize) clients $ - headIsInitializingWith parties - - putTextLn "Comitting initialUTxO from dataset" - expectedUTxO <- commitUTxO clients dataset - - waitFor tracer (fromIntegral $ 10 * clusterSize) clients $ - output "HeadIsOpen" ["utxo" .= expectedUTxO, "headId" .= headId] - - putTextLn "HeadIsOpen" - processedTransactions <- processTransactions clients dataset - - putTextLn "Closing the Head" - send leader $ input "Close" [] - - deadline <- waitMatch 300 leader $ \v -> do - guard $ v ^? key "tag" == Just "HeadIsClosed" - guard $ v ^? key "headId" == Just (toJSON headId) - v ^? key "contestationDeadline" . _JSON - - -- Expect to see ReadyToFanout within 3 seconds after deadline - remainingTime <- diffUTCTime deadline <$> getCurrentTime - waitFor tracer (remainingTime + 3) [leader] $ - output "ReadyToFanout" ["headId" .= headId] - - putTextLn "Finalizing the Head" - send leader $ input "Fanout" [] - waitMatch 100 leader $ \v -> do - guard (v ^? key "tag" == Just "HeadIsFinalized") - guard $ v ^? key "headId" == Just (toJSON headId) - - let res = mapMaybe analyze . Map.toList $ processedTransactions - aggregates = movingAverage res - - writeResultsCsv (workDir "results.csv") aggregates - - -- TODO: Create a proper summary - let confTimes = map (\(_, _, a) -> a) res - below1Sec = filter (< 1) confTimes - avgConfirmation = double (nominalDiffTimeToSeconds $ sum confTimes) / double (length confTimes) - percentBelow1Sec = double (length below1Sec) / double (length confTimes) * 100 - putTextLn $ "Confirmed txs: " <> show (length confTimes) - putTextLn $ "Average confirmation time: " <> show avgConfirmation - putTextLn $ "Confirmed below 1 sec: " <> show percentBelow1Sec <> "%" - percentBelow1Sec `shouldSatisfy` (> 90) + deriving stock (Generic, Eq, Show) + deriving anyclass (ToJSON) + +type Percent = Double + +data Summary = Summary + { numberOfTxs :: Int + , averageConfirmationTime :: NominalDiffTime + , percentBelow100ms :: Percent + } + deriving stock (Generic, Eq, Show) + deriving anyclass (ToJSON) + +bench :: Int -> DiffTime -> FilePath -> Dataset -> Word64 -> IO Summary +bench startingNodeId timeoutSeconds workDir dataset@Dataset{clientDatasets} clusterSize = + withFile (workDir "test.log") ReadWriteMode $ \hdl -> + withTracerOutputTo hdl "Test" $ \tracer -> + failAfter timeoutSeconds $ do + putTextLn "Starting benchmark" + let cardanoKeys = map (\ClientDataset{signingKey} -> (getVerificationKey signingKey, signingKey)) clientDatasets + let hydraKeys = generateSigningKey . show <$> [1 .. toInteger (length cardanoKeys)] + let parties = Set.fromList (deriveParty <$> hydraKeys) + withOSStats workDir $ + withCardanoNodeDevnet (contramap FromCardanoNode tracer) workDir $ \node@RunningNode{nodeSocket} -> do + putTextLn "Seeding network" + hydraScriptsTxId <- seedNetwork node dataset (contramap FromFaucet tracer) + let contestationPeriod = UnsafeContestationPeriod 10 + withHydraCluster tracer workDir nodeSocket startingNodeId cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \(leader :| followers) -> do + let clients = leader : followers + waitForNodesConnected tracer clients + + putTextLn "Initializing Head" + send leader $ input "Init" [] + headId <- + waitForAllMatch (fromIntegral $ 10 * clusterSize) clients $ + headIsInitializingWith parties + + putTextLn "Comitting initialUTxO from dataset" + expectedUTxO <- commitUTxO clients dataset + + waitFor tracer (fromIntegral $ 10 * clusterSize) clients $ + output "HeadIsOpen" ["utxo" .= expectedUTxO, "headId" .= headId] + + putTextLn "HeadIsOpen" + processedTransactions <- processTransactions clients dataset + + putTextLn "Closing the Head" + send leader $ input "Close" [] + + deadline <- waitMatch 300 leader $ \v -> do + guard $ v ^? key "tag" == Just "HeadIsClosed" + guard $ v ^? key "headId" == Just (toJSON headId) + v ^? key "contestationDeadline" . _JSON + + -- Expect to see ReadyToFanout within 3 seconds after deadline + remainingTime <- diffUTCTime deadline <$> getCurrentTime + waitFor tracer (remainingTime + 3) [leader] $ + output "ReadyToFanout" ["headId" .= headId] + + putTextLn "Finalizing the Head" + send leader $ input "Fanout" [] + waitMatch 100 leader $ \v -> do + guard (v ^? key "tag" == Just "HeadIsFinalized") + guard $ v ^? key "headId" == Just (toJSON headId) + + let res = mapMaybe analyze . Map.toList $ processedTransactions + aggregates = movingAverage res + + writeResultsCsv (workDir "results.csv") aggregates + + let confTimes = map (\(_, _, a) -> a) res + numberOfTxs = length confTimes + below100ms = filter (< 0.1) confTimes + averageConfirmationTime = sum confTimes / fromIntegral numberOfTxs + percentBelow100ms = double (length below100ms) / double numberOfTxs * 100 + pure $ Summary{numberOfTxs, averageConfirmationTime, percentBelow100ms} -- | Collect OS-level stats while running some 'IO' action. -- @@ -159,15 +166,18 @@ bench timeoutSeconds workDir dataset@Dataset{clientDatasets} clusterSize = -- @@ -- -- TODO: add more data points for memory and network consumption -withOSStats :: FilePath -> IO () -> IO () +withOSStats :: FilePath -> IO a -> IO a withOSStats workDir action = findExecutable "dstat" >>= \case Nothing -> action Just exePath -> withCreateProcess (process exePath){std_out = CreatePipe} $ \_stdin out _stderr _processHandle -> - race_ + race (collectStats out $ workDir "system.csv") action + >>= \case + Left () -> failure "dstat process failed unexpectedly" + Right a -> pure a where process exePath = (proc exePath ["-cm", "-n", "-N", "lo", "--integer", "--noheaders", "--noupdate", "5"]){cwd = Just workDir} @@ -362,18 +372,18 @@ waitForAllConfirmations n1 Registry{processedTxs} submissionQ allIds = do where go remainingIds | Set.null remainingIds = do - putStrLn "All transactions confirmed. Sweet!" + putStrLn "All transactions confirmed. Sweet!" | otherwise = do - waitForSnapshotConfirmation >>= \case - TxValid{transaction} -> do - validTx processedTxs (txId transaction) - go remainingIds - TxInvalid{transaction} -> do - atomically $ writeTBQueue submissionQ transaction - go remainingIds - SnapshotConfirmed{transactions} -> do - confirmedIds <- mapM (confirmTx processedTxs) transactions - go $ remainingIds \\ Set.fromList confirmedIds + waitForSnapshotConfirmation >>= \case + TxValid{transaction} -> do + validTx processedTxs (txId transaction) + go remainingIds + TxInvalid{transaction} -> do + atomically $ writeTBQueue submissionQ transaction + go remainingIds + SnapshotConfirmed{transactions} -> do + confirmedIds <- mapM (confirmTx processedTxs) transactions + go $ remainingIds \\ Set.fromList confirmedIds waitForSnapshotConfirmation = waitMatch 20 n1 $ \v -> maybeTxValid v <|> maybeTxInvalid v <|> maybeSnapshotConfirmed v diff --git a/hydra-cluster/bench/Main.hs b/hydra-cluster/bench/Main.hs index 34e5771fe57..9ddcc5a7362 100644 --- a/hydra-cluster/bench/Main.hs +++ b/hydra-cluster/bench/Main.hs @@ -3,8 +3,11 @@ module Main where import Hydra.Prelude import Test.Hydra.Prelude -import Bench.EndToEnd (bench) +import Bench.EndToEnd (Summary (..), bench) import Data.Aeson (eitherDecodeFileStrict', encodeFile) +import Data.ByteString (hPut) +import Data.Fixed (Nano) +import Data.Time (nominalDiffTimeToSeconds) import Hydra.Cardano.Api ( ShelleyBasedEra (..), ShelleyGenesis (..), @@ -25,19 +28,23 @@ import Options.Applicative ( metavar, option, progDesc, + short, strOption, value, ) import System.Directory (createDirectory, doesDirectoryExist) import System.Environment (withArgs) import System.FilePath (()) +import Test.HUnit.Lang (HUnitFailure (..), formatFailureReason) import Test.QuickCheck (generate, getSize, scale) data Options = Options - { outputDirectory :: Maybe FilePath + { workDirectory :: Maybe FilePath + , outputDirectory :: Maybe FilePath , scalingFactor :: Int , timeoutSeconds :: DiffTime , clusterSize :: Word64 + , startingNodeId :: Int } benchOptionsParser :: Parser Options @@ -45,9 +52,9 @@ benchOptionsParser = Options <$> optional ( strOption - ( long "output-directory" + ( long "work-directory" <> help - "Directory containing generated transactions and UTxO set. \ + "Directory containing generated transactions, UTxO set, log files for spawned processes, etc. \ \ * If the directory exists, it's assumed to be used for replaying \ \ a previous benchmark and is expected to contain 'txs.json' and \ \ 'utxo.json' files, \ @@ -55,6 +62,15 @@ benchOptionsParser = \ populated with new transactions and UTxO set." ) ) + <*> optional + ( strOption + ( long "output-directory" + <> metavar "DIR" + <> help + "The directory where to output markdown-formatted benchmark results. \ + \ If not set, raw text summary will be printed to the console. (default: none)" + ) + ) <*> option auto ( long "scaling-factor" @@ -78,6 +94,18 @@ benchOptionsParser = <> help "The number of Hydra nodes to start and connect (default: 3)" ) + <*> option + auto + ( long "starting-node-id" + <> short 'i' + <> value 0 + <> metavar "INT" + <> help + "The starting point for ids allocated to nodes in the cluster. This \ + \ id controls TCP ports allocation for various servers run by the nodes, \ + \ it's useful to change if local processes on the machine running the \ + \ benchmark conflicts with default ports allocation scheme (default: 0)" + ) benchOptions :: ParserInfo Options benchOptions = @@ -97,15 +125,16 @@ benchOptions = main :: IO () main = execParser benchOptions >>= \case - o@Options{outputDirectory = Just benchDir} -> do + o@Options{workDirectory = Just benchDir} -> do existsDir <- doesDirectoryExist benchDir if existsDir then replay o benchDir else createDirectory benchDir >> play o benchDir - o -> - createSystemTempDirectory "bench" >>= play o + o -> do + tmpDir <- createSystemTempDirectory "bench" + play o tmpDir where - play Options{scalingFactor, timeoutSeconds, clusterSize} benchDir = do + play options@Options{scalingFactor, clusterSize} benchDir = do numberOfTxs <- generate $ scale (* scalingFactor) getSize pparams <- eitherDecodeFileStrict' ("config" "devnet" "genesis-shelley.json") >>= \case @@ -114,19 +143,89 @@ main = pure $ fromLedgerPParams ShelleyBasedEraShelley (sgProtocolParams shelleyGenesis) dataset <- generateConstantUTxODataset pparams (fromIntegral clusterSize) numberOfTxs saveDataset benchDir dataset - run timeoutSeconds benchDir dataset clusterSize + run options benchDir dataset - replay Options{timeoutSeconds, clusterSize} benchDir = do + replay options benchDir = do datasets <- either die pure =<< eitherDecodeFileStrict' (benchDir "dataset.json") putStrLn $ "Using UTxO and Transactions from: " <> benchDir - run timeoutSeconds benchDir datasets clusterSize + run options benchDir datasets - -- TODO(SN): Ideally we would like to say "to re-run use ... " on errors - run timeoutSeconds benchDir datasets clusterSize = do + run options@Options{timeoutSeconds, clusterSize, startingNodeId} benchDir datasets = do putStrLn $ "Test logs available in: " <> (benchDir "test.log") - withArgs [] . hspec $ bench timeoutSeconds benchDir datasets clusterSize + withArgs [] $ + try (bench startingNodeId timeoutSeconds benchDir datasets clusterSize) >>= \case + Left (err :: HUnitFailure) -> + benchmarkFailedWith benchDir err + Right summary -> + benchmarkSucceeded options benchDir summary saveDataset tmpDir dataset = do let txsFile = tmpDir "dataset.json" putStrLn $ "Writing dataset to: " <> txsFile encodeFile txsFile dataset + +benchmarkFailedWith :: FilePath -> HUnitFailure -> IO () +benchmarkFailedWith benchDir (HUnitFailure sourceLocation reason) = do + putStrLn $ "Benchmark failed " <> formatLocation sourceLocation <> ": " <> formatFailureReason reason + putStrLn $ "To re-run with same dataset, pass '--work-directory=" <> benchDir <> "' to the executable" + exitFailure + where + formatLocation = maybe "" (\loc -> "at " <> prettySrcLoc loc) + +benchmarkSucceeded :: Options -> FilePath -> Summary -> IO () +benchmarkSucceeded Options{outputDirectory, clusterSize} _ Summary{numberOfTxs, averageConfirmationTime, percentBelow100ms} = do + now <- getCurrentTime + maybe dumpToStdout (writeMarkdownReportTo now) outputDirectory + where + dumpToStdout = do + putTextLn $ "Confirmed txs: " <> show numberOfTxs + putTextLn $ "Average confirmation time (ms): " <> show (nominalDiffTimeToMilliseconds averageConfirmationTime) + putTextLn $ "Confirmed below 100ms: " <> show percentBelow100ms <> "%" + + writeMarkdownReportTo now outputDir = do + existsDir <- doesDirectoryExist outputDir + unless existsDir $ createDirectory outputDir + withFile (outputDir "end-to-end-benchmarks.md") WriteMode $ \hdl -> do + hPut hdl $ encodeUtf8 $ unlines $ pageHeader now + hPut hdl $ encodeUtf8 $ unlines formattedSummary + + pageHeader :: UTCTime -> [Text] + pageHeader now = + [ "--- " + , "sidebar_label: 'End-to-End Benchmarks' " + , "sidebar_position: 4 " + , "--- " + , "" + , "# End-To-End Benchmark Results " + , "" + , "This page is intended to collect the latest end-to-end benchmarks \ + \ results produced by Hydra's Continuous Integration system from \ + \ the latest `master` code. Please take those results with a grain of \ + \ salt as they are produced from basic cloud VMs and not controlled \ + \ hardware. Instead of focusing on the _absolute_ results, the emphasis \ + \ should be on relative results, eg. how the timings for a scenario \ + \ evolve as the code changes." + , "" + , "_Generated at_ " <> show now + , "" + ] + + formattedSummary :: [Text] + formattedSummary = + [ "## Baseline Scenario" + , "" + , -- TODO: make the description part of the Dataset + "This scenario represents a minimal case and as such is a good baseline against which \ + \ to assess the overhead introduced by more complex setups. There is a single hydra-node \ + \ with a single client submitting single input and single output transactions with a \ + \ constant UTxO set of 1." + , "" + , "| Number of nodes | " <> show clusterSize <> " | " + , "| -- | -- |" + , "| _Number of txs_ | " <> show numberOfTxs <> " |" + , "| _Avg. Confirmation Time (ms)_ | " <> show (nominalDiffTimeToMilliseconds averageConfirmationTime) <> " |" + , "| _Share of Txs (%) < 100ms_ | " <> show percentBelow100ms <> " |" + ] + + nominalDiffTimeToMilliseconds :: NominalDiffTime -> Nano + nominalDiffTimeToMilliseconds = fromRational . (* 1000) . toRational . nominalDiffTimeToSeconds diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 82219776fb5..1f83090faa5 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -263,29 +263,30 @@ benchmark bench-e2e type: exitcode-stdio-1.0 other-modules: Bench.EndToEnd build-depends: - , aeson - , base >=4.7 && <5 - , bytestring - , cardano-crypto-class - , containers - , directory - , filepath - , hspec - , hydra-cardano-api - , hydra-cluster - , hydra-node - , hydra-prelude - , hydra-test-utils - , io-classes - , lens - , lens-aeson - , optparse-applicative - , process - , QuickCheck - , regex-tdfa - , scientific - , strict-containers - , time + HUnit + , QuickCheck + , aeson + , base >=4.7 && <5 + , bytestring + , cardano-crypto-class + , containers + , directory + , filepath + , hspec + , hydra-cardano-api + , hydra-cluster + , hydra-node + , hydra-prelude + , hydra-test-utils + , io-classes + , lens + , lens-aeson + , optparse-applicative + , process + , regex-tdfa + , scientific + , strict-containers + , time build-tool-depends: hydra-node:hydra-node ghc-options: -threaded -rtsopts diff --git a/hydra-cluster/src/CardanoNode.hs b/hydra-cluster/src/CardanoNode.hs index 73867c0d9ec..9cc51bd551d 100644 --- a/hydra-cluster/src/CardanoNode.hs +++ b/hydra-cluster/src/CardanoNode.hs @@ -117,8 +117,8 @@ withCardanoNodeDevnet :: Tracer IO NodeLog -> -- | State directory in which credentials, db & logs are persisted. FilePath -> - (RunningNode -> IO ()) -> - IO () + (RunningNode -> IO a) -> + IO a withCardanoNodeDevnet tracer stateDirectory action = do createDirectoryIfMissing True stateDirectory [dlgCert, signKey, vrfKey, kesKey, opCert] <- @@ -259,8 +259,8 @@ withCardanoNode :: NetworkId -> FilePath -> CardanoNodeArgs -> - (RunningNode -> IO ()) -> - IO () + (RunningNode -> IO a) -> + IO a withCardanoNode tr networkId stateDirectory args@CardanoNodeArgs{nodeSocket} action = do traceWith tr $ MsgNodeCmdSpec (show $ cmdspec process) traceWith tr $ MsgNodeStarting{stateDirectory} @@ -268,9 +268,13 @@ withCardanoNode tr networkId stateDirectory args@CardanoNodeArgs{nodeSocket} act hSetBuffering out NoBuffering withCreateProcess process{std_out = UseHandle out, std_err = UseHandle out} $ \_stdin _stdout _stderr processHandle -> - race_ - (checkProcessHasNotDied "cardano-node" processHandle) - waitForNode + ( race + (checkProcessHasNotDied "cardano-node" processHandle) + waitForNode + >>= \case + Left{} -> error "should never been reached" + Right a -> pure a + ) `finally` cleanupSocketFile where process = cardanoNodeProcess (Just stateDirectory) args diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 1961a462410..fffd6719e2f 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -202,6 +202,7 @@ withHydraCluster :: FilePath -> FilePath -> -- | First node id + -- This sets the starting point for assigning ports Int -> -- | NOTE: This decides on the size of the cluster! [(VerificationKey PaymentKey, SigningKey PaymentKey)] -> @@ -209,8 +210,8 @@ withHydraCluster :: -- | Transaction id at which Hydra scripts should have been published. TxId -> ContestationPeriod -> - (NonEmpty HydraClient -> IO ()) -> - IO () + (NonEmpty HydraClient -> IO a) -> + IO a withHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys hydraScriptsTxId contestationPeriod action = do when (clusterSize == 0) $ failure "Cannot run a cluster with 0 number of nodes" @@ -253,7 +254,7 @@ withHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys hydraSc (\c -> startNodes (c : clients) rest) -- | Run a hydra-node with given 'ChainConfig' and using the config from --- config/. +-- config/. withHydraNode :: Tracer IO EndToEndLog -> ChainConfig ->