tx-generator: remove mutable state

bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs

@@ -54,11 +54,7 @@ compileToScript = do
 
 initConstants :: Compiler ()
 initConstants = do
-  setN TNumberOfInputsPerTx  _nix_inputs_per_tx
-  setN TNumberOfOutputsPerTx _nix_outputs_per_tx
-  setN TNumberOfTxs          _nix_tx_count
   setN TTxAdditionalSize     _nix_add_tx_size
-  setN TMinValuePerUTxO      _nix_min_utxo_value
   setN TFee                  _nix_tx_fee
   setN TLocalSocket          _nix_localNodeSocketPath
   setConst  TTTL             1000000
@@ -148,7 +144,7 @@ benchmarkingPhase wallet = do
   plutusMode <- askNixOption _nix_plutusMode
   plutusAutoMode <- askNixOption _nix_plutusAutoMode
   targetNodes <- askNixOption _nix_targetNodes
-  tx_count <- askNixOption _nix_tx_count
+  extraArgs <- evilValueMagic
   tps <- askNixOption _nix_tps
   era <- askNixOption _nix_era
   let target = if debugMode then LocalSocket else NodeToNode targetNodes
@@ -164,7 +160,7 @@ benchmarkingPhase wallet = do
                   <*> (ScriptDataNumber <$> askNixOption _nix_plutusData)
                   <*> (ScriptDataNumber <$> askNixOption _nix_plutusRedeemer)
     (False,False) ->  return SpendOutput
-  emit $ RunBenchmark era wallet target spendMode (ThreadName "tx-submit-benchmark") tx_count tps
+  emit $ RunBenchmark era wallet target spendMode (ThreadName "tx-submit-benchmark") extraArgs tps
   unless debugMode $ do
     emit $ WaitBenchmark $ ThreadName "tx-submit-benchmark"
 
@@ -227,3 +223,30 @@ 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
+    }
+

bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs

@@ -22,7 +22,7 @@ action a = case a of
   Delay t -> delay t
   ImportGenesisFund era wallet submitMode genesisKey fundKey -> importGenesisFund era wallet submitMode genesisKey fundKey
   CreateChange era sourceWallet dstWallet payMode submitMode value count -> createChange era sourceWallet dstWallet payMode submitMode value count
-  RunBenchmark era sourceWallet submitMode spendMode thread count tps -> runBenchmark era sourceWallet submitMode spendMode thread count tps
+  RunBenchmark era sourceWallet submitMode spendMode thread auxArgs tps -> runBenchmark era sourceWallet submitMode spendMode thread auxArgs tps
   WaitBenchmark thread -> waitBenchmark thread
   CancelBenchmark thread -> cancelBenchmark thread
   WaitForEra era -> waitForEra era

bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs

@@ -102,6 +102,12 @@ 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

@@ -50,9 +50,8 @@ import           Cardano.Benchmarking.PlutusExample as PlutusExample
 
 import           Cardano.Benchmarking.LogTypes as Core (TraceBenchTxSubmit (..), btConnect_, btN2N_,
                    btSubmission2_, btTxSubmit_)
-import           Cardano.Benchmarking.Types as Core (NumberOfInputsPerTx (..),
-                   NumberOfOutputsPerTx (..), NumberOfTxs (..), SubmissionErrorPolicy (..), TPSRate,
-                   TxAdditionalSize (..))
+import           Cardano.Benchmarking.Types as Core (NumberOfTxs (..), SubmissionErrorPolicy (..),
+                   TPSRate, TxAdditionalSize (..))
 import           Cardano.Benchmarking.Wallet as Wallet hiding (keyAddress)
 
 import           Cardano.Benchmarking.Script.Aeson (readProtocolParametersFile)
@@ -241,74 +240,61 @@ makeMetadata = do
     Right m -> return m
     Left err -> throwE $ MetadataError err
 
-runBenchmark :: AnyCardanoEra -> WalletName -> SubmitMode -> SpendMode -> ThreadName -> NumberOfTxs -> TPSRate -> ActionM ()
-runBenchmark era sourceWallet submitMode spendMode threadName txCount tps
+runBenchmark :: AnyCardanoEra -> WalletName -> SubmitMode -> SpendMode -> ThreadName -> RunBenchmarkAux -> TPSRate -> ActionM ()
+runBenchmark era sourceWallet submitMode spendMode threadName extraArgs tps
   = case spendMode of
-      SpendOutput -> withEra era $ runBenchmarkInEra sourceWallet submitMode threadName txCount tps
+      SpendOutput -> withEra era $ runBenchmarkInEra sourceWallet submitMode threadName extraArgs tps
       SpendScript scriptFile scriptBudget scriptData scriptRedeemer
-        -> withEra era $ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData scriptRedeemer threadName txCount tps
-      SpendAutoScript scriptFile -> withEra era $ spendAutoScript sourceWallet submitMode scriptFile threadName txCount tps
+        -> withEra era $ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData scriptRedeemer threadName extraArgs tps
+      SpendAutoScript scriptFile -> withEra era $ spendAutoScript sourceWallet submitMode scriptFile threadName extraArgs tps
 
 runBenchmarkInEra :: forall era. IsShelleyBasedEra era
   => WalletName
   -> SubmitMode
   -> ThreadName
-  -> NumberOfTxs
+  -> RunBenchmarkAux
   -> TPSRate
   -> AsType era
   -> ActionM ()
-runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) txCount tps era = do
+runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) shape tps era = do
   tracers  <- get BenchTracers
   networkId <- getUser TNetworkId
   fundKey <- getName $ KeyName "pass-partout" -- should be walletkey
-  (NumberOfInputsPerTx   numInputs) <- getUser TNumberOfInputsPerTx
-  (NumberOfOutputsPerTx numOutputs) <- getUser TNumberOfOutputsPerTx
-  fee <- getUser TFee
-  minValuePerUTxO <- getUser TMinValuePerUTxO
   protocolParameters <- getProtocolParameters
   walletRefSrc <- getName sourceWallet
   let walletRefDst = walletRefSrc
   metadata <- makeMetadata
-  let
-    (Quantity minValue) = lovelaceToQuantity $ fromIntegral numOutputs * 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 numInputs
-
---    fundSource :: FundSet.Target -> FundSet.FundSource
---    fundSource target = mkWalletFundSource walletRef $ FundSet.selectInputs ConfirmedBeforeReuse numInputs minTxValue PlainOldFund target
 
   fundSource <- liftIO (mkBufferedSource walletRefSrc
-                   (fromIntegral (unNumberOfTxs txCount) * numInputs)
-                   minValuePerInput
-                   PlainOldFund numInputs) >>= \case
+                   (auxInputs shape)
+                   (auxMinValuePerUTxO shape)
+                   PlainOldFund
+                   (auxInputsPerTx shape)
+                   ) >>= \case
     Right a  -> return a
     Left err -> throwE $ WalletError err
 
   let
     inToOut :: [Lovelace] -> [Lovelace]
-    inToOut = FundSet.inputsToOutputsWithFee fee numOutputs
+    inToOut = FundSet.inputsToOutputsWithFee (auxFee shape) (auxOutputs shape)
 
-    txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (mkFee fee) metadata (KeyWitness KeyWitnessForSpending)
+    txGenerator = genTx protocolParameters (TxInsCollateralNone, []) (mkFee (auxFee shape)) metadata (KeyWitness KeyWitnessForSpending)
 
     toUTxO :: FundSet.Target -> FundSet.SeqNumber -> ToUTxO era
     toUTxO target seqNumber = Wallet.mkUTxO networkId fundKey (InFlight target seqNumber)
 
     fundToStore = mkWalletFundStore walletRefDst
 
     walletScript :: FundSet.Target -> WalletScript era
-    walletScript = benchmarkWalletScript walletRefSrc txGenerator txCount (const fundSource) inToOut toUTxO fundToStore
+    walletScript = benchmarkWalletScript walletRefSrc txGenerator (NumberOfTxs $ auxTxCount shape) (const fundSource) inToOut toUTxO fundToStore
 
   case submitMode of
     NodeToNode targetNodes -> do
       connectClient <- getConnectClient
       let
         coreCall :: AsType era -> ExceptT TxGenError IO AsyncBenchmarkControl
         coreCall eraProxy = GeneratorTx.walletBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) connectClient
-                                               threadName targetNodes tps LogErrors eraProxy txCount walletScript
+                                               threadName targetNodes tps LogErrors eraProxy (NumberOfTxs $ auxTxCount shape) walletScript
       ret <- liftIO $ runExceptT $ coreCall era
       case ret of
         Left err -> liftTxGenError err
@@ -323,16 +309,13 @@ runPlutusBenchmark :: forall era. IsShelleyBasedEra era
   -> ScriptData
   -> ScriptRedeemer
   -> ThreadName
-  -> NumberOfTxs
+  -> RunBenchmarkAux
   -> TPSRate
   -> AsType era
   -> ActionM ()
-runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData scriptRedeemer (ThreadName threadName) txCount tps era = do
+runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData scriptRedeemer (ThreadName threadName) extraArgs tps era = do
   tracers  <- get BenchTracers
-  (NumberOfInputsPerTx   numInputs) <- getUser TNumberOfInputsPerTx
-  (NumberOfOutputsPerTx numOutputs) <- getUser TNumberOfOutputsPerTx
   networkId <- getUser TNetworkId
-  minValuePerUTxO <- getUser TMinValuePerUTxO
   protocolParameters <- getProtocolParameters
   executionUnitPrices <- case protocolParamPrices protocolParameters of
     Just x -> return x
@@ -350,7 +333,6 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc
     Right c -> return c
     Left err -> throwE $ WalletError err
   baseFee <- getUser TFee
-  _minValuePerUTxO <- getUser TMinValuePerUTxO -- TODO:Fix
   metadata <- makeMetadata
 
   let costsPreRun = preExecuteScript protocolParameters script scriptData scriptRedeemer
@@ -384,27 +366,25 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc
          p = executionUnitPrices
          times w c = fromIntegral w % 1 * c
 
-    totalFee = baseFee +  fromIntegral numInputs * scriptFee
-    (Quantity minValue) = lovelaceToQuantity $ fromIntegral numOutputs * minValuePerUTxO + totalFee
+    totalFee = baseFee +  fromIntegral (auxInputsPerTx extraArgs) * scriptFee
+    (Quantity minValue) = lovelaceToQuantity $ fromIntegral (auxOutputsPerTx extraArgs) * auxMinValuePerUTxO extraArgs + totalFee
   -- 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 numInputs
-
---    fundSource :: FundSet.Target -> FundSet.FundSource
---    fundSource target = mkWalletFundSource walletRef $ FundSet.selectInputs ConfirmedBeforeReuse numInputs minTxValue PlainOldFund target
+        (d, m) = minValue `divMod` fromIntegral (auxInputsPerTx extraArgs)
 
   fundSource <- liftIO (mkBufferedSource walletRefSrc
-                   (fromIntegral (unNumberOfTxs txCount) * numInputs)
+                   (auxInputs extraArgs)
                    minValuePerInput
-                   (PlutusScriptFund scriptFile scriptData) numInputs) >>= \case
+                   (PlutusScriptFund scriptFile scriptData)
+                   (auxInputsPerTx extraArgs)) >>= \case
     Right a  -> return a
     Left err -> throwE $ WalletError err
 
   let
     inToOut :: [Lovelace] -> [Lovelace]
-    inToOut = FundSet.inputsToOutputsWithFee totalFee numOutputs
+    inToOut = FundSet.inputsToOutputsWithFee totalFee (auxOutputsPerTx extraArgs)
 --    inToOut = FundSet.inputsToOutputsWithFee totalFee 1
 
     PlutusScript PlutusScriptV1 script' = script
@@ -431,13 +411,13 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc
     toUTxO target seqNumber = Wallet.mkUTxO networkId fundKey (InFlight target seqNumber)
 
     walletScript :: FundSet.Target -> WalletScript era
-    walletScript = benchmarkWalletScript walletRefSrc txGenerator txCount (const fundSource) inToOut toUTxO fundToStore
+    walletScript = benchmarkWalletScript walletRefSrc txGenerator (NumberOfTxs $ auxTxCount extraArgs) (const fundSource) inToOut toUTxO fundToStore
 
   case submitMode of
     NodeToNode targetNodes -> do
       connectClient <- getConnectClient
       ret <- liftIO $ runExceptT $ GeneratorTx.walletBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) connectClient
-                               threadName targetNodes tps LogErrors era txCount walletScript
+                               threadName targetNodes tps LogErrors era (NumberOfTxs $ auxTxCount extraArgs) walletScript
       case ret of
         Left err -> liftTxGenError err
         Right ctl -> setName (ThreadName threadName) ctl
@@ -606,19 +586,20 @@ spendAutoScript :: forall era. IsShelleyBasedEra era
   -> SubmitMode
   -> FilePath
   -> ThreadName
-  -> NumberOfTxs
+  -> RunBenchmarkAux
   -> TPSRate
   -> AsType era
   -> ActionM ()
-spendAutoScript sourceWallet submitMode loopScriptFile threadName txCount tps era = do
+spendAutoScript sourceWallet submitMode loopScriptFile threadName extraArgs tps era = do
   protocolParameters <- getProtocolParameters
   perTxBudget <- case protocolParamMaxTxExUnits protocolParameters of
     Nothing -> throwE $ ApiError "Cannot determine protocolParamMaxTxExUnits"
     Just b -> return b
   traceDebug $ "Plutus auto mode : Available budget per TX: " ++ show perTxBudget
 
-  numInputs <- fromIntegral <$> getUser TNumberOfInputsPerTx
-  let budget = ExecutionUnits
+  let
+    numInputs = fromIntegral $ auxInputsPerTx extraArgs
+    budget = ExecutionUnits
                  (executionSteps perTxBudget `div` numInputs)
                  (executionMemory perTxBudget `div` numInputs)
   traceDebug $ "Plutus auto mode : Available budget per script run: " ++ show budget
@@ -633,7 +614,7 @@ spendAutoScript sourceWallet submitMode loopScriptFile threadName txCount tps er
   redeemer <- case startSearch isInLimits 0 searchUpperBound of
     Left err -> throwE $ ApiError $ "cannot find fitting redeemer :" ++ err
     Right n -> return $ toLoopArgument n
-  runPlutusBenchmark sourceWallet submitMode loopScriptFile PreExecuteScript (ScriptDataNumber 0) redeemer threadName txCount tps era
+  runPlutusBenchmark sourceWallet submitMode loopScriptFile PreExecuteScript (ScriptDataNumber 0) redeemer threadName extraArgs tps era
   where
     -- This is the hardcoded calling convention of the loop.plutus script.
     -- To loop n times one has to pass n + 1_000_000 as redeemer.

bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs

@@ -43,11 +43,8 @@ printJSON = BSL.putStrLn $ prettyPrint $ testScript "/dev/zero" DiscardTX
 testScript :: FilePath -> SubmitMode -> [Action]
 testScript protocolFile submitMode =
   [ SetProtocolParameters (UseLocalProtocolFile protocolFile)
-  , Set (TNumberOfInputsPerTx ==>  2)
-  , Set (TNumberOfOutputsPerTx ==>  2)
   , Set (TTxAdditionalSize ==>  39)
   , Set (TFee ==>  Lovelace 212345)
-  , Set (TMinValuePerUTxO ==>  Lovelace 1000000)
   , Set (TTTL ==> SlotNo 1000000)
   , Set (TNetworkId ==> Testnet (NetworkMagic {unNetworkMagic = 42}))
   , InitWallet wallet
@@ -64,7 +61,7 @@ testScript protocolFile submitMode =
   , RunBenchmark era wallet
     submitMode
     SpendOutput
-    (ThreadName "walletBasedBenchmark") 4000 (TPSRate 10.0)
+    (ThreadName "walletBasedBenchmark") extraArgs (TPSRate 10.0)
   ]
   where
     era = AnyCardanoEra AllegraEra
@@ -73,3 +70,12 @@ testScript protocolFile submitMode =
     addr = PayToAddr key
     createChange val count
       = CreateChange era wallet wallet submitMode addr (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

@@ -24,11 +24,7 @@ import           Cardano.Benchmarking.Types
 
 -- Some boiler plate; ToDo may generate this.
 data Tag v where
-  TNumberOfInputsPerTx  :: Tag NumberOfInputsPerTx
-  TNumberOfOutputsPerTx :: Tag NumberOfOutputsPerTx
-  TNumberOfTxs          :: Tag NumberOfTxs
   TFee                  :: Tag Lovelace
-  TMinValuePerUTxO      :: Tag Lovelace
   TTTL                  :: Tag SlotNo
   TTxAdditionalSize     :: Tag TxAdditionalSize
   TLocalSocket          :: Tag String
@@ -43,11 +39,7 @@ deriving instance Show (Tag v)
 deriving instance Eq (Tag v)
 
 data Sum where
-  SNumberOfInputsPerTx  :: !NumberOfInputsPerTx  -> Sum
-  SNumberOfOutputsPerTx :: !NumberOfOutputsPerTx -> Sum
-  SNumberOfTxs          :: !NumberOfTxs          -> Sum
   SFee                  :: !Lovelace             -> Sum
-  SMinValuePerUTxO      :: !Lovelace             -> Sum
   STTL                  :: !SlotNo               -> Sum
   STxAdditionalSize     :: !TxAdditionalSize     -> Sum
   SLocalSocket          :: !String               -> Sum
@@ -56,23 +48,15 @@ data Sum where
 
 taggedToSum :: Applicative f => DSum Tag f -> f Sum
 taggedToSum x = case x of
-  (TNumberOfInputsPerTx  :=> v) -> SNumberOfInputsPerTx  <$> v
-  (TNumberOfOutputsPerTx :=> v) -> SNumberOfOutputsPerTx <$> v
-  (TNumberOfTxs          :=> v) -> SNumberOfTxs          <$> v
   (TFee                  :=> v) -> SFee                  <$> v
-  (TMinValuePerUTxO      :=> v) -> SMinValuePerUTxO      <$> 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
-  SNumberOfInputsPerTx  v -> TNumberOfInputsPerTx  ==> v
-  SNumberOfOutputsPerTx v -> TNumberOfOutputsPerTx ==> v
-  SNumberOfTxs          v -> TNumberOfTxs          ==> v
   SFee                  v -> TFee                  ==> v
-  SMinValuePerUTxO      v -> TMinValuePerUTxO      ==> v
   STTL                  v -> TTTL                  ==> v
   STxAdditionalSize     v -> TTxAdditionalSize     ==> v
   SLocalSocket          v -> TLocalSocket          ==> v