Skip to content

tx-generator: Fix self-test. #4467

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Sep 22, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
49 changes: 32 additions & 17 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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

Expand All @@ -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
Expand All @@ -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
13 changes: 12 additions & 1 deletion bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,9 @@

module Cardano.Benchmarking.Tracer
( initDefaultTracers
) where
, initNullTracers
)
where

import "contra-tracer" Control.Tracer (Tracer (..))
import GHC.Generics
Expand Down Expand Up @@ -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
Expand Down
14 changes: 2 additions & 12 deletions bench/tx-generator/src/Cardano/TxGenerator/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,6 @@ module Cardano.TxGenerator.Types
where

import Cardano.Api
import Cardano.Prelude (Text)

import Cardano.TxGenerator.Fund (Fund)

Expand Down Expand Up @@ -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

{-
Expand Down
7 changes: 6 additions & 1 deletion bench/tx-generator/test/Bench.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Trustworthy #-}
module Main (main) where

Expand All @@ -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
]
]