tx-generator: replace benchmarkTx with generic NtoM tx

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
-    }
-

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

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

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,41 +311,28 @@ 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
         txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (Utils.mkTxFee fee) TxMetadataNone
         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

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
-      }

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

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

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
   }