From b0edcc0071b94de7487afa76027512741a2531e7 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Wed, 14 Sep 2022 10:40:09 +0200 Subject: [PATCH 1/5] tx-generator: remove dispensable newtypes --- .../src/Cardano/Benchmarking/Compiler.hs | 17 ++-- .../src/Cardano/Benchmarking/GeneratorTx.hs | 9 +- .../Benchmarking/GeneratorTx/Submission.hs | 3 +- .../Cardano/Benchmarking/GeneratorTx/Tx.hs | 4 +- .../src/Cardano/Benchmarking/LogTypes.hs | 1 + .../src/Cardano/Benchmarking/NixOptions.hs | 13 +-- .../src/Cardano/Benchmarking/Script/Core.hs | 29 +++---- .../Cardano/Benchmarking/Script/Setters.hs | 2 +- .../src/Cardano/Benchmarking/Script/Types.hs | 21 ++--- .../src/Cardano/Benchmarking/TpsThrottle.hs | 12 +-- .../src/Cardano/Benchmarking/Types.hs | 84 +------------------ .../src/Cardano/TxGenerator/Types.hs | 29 ++++++- 12 files changed, 85 insertions(+), 139 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index 023d7110109..0052faae424 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -17,7 +17,6 @@ import Data.Text (Text) import qualified Data.Text as Text import Cardano.Api -import Cardano.Benchmarking.Types import Cardano.Benchmarking.NixOptions import Cardano.Benchmarking.Script.Setters import Cardano.Benchmarking.Script.Store (Name(..), WalletName) @@ -101,8 +100,8 @@ addCollaterals src = do splittingPhase :: SrcWallet -> Compiler DstWallet splittingPhase srcWallet = do - (NumberOfTxs tx_count) <- askNixOption _nix_tx_count - (NumberOfInputsPerTx inputs_per_tx) <- askNixOption _nix_inputs_per_tx + tx_count <- askNixOption _nix_tx_count + inputs_per_tx <- askNixOption _nix_inputs_per_tx tx_fee <- askNixOption _nix_tx_fee era <- askNixOption _nix_era minValuePerInput <- _minValuePerInput <$> evilFeeMagic @@ -177,7 +176,7 @@ benchmarkingPhaseNew wallet collateralWallet = do extraArgs <- evilValueMagic tps <- askNixOption _nix_tps era <- askNixOption _nix_era - (NumberOfTxs txCount) <- askNixOption _nix_tx_count + txCount <- askNixOption _nix_tx_count let submitMode = if debugMode then LocalSocket @@ -196,8 +195,8 @@ evilFeeMagic :: Compiler Fees evilFeeMagic = do (Quantity tx_fee) <- lovelaceToQuantity <$> askNixOption _nix_tx_fee plutusMode <- askNixOption _nix_plutusMode - (NumberOfInputsPerTx inputs_per_tx) <- askNixOption _nix_inputs_per_tx - (NumberOfOutputsPerTx outputs_per_tx) <- askNixOption _nix_outputs_per_tx + inputs_per_tx <- askNixOption _nix_inputs_per_tx + outputs_per_tx <- askNixOption _nix_outputs_per_tx (Quantity min_utxo_value) <- lovelaceToQuantity <$> askNixOption _nix_min_utxo_value let scriptFees = 5000000; @@ -253,9 +252,9 @@ newWallet n = do -- 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 + inputsPerTx <- askNixOption _nix_inputs_per_tx + outputsPerTx <- askNixOption _nix_outputs_per_tx + txCount <- askNixOption _nix_tx_count fee <- askNixOption _nix_tx_fee minValuePerUTxO <- askNixOption _nix_min_utxo_value let diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs index 97d842de5b2..b7bbf87d08f 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE PackageImports #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} @@ -10,7 +10,6 @@ module Cardano.Benchmarking.GeneratorTx ( AsyncBenchmarkControl - , TxGenError , walletBenchmark , readSigningKey , waitBenchmark @@ -34,14 +33,14 @@ import Cardano.Node.Configuration.NodeAddress import Cardano.Api hiding (txFee) -import Cardano.TxGenerator.Types (TxGenError(..)) import Cardano.Benchmarking.GeneratorTx.NodeToNode import Cardano.Benchmarking.GeneratorTx.Submission import Cardano.Benchmarking.GeneratorTx.SubmissionClient -import Cardano.Benchmarking.TpsThrottle import Cardano.Benchmarking.LogTypes +import Cardano.Benchmarking.TpsThrottle import Cardano.Benchmarking.Types import Cardano.Benchmarking.Wallet (TxStream) +import Cardano.TxGenerator.Types (NumberOfTxs, TPSRate, TxGenError (..)) readSigningKey :: SigningKeyFile -> ExceptT TxGenError IO (SigningKey PaymentKey) readSigningKey = @@ -138,7 +137,7 @@ walletBenchmark traceDebug $ "******* Tx generator, launching Tx peers: " ++ show (NE.length remoteAddresses) ++ " of them" startTime <- Clock.getCurrentTime - tpsThrottle <- newTpsThrottle 32 (unNumberOfTxs count) tpsRate + tpsThrottle <- newTpsThrottle 32 count tpsRate reportRefs <- STM.atomically $ replicateM (fromIntegral numTargets) STM.newEmptyTMVar diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs index b33414a243e..975adf27aa4 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs @@ -47,6 +47,7 @@ import Cardano.Tracing.OrphanInstances.Shelley () import Ouroboros.Network.Protocol.TxSubmission2.Type (TokBlockingStyle (..)) import Cardano.Api +import Cardano.TxGenerator.Types (TPSRate) import Cardano.Benchmarking.TpsThrottle import Cardano.Benchmarking.LogTypes @@ -112,7 +113,7 @@ mkSubmissionSummary ssThreadName startTime reportsRefs where txDiffTimeTPS :: Int -> NominalDiffTime -> TPSRate txDiffTimeTPS n delta = - TPSRate $ realToFrac $ fromIntegral n / delta + realToFrac $ fromIntegral n / delta threadReportTps :: SubmissionThreadReport -> TPSRate threadReportTps diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs index f5f7f066e05..e06c11c0c76 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs @@ -16,7 +16,7 @@ module Cardano.Benchmarking.GeneratorTx.Tx where import Prelude -import Cardano.Benchmarking.Types (TxAdditionalSize (..)) +import Cardano.TxGenerator.Types (TxAdditionalSize) import Cardano.Api @@ -37,7 +37,7 @@ mkGenesisTransaction :: forall era . -> [TxIn] -> [TxOut CtxTx era] -> Tx era -mkGenesisTransaction key _payloadSize ttl fee txins txouts +mkGenesisTransaction key _payloadSizesss ttl fee txins txouts = case makeTransactionBody txBodyContent of Right b -> signShelleyTransaction b [WitnessGenesisUTxOKey key] Left err -> error $ show err diff --git a/bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs b/bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs index 3ad1d5be65f..be35eb50d5c 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs @@ -52,6 +52,7 @@ import Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2) import Cardano.Benchmarking.Types import Cardano.Benchmarking.Version as Version +import Cardano.TxGenerator.Types (TPSRate) data BenchTracers = BenchTracers diff --git a/bench/tx-generator/src/Cardano/Benchmarking/NixOptions.hs b/bench/tx-generator/src/Cardano/Benchmarking/NixOptions.hs index 98f8dc3136d..226873518f0 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/NixOptions.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/NixOptions.hs @@ -3,17 +3,18 @@ module Cardano.Benchmarking.NixOptions where -import Prelude -import GHC.Generics -import GHC.Natural import Data.Aeson import Data.List.NonEmpty +import GHC.Generics +import GHC.Natural +import Prelude -import Cardano.CLI.Types (SigningKeyFile(..)) +import Cardano.CLI.Types (SigningKeyFile (..)) +import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address) import Cardano.Api (AnyCardanoEra, Lovelace) -import Cardano.Benchmarking.Types import Cardano.Benchmarking.Script.Aeson (parseJSONFile) +import Cardano.TxGenerator.Types parseNixServiceOptions :: FilePath -> IO NixServiceOptions parseNixServiceOptions = parseJSONFile fromJSON @@ -58,7 +59,7 @@ jsonOptions = defaultOptions { fieldLabelModifier = stripPrefix } stripPrefix :: String -> String stripPrefix ('_':'n':'i':'x':'_':baseName) = baseName stripPrefix bad = error $ "bad fieldname: " ++ bad - + instance ToJSON NixServiceOptions where toJSON = genericToJSON jsonOptions toEncoding = genericToEncoding jsonOptions diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index d47046c29d0..0447d1aa7d0 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -37,12 +37,14 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult import Cardano.TxGenerator.Fund as Fund import qualified Cardano.TxGenerator.FundQueue as FundQueue import Cardano.TxGenerator.Tx -import qualified Cardano.TxGenerator.Utils as Utils (includeChange, inputsToOutputsWithFee, liftAnyEra) +import Cardano.TxGenerator.Types import Cardano.TxGenerator.UTxO +import qualified Cardano.TxGenerator.Utils as Utils (includeChange, inputsToOutputsWithFee, + liftAnyEra) -import Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl, TxGenError) -import qualified Cardano.Benchmarking.GeneratorTx as GeneratorTx (readSigningKey, - waitBenchmark, walletBenchmark) +import Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl) +import qualified Cardano.Benchmarking.GeneratorTx as GeneratorTx (readSigningKey, waitBenchmark, + walletBenchmark) import qualified Cardano.Benchmarking.GeneratorTx.Genesis as Genesis import Cardano.Benchmarking.GeneratorTx.NodeToNode (ConnectClient, benchmarkConnectTxSubmit) @@ -55,8 +57,7 @@ import Cardano.Benchmarking.PlutusExample as PlutusExample import Cardano.Benchmarking.LogTypes as Core (TraceBenchTxSubmit (..), btConnect_, btN2N_, btSubmission2_, btTxSubmit_) -import Cardano.Benchmarking.Types as Core (NumberOfTxs (..), SubmissionErrorPolicy (..), - TPSRate, TxAdditionalSize (..)) +import Cardano.Benchmarking.Types as Core (SubmissionErrorPolicy (..)) import Cardano.Benchmarking.Wallet as Wallet import Cardano.Benchmarking.Script.Aeson (readProtocolParametersFile) @@ -221,7 +222,7 @@ localSubmitTx tx = do SubmitFail e -> do let msg = concat [ "local submit failed: " , show e , " (" , show tx , ")" ] traceDebug msg - return ret + return ret -- throwE $ ApiError msg -- TODO: @@ -232,7 +233,7 @@ localSubmitTx tx = do makeMetadata :: forall era. IsShelleyBasedEra era => ActionM (TxMetadataInEra era) makeMetadata = do payloadSize <- getUser TTxAdditionalSize - case mkMetadata $ unTxAdditionalSize payloadSize of + case mkMetadata payloadSize of Right m -> return m Left err -> throwE $ MetadataError err @@ -276,7 +277,7 @@ benchmarkTxStream txStream targetNodes (ThreadName threadName) tps shape era = d let coreCall :: AsType era -> ExceptT TxGenError IO AsyncBenchmarkControl coreCall eraProxy = GeneratorTx.walletBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) connectClient - threadName targetNodes tps LogErrors eraProxy (NumberOfTxs $ auxTxCount shape) txStream + threadName targetNodes tps LogErrors eraProxy (auxTxCount shape) txStream ret <- liftIO $ runExceptT $ coreCall era case ret of Left err -> liftTxGenError err @@ -284,7 +285,7 @@ benchmarkTxStream txStream targetNodes (ThreadName threadName) tps shape era = d evalGenerator :: forall era. IsShelleyBasedEra era => Generator -> AsType era -> ActionM (TxStream IO era) evalGenerator generator era = do - networkId <- getUser TNetworkId + networkId <- getUser TNetworkId protocolParameters <- getProtocolParameters case generator of SecureGenesis fee wallet genesisKeyName destKeyName -> do @@ -317,7 +318,7 @@ evalGenerator generator era = do SplitN fee walletName payMode count -> do wallet <- getName walletName (toUTxO, addressOut) <- interpretPayMode payMode - traceDebug $ "split output address : " ++ addressOut + traceDebug $ "split output address : " ++ addressOut let fundSource = walletSource wallet 1 inToOut = Utils.inputsToOutputsWithFee fee count @@ -341,7 +342,7 @@ evalGenerator generator era = do toUTxO :: [ ToUTxO era ] toUTxO = repeat $ mkUTxOVariant networkId fundKey -- TODO: make configurable - + fundToStore = mkWalletFundStoreList walletRefDst sourceToStore = sourceToStoreTransaction txGenerator fundSource inToOut (makeToUTxOList toUTxO) fundToStore @@ -370,7 +371,7 @@ selectCollateralFunds (Just walletName) = do case collateralSupportedInEra (cardanoEra @ era) of Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @ era) Just p -> return (TxInsCollateral p $ map getFundTxIn collateralFunds, collateralFunds) - + dumpToFile :: FilePath -> TxInMode CardanoMode -> ActionM () dumpToFile filePath tx = liftIO $ dumpToFileIO filePath tx @@ -390,7 +391,7 @@ interpretPayMode payMode = do return ( createAndStore (mkUTxOVariant networkId fundKey) (mkWalletFundStore walletRef) , Text.unpack $ serialiseAddress $ keyAddress @ era networkId fundKey) PayToScript scriptSpec destWallet -> do - walletRef <- getName destWallet + walletRef <- getName destWallet (witness, script, scriptData, _scriptFee) <- makePlutusContext scriptSpec return ( createAndStore (mkUTxOScript networkId (script, scriptData) witness) (mkWalletFundStore walletRef) , Text.unpack $ serialiseAddress $ makeShelleyAddress networkId (PaymentCredentialByScript $ hashScript script) NoStakeAddress ) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs index bbcc41e2437..58669b80631 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs @@ -20,7 +20,7 @@ import Data.GADT.Show.TH (deriveGShow) import Cardano.Api (SlotNo, Lovelace, NetworkId) -import Cardano.Benchmarking.Types +import Cardano.TxGenerator.Types (TxAdditionalSize) -- Some boiler plate; ToDo may generate this. data Tag v where diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 313900c7277..8d19db0079a 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -1,29 +1,30 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Cardano.Benchmarking.Script.Types where -import Prelude import GHC.Generics +import Prelude import Data.List.NonEmpty import Data.Text (Text) +import Cardano.Api (AnyCardanoEra, ExecutionUnits, Lovelace, ScriptData, ScriptRedeemer, + TextEnvelope, TxIn) import Cardano.Benchmarking.OuroborosImports (SigningKeyFile) -import Cardano.Api (AnyCardanoEra, ExecutionUnits, Lovelace, ScriptData, ScriptRedeemer, TextEnvelope, TxIn) - +import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address) import Cardano.Benchmarking.Script.Env import Cardano.Benchmarking.Script.Store -import Cardano.Benchmarking.Types (TPSRate, NodeIPv4Address) +import Cardano.TxGenerator.Types (TPSRate) data Action where Set :: !SetKeyVal -> Action @@ -46,10 +47,10 @@ deriving instance Generic Action data Generator where SecureGenesis :: !Lovelace -> !WalletName -> !KeyName -> !KeyName -> Generator -- 0 to N - Split :: !Lovelace -> !WalletName -> !PayMode -> !PayMode -> [ Lovelace ] -> Generator + Split :: !Lovelace -> !WalletName -> !PayMode -> !PayMode -> [ Lovelace ] -> Generator SplitN :: !Lovelace -> !WalletName -> !PayMode -> !Int -> Generator -- 1 to N BechmarkTx :: !WalletName -> !RunBenchmarkAux -> Maybe WalletName -> Generator -- N to M --- Generic NtoM :: +-- Generic NtoM :: Sequence :: [Generator] -> Generator Cycle :: !Generator -> Generator Take :: !Int -> !Generator -> Generator diff --git a/bench/tx-generator/src/Cardano/Benchmarking/TpsThrottle.hs b/bench/tx-generator/src/Cardano/Benchmarking/TpsThrottle.hs index b3c4cc3af6c..0dfb129d7e7 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/TpsThrottle.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/TpsThrottle.hs @@ -2,15 +2,15 @@ module Cardano.Benchmarking.TpsThrottle where -import Prelude import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.STM as STM import Control.Monad +import Prelude ---import Data.Time.Clock (NominalDiffTime, UTCTime) import qualified Data.Time.Clock as Clock import Cardano.Benchmarking.Types +import Cardano.TxGenerator.Types (TPSRate) data Step = Next | Stop deriving (Eq, Show) @@ -26,14 +26,14 @@ data TpsThrottle = TpsThrottle { -- empty -> Block submission -- Just 0 -> illegal state -- Just n -> allow n transmissions ( n must be >0 ) --- Nothing -> teminate transmission +-- Nothing -> teminate transmission newTpsThrottle :: Int -> Int -> TPSRate -> IO TpsThrottle newTpsThrottle buffersize count tpsRate = do var <- newEmptyTMVarIO return $ TpsThrottle { startSending = sendNTicks tpsRate buffersize count var - , sendStop = putTMVar var Nothing + , sendStop = putTMVar var Nothing , receiveBlocking = takeTMVar var >>= receiveAction var , receiveNonBlocking = (Just <$> (takeTMVar var >>= receiveAction var )) `orElse` return Nothing @@ -51,7 +51,7 @@ receiveAction var state = case state of return Next sendNTicks :: TPSRate -> Int -> Int -> TMVar (Maybe Int) -> IO () -sendNTicks (TPSRate rate) buffersize count var = do +sendNTicks rate buffersize count var = do now <- Clock.getCurrentTime worker count now 0 where @@ -117,7 +117,7 @@ test = do consumer2 t n = do r <- atomically $ receiveNonBlocking t case r of - Just s -> do + Just s -> do print (n, s) if s == Next then consumer2 t n else putStrLn $ "Done " ++ show n Nothing -> do diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Types.hs index e68c8a76e28..6f00e2eb53e 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Types.hs @@ -2,92 +2,14 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-all-missed-specialisations #-} -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} module Cardano.Benchmarking.Types - ( Ack(..) - , NodeIPv4Address - , NumberOfInputsPerTx(..) - , NumberOfOutputsPerTx(..) - , NumberOfTxs(..) - , Req(..) - , Sent(..) - , SubmissionErrorPolicy(..) - , ToAnnce(..) - , TxAdditionalSize(..) - , TPSRate(..) - , UnAcked(..) - , Unav(..) + ( module Cardano.Benchmarking.Types ) where +import GHC.Generics (Generic) +import Data.Aeson (ToJSON) -import Prelude -import GHC.Generics -import Data.Aeson - -import Cardano.Node.Configuration.NodeAddress - -myJsonOptions :: Options -myJsonOptions = defaultOptions { - unwrapUnaryRecords = True - } - -newtype NumberOfInputsPerTx = - NumberOfInputsPerTx Int - deriving newtype (Eq, Ord, Enum, Real, Num, Integral, Show) -deriving stock instance Generic NumberOfInputsPerTx -instance ToJSON NumberOfInputsPerTx where - toJSON = genericToJSON myJsonOptions - toEncoding = genericToEncoding myJsonOptions - -instance FromJSON NumberOfInputsPerTx where parseJSON = genericParseJSON myJsonOptions - -newtype NumberOfOutputsPerTx = - NumberOfOutputsPerTx Int - deriving newtype (Eq, Ord, Num, Show) -deriving stock instance Generic NumberOfOutputsPerTx -instance ToJSON NumberOfOutputsPerTx where - toJSON = genericToJSON myJsonOptions - toEncoding = genericToEncoding myJsonOptions -instance FromJSON NumberOfOutputsPerTx where parseJSON = genericParseJSON myJsonOptions - -newtype NumberOfTxs = - NumberOfTxs { unNumberOfTxs :: Int } - deriving newtype (Eq, Ord, Enum, Real, Num, Integral, Show) -deriving stock instance Generic NumberOfTxs -instance ToJSON NumberOfTxs where - toJSON = genericToJSON myJsonOptions - toEncoding = genericToEncoding myJsonOptions -instance FromJSON NumberOfTxs where parseJSON = genericParseJSON myJsonOptions - -newtype TPSRate= - TPSRate Double - deriving newtype (Eq, Ord, Num, Show) -deriving stock instance Generic TPSRate -instance ToJSON TPSRate where - toJSON = genericToJSON myJsonOptions - toEncoding = genericToEncoding myJsonOptions -instance FromJSON TPSRate where parseJSON = genericParseJSON myJsonOptions - --- | This parameter specifies additional size (in bytes) of transaction. --- Since 1 transaction is ([input] + [output] + attributes), its size --- is defined by its inputs and outputs. We want to have an ability to --- increase transaction's size without increasing the number of inputs/ --- outputs. Such a big transaction will give us more real-world results --- of benchmarking. --- Technically this parameter specifies the size of attribute we'll --- add to transaction (by default attributes are empty, so if this --- parameter is skipped, attributes will remain empty). -newtype TxAdditionalSize = - TxAdditionalSize { unTxAdditionalSize :: Int } - deriving newtype (Eq, Ord, Num, Show) -deriving stock instance Generic TxAdditionalSize -instance ToJSON TxAdditionalSize where - toJSON = genericToJSON myJsonOptions - toEncoding = genericToEncoding myJsonOptions -instance FromJSON TxAdditionalSize where parseJSON = genericParseJSON myJsonOptions -- | Transactions we decided to announce now. newtype ToAnnce tx = ToAnnce [tx] diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs index bb5d2851577..ad2aa7490cd 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs @@ -10,6 +10,13 @@ import Cardano.Prelude (Text) import Cardano.TxGenerator.Fund (Fund) +-- some type aliases to keep compatibility with code in Cardano.Benchmarking +type NumberOfInputsPerTx = Int +type NumberOfOutputsPerTx = Int +type NumberOfTxs = Int +type TxAdditionalSize = Int +type TPSRate = Double + type TxGenerator era = [Fund] -> [TxOut CtxTx era] -> Either String (Tx era, TxId) @@ -23,10 +30,10 @@ data PayWithChange data TxGenTxParams = TxGenTxParams - { txParamFee :: !Lovelace -- ^ Transaction fee, in Lovelace - , txParamAddTxSize :: !Int -- ^ Extra transaction payload, in bytes - , txParamInputs :: !Int -- ^ Inputs per transaction - , txParamOutputs :: !Int -- ^ Outputs per transaction + { txParamFee :: !Lovelace -- ^ Transaction fee, in Lovelace + , txParamAddTxSize :: !Int -- ^ Extra transaction payload, in bytes -- Note [Tx additional size] + , txParamInputs :: !NumberOfInputsPerTx -- ^ Inputs per transaction + , txParamOutputs :: !NumberOfOutputsPerTx -- ^ Outputs per transaction } deriving Show @@ -74,3 +81,17 @@ data TxGenError = -- number of transactions to send (first value). | BadPayloadSize !Text deriving Show + +{- +Note [Tx additional size] +~~~~~~~~~~~~~~~~~~~~~~~~~ +This parameter specifies the additional size (in bytes) of a transaction. +Since one transaction is ([input] + [output] + attributes), its size +is defined by its inputs and outputs. We want to have an ability to +increase a transaction's size without increasing the number of inputs or +outputs. Such a big transaction will give us more real-world results +of benchmarking. +Technically, this parameter specifies the size of the attribute we'll +add to the transaction (by default attributes are empty, so if this +parameter is skipped, attributes will remain empty). +-} From 91b5ea3bae409661a9c1868cc596dc39d2eaa46f Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Wed, 14 Sep 2022 17:15:33 +0200 Subject: [PATCH 2/5] tx-generator: factor out module Tx.hs --- .../Benchmarking/GeneratorTx/Genesis.hs | 43 ++++++++- .../Benchmarking/GeneratorTx/SizedMetadata.hs | 8 +- .../Cardano/Benchmarking/GeneratorTx/Tx.hs | 95 ------------------- .../src/Cardano/Benchmarking/Script/Core.hs | 16 ++-- .../src/Cardano/TxGenerator/Utils.hs | 28 +++++- bench/tx-generator/tx-generator.cabal | 1 - 6 files changed, 77 insertions(+), 114 deletions(-) delete mode 100644 bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Genesis.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Genesis.hs index ae12d54ed08..7d5b83d35b9 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Genesis.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Genesis.hs @@ -12,12 +12,12 @@ import qualified Data.ListMap as ListMap import Prelude (error, filter) import Cardano.Api -import Cardano.Api.Shelley (fromShelleyLovelace, fromShelleyPaymentCredential, - fromShelleyStakeReference, ReferenceScript(..)) +import Cardano.Api.Shelley (ReferenceScript (..), fromShelleyLovelace, + fromShelleyPaymentCredential, fromShelleyStakeReference) import Control.Arrow ((***)) -import Cardano.TxGenerator.FundQueue -import Cardano.Benchmarking.GeneratorTx.Tx +import Cardano.TxGenerator.Fund +import Cardano.TxGenerator.Utils import Cardano.Ledger.Shelley.API (Addr (..), ShelleyGenesis, sgInitialFunds) import Ouroboros.Consensus.Shelley.Eras (StandardShelley) @@ -58,7 +58,7 @@ genesisExpenditure :: -> (Tx era, Fund) genesisExpenditure networkId inputKey addr coin fee ttl outputKey = (tx, Fund $ InAnyCardanoEra cardanoEra fund) where - tx = mkGenesisTransaction (castKey inputKey) 0 ttl fee [ pseudoTxIn ] [ txout ] + tx = mkGenesisTransaction (castKey inputKey) ttl fee [ pseudoTxIn ] [ txout ] value = mkTxOutValueAdaOnly $ coin - fee txout = TxOut addr value TxOutDatumNone ReferenceScriptNone @@ -75,3 +75,36 @@ genesisExpenditure networkId inputKey addr coin fee ttl outputKey = (tx, Fund $ , _fundVal = value , _fundSigningKey = Just outputKey } + +mkGenesisTransaction :: forall era . + IsShelleyBasedEra era + => SigningKey GenesisUTxOKey + -> SlotNo + -> Lovelace + -> [TxIn] + -> [TxOut CtxTx era] + -> Tx era +mkGenesisTransaction key ttl fee txins txouts + = case makeTransactionBody txBodyContent of + Right b -> signShelleyTransaction b [WitnessGenesisUTxOKey key] + Left err -> error $ show err + where + txBodyContent = TxBodyContent { + txIns = zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending + , txInsCollateral = TxInsCollateralNone + , txInsReference = TxInsReferenceNone + , txOuts = txouts + , txFee = mkTxFee fee + , txValidityRange = (TxValidityNoLowerBound, mkTxValidityUpperBound ttl) + , txMetadata = TxMetadataNone + , txAuxScripts = TxAuxScriptsNone + , txExtraKeyWits = TxExtraKeyWitnessesNone + , txProtocolParams = BuildTxWith Nothing + , txWithdrawals = TxWithdrawalsNone + , txCertificates = TxCertificatesNone + , txUpdateProposal = TxUpdateProposalNone + , txMintValue = TxMintNone + , txScriptValidity = TxScriptValidityNone + , txReturnCollateral = TxReturnCollateralNone + , txTotalCollateral = TxTotalCollateralNone + } diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index 6b22316ba7d..94a98e04529 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -9,11 +9,13 @@ where import Prelude import Cardano.Api -import Cardano.Benchmarking.GeneratorTx.Tx import qualified Data.ByteString as BS import qualified Data.Map.Strict as Map import Data.Word (Word64) +import Cardano.TxGenerator.Utils + + maxMapSize :: Int maxMapSize = 1000 maxBSSize :: Int @@ -110,8 +112,8 @@ dummyTxSizeInEra metadata = case makeTransactionBody dummyTx of , txInsCollateral = TxInsCollateralNone , txInsReference = TxInsReferenceNone , txOuts = [] - , txFee = mkFee 0 - , txValidityRange = (TxValidityNoLowerBound, mkValidityUpperBound 0) + , txFee = mkTxFee 0 + , txValidityRange = (TxValidityNoLowerBound, mkTxValidityUpperBound 0) , txMetadata = metadata , txAuxScripts = TxAuxScriptsNone , txExtraKeyWits = TxExtraKeyWitnessesNone diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs deleted file mode 100644 index e06c11c0c76..00000000000 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs +++ /dev/null @@ -1,95 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -Wno-all-missed-specialisations #-} - -module Cardano.Benchmarking.GeneratorTx.Tx - ( keyAddress - , mkGenesisTransaction - , mkFee - , mkTxOutValueAdaOnly - , mkValidityUpperBound - , txOutValueToLovelace - , txInModeCardano - ) -where - -import Prelude -import Cardano.TxGenerator.Types (TxAdditionalSize) - -import Cardano.Api - -keyAddress :: forall era. IsShelleyBasedEra era => NetworkId -> SigningKey PaymentKey -> AddressInEra era -keyAddress networkId k - = makeShelleyAddressInEra - networkId - (PaymentCredentialByKey $ verificationKeyHash $ getVerificationKey k) - NoStakeAddress - ---{-# DEPRECATED mkGenesisTransaction "to be removed" #-} -mkGenesisTransaction :: forall era . - IsShelleyBasedEra era - => SigningKey GenesisUTxOKey - -> TxAdditionalSize - -> SlotNo - -> Lovelace - -> [TxIn] - -> [TxOut CtxTx era] - -> Tx era -mkGenesisTransaction key _payloadSizesss ttl fee txins txouts - = case makeTransactionBody txBodyContent of - Right b -> signShelleyTransaction b [WitnessGenesisUTxOKey key] - Left err -> error $ show err - where - txBodyContent = TxBodyContent { - txIns = zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending - , txInsCollateral = TxInsCollateralNone - , txInsReference = TxInsReferenceNone - , txOuts = txouts - , txFee = mkFee fee - , txValidityRange = (TxValidityNoLowerBound, validityUpperBound) - , txMetadata = TxMetadataNone - , txAuxScripts = TxAuxScriptsNone - , txExtraKeyWits = TxExtraKeyWitnessesNone - , txProtocolParams = BuildTxWith Nothing - , txWithdrawals = TxWithdrawalsNone - , txCertificates = TxCertificatesNone - , txUpdateProposal = TxUpdateProposalNone - , txMintValue = TxMintNone - , txScriptValidity = TxScriptValidityNone - , txReturnCollateral = TxReturnCollateralNone - , txTotalCollateral = TxTotalCollateralNone - } - validityUpperBound = case shelleyBasedEra @ era of - ShelleyBasedEraShelley -> TxValidityUpperBound ValidityUpperBoundInShelleyEra ttl - ShelleyBasedEraAllegra -> TxValidityUpperBound ValidityUpperBoundInAllegraEra ttl - ShelleyBasedEraMary -> TxValidityUpperBound ValidityUpperBoundInMaryEra ttl - ShelleyBasedEraAlonzo -> TxValidityUpperBound ValidityUpperBoundInAlonzoEra ttl - ShelleyBasedEraBabbage -> TxValidityUpperBound ValidityUpperBoundInBabbageEra ttl - -mkFee :: forall era . - IsShelleyBasedEra era - => Lovelace - -> TxFee era -mkFee f = case txFeesExplicitInEra (cardanoEra @ era) of - Right e -> TxFeeExplicit e f - Left b -> TxFeeImplicit b -- error "unreachable" - -mkValidityUpperBound :: forall era . - IsShelleyBasedEra era - => SlotNo - -> TxValidityUpperBound era -mkValidityUpperBound ttl = case validityUpperBoundSupportedInEra (cardanoEra @ era) of - Just p -> TxValidityUpperBound p ttl - Nothing -> error "unreachable" - -mkTxOutValueAdaOnly :: forall era . IsShelleyBasedEra era => Lovelace -> TxOutValue era -mkTxOutValueAdaOnly l = case multiAssetSupportedInEra (cardanoEra @ era) of - Right p -> TxOutValue p $ lovelaceToValue l - Left p -> TxOutAdaOnly p l - -txInModeCardano :: forall era . IsShelleyBasedEra era => Tx era -> TxInMode CardanoMode -txInModeCardano tx = case toEraInMode (cardanoEra @ era) CardanoMode of - Just t -> TxInMode tx t - Nothing -> error "txInModeCardano :unreachable" diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 0447d1aa7d0..78f9556f52d 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -39,8 +39,7 @@ import qualified Cardano.TxGenerator.FundQueue as FundQueue import Cardano.TxGenerator.Tx import Cardano.TxGenerator.Types import Cardano.TxGenerator.UTxO -import qualified Cardano.TxGenerator.Utils as Utils (includeChange, inputsToOutputsWithFee, - liftAnyEra) +import qualified Cardano.TxGenerator.Utils as Utils import Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl) import qualified Cardano.Benchmarking.GeneratorTx as GeneratorTx (readSigningKey, waitBenchmark, @@ -49,7 +48,6 @@ import qualified Cardano.Benchmarking.GeneratorTx.Genesis as Genesis import Cardano.Benchmarking.GeneratorTx.NodeToNode (ConnectClient, benchmarkConnectTxSubmit) import Cardano.Benchmarking.GeneratorTx.SizedMetadata (mkMetadata) -import Cardano.Benchmarking.GeneratorTx.Tx as Core (keyAddress, mkFee, txInModeCardano) import Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, SigningKeyFile, makeLocalConnectInfo, protocolToCodecConfig) @@ -246,7 +244,7 @@ submitInEra submitMode generator era = do case submitMode of NodeToNode _ -> error "NodeToNode deprecated: ToDo: remove" Benchmark nodes threadName tpsRate extra -> benchmarkTxStream txStream nodes threadName tpsRate extra era - LocalSocket -> submitAll (void . localSubmitTx . txInModeCardano) txStream + LocalSocket -> submitAll (void . localSubmitTx . Utils.mkTxInModeCardano) txStream DumpToFile filePath -> liftIO $ Streaming.writeFile filePath $ Streaming.map showTx txStream DiscardTX -> liftIO $ Streaming.effects txStream where @@ -295,7 +293,7 @@ evalGenerator generator era = do destWallet <- getName wallet genesisKey <- getName genesisKeyName let - outAddr = Core.keyAddress @ era networkId destKey + outAddr = Utils.keyAddress @ era networkId destKey (_inAddr, lovelace) = Genesis.genesisFundForKey @ era networkId genesis genesisKey (tx, fund) = Genesis.genesisExpenditure networkId genesisKey outAddr lovelace fee ttl destKey gen = do @@ -311,7 +309,7 @@ evalGenerator generator era = do let fundSource = walletSource wallet 1 inToOut = Utils.includeChange fee coins - txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (mkFee fee) TxMetadataNone + txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (Utils.mkTxFee fee) TxMetadataNone sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut $ mangleWithChange toUTxOChange toUTxO return $ Streaming.effect (Streaming.yield <$> sourceToStore) @@ -322,7 +320,7 @@ evalGenerator generator era = do let fundSource = walletSource wallet 1 inToOut = Utils.inputsToOutputsWithFee fee count - txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (mkFee fee) TxMetadataNone + txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (Utils.mkTxFee fee) TxMetadataNone sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut (mangle $ repeat toUTxO) return $ Streaming.effect (Streaming.yield <$> sourceToStore) @@ -338,7 +336,7 @@ evalGenerator generator era = do inToOut :: [Lovelace] -> [Lovelace] inToOut = Utils.inputsToOutputsWithFee (auxFee shape) (auxOutputsPerTx shape) - txGenerator = genTx protocolParameters collaterals (mkFee (auxFee shape)) metadata + txGenerator = genTx protocolParameters collaterals (Utils.mkTxFee (auxFee shape)) metadata toUTxO :: [ ToUTxO era ] toUTxO = repeat $ mkUTxOVariant networkId fundKey -- TODO: make configurable @@ -389,7 +387,7 @@ interpretPayMode payMode = do fundKey <- getName keyName walletRef <- getName destWallet return ( createAndStore (mkUTxOVariant networkId fundKey) (mkWalletFundStore walletRef) - , Text.unpack $ serialiseAddress $ keyAddress @ era networkId fundKey) + , Text.unpack $ serialiseAddress $ Utils.keyAddress @ era networkId fundKey) PayToScript scriptSpec destWallet -> do walletRef <- getName destWallet (witness, script, scriptData, _scriptFee) <- makePlutusContext scriptSpec diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs index 6bac467b0e8..dc23b913d6a 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs @@ -1,10 +1,14 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.TxGenerator.Utils (module Cardano.TxGenerator.Utils) where +import Data.Maybe (fromJust) + import Cardano.Api as Api import Cardano.TxGenerator.Types @@ -38,5 +42,27 @@ includeChange :: Lovelace -> [Lovelace] -> [Lovelace] -> PayWithChange includeChange fee spend have = case compare changeValue 0 of GT -> PayWithChange changeValue spend EQ -> PayExact spend - LT -> error "genTX: Bad transaction: insufficient funds" + LT -> error "includeChange: Bad transaction: insufficient funds" where changeValue = sum have - sum spend - fee + + +-- some convenience constructors +mkTxFee :: forall era. IsCardanoEra era => Lovelace -> TxFee era +mkTxFee f = either + TxFeeImplicit + (\e -> TxFeeExplicit e f) + (txFeesExplicitInEra (cardanoEra @ era)) + +mkTxValidityUpperBound :: forall era. IsShelleyBasedEra era => SlotNo -> TxValidityUpperBound era +mkTxValidityUpperBound = + TxValidityUpperBound (fromJust $ validityUpperBoundSupportedInEra (cardanoEra @ era)) + +mkTxOutValueAdaOnly :: forall era . IsShelleyBasedEra era => Lovelace -> TxOutValue era +mkTxOutValueAdaOnly l = either + (\p -> TxOutAdaOnly p l) + (\p -> TxOutValue p $ lovelaceToValue l) + (multiAssetSupportedInEra (cardanoEra @ era)) + +mkTxInModeCardano :: forall era . IsShelleyBasedEra era => Tx era -> TxInMode CardanoMode +mkTxInModeCardano tx = + TxInMode tx (fromJust $ toEraInMode (cardanoEra @ era) CardanoMode) diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 88dd7e63a47..5ec532b59a7 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -30,7 +30,6 @@ library Cardano.Benchmarking.GeneratorTx Cardano.Benchmarking.GeneratorTx.Genesis Cardano.Benchmarking.GeneratorTx.NodeToNode - Cardano.Benchmarking.GeneratorTx.Tx Cardano.Benchmarking.GeneratorTx.SizedMetadata Cardano.Benchmarking.GeneratorTx.Tx.Byron Cardano.Benchmarking.GeneratorTx.Submission From 7e45f66b93ec2d5b4b918aa3a7c8ef74dd5371a6 Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Mon, 19 Sep 2022 10:03:02 +0200 Subject: [PATCH 3/5] tx-generator: remove unused Byron.hs; linting --- .../Benchmarking/GeneratorTx/Tx/Byron.hs | 71 ------------------- .../src/Cardano/TxGenerator/Utils.hs | 4 +- bench/tx-generator/tx-generator.cabal | 1 - 3 files changed, 2 insertions(+), 74 deletions(-) delete mode 100644 bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx/Byron.hs diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx/Byron.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx/Byron.hs deleted file mode 100644 index 1b95e21146b..00000000000 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx/Byron.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -Wno-all-missed-specialisations -Wextra #-} - -module Cardano.Benchmarking.GeneratorTx.Tx.Byron - ( normalByronTxToGenTx - , byronGenesisUTxOTxIn - ) -where - -import Cardano.Prelude hiding (option, trace, (%)) -import Prelude (error) - -import qualified Data.Map.Strict as Map -import qualified Data.Text as T -import Formatting (sformat, (%)) - -import Cardano.Chain.Common (Address) -import qualified Cardano.Chain.Common as Common -import Cardano.Chain.Genesis as Genesis -import qualified Cardano.Chain.UTxO as UTxO -import qualified Cardano.Crypto.Signing as Crypto - -import Ouroboros.Consensus.Byron.Ledger (ByronBlock, GenTx (..)) -import qualified Ouroboros.Consensus.Byron.Ledger as Byron - --- | The 'GenTx' is all the kinds of transactions that can be submitted --- and \"normal\" Byron transactions are just one of the kinds. -normalByronTxToGenTx :: UTxO.ATxAux ByteString -> GenTx ByronBlock -normalByronTxToGenTx tx' = Byron.ByronTx (Byron.byronIdTx tx') tx' - --- | Given a genesis, and a pair of a genesis public key and address, --- reconstruct a TxIn corresponding to the genesis UTxO entry. -byronGenesisUTxOTxIn :: Genesis.Config -> Crypto.VerificationKey -> Common.Address -> UTxO.TxIn -byronGenesisUTxOTxIn gc vk genAddr = - handleMissingAddr $ fst <$> Map.lookup genAddr initialUtxo - where - initialUtxo :: Map Common.Address (UTxO.TxIn, UTxO.TxOut) - initialUtxo = - Map.fromList - . mapMaybe (\(inp, out) -> mkEntry inp genAddr <$> keyMatchesUTxO vk out) - . map (bimap UTxO.fromCompactTxIn UTxO.fromCompactTxOut) - . Map.toList - . UTxO.unUTxO - . UTxO.genesisUtxo - $ gc - - mkEntry :: UTxO.TxIn - -> Address - -> UTxO.TxOut - -> (Address, (UTxO.TxIn, UTxO.TxOut)) - mkEntry inp addr out = (addr, (inp, out)) - - keyMatchesUTxO :: Crypto.VerificationKey -> UTxO.TxOut -> Maybe UTxO.TxOut - keyMatchesUTxO key out = - if Common.checkVerKeyAddress key (UTxO.txOutAddress out) - then Just out else Nothing - - handleMissingAddr :: Maybe UTxO.TxIn -> UTxO.TxIn - handleMissingAddr = fromMaybe . error - $ "\nGenesis UTxO has no address\n" - <> T.unpack (prettyAddress genAddr) - <> "\n\nIt has the following, though:\n\n" - <> Cardano.Prelude.concat (T.unpack . prettyAddress <$> Map.keys initialUtxo) - - prettyAddress :: Common.Address -> Text - prettyAddress addr = sformat - (Common.addressF %"\n"%Common.addressDetailedF) - addr addr diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs index dc23b913d6a..c66e892a230 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs @@ -50,7 +50,7 @@ includeChange fee spend have = case compare changeValue 0 of mkTxFee :: forall era. IsCardanoEra era => Lovelace -> TxFee era mkTxFee f = either TxFeeImplicit - (\e -> TxFeeExplicit e f) + (`TxFeeExplicit` f) (txFeesExplicitInEra (cardanoEra @ era)) mkTxValidityUpperBound :: forall era. IsShelleyBasedEra era => SlotNo -> TxValidityUpperBound era @@ -59,7 +59,7 @@ mkTxValidityUpperBound = mkTxOutValueAdaOnly :: forall era . IsShelleyBasedEra era => Lovelace -> TxOutValue era mkTxOutValueAdaOnly l = either - (\p -> TxOutAdaOnly p l) + (`TxOutAdaOnly` l) (\p -> TxOutValue p $ lovelaceToValue l) (multiAssetSupportedInEra (cardanoEra @ era)) diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 5ec532b59a7..9906502107a 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -31,7 +31,6 @@ library Cardano.Benchmarking.GeneratorTx.Genesis Cardano.Benchmarking.GeneratorTx.NodeToNode Cardano.Benchmarking.GeneratorTx.SizedMetadata - Cardano.Benchmarking.GeneratorTx.Tx.Byron Cardano.Benchmarking.GeneratorTx.Submission Cardano.Benchmarking.GeneratorTx.SubmissionClient Cardano.Benchmarking.LogTypes From 50e47a28d2aa354e5f2eafe9c539146cde1b79ad Mon Sep 17 00:00:00 2001 From: MarcFontaine Date: Wed, 14 Sep 2022 13:19:16 +0200 Subject: [PATCH 4/5] tx-generator: WIP: fix multi-threaded use of tx-streams --- .../src/Cardano/Benchmarking/GeneratorTx.hs | 3 +- .../Benchmarking/GeneratorTx/Submission.hs | 59 ++++++++++++------- 2 files changed, 40 insertions(+), 22 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs index b7bbf87d08f..4ca178880ca 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs @@ -141,13 +141,14 @@ walletBenchmark reportRefs <- STM.atomically $ replicateM (fromIntegral numTargets) STM.newEmptyTMVar + txStreamRef <- newMVar $ StreamActive txSource allAsyncs <- forM (zip reportRefs $ NE.toList remoteAddresses) $ \(reportRef, remoteAddr) -> do let errorHandler = handleTxSubmissionClientError traceSubmit remoteAddr reportRef errorPolicy client = txSubmissionClient traceN2N traceSubmit - (txStreamSource txSource tpsThrottle) + (txStreamSource txStreamRef tpsThrottle) (submitSubmissionThreadStats reportRef) async $ handle errorHandler (connectClient remoteAddr client) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs index 975adf27aa4..653c65bce1b 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoMonomorphismRestriction #-} @@ -18,7 +19,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cardano.Benchmarking.GeneratorTx.Submission - ( SubmissionParams(..) + ( StreamState (..) + , SubmissionParams(..) , SubmissionThreadReport , TxSource , ReportRef @@ -121,29 +123,44 @@ mkSubmissionSummary ssThreadName startTime reportsRefs { strStats=SubmissionThreadStats{stsAcked=Ack ack}, strEndOfProtocol } = txDiffTimeTPS ack (Clock.diffUTCTime strEndOfProtocol startTime) -txStreamSource :: forall era. TxStream IO era -> TpsThrottle -> TxSource era -txStreamSource stream tpsThrottle = Active $ worker stream +txStreamSource :: forall era. MVar (StreamState (TxStream IO era)) -> TpsThrottle -> TxSource era +txStreamSource streamRef tpsThrottle = Active worker where - worker :: forall m blocking . MonadIO m => TxStream IO era -> TokBlockingStyle blocking -> Req -> m (TxSource era, [Tx era]) - worker s blocking req = do + worker :: forall m blocking . MonadIO m => TokBlockingStyle blocking -> Req -> m (TxSource era, [Tx era]) + worker blocking req = do (done, txCount) <- case blocking of TokBlocking -> liftIO $ consumeTxsBlocking tpsThrottle req TokNonBlocking -> liftIO $ consumeTxsNonBlocking tpsThrottle req - (txList, newScript) <- liftIO $ unFold s txCount + txList <- liftIO $ unFold txCount case done of Stop -> return (Exhausted, txList) - Next -> return (Active $ worker newScript, txList) - - unFold :: TxStream IO era -> Int -> IO ([Tx era], TxStream IO era) - unFold s 0 = return ([], s) - unFold s n = do - next <- Streaming.next s - case next of - -- Node2node clients buffer a number x of TXs internally (x is determined by the node.) - -- Therefore it is possible that the submission client requests TXs from an empty TxStream. - -- In other words, it is not an error to request more TXs than there are in the TxStream. - Left _ -> return ([], s) - Right (Right tx, t) -> do - (l, out) <- unFold t $ pred n - return (tx:l, out) - Right (Left err, _) -> error err + Next -> return (Active worker, txList) + + unFold :: Int -> IO [Tx era] + unFold 0 = return [] + unFold n = nextOnMVar streamRef >>= \case + -- Node2node clients buffer a number x of TXs internally (x is determined by the node.) + -- Therefore it is possible that the submission client requests TXs from an empty TxStream. + -- In other words, it is not an error to request more TXs than there are in the TxStream. + StreamEmpty -> return [] + StreamError err -> error err + StreamActive tx -> do + l <- unFold $ pred n + return $ tx:l + + nextOnMVar :: MVar (StreamState (TxStream IO era)) -> IO (StreamState (Tx era)) + nextOnMVar v = modifyMVar v $ \x -> case x of + StreamEmpty -> return (StreamEmpty, StreamEmpty) + StreamError err -> return (StreamError err, StreamError err) + StreamActive s -> update <$> Streaming.next s + where + update :: Either () (Either String (Tx era), TxStream IO era) -> (StreamState (TxStream IO era), StreamState (Tx era)) + update x = case x of + Left () -> (StreamEmpty, StreamEmpty) + Right (Right tx, t) -> (StreamActive t, StreamActive tx) + Right (Left err, _) -> (StreamError err, StreamError err) + +data StreamState x + = StreamEmpty + | StreamError String + | StreamActive x From 081864742944a4485256e8f8b5b019f2f2431b31 Mon Sep 17 00:00:00 2001 From: MarcFontaine Date: Thu, 15 Sep 2022 12:39:32 +0200 Subject: [PATCH 5/5] tx-generator: replace benchmarkTx with generic NtoM tx --- .../src/Cardano/Benchmarking/Compiler.hs | 45 ++++------------- .../Benchmarking/GeneratorTx/Submission.hs | 2 +- .../src/Cardano/Benchmarking/Script/Aeson.hs | 6 --- .../src/Cardano/Benchmarking/Script/Core.hs | 50 +++++++------------ .../Cardano/Benchmarking/Script/Selftest.hs | 15 +----- .../Cardano/Benchmarking/Script/Setters.hs | 12 +---- .../src/Cardano/Benchmarking/Script/Types.hs | 21 ++------ .../src/Cardano/TxGenerator/Types.hs | 4 +- 8 files changed, 39 insertions(+), 116 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index 0052faae424..7af1ee18eec 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -53,12 +53,10 @@ compileToScript = do genesisWallet <- importGenesisFunds collateralWallet <- addCollaterals genesisWallet splitWallet <- splittingPhase genesisWallet - benchmarkingPhaseNew splitWallet collateralWallet + benchmarkingPhase splitWallet collateralWallet initConstants :: Compiler () initConstants = do - setN TTxAdditionalSize _nix_add_tx_size - setN TFee _nix_tx_fee setN TLocalSocket _nix_localNodeSocketPath setConst TTTL 1000000 where @@ -169,19 +167,23 @@ unfoldSplitSequence fee value outputs (x, 0) -> x (x, _rest) -> x+1 -benchmarkingPhaseNew :: WalletName -> Maybe WalletName -> Compiler () -benchmarkingPhaseNew wallet collateralWallet = do +benchmarkingPhase :: WalletName -> Maybe WalletName -> Compiler () +benchmarkingPhase wallet collateralWallet = do debugMode <- askNixOption _nix_debugMode targetNodes <- askNixOption _nix_targetNodes - extraArgs <- evilValueMagic tps <- askNixOption _nix_tps era <- askNixOption _nix_era txCount <- askNixOption _nix_tx_count + fee <- askNixOption _nix_tx_fee + inputs <- askNixOption _nix_inputs_per_tx + outputs <- askNixOption _nix_outputs_per_tx + metadataSize <- askNixOption _nix_add_tx_size let + payMode = PayToAddr (KeyName "pass-partout") wallet --todo: used different wallet here ! submitMode = if debugMode then LocalSocket - else Benchmark targetNodes (ThreadName "tx-submit-benchmark") tps extraArgs - generator = Take txCount $ Cycle $ BechmarkTx wallet extraArgs collateralWallet + else Benchmark targetNodes (ThreadName "tx-submit-benchmark") tps txCount + generator = Take txCount $ Cycle $ NtoM fee wallet payMode inputs outputs (Just metadataSize) collateralWallet emit $ Submit era submitMode generator unless debugMode $ do emit $ WaitBenchmark $ ThreadName "tx-submit-benchmark" @@ -248,30 +250,3 @@ 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 - inputsPerTx <- askNixOption _nix_inputs_per_tx - outputsPerTx <- askNixOption _nix_outputs_per_tx - 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/GeneratorTx/Submission.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs index 653c65bce1b..e72ec177312 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Submission.hs @@ -149,7 +149,7 @@ txStreamSource streamRef tpsThrottle = Active worker return $ tx:l nextOnMVar :: MVar (StreamState (TxStream IO era)) -> IO (StreamState (Tx era)) - nextOnMVar v = modifyMVar v $ \x -> case x of + nextOnMVar v = modifyMVar v $ \case StreamEmpty -> return (StreamEmpty, StreamEmpty) StreamError err -> return (StreamError err, StreamError err) StreamActive s -> update <$> Streaming.next s diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs index 35340e42309..54dbf7f7fff 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs @@ -108,12 +108,6 @@ 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 78f9556f52d..aa069ec140c 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -228,12 +228,11 @@ localSubmitTx tx = do -- Problem 1: When doing throwE $ ApiError msg logmessages get lost ! -- Problem 2: Workbench restarts the tx-generator -> this may be the reason for loss of messages -makeMetadata :: forall era. IsShelleyBasedEra era => ActionM (TxMetadataInEra era) -makeMetadata = do - payloadSize <- getUser TTxAdditionalSize - case mkMetadata payloadSize of - Right m -> return m - Left err -> throwE $ MetadataError err +toMetadata :: forall era. IsShelleyBasedEra era => Maybe Int -> TxMetadataInEra era +toMetadata Nothing = TxMetadataNone +toMetadata (Just payloadSize) = case mkMetadata payloadSize of + Right m -> m + Left err -> error err submitAction :: AnyCardanoEra -> SubmitMode -> Generator -> ActionM () submitAction era submitMode generator = withEra era $ submitInEra submitMode generator @@ -243,7 +242,7 @@ submitInEra submitMode generator era = do txStream <- evalGenerator generator era case submitMode of NodeToNode _ -> error "NodeToNode deprecated: ToDo: remove" - Benchmark nodes threadName tpsRate extra -> benchmarkTxStream txStream nodes threadName tpsRate extra era + Benchmark nodes threadName tpsRate txCount -> benchmarkTxStream txStream nodes threadName tpsRate txCount era LocalSocket -> submitAll (void . localSubmitTx . Utils.mkTxInModeCardano) txStream DumpToFile filePath -> liftIO $ Streaming.writeFile filePath $ Streaming.map showTx txStream DiscardTX -> liftIO $ Streaming.effects txStream @@ -266,16 +265,16 @@ benchmarkTxStream :: forall era. IsShelleyBasedEra era -> TargetNodes -> ThreadName -> TPSRate - -> RunBenchmarkAux + -> NumberOfTxs -> AsType era -> ActionM () -benchmarkTxStream txStream targetNodes (ThreadName threadName) tps shape era = do +benchmarkTxStream txStream targetNodes (ThreadName threadName) tps txCount era = do tracers <- get BenchTracers connectClient <- getConnectClient let coreCall :: AsType era -> ExceptT TxGenError IO AsyncBenchmarkControl coreCall eraProxy = GeneratorTx.walletBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) connectClient - threadName targetNodes tps LogErrors eraProxy (auxTxCount shape) txStream + threadName targetNodes tps LogErrors eraProxy txCount txStream ret <- liftIO $ runExceptT $ coreCall era case ret of Left err -> liftTxGenError err @@ -312,11 +311,10 @@ evalGenerator generator era = do txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (Utils.mkTxFee fee) TxMetadataNone sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut $ mangleWithChange toUTxOChange toUTxO return $ Streaming.effect (Streaming.yield <$> sourceToStore) - SplitN fee walletName payMode count -> do wallet <- getName walletName (toUTxO, addressOut) <- interpretPayMode payMode - traceDebug $ "split output address : " ++ addressOut + traceDebug $ "SplitN output address : " ++ addressOut let fundSource = walletSource wallet 1 inToOut = Utils.inputsToOutputsWithFee fee count @@ -324,29 +322,17 @@ evalGenerator generator era = do sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut (mangle $ repeat toUTxO) return $ Streaming.effect (Streaming.yield <$> sourceToStore) - BechmarkTx sourceWallet shape collateralWallet -> do - fundKey <- getName $ KeyName "pass-partout" -- should be walletkey -- TODO: Remove magic - walletRefSrc <- getName sourceWallet + NtoM fee walletName payMode inputs outputs metadataSize collateralWallet -> do + wallet <- getName walletName collaterals <- selectCollateralFunds collateralWallet - metadata <- makeMetadata + (toUTxO, addressOut) <- interpretPayMode payMode + traceDebug $ "NtoM output address : " ++ addressOut let - walletRefDst = walletRefSrc - fundSource = walletSource walletRefSrc (auxInputsPerTx shape) - - inToOut :: [Lovelace] -> [Lovelace] - inToOut = Utils.inputsToOutputsWithFee (auxFee shape) (auxOutputsPerTx shape) - - txGenerator = genTx protocolParameters collaterals (Utils.mkTxFee (auxFee shape)) metadata - - toUTxO :: [ ToUTxO era ] - toUTxO = repeat $ mkUTxOVariant networkId fundKey -- TODO: make configurable - - fundToStore = mkWalletFundStoreList walletRefDst - - sourceToStore = sourceToStoreTransaction txGenerator fundSource inToOut (makeToUTxOList toUTxO) fundToStore - + fundSource = walletSource wallet inputs + inToOut = Utils.inputsToOutputsWithFee fee outputs + txGenerator = genTx protocolParameters collaterals (Utils.mkTxFee fee) (toMetadata metadataSize) + sourceToStore = sourceToStoreTransactionNew txGenerator fundSource inToOut (mangle $ repeat toUTxO) return $ Streaming.effect (Streaming.yield <$> sourceToStore) - Sequence l -> do gList <- forM l $ \g -> evalGenerator g era return $ Streaming.for (Streaming.each gList) id diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index 04bb4408beb..459d40f9ad8 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -40,10 +40,8 @@ printJSON :: IO () printJSON = BSL.putStrLn $ prettyPrint $ testScript "/dev/zero" DiscardTX testScript :: FilePath -> SubmitMode -> [Action] -testScript protocolFile submitMode = +testScript protocolFile _submitMode = [ SetProtocolParameters (UseLocalProtocolFile protocolFile) - , Set (TTxAdditionalSize ==> 39) - , Set (TFee ==> Lovelace 212345) , Set (TTTL ==> SlotNo 1000000) , Set (TNetworkId ==> Testnet (NetworkMagic {unNetworkMagic = 42})) , InitWallet wallet @@ -57,7 +55,7 @@ testScript protocolFile submitMode = , createChange 2200000000000 10 , createChange 70000000000 300 , createChange 2300000000 9000 - , Submit era submitMode $ Take 4000 $ Cycle $ BechmarkTx wallet extraArgs Nothing +-- , Submit era submitMode $ Take 4000 $ Cycle $ BechmarkTx wallet extraArgs Nothing ] where era = AnyCardanoEra AllegraEra @@ -67,12 +65,3 @@ testScript protocolFile submitMode = createChange :: Int -> Int -> Action createChange _val _count = LogMsg "TODO: Fix this " -- CreateChange era wallet submitMode payMode payMode (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 58669b80631..647ee5fb78a 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs @@ -18,15 +18,11 @@ import Data.Dependent.Sum (DSum(..) , (==>) ) import Data.GADT.Compare.TH (deriveGCompare, deriveGEq) import Data.GADT.Show.TH (deriveGShow) -import Cardano.Api (SlotNo, Lovelace, NetworkId) - -import Cardano.TxGenerator.Types (TxAdditionalSize) +import Cardano.Api (SlotNo, NetworkId) -- Some boiler plate; ToDo may generate this. data Tag v where - TFee :: Tag Lovelace TTTL :: Tag SlotNo - TTxAdditionalSize :: Tag TxAdditionalSize TLocalSocket :: Tag String TNetworkId :: Tag NetworkId @@ -39,25 +35,19 @@ deriving instance Show (Tag v) deriving instance Eq (Tag v) data Sum where - SFee :: !Lovelace -> Sum STTL :: !SlotNo -> Sum - STxAdditionalSize :: !TxAdditionalSize -> Sum SLocalSocket :: !String -> Sum SNetworkId :: !NetworkId -> Sum deriving (Eq, Show, Generic) taggedToSum :: Applicative f => DSum Tag f -> f Sum taggedToSum x = case x of - (TFee :=> v) -> SFee <$> v (TTTL :=> v) -> STTL <$> v - (TTxAdditionalSize :=> v) -> STxAdditionalSize <$> v (TLocalSocket :=> v) -> SLocalSocket <$> v (TNetworkId :=> v) -> SNetworkId <$> v sumToTagged :: Applicative f => Sum -> DSum Tag f sumToTagged x = case x of - SFee v -> TFee ==> v STTL v -> TTTL ==> v - STxAdditionalSize v -> TTxAdditionalSize ==> v SLocalSocket v -> TLocalSocket ==> v SNetworkId v -> TNetworkId ==> v diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 8d19db0079a..4a5caa770b4 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -22,9 +22,10 @@ import Cardano.Api (AnyCardanoEra, ExecutionUnits, Lovelace, ScriptDat import Cardano.Benchmarking.OuroborosImports (SigningKeyFile) import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address) +import Cardano.TxGenerator.Types (NumberOfInputsPerTx, NumberOfOutputsPerTx, NumberOfTxs, TPSRate) + import Cardano.Benchmarking.Script.Env import Cardano.Benchmarking.Script.Store -import Cardano.TxGenerator.Types (TPSRate) data Action where Set :: !SetKeyVal -> Action @@ -49,8 +50,8 @@ data Generator where SecureGenesis :: !Lovelace -> !WalletName -> !KeyName -> !KeyName -> Generator -- 0 to N Split :: !Lovelace -> !WalletName -> !PayMode -> !PayMode -> [ Lovelace ] -> Generator SplitN :: !Lovelace -> !WalletName -> !PayMode -> !Int -> Generator -- 1 to N - BechmarkTx :: !WalletName -> !RunBenchmarkAux -> Maybe WalletName -> Generator -- N to M --- Generic NtoM :: + NtoM :: !Lovelace -> !WalletName -> !PayMode -> !NumberOfInputsPerTx -> !NumberOfOutputsPerTx + -> !(Maybe Int) -> Maybe WalletName -> Generator Sequence :: [Generator] -> Generator Cycle :: !Generator -> Generator Take :: !Int -> !Generator -> Generator @@ -70,7 +71,7 @@ type TargetNodes = NonEmpty NodeIPv4Address data SubmitMode where LocalSocket :: SubmitMode - Benchmark :: !TargetNodes -> !ThreadName -> !TPSRate -> !RunBenchmarkAux -> SubmitMode + Benchmark :: !TargetNodes -> !ThreadName -> !TPSRate -> !NumberOfTxs -> SubmitMode DumpToFile :: !FilePath -> SubmitMode DiscardTX :: SubmitMode NodeToNode :: NonEmpty NodeIPv4Address -> SubmitMode --deprecated @@ -97,15 +98,3 @@ data ScriptSpec = ScriptSpec } deriving (Show, Eq) deriving instance Generic ScriptSpec - -data RunBenchmarkAux = RunBenchmarkAux { - auxTxCount :: Int - , auxFee :: Lovelace - , auxOutputsPerTx :: Int - , auxInputsPerTx :: Int - , auxInputs :: Int - , auxOutputs ::Int - , auxMinValuePerUTxO :: Lovelace - } - deriving (Show, Eq) -deriving instance Generic RunBenchmarkAux diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs index ad2aa7490cd..6b4e4d24e16 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs @@ -42,8 +42,8 @@ defaultTxGenTxParams :: TxGenTxParams defaultTxGenTxParams = TxGenTxParams { txParamFee = 10_000_000 , txParamAddTxSize = 100 - , txParamInputs = 4 - , txParamOutputs = 4 + , txParamInputs = 2 + , txParamOutputs = 2 }