tx-generator cleanups

* Merge `createChangeInEra` with `createScriptChange`.
* Make `mkUTxOScript` polymorphic on the era.

Author: MarcFontaine

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 module Cardano.Benchmarking.PlutusExample
 where
 import           Prelude
@@ -21,31 +22,34 @@ import           Cardano.Benchmarking.Wallet
 import qualified Plutus.V1.Ledger.Api as Plutus
 import           Plutus.V1.Ledger.Contexts (ScriptContext(..), ScriptPurpose(..), TxInfo(..), TxOutRef(..))
 
-mkUtxoScript ::
-     NetworkId
+mkUTxOScript :: forall era.
+     (IsCardanoEra era, IsShelleyBasedEra era)
+  => NetworkId
   -> (FilePath, Script PlutusScriptV1, ScriptData)
   -> Validity
-  -> ToUTxO AlonzoEra
-mkUtxoScript networkId (scriptFile, script, txOutDatum) validity values
+  -> ToUTxO era
+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
 
+  mkTxOut v = case scriptDataSupportedInEra (cardanoEra @ era) of
+    Nothing -> error " mkUtxOScript scriptDataSupportedInEra==Nothing"
+    Just tag -> TxOut
+                  plutusScriptAddr
+                  (lovelaceToTxOutValue v)
+                  (TxOutDatumHash tag $ hashScriptData txOutDatum)
+                  ReferenceScriptNone   
+
   newFunds txId = zipWith (mkNewFund txId) [TxIx 0 ..] values
 
   mkNewFund :: TxId -> TxIx -> Lovelace -> Fund
-  mkNewFund txId txIx val = Fund $ InAnyCardanoEra AlonzoEra $ FundInEra {
+  mkNewFund txId txIx val = Fund $ InAnyCardanoEra (cardanoEra @ era) $ FundInEra {
       _fundTxIn = TxIn txId txIx
     , _fundVal = lovelaceToTxOutValue val
     , _fundSigningKey = Nothing

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

@@ -265,6 +265,7 @@ runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) shape tps era
   let walletRefDst = walletRefSrc
   metadata <- makeMetadata
 
+
   fundSource <- liftIO (mkBufferedSource walletRefSrc
                    (auxInputs shape)
                    (auxMinValuePerUTxO shape)
@@ -326,6 +327,7 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc
     walletRefDst = walletRefSrc
     walletRefCollateral = walletRefSrc
   fundKey <- getName $ KeyName "pass-partout"
+
   script <- liftIO $ PlutusExample.readScript scriptFile
   -- This does not remove the collateral from the wallet, i.e. same collateral is uses for everything.
   -- This is fine unless a script ever fails.
@@ -464,72 +466,44 @@ initWallet :: WalletName -> ActionM ()
 initWallet name = liftIO Wallet.initWallet >>= setName name
 
 createChange :: AnyCardanoEra -> WalletName -> WalletName -> SubmitMode -> PayMode -> Lovelace -> Int -> ActionM ()
-createChange era sourceWallet dstWallet submitMode payMode value count = case payMode of
-  PayToAddr keyName -> withEra era $ createChangeInEra sourceWallet dstWallet submitMode PlainOldFund keyName value count
-  -- Problem here: PayToCollateral will create an output marked as collateral
-  -- and also return any change to a collateral, which makes the returned change unusable.
-  PayToCollateral keyName -> withEra era $ createChangeInEra sourceWallet dstWallet submitMode CollateralFund keyName value count
-  PayToScript scriptFile scriptData -> createChangeScriptFunds sourceWallet dstWallet submitMode scriptFile scriptData value count
-
-createChangeScriptFunds :: WalletName -> WalletName -> SubmitMode -> FilePath -> ScriptData -> Lovelace -> Int -> ActionM ()
-createChangeScriptFunds sourceWallet dstWallet submitMode scriptFile scriptData value count = do
-  walletRef <- getName dstWallet
-  networkId <- getUser TNetworkId
-  protocolParameters <- getProtocolParameters
-  _fundKey <- getName $ KeyName "pass-partout"
-  fee <- getUser TFee
-  script <- liftIO $ PlutusExample.readScript scriptFile --TODO: this should throw a file-not-found-error !
-  let
-    createCoins fundSource coins = do
-      let
---        selector :: FundSet.FundSource
---        selector = mkWalletFundSource walletRef $ FundSet.selectMinValue $ sum coins + fee
-        inOut :: [Lovelace] -> [Lovelace]
-        inOut = Wallet.includeChange fee coins
-        toUTxO = PlutusExample.mkUtxoScript networkId (scriptFile, script, scriptData) Confirmed
-        fundToStore = mkWalletFundStore walletRef
-
-      tx <- liftIO $ sourceToStoreTransaction
-                                      (genTx protocolParameters (TxInsCollateralNone, [])
-                                       (mkFee fee) TxMetadataNone (KeyWitness KeyWitnessForSpending))
-                                      fundSource inOut toUTxO fundToStore
-      return $ fmap txInModeCardano tx
-    addressMsg =  Text.unpack $ serialiseAddress $ makeShelleyAddress networkId (PaymentCredentialByScript $ hashScript script) NoStakeAddress
-  createChangeGeneric sourceWallet submitMode createCoins addressMsg value count
+createChange era sourceWallet dstWallet submitMode payMode value count
+  = withEra era $ createChangeInEra sourceWallet dstWallet submitMode payMode value count
 
 createChangeInEra :: forall era. IsShelleyBasedEra era
   => WalletName
   -> WalletName
   -> SubmitMode
-  -> Variant
-  -> KeyName
+  -> PayMode
   -> Lovelace
   -> Int
   -> AsType era
   -> ActionM ()
-createChangeInEra sourceWallet dstWallet submitMode variant keyName value count _proxy = do
+createChangeInEra sourceWallet dstWallet submitMode payMode value count era = do
   networkId <- getUser TNetworkId
   walletRef <- getName dstWallet
   fee <- getUser TFee
   protocolParameters <- getProtocolParameters
-  fundKey <- getName keyName
+  (toUTxO, addressMsg) <- case payMode of
+    PayToAddr keyName -> do
+      fundKey <- getName keyName
+      return ( Wallet.mkUTxOVariant PlainOldFund networkId fundKey Confirmed
+             , Text.unpack $ serialiseAddress $ keyAddress @ era networkId fundKey)
+    PayToCollateral keyName -> do
+      fundKey <- getName keyName
+      return ( Wallet.mkUTxOVariant CollateralFund networkId fundKey Confirmed
+             , Text.unpack $ serialiseAddress $ keyAddress @ era networkId fundKey)
+    PayToScript scriptFile scriptData -> do
+      script <- liftIO $ PlutusExample.readScript scriptFile --TODO: this should throw a file-not-found-error !
+      return ( PlutusExample.mkUTxOScript networkId (scriptFile, script, scriptData) Confirmed
+               , Text.unpack $ serialiseAddress $ makeShelleyAddress networkId (PaymentCredentialByScript $ hashScript script) NoStakeAddress )
   let
     createCoins :: FundSet.FundSource -> [Lovelace] -> ActionM (Either String (TxInMode CardanoMode))
     createCoins fundSource coins = do
-      let
---        selector :: FundSet.FundSource
---        selector = mkWalletFundSource walletRef $ FundSet.selectMinValue $ sum coins + fee
-        inOut :: [Lovelace] -> [Lovelace]
-        inOut = Wallet.includeChange fee coins
-        toUTxO = Wallet.mkUTxOVariant variant networkId fundKey Confirmed
-        fundToStore = mkWalletFundStore walletRef
-
       (tx :: Either String (Tx era)) <- liftIO $ sourceToStoreTransaction
                                                   (genTx protocolParameters (TxInsCollateralNone, [])
                                                    (mkFee fee) TxMetadataNone (KeyWitness KeyWitnessForSpending))
-                                                  fundSource inOut toUTxO fundToStore
+                                                  fundSource (Wallet.includeChange fee coins) toUTxO (mkWalletFundStore walletRef)
       return $ fmap txInModeCardano tx
-    addressMsg = Text.unpack $ serialiseAddress $ keyAddress @ era networkId fundKey
   createChangeGeneric sourceWallet submitMode createCoins addressMsg value count
 
 createChangeGeneric ::

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

@@ -18,6 +18,8 @@ import           Cardano.Api.Shelley (ProtocolParameters, ReferenceScript(..))
 type WalletRef = MVar Wallet
 
 type TxGenerator era = [Fund] -> [TxOut CtxTx era] -> Either String (Tx era, TxId)
+-- Todo: ToUTxO implicitly assumes that all outputs are of the same type (Plutus. normal, collateral).
+-- This is too special
 type ToUTxO era = [Lovelace] -> ([TxOut CtxTx era], TxId -> [Fund])
 
 data Wallet = Wallet {