diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index 023d7110109..1f15e2c8011 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -54,12 +54,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 @@ -170,19 +168,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 - (NumberOfTxs txCount) <- askNixOption _nix_tx_count + txCount <- askNixOption _nix_tx_count + fee <- askNixOption _nix_tx_fee + inputs <- askNixOption _nix_inputs_per_tx + outputs <- askNixOption _nix_outputs_per_tx + (TxAdditionalSize 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 (unNumberOfTxs 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" @@ -249,30 +251,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 - (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/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 d47046c29d0..9a376a72331 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -55,7 +55,8 @@ 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 (..), +import Cardano.Benchmarking.Types as Core ( + NumberOfInputsPerTx (..), NumberOfOutputsPerTx (..), NumberOfTxs (..), SubmissionErrorPolicy (..), TPSRate, TxAdditionalSize (..)) import Cardano.Benchmarking.Wallet as Wallet @@ -229,12 +230,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 $ unTxAdditionalSize 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 @@ -244,7 +244,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 . txInModeCardano) txStream DumpToFile filePath -> liftIO $ Streaming.writeFile filePath $ Streaming.map showTx txStream DiscardTX -> liftIO $ Streaming.effects txStream @@ -267,16 +267,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 (NumberOfTxs $ auxTxCount shape) txStream + threadName targetNodes tps LogErrors eraProxy txCount txStream ret <- liftIO $ runExceptT $ coreCall era case ret of Left err -> liftTxGenError err @@ -313,11 +313,10 @@ evalGenerator generator era = do txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (mkFee 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 @@ -325,29 +324,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 (NumberOfInputsPerTx inputs) (NumberOfOutputsPerTx 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 (mkFee (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 (mkFee 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..cb536dd6b23 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -42,8 +42,6 @@ printJSON = BSL.putStrLn $ prettyPrint $ testScript "/dev/zero" DiscardTX testScript :: FilePath -> SubmitMode -> [Action] 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 bbcc41e2437..7804db51bcb 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Setters.hs @@ -24,9 +24,7 @@ import Cardano.Benchmarking.Types -- 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 +37,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 313900c7277..a8b01657237 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -23,7 +23,7 @@ import Cardano.Api (AnyCardanoEra, ExecutionUnits, Lovelace, ScriptDat import Cardano.Benchmarking.Script.Env import Cardano.Benchmarking.Script.Store -import Cardano.Benchmarking.Types (TPSRate, NodeIPv4Address) +import Cardano.Benchmarking.Types (NumberOfInputsPerTx, NumberOfOutputsPerTx, NumberOfTxs, TPSRate, NodeIPv4Address) data Action where Set :: !SetKeyVal -> Action @@ -48,8 +48,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 :: + -- N to M + NtoM :: !Lovelace -> !WalletName -> !PayMode -> !NumberOfInputsPerTx -> !NumberOfOutputsPerTx -> !(Maybe Int) -> Maybe WalletName -> Generator Sequence :: [Generator] -> Generator Cycle :: !Generator -> Generator Take :: !Int -> !Generator -> Generator @@ -69,7 +69,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 @@ -96,15 +96,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 bb5d2851577..d2290747e70 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs @@ -35,8 +35,8 @@ defaultTxGenTxParams :: TxGenTxParams defaultTxGenTxParams = TxGenTxParams { txParamFee = 10_000_000 , txParamAddTxSize = 100 - , txParamInputs = 4 - , txParamOutputs = 4 + , txParamInputs = 2 + , txParamOutputs = 2 }