From 95b4a71d56316850d9750dd0654f64ef39a28450 Mon Sep 17 00:00:00 2001 From: MarcFontaine Date: Thu, 22 Sep 2022 13:58:08 +0200 Subject: [PATCH] tx-generator: Fix selftest. 'cabal run tx-generator:benchmark:tx-generator-bench' now works. --- .../src/Cardano/Benchmarking/Script/Core.hs | 4 +- .../Cardano/Benchmarking/Script/Selftest.hs | 49 ++++++++++++------- .../src/Cardano/Benchmarking/Tracer.hs | 13 ++++- .../src/Cardano/TxGenerator/Types.hs | 14 +----- bench/tx-generator/test/Bench.hs | 7 ++- 5 files changed, 55 insertions(+), 32 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index aa069ec140c..32edd9563c0 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -245,8 +245,10 @@ submitInEra submitMode generator era = do 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 + DiscardTX -> liftIO $ Streaming.mapM_ forceTx txStream where + forceTx (Right _) = return () + forceTx (Left err) = error err showTx (Left err) = error err showTx (Right tx) = '\n' : show tx -- todo: use Streaming.run diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index 459d40f9ad8..c8dbb54ffa7 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -9,7 +9,6 @@ import Data.Dependent.Sum ((==>)) import Data.String import Control.Monad -import Control.Monad.IO.Class (liftIO) import Cardano.Api import Ouroboros.Network.NodeToClient (IOManager) @@ -20,7 +19,7 @@ import Cardano.Benchmarking.Script.Env as Script import Cardano.Benchmarking.Script.Setters import Cardano.Benchmarking.Script.Store import Cardano.Benchmarking.Script.Types -import Cardano.Benchmarking.Tracer (initDefaultTracers) +import Cardano.Benchmarking.Tracer (initNullTracers) import Paths_tx_generator @@ -30,7 +29,7 @@ runSelftest iom outFile = do let submitMode = maybe DiscardTX DumpToFile outFile fullScript = do - liftIO initDefaultTracers >>= set BenchTracers + set BenchTracers initNullTracers forM_ (testScript protocolFile submitMode) action runActionM fullScript iom >>= \case (Right a , _ , ()) -> return $ Right a @@ -40,28 +39,44 @@ printJSON :: IO () printJSON = BSL.putStrLn $ prettyPrint $ testScript "/dev/zero" DiscardTX testScript :: FilePath -> SubmitMode -> [Action] -testScript protocolFile _submitMode = +testScript protocolFile submitMode = [ SetProtocolParameters (UseLocalProtocolFile protocolFile) , Set (TTTL ==> SlotNo 1000000) , Set (TNetworkId ==> Testnet (NetworkMagic {unNetworkMagic = 42})) - , InitWallet wallet + , InitWallet genesisWallet + , InitWallet splitWallet1 + , InitWallet splitWallet2 + , InitWallet splitWallet3 + , InitWallet doneWallet , DefineSigningKey key (TextEnvelope { teType = TextEnvelopeType "GenesisUTxOSigningKey_ed25519" , teDescription = fromString "Genesis Initial UTxO Signing Key" - , teRawCBOR = "X \vl1~\182\201v(\152\250A\202\157h0\ETX\248h\153\171\SI/m\186\242D\228\NAK\182(&\162"}) - , AddFund era wallet + , teRawCBOR = "X \vl1~\182\201v(\152\250A\202\157h0\ETX\248h\153\171\SI/m\186\242D\228\NAK\182(&\162"}) + , AddFund era genesisWallet (TxIn "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162" (TxIx 0)) (Lovelace 90000000000000) key - , createChange 2200000000000 10 - , createChange 70000000000 300 - , createChange 2300000000 9000 --- , Submit era submitMode $ Take 4000 $ Cycle $ BechmarkTx wallet extraArgs Nothing + , createChange genesisWallet splitWallet1 1 10 + , createChange splitWallet1 splitWallet2 10 30 -- 10 TXs with 30 outputs -> in total 300 outputs + , createChange splitWallet2 splitWallet3 300 30 +{- + , createChange genesisWallet splitWallet3 1 10 + -- Fifo implementation should also work fine when sourceWallet==destWallet + , createChange splitWallet3 splitWallet3 10 30 + , createChange splitWallet3 splitWallet3 300 30 +-} + + , Submit era submitMode $ Take 4000 $ Cycle + $ NtoM fee splitWallet3 (PayToAddr key doneWallet) 2 2 Nothing Nothing ] - where + where era = AnyCardanoEra AllegraEra - wallet = WalletName "test-wallet" + fee = 1000000 + genesisWallet = WalletName "genesisWallet" + splitWallet1 = WalletName "SplitWallet-1" + splitWallet2 = WalletName "SplitWallet-2" + splitWallet3 = WalletName "SplitWallet-3" + doneWallet = WalletName "doneWallet" key = KeyName "pass-partout" --- payMode = PayToAddr key wallet - createChange :: Int -> Int -> Action - createChange _val _count - = LogMsg "TODO: Fix this " -- CreateChange era wallet submitMode payMode payMode (Lovelace val) count + createChange :: WalletName -> WalletName -> Int -> Int -> Action + createChange src dest txCount outputs + = Submit era submitMode $ Take txCount $ Cycle $ SplitN fee src (PayToAddr key dest) outputs diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index 77cb333e5f1..f3e6931f9a2 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -20,7 +20,9 @@ module Cardano.Benchmarking.Tracer ( initDefaultTracers - ) where + , initNullTracers + ) +where import "contra-tracer" Control.Tracer (Tracer (..)) import GHC.Generics @@ -49,6 +51,15 @@ generatorTracer namesFor tracerName tr = do $ appendName tracerName tr'' +initNullTracers :: BenchTracers +initNullTracers = BenchTracers + { btTxSubmit_ = Tracer ignore + , btConnect_ = Tracer ignore + , btSubmission2_ = Tracer ignore + , btN2N_ = Tracer ignore + } + where ignore _ = return () + initDefaultTracers :: IO BenchTracers initDefaultTracers = do st <- standardTracer diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs index 6b4e4d24e16..9113cc0c736 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs @@ -6,7 +6,6 @@ module Cardano.TxGenerator.Types where import Cardano.Api -import Cardano.Prelude (Text) import Cardano.TxGenerator.Fund (Fund) @@ -69,17 +68,8 @@ data TxGenPlutusParams = | PlutusOff -- ^ Do not generate Plutus Txs deriving Show - -data TxGenError = - InsufficientFundsForRecipientTx !Lovelace !Lovelace - -- ^ The calculated expenditure (second value) was not available as a single - -- UTxO entry. The first value is the largest single UTxO available. - | TxFileError !(FileError TextEnvelopeError) - | SplittingSubmissionError !Text - | SuppliedUtxoTooSmall !Int !Int - -- ^ The supplied UTxO size (second value) was less than the requested - -- number of transactions to send (first value). - | BadPayloadSize !Text +newtype TxGenError + = TxFileError (FileError TextEnvelopeError) deriving Show {- diff --git a/bench/tx-generator/test/Bench.hs b/bench/tx-generator/test/Bench.hs index 2ce7c8d8da8..c9d7c0c7ac1 100644 --- a/bench/tx-generator/test/Bench.hs +++ b/bench/tx-generator/test/Bench.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE Trustworthy #-} module Main (main) where @@ -8,6 +9,10 @@ import Cardano.Benchmarking.Script.Selftest main :: IO () main = defaultMain [ bgroup "cardano-tx-generator-integration" [ - bench "tx-gen" $ whnfIO $ runSelftest (error "noIOManager") Nothing + bench "tx-gen" $ whnfIO $ do + runSelftest (error "noIOManager") Nothing >>= \case + Right _ -> return () + Left err -> error $ show err ] ] +