cardano-testnet: Test plutus script cost calculation command

cabal.project

@@ -16,6 +16,20 @@ index-state:
   , hackage.haskell.org 2025-01-01T23:24:19Z
   , cardano-haskell-packages 2025-01-16T11:44:54Z
 
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-cli
+  tag: 3604f0c7e1872fe8c78850fafb0eac69e5eb4eba
+  --sha256: sha256-YpdzFbTILGaRKrV5GiyU0XjePpSSL6rSa0Ovv70CoDk=
+  subdir: cardano-cli
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-api
+  tag: ec80c4a372e5f91f7e024f1d60de4cd4221e7f2e
+  --sha256: sha256-NVVbLKB33ywiLzmv1KVUAxEe8KJ/YGGntjyt8mPu4ow=
+  subdir: cardano-api
+
 packages:
   cardano-node
   cardano-node-capi

cardano-testnet/cardano-testnet.cabal

@@ -184,12 +184,13 @@ test-suite cardano-testnet-test
 
   main-is:              cardano-testnet-test.hs
 
-  other-modules:        Cardano.Testnet.Test.Cli.Conway.Plutus
-                        Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
+  other-modules:        Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
                         Cardano.Testnet.Test.Cli.KesPeriodInfo
                         Cardano.Testnet.Test.Cli.LeadershipSchedule
                         Cardano.Testnet.Test.Cli.Query
                         Cardano.Testnet.Test.Cli.QuerySlotNumber
+                        Cardano.Testnet.Test.Cli.Plutus.Purposes
+                        Cardano.Testnet.Test.Cli.Plutus.CostCalculation
                         Cardano.Testnet.Test.Cli.StakeSnapshot
                         Cardano.Testnet.Test.Cli.Transaction
                         Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress

cardano-testnet/src/Testnet/Components/Query.hs

@@ -39,32 +39,40 @@ module Testnet.Components.Query
   , getGovActionLifetime
   , getKeyDeposit
   , getDelegationState
+  , getTxIx
   ) where
 
 import           Cardano.Api as Api
 import           Cardano.Api.Ledger (Credential, DRepState, EpochInterval (..), KeyRole (DRepRole),
-                   StandardCrypto)
+                   StandardCrypto, extractHash)
+import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut)
 
+import           Cardano.Crypto.Hash (hashToStringAsHex)
 import           Cardano.Ledger.Api (ConwayGovState)
 import qualified Cardano.Ledger.Api as L
-import qualified Cardano.Ledger.Coin as L
+import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Conway.PParams as L
+import           Cardano.Ledger.Core (valueTxOutL)
+import           Cardano.Ledger.Shelley.LedgerState (esLStateL, lsUTxOStateL, nesEpochStateL,
+                   utxosUtxoL)
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 import qualified Cardano.Ledger.UMap as L
 import qualified Cardano.Ledger.UTxO as L
 
+import           Prelude
+
 import           Control.Exception.Safe (MonadCatch)
 import           Control.Monad
 import           Control.Monad.Trans.Resource
 import           Control.Monad.Trans.State.Strict (put)
 import           Data.Bifunctor (bimap)
 import           Data.IORef
 import           Data.List (sortOn)
+import qualified Data.Map as Map
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import qualified Data.Map.Strict as Map
 import           Data.Maybe
 import           Data.Ord (Down (..))
 import           Data.Text (Text)
@@ -78,10 +86,10 @@ import           Lens.Micro (Lens', to, (^.))
 import           Testnet.Property.Assert
 import           Testnet.Types
 
+import           Hedgehog
 import qualified Hedgehog as H
 import           Hedgehog.Extras (MonadAssertion)
 import qualified Hedgehog.Extras as H
-import           Hedgehog.Internal.Property (MonadTest)
 
 -- | Block and wait for the desired epoch.
 waitUntilEpoch
@@ -608,3 +616,24 @@ getDelegationState epochStateView = do
 
   pure $ L.toStakeCredentials pools
 
+-- | Returns the transaction index of a transaction with a given amount and ID.
+getTxIx :: forall m era. (HasCallStack, MonadTest m) => ShelleyBasedEra era -> String -> L.Coin -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int)
+getTxIx sbe txId amount (AnyNewEpochState sbe' newEpochState, _, _) = do
+    Refl <- H.leftFail $ assertErasEqual sbe sbe'
+    shelleyBasedEraConstraints
+        sbe'
+        ( return
+            $ Map.foldlWithKey
+                ( \acc (L.TxIn (L.TxId thisTxId) (L.TxIx thisTxIx)) txOut ->
+                    case acc of
+                        Nothing
+                            | hashToStringAsHex (extractHash thisTxId) == txId
+                                && valueToLovelace (fromLedgerValue sbe (txOut ^. valueTxOutL)) == Just amount ->
+                                Just $ fromIntegral thisTxIx
+                            | otherwise -> Nothing
+                        x -> x
+                )
+                Nothing
+            $ L.unUTxO
+            $ newEpochState ^. nesEpochStateL . esLStateL . lsUTxOStateL . utxosUtxoL
+        )

cardano-testnet/src/Testnet/Process/Cli/Transaction.hs

@@ -10,9 +10,10 @@ module Testnet.Process.Cli.Transaction
   , retrieveTransactionId
   , SignedTx
   , TxBody
-  , TxOutAddress(..)
+  , TxOutAddress (..)
   , VoteFile
-  ) where
+  )
+where
 
 import           Cardano.Api hiding (Certificate, TxBody)
 import           Cardano.Api.Experimental (Some (..))
@@ -29,83 +30,93 @@ import           GHC.IO.Exception (ExitCode (..))
 import           GHC.Stack
 import           System.FilePath ((</>))
 
+import           Hedgehog (MonadTest)
+import qualified Hedgehog.Extras as H
+
 import           Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey)
 import           Testnet.Process.Run (execCli')
 import           Testnet.Start.Types (anyEraToString)
 import           Testnet.Types
 
-import           Hedgehog (MonadTest)
-import qualified Hedgehog.Extras as H
-
 -- Transaction signing
 data VoteFile
 
 data TxBody
 
 data SignedTx
 
-data ReferenceScriptJSON
+data ScriptJSON
 
-data TxOutAddress = PubKeyAddress PaymentKeyInfo
-                  | ReferenceScriptAddress (File ReferenceScriptJSON In)
-                  -- ^ The output will be created at the script address
-                  -- and the output will include the reference script.
+data TxOutAddress
+  = PubKeyAddress PaymentKeyInfo
+  | -- | The output will be created at the script address.
+    ScriptAddress (File ScriptJSON In)
 
 -- | Calls @cardano-cli@ to build a simple ADA transfer transaction to
--- the specified outputs of the specified amount of ADA. In the case of
--- a reference script address, the output will be created at the
--- corresponding script address, and the output will contain the reference
--- script.
+-- the specified outputs of the specified amount of ADA. Destination
+-- address may be specified as a 'PaymentKeyInfo' or with a script file.
+-- For each output, an extra optional script file may be provided, and
+-- if provided, the script provided will be published in that output
+-- as a reference script.
 --
 -- Returns the generated @File TxBody In@ file path to the created unsigned
 -- transaction file.
 mkSpendOutputsOnlyTx
-  :: HasCallStack
-  => Typeable era
-  => H.MonadAssertion m
-  => MonadTest m
-  => MonadCatch m
-  => MonadIO m
-  => H.ExecConfig -- ^ Specifies the CLI execution configuration.
-  -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
-                    -- using the 'getEpochStateView' function.
-  -> ShelleyBasedEra era -- ^ Witness for the current Cardano era.
-  -> FilePath -- ^ Base directory path where the unsigned transaction file will be stored.
-  -> String -- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@.
-  -> PaymentKeyInfo -- ^ Payment key pair used for paying the transaction.
-  -> [(TxOutAddress, Coin)] -- ^ List of pairs of transaction output addresses and amounts.
+  :: (HasCallStack, Typeable era, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m)
+  => H.ExecConfig
+  -- ^ Specifies the CLI execution configuration.
+  -> EpochStateView
+  -- ^ Current epoch state view for transaction building. It can be obtained
+  -- using the 'getEpochStateView' function.
+  -> ShelleyBasedEra era
+  -- ^ Witness for the current Cardano era.
+  -> FilePath
+  -- ^ Base directory path where the unsigned transaction file will be stored.
+  -> String
+  -- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@.
+  -> PaymentKeyInfo
+  -- ^ Payment key pair used for paying the transaction.
+  -> [(TxOutAddress, Coin, Maybe (File ScriptJSON In))]
+  -- ^ List of tuples with transaction output addresses, amounts, and reference scripts.
   -> m (File TxBody In)
 mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet txOutputs = do
-
   txIn <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet
   fixedTxOuts :: [String] <- computeTxOuts
-  void $ execCli' execConfig $ mconcat
-    [ [ anyEraToString cEra, "transaction", "build"
-      , "--change-address", srcAddress
-      , "--tx-in", T.unpack $ renderTxIn txIn
-      ]
-    , fixedTxOuts
-    , [ "--out-file", unFile txBody
-      ]
-    ]
+  void $ execCli' execConfig $
+           mconcat
+             [ [ anyEraToString cEra
+               , "transaction", "build"
+               , "--change-address", srcAddress
+               , "--tx-in", T.unpack $ renderTxIn txIn
+               ]
+             , fixedTxOuts
+             , [ "--out-file", unFile txBody
+               ]
+             ]
   return txBody
-  where
-    era = toCardanoEra sbe
-    cEra = AnyCardanoEra era
-    txBody = File (work </> prefix <> ".txbody")
-    srcAddress = T.unpack $ paymentKeyInfoAddr srcWallet
-    computeTxOuts = concat <$> sequence
+ where
+  era = toCardanoEra sbe
+  cEra = AnyCardanoEra era
+  txBody = File (work </> prefix <> ".txbody")
+  srcAddress = T.unpack $ paymentKeyInfoAddr srcWallet
+  computeTxOuts =
+    concat <$> sequence
       [ case txOut of
           PubKeyAddress dstWallet ->
-            return ["--tx-out", T.unpack (paymentKeyInfoAddr dstWallet) <> "+" ++ show (unCoin amount) ]
-          ReferenceScriptAddress (File referenceScriptJSON) -> do
-            scriptAddress <- execCli' execConfig [ anyEraToString cEra, "address", "build"
-                                                 , "--payment-script-file", referenceScriptJSON
-                                                 ]
-            return [ "--tx-out", scriptAddress <> "+" ++ show (unCoin amount)
-                   , "--tx-out-reference-script-file", referenceScriptJSON
-                   ]
-      | (txOut, amount) <- txOutputs
+            return ["--tx-out", T.unpack (paymentKeyInfoAddr dstWallet) <> "+" ++ show (unCoin amount)]
+          ScriptAddress (File referenceScriptJSON) -> do
+            scriptAddress <-
+              execCli'
+                execConfig
+                [ anyEraToString cEra
+                , "address", "build"
+                , "--payment-script-file", referenceScriptJSON
+                ]
+            return
+              ( ["--tx-out", scriptAddress <> "+" ++ show (unCoin amount)]
+                  <> maybe [] (\(File newRefScript) -> ["--tx-out-reference-script-file", newRefScript]) mNewRefScript
+              )
+      | (txOut, amount, mNewRefScript) <- txOutputs
       ]
 
 -- | Calls @cardano-cli@ to build a simple ADA transfer transaction to
@@ -131,7 +142,7 @@ mkSimpleSpendOutputsOnlyTx
   -> Coin -- ^ Amount of ADA to transfer (in Lovelace).
   -> m (File TxBody In)
 mkSimpleSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount =
-  mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet [(PubKeyAddress dstWallet, amount)]
+  mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet [(PubKeyAddress dstWallet, amount, Nothing)]
 
 -- | Calls @cardano-cli@ to signs a transaction body using the specified key pairs.
 --