Merge #4231

4231: tx-generator cleanups r=MarcFontaine a=MarcFontaine

* Merge `createChangeInEra` with `createScriptChange`.
* Make `mkUTxOScript` polymorphic on the era.
* Merge `runBenchmarkInEra` with `runPlutusBenchmark`.
  `runBenchmark` can now create transactions that contain any mix of normal and plutus inputs.
* Change `ToUTxO era = [Lovelace] -> ([TxOut CtxTx era], TxId -> [Fund])` to
  `ToUTxO era = Lovelace -> (TxOut CtxTx era, TxIx -> TxId -> Fund)`
  (Deal with every output of a TX individually. This makes it possible to create TXs with a mix of regular and Plutus outputs). 

Co-authored-by: MarcFontaine <[email protected]>

Author: iohk-bors[bot]

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

@@ -49,8 +49,8 @@ compileToScript = do
   genesisWallet <- newWallet "genesis_wallet"
   importGenesisFunds genesisWallet
   splitWallet <- splittingPhase genesisWallet
-  addCollaterals genesisWallet splitWallet
-  benchmarkingPhase splitWallet
+  collateralWallet <- addCollaterals genesisWallet
+  benchmarkingPhase splitWallet collateralWallet
 
 initConstants :: Compiler ()
 initConstants = do
@@ -72,16 +72,18 @@ importGenesisFunds wallet = do
   emit $ ImportGenesisFund era wallet LocalSocket (KeyName "pass-partout") (KeyName "pass-partout")
   delay
 
-addCollaterals :: SrcWallet -> DstWallet -> Compiler ()
-addCollaterals src dest = do
+addCollaterals :: SrcWallet -> Compiler (Maybe WalletName)
+addCollaterals src = do
   era <- askNixOption _nix_era
   isAnyPlutusMode >>= \case
-    False -> return ()
-    True -> do
+    False -> return Nothing
+    True -> do      
       tx_fee <- askNixOption _nix_tx_fee
       safeCollateral <- _safeCollateral <$> evilFeeMagic
+      collateralWallet <- newWallet "collaeral_wallet"
       emit $ CreateChange era src src LocalSocket (PayToAddr $ KeyName "pass-partout") (safeCollateral + tx_fee) 1
-      emit $ CreateChange era src dest LocalSocket (PayToCollateral $ KeyName "pass-partout") safeCollateral 1
+      emit $ CreateChange era src collateralWallet LocalSocket (PayToCollateral $ KeyName "pass-partout") safeCollateral 1
+      return $ Just collateralWallet
 
 splittingPhase :: SrcWallet -> Compiler DstWallet
 splittingPhase srcWallet = do
@@ -104,10 +106,17 @@ splittingPhase srcWallet = do
   createChangePlutus :: AnyCardanoEra -> SplitStep -> Compiler DstWallet
   createChangePlutus era (src, dst, value, count) = do
      autoMode <- isPlutusAutoMode
-     plutusTarget <- if autoMode
-       then PayToScript <$> askNixOption _nix_plutusLoopScript <*> pure (ScriptDataNumber 0)
-       else PayToScript <$> askNixOption _nix_plutusScript     <*> (ScriptDataNumber <$> askNixOption _nix_plutusData)
-     emit $ CreateChange era src dst LocalSocket plutusTarget value count
+     scriptSpec <- if autoMode
+       then ScriptSpec <$> askNixOption _nix_plutusLoopScript <*> pure AutoScript
+       else do
+         executionUnits <- ExecutionUnits <$> askNixOption _nix_executionMemory <*> askNixOption _nix_executionSteps
+         debugMode <- askNixOption _nix_debugMode
+         budget <- (if debugMode then CheckScriptBudget else StaticScriptBudget)
+                     <$> (ScriptDataNumber <$> askNixOption _nix_plutusData)
+                     <*> (ScriptDataNumber <$> askNixOption _nix_plutusRedeemer)
+                     <*> pure executionUnits
+         ScriptSpec <$> askNixOption _nix_plutusScript <*> pure budget
+     emit $ CreateChange era src dst LocalSocket (PayToScript scriptSpec) value count
      delay
      return dst
 
@@ -138,29 +147,15 @@ unfoldSplitSequence fee value count
     -- todo: this must be in sync with Scipt/Core.hs
     maxOutputs = 30
 
-benchmarkingPhase :: WalletName -> Compiler ()
-benchmarkingPhase wallet = do
+benchmarkingPhase :: WalletName -> Maybe WalletName -> Compiler ()
+benchmarkingPhase wallet collateralWallet = do
   debugMode <- askNixOption _nix_debugMode
-  plutusMode <- askNixOption _nix_plutusMode
-  plutusAutoMode <- askNixOption _nix_plutusAutoMode
   targetNodes <- askNixOption _nix_targetNodes
   extraArgs <- evilValueMagic
   tps <- askNixOption _nix_tps
   era <- askNixOption _nix_era
   let target = if debugMode then LocalSocket else NodeToNode targetNodes
-  spendMode <- case (plutusAutoMode, plutusMode) of
-    ( True,    _ ) -> SpendAutoScript <$> askNixOption  _nix_plutusLoopScript
-    (False, True ) -> do
-      executionUnits <- ExecutionUnits <$> askNixOption _nix_executionMemory <*> askNixOption _nix_executionSteps
-      scriptBudget <- if debugMode
-        then return $ CheckScriptBudget executionUnits
-        else return $ StaticScriptBudget executionUnits
-      SpendScript <$> askNixOption _nix_plutusScript
-                  <*> pure scriptBudget
-                  <*> (ScriptDataNumber <$> askNixOption _nix_plutusData)
-                  <*> (ScriptDataNumber <$> askNixOption _nix_plutusRedeemer)
-    (False,False) ->  return SpendOutput
-  emit $ RunBenchmark era wallet target spendMode (ThreadName "tx-submit-benchmark") extraArgs tps
+  emit $ RunBenchmark era wallet target (ThreadName "tx-submit-benchmark") extraArgs collateralWallet tps
   unless debugMode $ do
     emit $ WaitBenchmark $ ThreadName "tx-submit-benchmark"
 

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

@@ -5,6 +5,8 @@
 {-# Language GeneralizedNewtypeDeriving #-}
 {-# Language MultiParamTypeClasses #-}
 {-# Language RankNTypes #-}
+{-# Language TypeApplications #-}
+{-# Language ScopedTypeVariables #-}
 
 module Cardano.Benchmarking.FundSet
 where
@@ -21,6 +23,7 @@ import           Cardano.Api as Api
 
 data FundInEra era = FundInEra {
     _fundTxIn :: !TxIn
+  , _fundWitness :: Witness WitCtxTxIn era
   , _fundVal  :: !(TxOutValue era)
   , _fundSigningKey :: !(Maybe (SigningKey PaymentKey))
   , _fundVariant :: !Variant
@@ -30,7 +33,7 @@ data FundInEra era = FundInEra {
 data Variant
   = PlainOldFund
   -- maybe better use the script itself instead of the filePath
-  | PlutusScriptFund !FilePath !ScriptData
+  | PlutusScriptFund
   -- A collateralFund is just a regular (PlainOldFund) on the chain,
   -- but tagged in the wallet so that it is not selected for spending.
   | CollateralFund
@@ -66,6 +69,22 @@ getFundLovelace (Fund (InAnyCardanoEra _ a)) = case _fundVal a of
   TxOutAdaOnly _era l -> l
   TxOutValue _era v -> selectLovelace v
 
+
+-- This effectively rules out era-transitions for transactions !
+-- This is not what we want !!
+getFundWitness :: forall era. IsShelleyBasedEra era => Fund -> Witness WitCtxTxIn era
+getFundWitness fund = case (cardanoEra @ era, fund) of
+  (ByronEra   , Fund (InAnyCardanoEra ByronEra   a)) -> _fundWitness a
+  (ShelleyEra , Fund (InAnyCardanoEra ShelleyEra a)) -> _fundWitness a
+  (AllegraEra , Fund (InAnyCardanoEra AllegraEra a)) -> _fundWitness a
+  (MaryEra    , Fund (InAnyCardanoEra MaryEra    a)) -> _fundWitness a
+  (AlonzoEra  , Fund (InAnyCardanoEra AlonzoEra  a)) -> _fundWitness a
+  (BabbageEra , Fund (InAnyCardanoEra BabbageEra a)) -> _fundWitness a
+-- This effectively rules out era-transitions for transactions !
+-- This is not what we want !!
+-- It should be possible to cast KeyWitnesses from one era to an other !
+  (_ , _) -> error "getFundWitness: era mismatch"
+
 data IsConfirmed = IsConfirmed | IsNotConfirmed
   deriving  (Show, Eq, Ord)
 
@@ -227,7 +246,7 @@ selectInputs allowRecycle count minTotalValue variant targetNode fs
 selectToBuffer ::
      Int
   -> Lovelace
-  -> Variant
+  -> Maybe Variant
   -> FundSet
   -> Either String [Fund]
 selectToBuffer count minValue variant fs
@@ -239,8 +258,9 @@ selectToBuffer count minValue variant fs
       ]
     else Right coins
  where
-  coins = take count $ toAscList ( Proxy :: Proxy Lovelace) (fs @=variant @= IsConfirmed @>= minValue)
-
+  coins = case variant of
+    Just v -> take count $ toAscList ( Proxy :: Proxy Lovelace) (fs @=v @= IsConfirmed @>= minValue)
+    Nothing -> take count $ toAscList ( Proxy :: Proxy Lovelace) (fs @= IsConfirmed @>= minValue)
 -- Todo: check sufficient funds and minimumValuePerUtxo
 inputsToOutputsWithFee :: Lovelace -> Int -> [Lovelace] -> [Lovelace]
 inputsToOutputsWithFee fee count inputs = map (quantityToLovelace . Quantity) outputs

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

@@ -16,7 +16,7 @@ mkBufferedSource ::
      WalletRef
   -> Int
   -> Lovelace
-  -> Variant
+  -> Maybe Variant
   -> Int
   -> IO (Either String FundSource)
 mkBufferedSource walletRef count minValue variant munch

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

@@ -12,47 +12,13 @@ import qualified Data.ByteString.Char8 as BSC
 import           Cardano.CLI.Shelley.Script (readFileScriptInAnyLang)
 
 import           Cardano.Api
-import           Cardano.Api.Shelley ( ProtocolParameters(..), PlutusScript(..), ReferenceScript(..)
+import           Cardano.Api.Shelley ( ProtocolParameters(..), PlutusScript(..)
                                      , fromAlonzoExUnits, protocolParamCostModels, toPlutusData)
 import           Cardano.Ledger.Alonzo.TxInfo (exBudgetToExUnits)
-import           Cardano.Benchmarking.FundSet
-import           Cardano.Benchmarking.Wallet
 
 import qualified Plutus.V1.Ledger.Api as Plutus
 import           Plutus.V1.Ledger.Contexts (ScriptContext(..), ScriptPurpose(..), TxInfo(..), TxOutRef(..))
 
-mkUtxoScript ::
-     NetworkId
-  -> (FilePath, Script PlutusScriptV1, ScriptData)
-  -> Validity
-  -> ToUTxO AlonzoEra
-mkUtxoScript networkId (scriptFile, script, txOutDatum) validity values
-  = ( map mkTxOut values
-    , newFunds
-    )
- where
-  mkTxOut v = TxOut
-                 plutusScriptAddr
-                 (lovelaceToTxOutValue v)
-                 (TxOutDatumHash ScriptDataInAlonzoEra $ hashScriptData txOutDatum)
-                 ReferenceScriptNone   
-                    
-  plutusScriptAddr = makeShelleyAddressInEra
-                       networkId
-                       (PaymentCredentialByScript $ hashScript script)
-                       NoStakeAddress
-
-  newFunds txId = zipWith (mkNewFund txId) [TxIx 0 ..] values
-
-  mkNewFund :: TxId -> TxIx -> Lovelace -> Fund
-  mkNewFund txId txIx val = Fund $ InAnyCardanoEra AlonzoEra $ FundInEra {
-      _fundTxIn = TxIn txId txIx
-    , _fundVal = lovelaceToTxOutValue val
-    , _fundSigningKey = Nothing
-    , _fundValidity = validity
-    , _fundVariant = PlutusScriptFund scriptFile txOutDatum
-    }
-
 readScript :: FilePath -> IO (Script PlutusScriptV1)
 readScript fp = do
   res <- runExceptT $ readFileScriptInAnyLang fp

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

@@ -22,7 +22,8 @@ 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 auxArgs tps -> runBenchmark era sourceWallet submitMode spendMode thread auxArgs tps
+  RunBenchmark era sourceWallet submitMode thread auxArgs collateralWallet tps
+    -> runBenchmark era sourceWallet submitMode thread auxArgs collateralWallet tps
   WaitBenchmark thread -> waitBenchmark thread
   CancelBenchmark thread -> cancelBenchmark thread
   WaitForEra era -> waitForEra era

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

@@ -73,16 +73,16 @@ instance ToJSON PayMode where
 instance FromJSON PayMode where
   parseJSON = genericParseJSON jsonOptionsUnTaggedSum
 
-instance ToJSON SpendMode where
+instance ToJSON ScriptBudget where
   toJSON     = genericToJSON jsonOptionsUnTaggedSum
   toEncoding = genericToEncoding jsonOptionsUnTaggedSum
-instance FromJSON SpendMode where
+instance FromJSON ScriptBudget where
   parseJSON = genericParseJSON jsonOptionsUnTaggedSum
 
-instance ToJSON ScriptBudget where
+instance ToJSON ScriptSpec where
   toJSON     = genericToJSON jsonOptionsUnTaggedSum
   toEncoding = genericToEncoding jsonOptionsUnTaggedSum
-instance FromJSON ScriptBudget where
+instance FromJSON ScriptSpec where
   parseJSON = genericParseJSON jsonOptionsUnTaggedSum
 
 instance ToJSON (DSum Tag Identity) where