From 73472d093132d10d1e28eb9d4edfaad0a8562595 Mon Sep 17 00:00:00 2001 From: Nadia Yvette Chambers Date: Wed, 22 May 2024 03:34:17 +0000 Subject: [PATCH] txgen-mvar: update tx-generator selftest test This partially updates the test to cope with API changes in terms of compile-time failures. Runtime issues still need to be addressed. --- .../src/Cardano/Benchmarking/Command.hs | 6 ++-- .../Cardano/Benchmarking/Script/Selftest.hs | 32 ++++++++++++------- bench/tx-generator/test/Bench.hs | 8 ++++- bench/tx-generator/tx-generator.cabal | 2 ++ 4 files changed, 32 insertions(+), 16 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs index 37220a1b006..1f2889929ec 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs @@ -22,7 +22,7 @@ import Cardano.Benchmarking.Compiler (compileOptions) import Cardano.Benchmarking.LogTypes (AsyncBenchmarkControl (..), EnvConsts (..)) import Cardano.Benchmarking.Script (parseScriptFileAeson, runScript) import Cardano.Benchmarking.Script.Aeson (parseJSONFile, prettyPrint) -import Cardano.Benchmarking.Script.Env as Env (emptyEnv, newEnvConsts) +import Cardano.Benchmarking.Script.Env as Env (Error, emptyEnv, newEnvConsts) import Cardano.Benchmarking.Script.Selftest (runSelftest) import Cardano.Benchmarking.Version as Version import Cardano.TxGenerator.Setup.NixService @@ -96,10 +96,10 @@ runCommand' iocp = do case compileOptions o of Right script -> BSL.putStr $ prettyPrint script Left err -> die $ "tx-generator:Cardano.Command.runCommand Compile: " ++ show err - Selftest outFile -> runSelftest emptyEnv envConsts outFile >>= handleError + Selftest outFile -> runSelftest emptyEnv envConsts outFile >>= \abc -> handleError (Right abc, abc) VersionCmd -> runVersionCommand where - handleError :: Show a => (Either a b, abc) -> IO () + handleError :: (Either Env.Error b, abc) -> IO () handleError = \case (Right _, _) -> exitSuccess (Left err, _) -> die $ "tx-generator:Cardano.Command.runCommand handleError: " ++ show err diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index 893f4a260b1..f7b10bf782a 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} {-| Module : Cardano.Benchmarking.Script.Selftest Description : Run self-tests using statically-defined data. @@ -11,24 +13,25 @@ where import Cardano.Api hiding (Env) +import Cardano.Benchmarking.GeneratorTx as GeneratorTx (walletBenchmark) import Cardano.Benchmarking.LogTypes (AsyncBenchmarkControl, EnvConsts (..)) import Cardano.Benchmarking.Script.Action import Cardano.Benchmarking.Script.Aeson (prettyPrint) -import Cardano.Benchmarking.Script.Env as Env (Env (..)) +import Cardano.Benchmarking.Script.Core (getConnectClient) +import Cardano.Benchmarking.Script.Env as Env (Env (..), getEnvThreads, liftTxGenError, setEnvThreads) import qualified Cardano.Benchmarking.Script.Env as Env (Error, runActionMEnv, setBenchTracers) import Cardano.Benchmarking.Script.Types import Cardano.Benchmarking.Tracer (initNullTracers) +import Cardano.Benchmarking.Types (SubmissionErrorPolicy (..)) import qualified Cardano.Ledger.Coin as L import Cardano.TxGenerator.Setup.SigningKey import Cardano.TxGenerator.Types import Prelude -import qualified Control.Concurrent.STM as STM (atomically, readTVar) import Control.Monad import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Either (fromRight) -import qualified Data.List as List (unwords) import Data.String import Paths_tx_generator @@ -40,22 +43,27 @@ import Paths_tx_generator -- transaction 'Streaming.Stream' that -- 'Cardano.Benchmarking.Script.Core.submitInEra' -- does 'show' and 'writeFile' on. -runSelftest :: Env -> EnvConsts -> Maybe FilePath -> IO (Either Env.Error (), AsyncBenchmarkControl) -runSelftest env envConsts@EnvConsts { .. } outFile = do +runSelftest :: Env -> EnvConsts -> Maybe FilePath -> IO (Either Env.Error (Maybe AsyncBenchmarkControl)) +runSelftest env envConsts outFile = do protocolFile <- getDataFileName "data/protocol-parameters.json" let + targetNodes :: TargetNodes = undefined + tps :: Double = 0.0 + eraProxy :: AsType ConwayEra = undefined + txCount = undefined + txStream = undefined submitMode = maybe DiscardTX DumpToFile outFile fullScript = do Env.setBenchTracers initNullTracers + client <- getConnectClient + ret <- liftIO $ runExceptT $ GeneratorTx.walletBenchmark mempty mempty client "unused-thread-name" targetNodes tps LogErrors eraProxy txCount txStream + case ret of + Left err -> liftTxGenError err + Right abc -> setEnvThreads abc forM_ (testScript protocolFile submitMode) action + getEnvThreads (result, Env { }, ()) <- Env.runActionMEnv env fullScript envConsts - abcMaybe <- STM.atomically $ STM.readTVar envThreads - case abcMaybe of - Just abc -> pure (result, abc) - Nothing -> error $ - List.unwords - [ "Cardano.Benchmarking.Script.Selftest.runSelftest:" - , "thread state improperly initialized" ] + pure result -- | 'printJSON' prints out the list of actions using Aeson. -- It has no callers within @cardano-node@. diff --git a/bench/tx-generator/test/Bench.hs b/bench/tx-generator/test/Bench.hs index c9d7c0c7ac1..0ad558b37bb 100644 --- a/bench/tx-generator/test/Bench.hs +++ b/bench/tx-generator/test/Bench.hs @@ -1,16 +1,22 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} module Main (main) where import Prelude +import Control.Monad.STM as STM (atomically) import Criterion.Main import Cardano.Benchmarking.Script.Selftest +import Cardano.Benchmarking.Script.Env as Env +import Ouroboros.Network.IOManager (IOManager) main :: IO () main = defaultMain [ bgroup "cardano-tx-generator-integration" [ bench "tx-gen" $ whnfIO $ do - runSelftest (error "noIOManager") Nothing >>= \case + let iom :: IOManager = error "noIOManager" + envConsts <- STM.atomically $ Env.newEnvConsts iom Nothing + runSelftest Env.emptyEnv envConsts Nothing >>= \case Right _ -> return () Left err -> error $ show err ] diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index df1c0fce851..42dd74fb627 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -253,6 +253,8 @@ benchmark tx-generator-bench build-depends: base , criterion + , ouroboros-network-framework + , stm , tx-generator default-language: Haskell2010