From de785aa213458aa8019339a124ab6b52e1e3992f Mon Sep 17 00:00:00 2001 From: MarcFontaine Date: Wed, 8 Dec 2021 13:02:04 +0100 Subject: [PATCH] tx-generator: towards stand-alone mode In the stand-alone mode, the transaction generator can generate lists of transactions and dump them to files, without a connection to a local or remote node. This supports new use cases of the transaction generator outside of benchmarking and makes it easier to test and debug the transaction generator. This PR add the script action `{ "SetProtocolParameters": { "UseLocalProtocolFile": "/tmp/t2.json" } }` that reads the protocol parameters from a file (instead of querying a node). --- bench/script/test-stand-alone.json | 54 +++++++++++ .../GeneratorTx/LocalProtocolDefinition.hs | 2 +- .../src/Cardano/Benchmarking/Script.hs | 8 +- .../src/Cardano/Benchmarking/Script/Action.hs | 1 + .../src/Cardano/Benchmarking/Script/Aeson.hs | 28 +++++- .../Benchmarking/Script/AesonLegacy.hs | 1 + .../src/Cardano/Benchmarking/Script/Core.hs | 92 +++++++++++-------- .../src/Cardano/Benchmarking/Script/Env.hs | 2 +- .../Cardano/Benchmarking/Script/Setters.hs | 6 +- .../src/Cardano/Benchmarking/Script/Store.hs | 9 +- .../src/Cardano/Benchmarking/Script/Types.hs | 8 +- .../src/Cardano/Benchmarking/Tracer.hs | 51 +++++----- .../src/Cardano/Benchmarking/Wallet.hs | 12 +-- 13 files changed, 199 insertions(+), 75 deletions(-) create mode 100644 bench/script/test-stand-alone.json diff --git a/bench/script/test-stand-alone.json b/bench/script/test-stand-alone.json new file mode 100644 index 00000000000..e3e8f532bf3 --- /dev/null +++ b/bench/script/test-stand-alone.json @@ -0,0 +1,54 @@ +[ + { "SetProtocolParameters": { "UseLocalProtocolFile": "/tmp/t2.json" } }, + { "Set": { "SNumberOfInputsPerTx": 2 } }, + { "Set": { "SNumberOfOutputsPerTx": 2 } }, + { "Set": { "STxAdditionalSize": 39 } }, + { "Set": { "SFee": 212345 } }, + { "Set": { "SMinValuePerUTxO": 1000000 } }, + { "Set": { "STTL": 1000000 } }, + { "Set": { "SEra": "Allegra" } }, + { "Set": { "SNetworkId": "Mainnet" } }, + { "ReadSigningKey": [ "pass-partout", "run/current/genesis/utxo-keys/utxo1.skey" ] }, + { "CreateChange": [ + { "DumpToFile": "/tmp/script-txs.txt" }, + { "PayToAddr": [] }, + 149200212345, + 1 + ] }, + { "CreateChange": [ + { "DumpToFile": "/tmp/script-txs.txt" }, + { "PayToCollateral": [] }, + 149200000000, + 1 + ] }, + { "CreateChange": [ + { "DumpToFile": "/tmp/split-txs.txt" }, + { "PayToAddr": [] }, + 2200000000000, + 10 + ] }, + { "CreateChange": [ + { "DumpToFile": "/tmp/split-txs.txt" }, + { "PayToAddr": [] }, + 70000000000, + 300 + ] }, + { "CreateChange": [ + { "DumpToFile": "/tmp/script-txs.txt" }, + { "PayToScript": [ "bench/script/sum1ToN.plutus", 3 ] }, + 2300000000, + 9000 + ] }, + { "RunBenchmark": [ + { "DumpToFile": "/tmp/submit-txs.txt" }, + { "SpendScript": [ + "bench/script/sum1ToN.plutus", + { "PreExecuteScript": [] }, + 3, + 6 + ] }, + "walletBasedBenchmark", + 4000, + 10 + ] } +] diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/LocalProtocolDefinition.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/LocalProtocolDefinition.hs index f208e82ed75..c313fd04bc5 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/LocalProtocolDefinition.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/LocalProtocolDefinition.hs @@ -107,7 +107,7 @@ runBenchmarkScriptWith :: runBenchmarkScriptWith iocp logConfigFile socketFile script = do (loggingLayer, ptcl) <- startProtocol logConfigFile let tracers :: BenchTracers - tracers = createTracers loggingLayer + tracers = createLoggingLayerTracers loggingLayer dslSet :: MonoDSLs dslSet = mangleLocalProtocolDefinition ptcl iocp socketFile tracers res <- firstExceptT BenchmarkRunnerError $ script (tracers, dslSet) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script.hs index 038ac10b762..2c56154b40f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script.hs @@ -17,9 +17,11 @@ import Control.Monad.IO.Class import Ouroboros.Network.NodeToClient (IOManager) import Cardano.Node.Configuration.Logging (shutdownLoggingLayer) +import Cardano.Benchmarking.Tracer (createDebugTracers) import Cardano.Benchmarking.Script.Action import Cardano.Benchmarking.Script.Aeson (parseScriptFileAeson) import Cardano.Benchmarking.Script.AesonLegacy (parseScriptFileLegacy) +import Cardano.Benchmarking.Script.Core (initGlobalWallet) import Cardano.Benchmarking.Script.Env import Cardano.Benchmarking.Script.Store import Cardano.Benchmarking.Script.Types @@ -27,7 +29,7 @@ import Cardano.Benchmarking.Script.Types type Script = [Action] runScript :: Script -> IOManager -> IO (Either Error ()) -runScript script iom = runActionM (forM_ script action) iom >>= \case +runScript script iom = runActionM execScript iom >>= \case (Right a , s , ()) -> do cleanup s shutDownLogging threadDelay 10_000_000 @@ -38,6 +40,10 @@ runScript script iom = runActionM (forM_ script action) iom >>= \case return $ Left err where cleanup s a = void $ runActionMEnv s a iom + execScript = do + initGlobalWallet + set BenchTracers createDebugTracers + forM_ script action shutDownLogging :: ActionM () shutDownLogging = do diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs index 514649d9eef..ca625286798 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs @@ -12,6 +12,7 @@ import Cardano.Benchmarking.Script.Types action :: Action -> ActionM () action a = case a of Set (key :=> (Identity val)) -> set (User key) val + SetProtocolParameters p -> setProtocolParameters p StartProtocol filePath -> startProtocol filePath ReadSigningKey name filePath -> readSigningKey name filePath SecureGenesisFund fundName fundKey genesisKey -> secureGenesisFund fundName fundKey genesisKey diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs index e27b76a2eac..7a7df60293a 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs @@ -20,7 +20,10 @@ import Data.Aeson.Types import Data.Aeson.Encode.Pretty import qualified Data.Attoparsec.ByteString as Atto -import Cardano.Api (AnyCardanoEra(..), CardanoEra(..), ScriptData, ScriptDataJsonSchema(..), scriptDataFromJson, scriptDataToJson) +import qualified Ouroboros.Network.Magic as Ouroboros (NetworkMagic(..)) +import Cardano.Api (AnyCardanoEra(..), CardanoEra(..), ScriptData, ScriptDataJsonSchema(..), NetworkId(..) + , scriptDataFromJson, scriptDataToJson) +import Cardano.Api.Shelley (ProtocolParameters) import Cardano.CLI.Types (SigningKeyFile(..)) import Cardano.Benchmarking.Script.Setters @@ -55,6 +58,12 @@ instance FromJSON AnyCardanoEra where jsonOptionsUnTaggedSum :: Options jsonOptionsUnTaggedSum = defaultOptions { sumEncoding = ObjectWithSingleField } +instance ToJSON ProtocolParametersSource where + toJSON = genericToJSON jsonOptionsUnTaggedSum + toEncoding = genericToEncoding jsonOptionsUnTaggedSum +instance FromJSON ProtocolParametersSource where + parseJSON = genericParseJSON jsonOptionsUnTaggedSum + -- Orphan instance used in the tx-generator instance ToJSON ScriptData where toJSON = scriptDataToJson ScriptDataJsonNoSchema @@ -140,6 +149,9 @@ parseJSONFile parser filePath = do parseScriptFileAeson :: FilePath -> IO [Action] parseScriptFileAeson = parseJSONFile fromJSON +readProtocolParametersFile :: FilePath -> IO ProtocolParameters +readProtocolParametersFile = parseJSONFile fromJSON + instance ToJSON KeyName where toJSON (KeyName a) = toJSON a instance ToJSON FundName where toJSON (FundName a) = toJSON a instance ToJSON FundListName where toJSON (FundListName a) = toJSON a @@ -153,3 +165,17 @@ instance FromJSON FundListName where parseJSON a = FundListName <$> parseJSON instance FromJSON TxListName where parseJSON a = TxListName <$> parseJSON a instance FromJSON ThreadName where parseJSON a = ThreadName <$> parseJSON a instance FromJSON SigningKeyFile where parseJSON a = SigningKeyFile <$> parseJSON a + +instance ToJSON NetworkId where + toJSON Mainnet = "Mainnet" + toJSON (Testnet (Ouroboros.NetworkMagic t)) = object ["Testnet" .= t] + +instance FromJSON NetworkId where + parseJSON j = case j of + (String "Mainnet") -> return Mainnet + (Object v) -> v .:? "Testnet" >>= \case + Nothing -> failed + Just w -> return $ Testnet $ Ouroboros.NetworkMagic w + _invalid -> failed + where + failed = fail $ "Parsing of NetworkId failed: " <> show j diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/AesonLegacy.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/AesonLegacy.hs index 4cadc120530..bdef861efd4 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/AesonLegacy.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/AesonLegacy.hs @@ -56,6 +56,7 @@ actionToJSON a = case a of CancelBenchmark (ThreadName t) -> singleton "cancelBenchmark" t WaitForEra era -> singleton "waitForEra" era Reserved l -> singleton "reserved" l + other -> error $ "Action not supported in legacy JSON mode : " ++ show other where singleton k v = object [ k .= v ] diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 55d1556dd0c..d5a6c83c475 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -26,7 +26,7 @@ import Control.Tracer (nullTracer) import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (..)) import Cardano.Api -import Cardano.Api.Shelley ( ProtocolParameters, protocolParamMaxTxExUnits, protocolParamPrices) +import Cardano.Api.Shelley (ProtocolParameters, protocolParamMaxTxExUnits, protocolParamPrices) import qualified Cardano.Benchmarking.FundSet as FundSet import Cardano.Benchmarking.FundSet (FundInEra(..), Validity(..), Variant(..), liftAnyEra ) @@ -46,7 +46,7 @@ import Cardano.Benchmarking.OuroborosImports as Core , getGenesis, protocolToNetworkId, protocolToCodecConfig, makeLocalConnectInfo) import Cardano.Benchmarking.PlutusExample as PlutusExample import Cardano.Benchmarking.Tracer as Core - ( createTracers, btTxSubmit_, btN2N_, btConnect_, btSubmission2_) + ( createLoggingLayerTracers, btTxSubmit_, btN2N_, btConnect_, btSubmission2_) import Cardano.Benchmarking.Types as Core (NumberOfInputsPerTx(..), NumberOfOutputsPerTx(..),NumberOfTxs(..), SubmissionErrorPolicy(..) , TPSRate, TxAdditionalSize(..)) @@ -54,6 +54,7 @@ import Cardano.Benchmarking.Wallet as Wallet hiding (keyAddress) import Cardano.Benchmarking.FundSet as FundSet (getFundTxIn) import Cardano.Benchmarking.ListBufferedSelector +import Cardano.Benchmarking.Script.Aeson (readProtocolParametersFile) import Cardano.Benchmarking.Script.Env import Cardano.Benchmarking.Script.Setters import Cardano.Benchmarking.Script.Store as Store @@ -72,6 +73,14 @@ withEra action = do AnyCardanoEra ShelleyEra -> action AsShelleyEra AnyCardanoEra ByronEra -> error "byron not supported" +setProtocolParameters :: ProtocolParametersSource -> ActionM () +setProtocolParameters s = case s of + QueryLocalNode -> do + set ProtocolParameterMode ProtocolParameterQuery + UseLocalProtocolFile file -> do + protocolParameters <- liftIO $ readProtocolParametersFile file + set ProtocolParameterMode $ ProtocolParameterLocal protocolParameters + startProtocol :: FilePath -> ActionM () startProtocol filePath = do liftIO (runExceptT $ Core.startProtocol filePath) >>= \case @@ -79,9 +88,9 @@ startProtocol filePath = do Right (loggingLayer, protocol) -> do set LoggingLayer loggingLayer set Protocol protocol - set BenchTracers $ Core.createTracers loggingLayer + set BenchTracers $ Core.createLoggingLayerTracers loggingLayer set Genesis $ Core.getGenesis protocol - set NetworkId $ protocolToNetworkId protocol + set (User TNetworkId) $ protocolToNetworkId protocol readSigningKey :: KeyName -> SigningKeyFile -> ActionM () readSigningKey name filePath = @@ -101,7 +110,7 @@ secureGenesisFund secureGenesisFund fundName destKey genesisKeyName = do tracer <- btTxSubmit_ <$> get BenchTracers localSubmit <- getLocalSubmitTx - networkId <- get NetworkId + networkId <- getUser TNetworkId genesis <- get Genesis fee <- getUser TFee ttl <- getUser TTTL @@ -127,7 +136,7 @@ splitFundN splitFundN count destKeyName sourceFund = do tracer <- btTxSubmit_ <$> get BenchTracers localSubmit <- getLocalSubmitTx - networkId <- get NetworkId + networkId <- getUser TNetworkId fee <- getUser TFee destKey <- getName destKeyName (fund, fundKey) <- consumeName sourceFund @@ -171,7 +180,7 @@ prepareTxList -> ActionM () prepareTxList name destKey srcFundName = do tracer <- btTxSubmit_ <$> get BenchTracers - networkId <- get NetworkId + networkId <- getUser TNetworkId fee <- getUser TFee fundList <- consumeName srcFundName key <- getName destKey @@ -199,7 +208,7 @@ waitBenchmarkCore ctl = do getConnectClient :: ActionM ConnectClient getConnectClient = do tracers <- get BenchTracers - (Testnet networkMagic) <- get NetworkId + (Testnet networkMagic) <- getUser TNetworkId protocol <- get Protocol void $ return $(btSubmission2_ tracers) ioManager <- askIOManager @@ -244,7 +253,7 @@ cancelBenchmark n = do waitBenchmarkCore ctl getLocalConnectInfo :: ActionM (LocalNodeConnectInfo CardanoMode) -getLocalConnectInfo = makeLocalConnectInfo <$> get NetworkId <*> getUser TLocalSocket +getLocalConnectInfo = makeLocalConnectInfo <$> getUser TNetworkId <*> getUser TLocalSocket queryEra :: ActionM AnyCardanoEra queryEra = do @@ -255,8 +264,8 @@ queryEra = do Right era -> return era Left err -> throwE $ ApiError $ show err -queryProtocolParameters :: ActionM ProtocolParameters -queryProtocolParameters = do +queryRemoteProtocolParameters :: ActionM ProtocolParameters +queryRemoteProtocolParameters = do localNodeConnectInfo <- getLocalConnectInfo chainTip <- liftIO $ getLocalChainTip localNodeConnectInfo ret <- liftIO $ queryNodeLocalState localNodeConnectInfo (Just $ chainTipToChainPoint chainTip) @@ -266,6 +275,12 @@ queryProtocolParameters = do Right (Left err) -> throwE $ ApiError $ show err Left err -> throwE $ ApiError $ show err +getProtocolParameters :: ActionM ProtocolParameters +getProtocolParameters = do + get ProtocolParameterMode >>= \case + ProtocolParameterQuery -> queryRemoteProtocolParameters + ProtocolParameterLocal parameters -> return parameters + waitForEra :: AnyCardanoEra -> ActionM () waitForEra era = do currentEra <- queryEra @@ -322,14 +337,14 @@ runBenchmark submitMode spendMode threadName txCount tps runBenchmarkInEra :: forall era. IsShelleyBasedEra era => SubmitMode -> ThreadName -> NumberOfTxs -> TPSRate -> AsType era -> ActionM () runBenchmarkInEra submitMode (ThreadName threadName) txCount tps era = do tracers <- get BenchTracers - networkId <- get NetworkId + networkId <- getUser TNetworkId fundKey <- getName $ KeyName "pass-partout" -- should be walletkey targets <- getUser TTargets (NumberOfInputsPerTx numInputs) <- getUser TNumberOfInputsPerTx (NumberOfOutputsPerTx numOutputs) <- getUser TNumberOfOutputsPerTx fee <- getUser TFee minValuePerUTxO <- getUser TMinValuePerUTxO - protocolParameters <- queryProtocolParameters + protocolParameters <- getProtocolParameters walletRef <- get GlobalWallet metadata <- makeMetadata connectClient <- getConnectClient @@ -383,9 +398,9 @@ runPlutusBenchmark submitMode scriptFile scriptBudget scriptData scriptRedeemer targets <- getUser TTargets (NumberOfInputsPerTx numInputs) <- getUser TNumberOfInputsPerTx (NumberOfOutputsPerTx numOutputs) <- getUser TNumberOfOutputsPerTx - networkId <- get NetworkId + networkId <- getUser TNetworkId minValuePerUTxO <- getUser TMinValuePerUTxO - protocolParameters <- queryProtocolParameters + protocolParameters <- getProtocolParameters executionUnitPrices <- case protocolParamPrices protocolParameters of Just x -> return x Nothing -> throwE $ WalletError "unexpected protocolParamPrices == Nothing in runPlutusBenchmark" @@ -506,7 +521,7 @@ importGenesisFund submitMode genesisKeyName destKey = do NodeToNode -> throwE $ WalletError "NodeToNode mode not supported in importGenesisFund" DumpToFile filePath -> return $ \tx -> dumpToFileIO filePath tx >> return SubmitSuccess DiscardTX -> return $ \_ -> return SubmitSuccess - networkId <- get NetworkId + networkId <- getUser TNetworkId genesis <- get Genesis fee <- getUser TFee ttl <- getUser TTTL @@ -518,24 +533,25 @@ importGenesisFund submitMode genesisKeyName destKey = do let addr = Core.keyAddress @ era networkId fundKey f <- GeneratorTx.secureGenesisFund tracer localSubmit networkId genesis fee ttl genesisKey addr return (f, fundKey) - liftCoreWithEra coreCall >>= \case + result <- liftCoreWithEra coreCall + case result of Left err -> liftTxGenError err - Right fund -> initGlobalWallet networkId fundKey fund - --- Todo split init and import of funds -initGlobalWallet :: NetworkId -> SigningKey PaymentKey -> Fund -> ActionM () -initGlobalWallet networkId key ((txIn, outVal), skey) = do - wallet <- liftIO $ initWallet networkId key - liftIO (walletRefInsertFund wallet (FundSet.Fund $ mkFund outVal)) - set GlobalWallet wallet - where - mkFund = liftAnyEra $ \value -> FundInEra { - _fundTxIn = txIn - , _fundVal = value - , _fundSigningKey = Just skey - , _fundValidity = Confirmed - , _fundVariant = PlainOldFund - } + Right fund -> addToWallet fund + where + addToWallet ((txIn, outVal), skey) = do + let + mkFund = liftAnyEra $ \value -> FundInEra { + _fundTxIn = txIn + , _fundVal = value + , _fundSigningKey = Just skey + , _fundValidity = Confirmed + , _fundVariant = PlainOldFund + } + wallet <- get GlobalWallet + liftIO (walletRefInsertFund wallet (FundSet.Fund $ mkFund outVal)) + +initGlobalWallet :: ActionM () +initGlobalWallet = liftIO initWallet >>= set GlobalWallet createChange :: SubmitMode -> PayMode -> Lovelace -> Int -> ActionM () createChange submitMode payMode value count = case payMode of @@ -548,8 +564,8 @@ createChange submitMode payMode value count = case payMode of createChangeScriptFunds :: SubmitMode -> FilePath -> ScriptData -> Lovelace -> Int -> ActionM () createChangeScriptFunds submitMode scriptFile scriptData value count = do walletRef <- get GlobalWallet - networkId <- get NetworkId - protocolParameters <- queryProtocolParameters + networkId <- getUser TNetworkId + protocolParameters <- getProtocolParameters _fundKey <- getName $ KeyName "pass-partout" fee <- getUser TFee script <- liftIO $ PlutusExample.readScript scriptFile --TODO: this should throw a file-not-found-error ! @@ -573,10 +589,10 @@ createChangeScriptFunds submitMode scriptFile scriptData value count = do createChangeInEra :: forall era. IsShelleyBasedEra era => SubmitMode -> Variant -> Lovelace -> Int -> AsType era -> ActionM () createChangeInEra submitMode variant value count _proxy = do - networkId <- get NetworkId + networkId <- getUser TNetworkId fee <- getUser TFee walletRef <- get GlobalWallet - protocolParameters <- queryProtocolParameters + protocolParameters <- getProtocolParameters fundKey <- getName $ KeyName "pass-partout" let createCoins :: FundSet.FundSource -> [Lovelace] -> ActionM (Either String (TxInMode CardanoMode)) @@ -647,7 +663,7 @@ spendAutoScript relies on a particular calling convention of the loop script. -} spendAutoScript :: SubmitMode -> FilePath -> ThreadName -> NumberOfTxs -> TPSRate -> ActionM () spendAutoScript submitMode loopScriptFile threadName txCount tps = do - protocolParameters <- queryProtocolParameters + protocolParameters <- getProtocolParameters perTxBudget <- case protocolParamMaxTxExUnits protocolParameters of Nothing -> throwE $ ApiError "Cannot determine protocolParamMaxTxExUnits" Just b -> return b diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs index 9c975490694..0eedba83d5b 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Env.hs @@ -50,7 +50,7 @@ runActionMEnv env action iom = RWS.runRWST (runExceptT action) iom env type SetKeyVal = DSum Setters.Tag Identity data Error where - LookupError :: !(Store v) -> Error + LookupError :: !(Store v) -> Error TxGenError :: !TxGenError -> Error CliError :: !CliError -> Error ApiError :: !String -> Error diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs index 1f996265161..8c3c38c6e2f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs @@ -19,7 +19,7 @@ import Data.GADT.Compare.TH (deriveGCompare, deriveGEq) import Data.GADT.Show.TH (deriveGShow) import Data.List.NonEmpty -import Cardano.Api (Lovelace, SlotNo, AnyCardanoEra(..)) +import Cardano.Api (AnyCardanoEra(..), SlotNo, Lovelace, NetworkId) import Cardano.Benchmarking.Types @@ -35,6 +35,7 @@ data Tag v where TLocalSocket :: Tag String TEra :: Tag AnyCardanoEra TTargets :: Tag (NonEmpty NodeIPv4Address) + TNetworkId :: Tag NetworkId deriveGEq ''Tag deriveGCompare ''Tag @@ -55,6 +56,7 @@ data Sum where SLocalSocket :: !String -> Sum SEra :: !AnyCardanoEra -> Sum STargets :: !(NonEmpty NodeIPv4Address) -> Sum + SNetworkId :: !NetworkId -> Sum deriving (Eq, Show, Generic) taggedToSum :: Applicative f => DSum Tag f -> f Sum @@ -69,6 +71,7 @@ taggedToSum x = case x of (TLocalSocket :=> v) -> SLocalSocket <$> v (TEra :=> v) -> SEra <$> v (TTargets :=> v) -> STargets <$> v + (TNetworkId :=> v) -> SNetworkId <$> v sumToTagged :: Applicative f => Sum -> DSum Tag f sumToTagged x = case x of @@ -82,3 +85,4 @@ sumToTagged x = case x of SLocalSocket v -> TLocalSocket ==> v SEra v -> TEra ==> v STargets v -> TTargets ==> v + SNetworkId v -> TNetworkId ==> v diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Store.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Store.hs index 8cd6697a9b4..256c12b0b11 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Store.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Store.hs @@ -19,12 +19,13 @@ import Data.GADT.Compare.TH (deriveGCompare, deriveGEq) import Data.GADT.Show.TH (deriveGShow) import Cardano.Api as Cardano (InAnyCardanoEra(..), Tx) +import Cardano.Api.Shelley as Cardano (ProtocolParameters) import Cardano.Node.Protocol.Types (SomeConsensusProtocol) import Cardano.Benchmarking.Script.Setters as Setters import Cardano.Benchmarking.OuroborosImports as Cardano ( LoggingLayer, ShelleyGenesis, StandardShelley - , NetworkId, SigningKey, PaymentKey) + , SigningKey, PaymentKey) import Cardano.Benchmarking.GeneratorTx as Core (AsyncBenchmarkControl) import qualified Cardano.Benchmarking.GeneratorTx.Tx as Core (Fund) @@ -39,9 +40,9 @@ data Store v where LoggingLayer :: Store LoggingLayer Protocol :: Store SomeConsensusProtocol BenchTracers :: Store Core.BenchTracers - NetworkId :: Store Cardano.NetworkId -- could be in Setters (just need JSON instance) Genesis :: Store (ShelleyGenesis StandardShelley) Named :: Name x -> Store x + ProtocolParameterMode :: Store ProtocolParameterMode data Name x where KeyName :: !String -> Name (SigningKey PaymentKey) @@ -58,6 +59,10 @@ type ThreadName = Name AsyncBenchmarkControl newtype TxList era = TxList [Tx era] +data ProtocolParameterMode where + ProtocolParameterQuery :: ProtocolParameterMode + ProtocolParameterLocal :: ProtocolParameters -> ProtocolParameterMode + -- Remember when debugging at 4:00AM : -- TH-Haskell is imperative: It breaks up Main into smaller binding groups! -- This means declarations below a splice are not visible above. diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 9775a32e01f..5c44bb869e8 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -39,9 +39,16 @@ data Action where CancelBenchmark :: !ThreadName -> Action Reserved :: [String] -> Action WaitForEra :: !AnyCardanoEra -> Action + SetProtocolParameters :: ProtocolParametersSource -> Action deriving (Show, Eq) deriving instance Generic Action +data ProtocolParametersSource where + QueryLocalNode :: ProtocolParametersSource + UseLocalProtocolFile :: !FilePath -> ProtocolParametersSource + deriving (Show, Eq) +deriving instance Generic ProtocolParametersSource + data SubmitMode where LocalSocket :: SubmitMode NodeToNode :: SubmitMode @@ -70,4 +77,3 @@ data ScriptBudget where CheckScriptBudget :: !ExecutionUnits -> ScriptBudget deriving (Show, Eq) deriving instance Generic ScriptBudget - diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index cec3383280d..e7fcdee2e70 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -20,29 +20,32 @@ module Cardano.Benchmarking.Tracer , SubmissionSummary(..) , TraceBenchTxSubmit(..) , TraceLowLevelSubmit(..) - , createTracers + , createLoggingLayerTracers + , createDebugTracers ) where -import Prelude (Show(..), String) - -import Cardano.Prelude hiding (TypeError, show) -import qualified Codec.CBOR.Term as CBOR -import Cardano.BM.Tracing -import Data.Aeson (ToJSON (..), (.=)) +import Prelude (Show(..), String) +import Data.Aeson (ToJSON (..), (.=), encode) import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy.Char8 as BSL (unpack) import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import Data.Time.Clock (DiffTime, NominalDiffTime, getCurrentTime) --- Mode-agnostic imports. -import Cardano.BM.Data.Tracer - (emptyObject, mkObject, trStructured) -import Network.Mux (WithMuxBearer(..)) --- Node API imports. +import Control.Tracer (debugTracer) + +import qualified Codec.CBOR.Term as CBOR import Cardano.Api --- Node imports. +import Cardano.Prelude hiding (TypeError, show) + + +import Cardano.BM.Tracing +import Cardano.BM.Data.Tracer (emptyObject, mkObject, trStructured) +import Network.Mux (WithMuxBearer(..)) + + import Cardano.Node.Configuration.Logging (LOContent(..), LoggingLayer (..)) import Cardano.Tracing.OrphanInstances.Byron() import Cardano.Tracing.OrphanInstances.Common() @@ -70,8 +73,20 @@ data BenchTracers = , btN2N_ :: Tracer IO NodeToNodeSubmissionTrace } -createTracers :: LoggingLayer -> BenchTracers -createTracers loggingLayer = +createDebugTracers :: BenchTracers +createDebugTracers = initTracers tr tr + where + tr = contramap (\(_,t) -> BSL.unpack $ encode t) debugTracer + +createLoggingLayerTracers :: LoggingLayer -> BenchTracers +createLoggingLayerTracers loggingLayer + = initTracers baseTrace tr + where + baseTrace = llBasicTrace loggingLayer + tr = llAppendName loggingLayer "cli" baseTrace + +initTracers :: Trace IO Text -> Trace IO Text -> BenchTracers +initTracers baseTrace tr = BenchTracers baseTrace benchTracer @@ -80,12 +95,6 @@ createTracers loggingLayer = lowLevelSubmitTracer n2nSubmitTracer where - baseTrace :: Trace IO Text - baseTrace = llBasicTrace loggingLayer - - tr :: Trace IO Text - tr = llAppendName loggingLayer "cli" baseTrace - tr' :: Trace IO Text tr' = appendName "generate-txs" tr diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs b/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs index 935e5a9078d..0a4a594c22a 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs @@ -21,17 +21,13 @@ type TxGenerator era = [Fund] -> [TxOut CtxTx era] -> Either String (Tx era, TxI type ToUTxO era = [Lovelace] -> ([TxOut CtxTx era], TxId -> [Fund]) data Wallet = Wallet { - walletNetworkId :: !NetworkId - , walletKey :: !(SigningKey PaymentKey) - , walletSeqNumber :: !SeqNumber + walletSeqNumber :: !SeqNumber , walletFunds :: !FundSet } -initWallet :: NetworkId -> SigningKey PaymentKey -> IO (MVar Wallet) -initWallet network key = newMVar $ Wallet { - walletNetworkId = network - , walletKey = key - , walletSeqNumber = SeqNumber 1 +initWallet :: IO (MVar Wallet) +initWallet = newMVar $ Wallet { + walletSeqNumber = SeqNumber 1 , walletFunds = emptyFunds }