diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index a3b10273092..e6c3f146927 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -54,11 +54,7 @@ compileToScript = do initConstants :: Compiler () initConstants = do - setN TNumberOfInputsPerTx _nix_inputs_per_tx - setN TNumberOfOutputsPerTx _nix_outputs_per_tx - setN TNumberOfTxs _nix_tx_count setN TTxAdditionalSize _nix_add_tx_size - setN TMinValuePerUTxO _nix_min_utxo_value setN TFee _nix_tx_fee setN TLocalSocket _nix_localNodeSocketPath setConst TTTL 1000000 @@ -148,7 +144,7 @@ benchmarkingPhase wallet = do plutusMode <- askNixOption _nix_plutusMode plutusAutoMode <- askNixOption _nix_plutusAutoMode targetNodes <- askNixOption _nix_targetNodes - tx_count <- askNixOption _nix_tx_count + extraArgs <- evilValueMagic tps <- askNixOption _nix_tps era <- askNixOption _nix_era let target = if debugMode then LocalSocket else NodeToNode targetNodes @@ -164,7 +160,7 @@ benchmarkingPhase wallet = do <*> (ScriptDataNumber <$> askNixOption _nix_plutusData) <*> (ScriptDataNumber <$> askNixOption _nix_plutusRedeemer) (False,False) -> return SpendOutput - emit $ RunBenchmark era wallet target spendMode (ThreadName "tx-submit-benchmark") tx_count tps + emit $ RunBenchmark era wallet target spendMode (ThreadName "tx-submit-benchmark") extraArgs tps unless debugMode $ do emit $ WaitBenchmark $ ThreadName "tx-submit-benchmark" @@ -227,3 +223,30 @@ newWallet n = do name <- WalletName <$> newIdentifier n emit $ InitWallet name return name + +-- Approximate the ada values for inputs of the benchmarking Phase +evilValueMagic :: Compiler RunBenchmarkAux +evilValueMagic = do + (NumberOfInputsPerTx inputsPerTx) <- askNixOption _nix_inputs_per_tx + (NumberOfOutputsPerTx outputsPerTx) <- askNixOption _nix_outputs_per_tx + (NumberOfTxs txCount) <- askNixOption _nix_tx_count + fee <- askNixOption _nix_tx_fee + minValuePerUTxO <- askNixOption _nix_min_utxo_value + let + (Quantity minValue) = lovelaceToQuantity $ fromIntegral outputsPerTx * minValuePerUTxO + fee + + -- this is not totally correct: + -- beware of rounding errors ! + minValuePerInput = quantityToLovelace $ fromIntegral (if m==0 then d else d+1) + where + (d, m) = minValue `divMod` fromIntegral inputsPerTx + return $ RunBenchmarkAux { + auxTxCount = txCount + , auxFee = fee + , auxOutputsPerTx = outputsPerTx + , auxInputsPerTx = inputsPerTx + , auxInputs = inputsPerTx * txCount + , auxOutputs = inputsPerTx * txCount + , auxMinValuePerUTxO = minValuePerInput + } + diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs index 77dce25c96b..3b88f09606d 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs @@ -22,7 +22,7 @@ action a = case a of Delay t -> delay t ImportGenesisFund era wallet submitMode genesisKey fundKey -> importGenesisFund era wallet submitMode genesisKey fundKey CreateChange era sourceWallet dstWallet payMode submitMode value count -> createChange era sourceWallet dstWallet payMode submitMode value count - RunBenchmark era sourceWallet submitMode spendMode thread count tps -> runBenchmark era sourceWallet submitMode spendMode thread count tps + RunBenchmark era sourceWallet submitMode spendMode thread auxArgs tps -> runBenchmark era sourceWallet submitMode spendMode thread auxArgs tps WaitBenchmark thread -> waitBenchmark thread CancelBenchmark thread -> cancelBenchmark thread WaitForEra era -> waitForEra era diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs index a8a779b5824..685bd756eb9 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs @@ -102,6 +102,12 @@ instance ToJSON Action where instance FromJSON Action where parseJSON = genericParseJSON jsonOptionsUnTaggedSum +instance ToJSON RunBenchmarkAux where + toJSON = genericToJSON jsonOptionsUnTaggedSum + toEncoding = genericToEncoding jsonOptionsUnTaggedSum +instance FromJSON RunBenchmarkAux where + parseJSON = genericParseJSON jsonOptionsUnTaggedSum + scanScriptFile :: FilePath -> IO Value scanScriptFile filePath = do input <- BS.readFile filePath diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 11b90002230..c1a594a74b1 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -50,9 +50,8 @@ import Cardano.Benchmarking.PlutusExample as PlutusExample import Cardano.Benchmarking.LogTypes as Core (TraceBenchTxSubmit (..), btConnect_, btN2N_, btSubmission2_, btTxSubmit_) -import Cardano.Benchmarking.Types as Core (NumberOfInputsPerTx (..), - NumberOfOutputsPerTx (..), NumberOfTxs (..), SubmissionErrorPolicy (..), TPSRate, - TxAdditionalSize (..)) +import Cardano.Benchmarking.Types as Core (NumberOfTxs (..), SubmissionErrorPolicy (..), + TPSRate, TxAdditionalSize (..)) import Cardano.Benchmarking.Wallet as Wallet hiding (keyAddress) import Cardano.Benchmarking.Script.Aeson (readProtocolParametersFile) @@ -241,58 +240,45 @@ makeMetadata = do Right m -> return m Left err -> throwE $ MetadataError err -runBenchmark :: AnyCardanoEra -> WalletName -> SubmitMode -> SpendMode -> ThreadName -> NumberOfTxs -> TPSRate -> ActionM () -runBenchmark era sourceWallet submitMode spendMode threadName txCount tps +runBenchmark :: AnyCardanoEra -> WalletName -> SubmitMode -> SpendMode -> ThreadName -> RunBenchmarkAux -> TPSRate -> ActionM () +runBenchmark era sourceWallet submitMode spendMode threadName extraArgs tps = case spendMode of - SpendOutput -> withEra era $ runBenchmarkInEra sourceWallet submitMode threadName txCount tps + SpendOutput -> withEra era $ runBenchmarkInEra sourceWallet submitMode threadName extraArgs tps SpendScript scriptFile scriptBudget scriptData scriptRedeemer - -> withEra era $ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData scriptRedeemer threadName txCount tps - SpendAutoScript scriptFile -> withEra era $ spendAutoScript sourceWallet submitMode scriptFile threadName txCount tps + -> withEra era $ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData scriptRedeemer threadName extraArgs tps + SpendAutoScript scriptFile -> withEra era $ spendAutoScript sourceWallet submitMode scriptFile threadName extraArgs tps runBenchmarkInEra :: forall era. IsShelleyBasedEra era => WalletName -> SubmitMode -> ThreadName - -> NumberOfTxs + -> RunBenchmarkAux -> TPSRate -> AsType era -> ActionM () -runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) txCount tps era = do +runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) shape tps era = do tracers <- get BenchTracers networkId <- getUser TNetworkId fundKey <- getName $ KeyName "pass-partout" -- should be walletkey - (NumberOfInputsPerTx numInputs) <- getUser TNumberOfInputsPerTx - (NumberOfOutputsPerTx numOutputs) <- getUser TNumberOfOutputsPerTx - fee <- getUser TFee - minValuePerUTxO <- getUser TMinValuePerUTxO protocolParameters <- getProtocolParameters walletRefSrc <- getName sourceWallet let walletRefDst = walletRefSrc metadata <- makeMetadata - let - (Quantity minValue) = lovelaceToQuantity $ fromIntegral numOutputs * minValuePerUTxO + fee - - -- this is not totally correct: - -- beware of rounding errors ! - minValuePerInput = quantityToLovelace $ fromIntegral (if m==0 then d else d+1) - where - (d, m) = minValue `divMod` fromIntegral numInputs - --- fundSource :: FundSet.Target -> FundSet.FundSource --- fundSource target = mkWalletFundSource walletRef $ FundSet.selectInputs ConfirmedBeforeReuse numInputs minTxValue PlainOldFund target fundSource <- liftIO (mkBufferedSource walletRefSrc - (fromIntegral (unNumberOfTxs txCount) * numInputs) - minValuePerInput - PlainOldFund numInputs) >>= \case + (auxInputs shape) + (auxMinValuePerUTxO shape) + PlainOldFund + (auxInputsPerTx shape) + ) >>= \case Right a -> return a Left err -> throwE $ WalletError err let inToOut :: [Lovelace] -> [Lovelace] - inToOut = FundSet.inputsToOutputsWithFee fee numOutputs + inToOut = FundSet.inputsToOutputsWithFee (auxFee shape) (auxOutputs shape) - txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (mkFee fee) metadata (KeyWitness KeyWitnessForSpending) + txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (mkFee (auxFee shape)) metadata (KeyWitness KeyWitnessForSpending) toUTxO :: FundSet.Target -> FundSet.SeqNumber -> ToUTxO era toUTxO target seqNumber = Wallet.mkUTxO networkId fundKey (InFlight target seqNumber) @@ -300,7 +286,7 @@ runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) txCount tps er fundToStore = mkWalletFundStore walletRefDst walletScript :: FundSet.Target -> WalletScript era - walletScript = benchmarkWalletScript walletRefSrc txGenerator txCount (const fundSource) inToOut toUTxO fundToStore + walletScript = benchmarkWalletScript walletRefSrc txGenerator (NumberOfTxs $ auxTxCount shape) (const fundSource) inToOut toUTxO fundToStore case submitMode of NodeToNode targetNodes -> do @@ -308,7 +294,7 @@ runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) txCount tps er let coreCall :: AsType era -> ExceptT TxGenError IO AsyncBenchmarkControl coreCall eraProxy = GeneratorTx.walletBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) connectClient - threadName targetNodes tps LogErrors eraProxy txCount walletScript + threadName targetNodes tps LogErrors eraProxy (NumberOfTxs $ auxTxCount shape) walletScript ret <- liftIO $ runExceptT $ coreCall era case ret of Left err -> liftTxGenError err @@ -323,16 +309,13 @@ runPlutusBenchmark :: forall era. IsShelleyBasedEra era -> ScriptData -> ScriptRedeemer -> ThreadName - -> NumberOfTxs + -> RunBenchmarkAux -> TPSRate -> AsType era -> ActionM () -runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData scriptRedeemer (ThreadName threadName) txCount tps era = do +runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData scriptRedeemer (ThreadName threadName) extraArgs tps era = do tracers <- get BenchTracers - (NumberOfInputsPerTx numInputs) <- getUser TNumberOfInputsPerTx - (NumberOfOutputsPerTx numOutputs) <- getUser TNumberOfOutputsPerTx networkId <- getUser TNetworkId - minValuePerUTxO <- getUser TMinValuePerUTxO protocolParameters <- getProtocolParameters executionUnitPrices <- case protocolParamPrices protocolParameters of Just x -> return x @@ -350,7 +333,6 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc Right c -> return c Left err -> throwE $ WalletError err baseFee <- getUser TFee - _minValuePerUTxO <- getUser TMinValuePerUTxO -- TODO:Fix metadata <- makeMetadata let costsPreRun = preExecuteScript protocolParameters script scriptData scriptRedeemer @@ -384,27 +366,25 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc p = executionUnitPrices times w c = fromIntegral w % 1 * c - totalFee = baseFee + fromIntegral numInputs * scriptFee - (Quantity minValue) = lovelaceToQuantity $ fromIntegral numOutputs * minValuePerUTxO + totalFee + totalFee = baseFee + fromIntegral (auxInputsPerTx extraArgs) * scriptFee + (Quantity minValue) = lovelaceToQuantity $ fromIntegral (auxOutputsPerTx extraArgs) * auxMinValuePerUTxO extraArgs + totalFee -- this is not totally correct: -- beware of rounding errors ! minValuePerInput = quantityToLovelace $ fromIntegral (if m==0 then d else d+1) where - (d, m) = minValue `divMod` fromIntegral numInputs - --- fundSource :: FundSet.Target -> FundSet.FundSource --- fundSource target = mkWalletFundSource walletRef $ FundSet.selectInputs ConfirmedBeforeReuse numInputs minTxValue PlainOldFund target + (d, m) = minValue `divMod` fromIntegral (auxInputsPerTx extraArgs) fundSource <- liftIO (mkBufferedSource walletRefSrc - (fromIntegral (unNumberOfTxs txCount) * numInputs) + (auxInputs extraArgs) minValuePerInput - (PlutusScriptFund scriptFile scriptData) numInputs) >>= \case + (PlutusScriptFund scriptFile scriptData) + (auxInputsPerTx extraArgs)) >>= \case Right a -> return a Left err -> throwE $ WalletError err let inToOut :: [Lovelace] -> [Lovelace] - inToOut = FundSet.inputsToOutputsWithFee totalFee numOutputs + inToOut = FundSet.inputsToOutputsWithFee totalFee (auxOutputsPerTx extraArgs) -- inToOut = FundSet.inputsToOutputsWithFee totalFee 1 PlutusScript PlutusScriptV1 script' = script @@ -431,13 +411,13 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc toUTxO target seqNumber = Wallet.mkUTxO networkId fundKey (InFlight target seqNumber) walletScript :: FundSet.Target -> WalletScript era - walletScript = benchmarkWalletScript walletRefSrc txGenerator txCount (const fundSource) inToOut toUTxO fundToStore + walletScript = benchmarkWalletScript walletRefSrc txGenerator (NumberOfTxs $ auxTxCount extraArgs) (const fundSource) inToOut toUTxO fundToStore case submitMode of NodeToNode targetNodes -> do connectClient <- getConnectClient ret <- liftIO $ runExceptT $ GeneratorTx.walletBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) connectClient - threadName targetNodes tps LogErrors era txCount walletScript + threadName targetNodes tps LogErrors era (NumberOfTxs $ auxTxCount extraArgs) walletScript case ret of Left err -> liftTxGenError err Right ctl -> setName (ThreadName threadName) ctl @@ -606,19 +586,20 @@ spendAutoScript :: forall era. IsShelleyBasedEra era -> SubmitMode -> FilePath -> ThreadName - -> NumberOfTxs + -> RunBenchmarkAux -> TPSRate -> AsType era -> ActionM () -spendAutoScript sourceWallet submitMode loopScriptFile threadName txCount tps era = do +spendAutoScript sourceWallet submitMode loopScriptFile threadName extraArgs tps era = do protocolParameters <- getProtocolParameters perTxBudget <- case protocolParamMaxTxExUnits protocolParameters of Nothing -> throwE $ ApiError "Cannot determine protocolParamMaxTxExUnits" Just b -> return b traceDebug $ "Plutus auto mode : Available budget per TX: " ++ show perTxBudget - numInputs <- fromIntegral <$> getUser TNumberOfInputsPerTx - let budget = ExecutionUnits + let + numInputs = fromIntegral $ auxInputsPerTx extraArgs + budget = ExecutionUnits (executionSteps perTxBudget `div` numInputs) (executionMemory perTxBudget `div` numInputs) traceDebug $ "Plutus auto mode : Available budget per script run: " ++ show budget @@ -633,7 +614,7 @@ spendAutoScript sourceWallet submitMode loopScriptFile threadName txCount tps er redeemer <- case startSearch isInLimits 0 searchUpperBound of Left err -> throwE $ ApiError $ "cannot find fitting redeemer :" ++ err Right n -> return $ toLoopArgument n - runPlutusBenchmark sourceWallet submitMode loopScriptFile PreExecuteScript (ScriptDataNumber 0) redeemer threadName txCount tps era + runPlutusBenchmark sourceWallet submitMode loopScriptFile PreExecuteScript (ScriptDataNumber 0) redeemer threadName extraArgs tps era where -- This is the hardcoded calling convention of the loop.plutus script. -- To loop n times one has to pass n + 1_000_000 as redeemer. diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index bb0f8f024c3..3d0cb67bc8b 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -43,11 +43,8 @@ printJSON = BSL.putStrLn $ prettyPrint $ testScript "/dev/zero" DiscardTX testScript :: FilePath -> SubmitMode -> [Action] testScript protocolFile submitMode = [ SetProtocolParameters (UseLocalProtocolFile protocolFile) - , Set (TNumberOfInputsPerTx ==> 2) - , Set (TNumberOfOutputsPerTx ==> 2) , Set (TTxAdditionalSize ==> 39) , Set (TFee ==> Lovelace 212345) - , Set (TMinValuePerUTxO ==> Lovelace 1000000) , Set (TTTL ==> SlotNo 1000000) , Set (TNetworkId ==> Testnet (NetworkMagic {unNetworkMagic = 42})) , InitWallet wallet @@ -64,7 +61,7 @@ testScript protocolFile submitMode = , RunBenchmark era wallet submitMode SpendOutput - (ThreadName "walletBasedBenchmark") 4000 (TPSRate 10.0) + (ThreadName "walletBasedBenchmark") extraArgs (TPSRate 10.0) ] where era = AnyCardanoEra AllegraEra @@ -73,3 +70,12 @@ testScript protocolFile submitMode = addr = PayToAddr key createChange val count = CreateChange era wallet wallet submitMode addr (Lovelace val) count + extraArgs = RunBenchmarkAux { + auxTxCount = 4000 + , auxFee = 1000000 + , auxOutputsPerTx = 2 + , auxInputsPerTx = 2 + , auxInputs = 8000 + , auxOutputs = 8000 + , auxMinValuePerUTxO = 10500000 + } diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs index 8ebb63a0e3e..bbcc41e2437 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs @@ -24,11 +24,7 @@ import Cardano.Benchmarking.Types -- Some boiler plate; ToDo may generate this. data Tag v where - TNumberOfInputsPerTx :: Tag NumberOfInputsPerTx - TNumberOfOutputsPerTx :: Tag NumberOfOutputsPerTx - TNumberOfTxs :: Tag NumberOfTxs TFee :: Tag Lovelace - TMinValuePerUTxO :: Tag Lovelace TTTL :: Tag SlotNo TTxAdditionalSize :: Tag TxAdditionalSize TLocalSocket :: Tag String @@ -43,11 +39,7 @@ deriving instance Show (Tag v) deriving instance Eq (Tag v) data Sum where - SNumberOfInputsPerTx :: !NumberOfInputsPerTx -> Sum - SNumberOfOutputsPerTx :: !NumberOfOutputsPerTx -> Sum - SNumberOfTxs :: !NumberOfTxs -> Sum SFee :: !Lovelace -> Sum - SMinValuePerUTxO :: !Lovelace -> Sum STTL :: !SlotNo -> Sum STxAdditionalSize :: !TxAdditionalSize -> Sum SLocalSocket :: !String -> Sum @@ -56,11 +48,7 @@ data Sum where taggedToSum :: Applicative f => DSum Tag f -> f Sum taggedToSum x = case x of - (TNumberOfInputsPerTx :=> v) -> SNumberOfInputsPerTx <$> v - (TNumberOfOutputsPerTx :=> v) -> SNumberOfOutputsPerTx <$> v - (TNumberOfTxs :=> v) -> SNumberOfTxs <$> v (TFee :=> v) -> SFee <$> v - (TMinValuePerUTxO :=> v) -> SMinValuePerUTxO <$> v (TTTL :=> v) -> STTL <$> v (TTxAdditionalSize :=> v) -> STxAdditionalSize <$> v (TLocalSocket :=> v) -> SLocalSocket <$> v @@ -68,11 +56,7 @@ taggedToSum x = case x of sumToTagged :: Applicative f => Sum -> DSum Tag f sumToTagged x = case x of - SNumberOfInputsPerTx v -> TNumberOfInputsPerTx ==> v - SNumberOfOutputsPerTx v -> TNumberOfOutputsPerTx ==> v - SNumberOfTxs v -> TNumberOfTxs ==> v SFee v -> TFee ==> v - SMinValuePerUTxO v -> TMinValuePerUTxO ==> v STTL v -> TTTL ==> v STxAdditionalSize v -> TTxAdditionalSize ==> v SLocalSocket v -> TLocalSocket ==> v diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 5457a887615..725a7ba319a 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -22,7 +22,7 @@ import Cardano.Api (AnyCardanoEra, ExecutionUnits, Lovelace, ScriptDat import Cardano.Benchmarking.Script.Env import Cardano.Benchmarking.Script.Store -import Cardano.Benchmarking.Types (TPSRate, NumberOfTxs, NodeIPv4Address) +import Cardano.Benchmarking.Types (TPSRate, NodeIPv4Address) data Action where Set :: !SetKeyVal -> Action @@ -35,7 +35,7 @@ data Action where AddFund :: !AnyCardanoEra -> !WalletName -> !TxIn -> !Lovelace -> !KeyName -> Action ImportGenesisFund :: !AnyCardanoEra -> !WalletName -> !SubmitMode -> !KeyName -> !KeyName -> Action CreateChange :: !AnyCardanoEra -> !WalletName -> !WalletName -> !SubmitMode -> !PayMode -> !Lovelace -> !Int -> Action - RunBenchmark :: !AnyCardanoEra -> !WalletName -> !SubmitMode -> !SpendMode -> !ThreadName -> !NumberOfTxs -> !TPSRate -> Action + RunBenchmark :: !AnyCardanoEra -> !WalletName -> !SubmitMode -> !SpendMode -> !ThreadName -> !RunBenchmarkAux -> !TPSRate -> Action WaitBenchmark :: !ThreadName -> Action CancelBenchmark :: !ThreadName -> Action Reserved :: [String] -> Action @@ -78,3 +78,15 @@ data ScriptBudget where CheckScriptBudget :: !ExecutionUnits -> ScriptBudget deriving (Show, Eq) deriving instance Generic ScriptBudget + +data RunBenchmarkAux = RunBenchmarkAux { + auxTxCount :: Int + , auxFee :: Lovelace + , auxOutputsPerTx :: Int + , auxInputsPerTx :: Int + , auxInputs :: Int + , auxOutputs ::Int + , auxMinValuePerUTxO :: Lovelace + } + deriving (Show, Eq) +deriving instance Generic RunBenchmarkAux