Merge #4467

4467: tx-generator: Fix self-test. r=MarcFontaine a=MarcFontaine This fixes the benchmarking self-test and criterion benchmark. 'cabal run tx-generator:benchmark:tx-generator-bench' now works. Co-authored-by: MarcFontaine <MarcFontaine@users.noreply.github.com>
IntersectMBO · Sep 22, 2022 · 420c4eb · 420c4eb
2 parents 002e0ca + 95b4a71
commit 420c4eb
Show file tree

Hide file tree

Showing 5 changed files with 55 additions and 32 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
     ]
   ]
+