Test the calculate-plutus-script-cost command against a reference s…

…cript

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/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/PlutusCostCalculation.hs

@@ -1,57 +1,162 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 
 module Cardano.Testnet.Test.Cli.PlutusCostCalculation (
     hprop_plutus_cost_calculation,
     -- | Execute tests in this module with:
-    -- @DISABLE_RETRIES=1 cabal run cardano-testnet-test -- -p "/Spec.hs.Spec.CLI.included plutus/"@
+    -- @DISABLE_RETRIES=1 cabal run cardano-testnet-test -- -p "/Spec.hs.Spec.CLI.plutus cost calc/"@
 ) where
 
-import           Cardano.Api
+import           Cardano.Api (AnyCardanoEra (AnyCardanoEra),
+                   AnyShelleyBasedEra (AnyShelleyBasedEra), File (File), MonadIO (liftIO),
+                   ShelleyBasedEra (ShelleyBasedEraConway), ToCardanoEra (toCardanoEra), renderTxIn,
+                   unFile)
+import           Cardano.Api.Experimental (Some (Some))
+import           Cardano.Api.Ledger (EpochInterval (EpochInterval), unCoin)
 
 import           Cardano.Testnet
 
 import           Prelude
 
-import           Data.Default.Class
+import           Control.Monad (void)
+import           Data.Default.Class (Default (def))
+import qualified Data.Text as Text
+import           System.Directory (makeAbsolute)
 import           System.FilePath ((</>))
 import qualified System.Info as SYS
 
-import           Testnet.Components.Query (getEpochStateView)
-import           Testnet.Process.Run (mkExecConfig)
+import           Testnet.Components.Query (findLargestUtxoForPaymentKey, getEpochStateView, getTxIx,
+                   watchEpochStateUpdate)
+import           Testnet.Process.Cli.Transaction (TxOutAddress (..), mkSpendOutputsOnlyTx,
+                   retrieveTransactionId, signTx, submitTx)
+import           Testnet.Process.Run (execCli', mkExecConfig)
 import           Testnet.Property.Util (integrationRetryWorkspace)
+import           Testnet.Start.Types (eraToString)
+import           Testnet.Types (PaymentKeyInfo (paymentKeyInfoAddr), paymentKeyInfoPair)
 
 import           Hedgehog (Property)
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
+import qualified Hedgehog.Extras.Test.Golden as H
 import qualified Hedgehog.Extras.Test.TestWatchdog as H
 
 hprop_plutus_cost_calculation :: Property
-hprop_plutus_cost_calculation = integrationRetryWorkspace 2 "included plutus" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do
+hprop_plutus_cost_calculation = integrationRetryWorkspace 2 "reference plutus script" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do
     H.note_ SYS.os
     conf@Conf{tempAbsPath} <- mkConf tempAbsBasePath'
     let tempAbsPath' = unTmpAbsPath tempAbsPath
-    _work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"
+    work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"
 
     let
         sbe = ShelleyBasedEraConway
-        _txEra = AsConwayEra
         era = toCardanoEra sbe
-        _cEra = AnyCardanoEra era
+        cEra = AnyCardanoEra era
+        eraName = eraToString era
         tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath'
         options = def{cardanoNodeEra = AnyShelleyBasedEra sbe}
 
     TestnetRuntime
         { configurationFile
         , testnetMagic
         , testnetNodes
-        , wallets = _wallet0 : _
+        , wallets = wallet0 : wallet1 : _
         } <-
         cardanoTestnetDefault options def conf
 
     poolNode1 <- H.headM testnetNodes
     poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1
-    _execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
-    _epochStateView <- getEpochStateView configurationFile (nodeSocketPath poolNode1)
+    execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
+    epochStateView <- getEpochStateView configurationFile (nodeSocketPath poolNode1)
 
-    H.failure
+    refScriptSizeWork <- H.createDirectoryIfMissing $ work </> "ref-script-publish"
+    plutusV3Script <- File <$> liftIO (makeAbsolute "test/cardano-testnet-test/files/plutus/v3/always-succeeds.plutus")
+
+    let scriptPublishUTxOAmount = 10_000_000
+
+    -- Submit a transaction to publish the reference script
+    txBodyPublishRefScript <-
+        mkSpendOutputsOnlyTx
+            execConfig
+            epochStateView
+            sbe
+            refScriptSizeWork
+            "tx-body"
+            wallet0
+            [(ReferenceScriptAddress plutusV3Script, scriptPublishUTxOAmount)]
+    signedTxPublishRefScript <- signTx execConfig cEra refScriptSizeWork "signed-tx" txBodyPublishRefScript [Some $ paymentKeyInfoPair wallet0]
+    submitTx execConfig cEra signedTxPublishRefScript
+
+    -- Wait until transaction is on chain and obtain transaction identifier
+    txIdPublishRefScript <- retrieveTransactionId execConfig signedTxPublishRefScript
+    txIxPublishRefScript <- H.evalMaybeM $ watchEpochStateUpdate epochStateView (EpochInterval 2) (getTxIx sbe txIdPublishRefScript scriptPublishUTxOAmount)
+
+    -- Submit a transaction to lock money in the reference script
+    refScriptLock <- H.createDirectoryIfMissing $ work </> "ref-script-lock"
+
+    let transferAmount = 20_000_000
+        enoughAmountForFees = 2_000_000 -- Needs to be more than min ada
+    txBodyLock <-
+        mkSpendOutputsOnlyTx
+            execConfig
+            epochStateView
+            sbe
+            refScriptLock
+            "tx-body"
+            wallet0
+            [(ReferenceScriptAddress plutusV3Script, transferAmount)]
+    signedTxLock <- signTx execConfig cEra refScriptLock "signed-tx" txBodyLock [Some $ paymentKeyInfoPair wallet0]
+    submitTx execConfig cEra signedTxLock
+
+    -- Wait until transaction is on chain and obtain transaction identifier
+    txIdLock <- retrieveTransactionId execConfig signedTxLock
+    txIxLock <- H.evalMaybeM $ watchEpochStateUpdate epochStateView (EpochInterval 2) (getTxIx sbe txIdLock transferAmount)
+
+    -- Create transaction that uses reference script
+    refScriptUnlock <- H.createDirectoryIfMissing $ work </> "ref-script-unlock"
+    let unsignedUnlockTx = File $ refScriptUnlock </> "unsigned-tx.tx"
+    largestUTxO <- findLargestUtxoForPaymentKey epochStateView sbe wallet1
+
+    void $
+        execCli'
+            execConfig
+            [ eraName
+            , "transaction"
+            , "build"
+            , "--change-address"
+            , Text.unpack $ paymentKeyInfoAddr wallet1
+            , "--tx-in"
+            , txIdLock <> "#" <> show txIxLock
+            , "--spending-reference-tx-in-inline-datum-present"
+            , "--spending-tx-in-reference"
+            , txIdPublishRefScript <> "#" <> show txIxPublishRefScript
+            , "--spending-plutus-script-v3"
+            , "--spending-reference-tx-in-redeemer-value"
+            , "42"
+            , "--tx-in-collateral"
+            , Text.unpack $ renderTxIn largestUTxO
+            , "--tx-out"
+            , Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show (unCoin (transferAmount - enoughAmountForFees))
+            , "--out-file"
+            , unFile unsignedUnlockTx
+            ]
+
+    signedUnlockTx <- signTx execConfig cEra refScriptUnlock "signed-tx" unsignedUnlockTx [Some $ paymentKeyInfoPair wallet1]
+
+    submitTx execConfig cEra signedUnlockTx
+
+    -- Calculate cost of the transaction
+    let txCostOutput = File $ refScriptUnlock </> "unsigned-tx.tx"
+    H.noteM_ $
+        execCli'
+            execConfig
+            [ eraName
+            , "transaction"
+            , "calculate-plutus-script-cost"
+            , "--tx-file"
+            , unFile signedUnlockTx
+            , "--out-file"
+            , unFile txCostOutput
+            ]
+
+    H.diffFileVsGoldenFile (unFile txCostOutput) "test/cardano-testnet-test/files/calculatePlutusScriptCost1.json"

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs

@@ -16,20 +16,14 @@ module Cardano.Testnet.Test.Cli.Query
 import           Cardano.Api
 import           Cardano.Api.Experimental (Some (..))
 import qualified Cardano.Api.Genesis as Api
-import           Cardano.Api.Ledger (Coin (Coin), EpochInterval (EpochInterval), StandardCrypto,
-                   extractHash, unboundRational)
+import           Cardano.Api.Ledger (Coin (Coin), EpochInterval (EpochInterval), StandardCrypto, unboundRational)
 import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey), StakePoolKey)
 
 import           Cardano.CLI.Types.Key (VerificationKeyOrFile (VerificationKeyFilePath),
                    readVerificationKeyOrFile)
 import           Cardano.CLI.Types.Output (QueryTipLocalStateOutput)
-import           Cardano.Crypto.Hash (hashToStringAsHex)
 import qualified Cardano.Ledger.BaseTypes as L
-import           Cardano.Ledger.Core (valueTxOutL)
-import           Cardano.Ledger.Shelley.LedgerState (esLStateL, lsUTxOStateL, nesEpochStateL,
-                   utxosUtxoL)
-import qualified Cardano.Ledger.UTxO as L
 import           Cardano.Testnet
 
 import           Prelude
@@ -44,7 +38,6 @@ import qualified Data.Aeson.KeyMap as Aeson
 import qualified Data.Aeson.Lens as Aeson
 import           Data.Bifunctor (bimap)
 import qualified Data.ByteString.Lazy as LBS
-import           Data.Data (type (:~:) (Refl))
 import           Data.Default.Class
 import qualified Data.Map as Map
 import           Data.String (IsString (fromString))
@@ -56,18 +49,16 @@ import qualified Data.Vector as Vector
 import           GHC.Exts (IsList (..))
 import           GHC.Stack (HasCallStack, withFrozenCallStack)
 import qualified GHC.Stack as GHC
-import           Lens.Micro ((^.))
 import           System.Directory (makeAbsolute)
 import           System.FilePath ((</>))
 
 import           Testnet.Components.Configuration (eraToString)
 import           Testnet.Components.Query (EpochStateView, checkDRepsNumber, getEpochStateView,
-                   watchEpochStateUpdate)
+                   watchEpochStateUpdate, getTxIx)
 import qualified Testnet.Defaults as Defaults
 import           Testnet.Process.Cli.Transaction (TxOutAddress (..), mkSimpleSpendOutputsOnlyTx,
                    mkSpendOutputsOnlyTx, retrieveTransactionId, signTx, submitTx)
 import           Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig)
-import           Testnet.Property.Assert (assertErasEqual)
 import           Testnet.Property.Util (integrationWorkspace)
 import           Testnet.Start.Types (GenesisOptions (..), NumPools (..), cardanoNumPools)
 import           Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands)
@@ -492,17 +483,6 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H.
   _verificationStakeKeyToStakeAddress testnetMagic delegatorVKey =
     makeStakeAddress (fromNetworkMagic $ NetworkMagic $ fromIntegral testnetMagic) (StakeCredentialByKey $ verificationKeyHash delegatorVKey)
 
-  getTxIx :: forall m era. HasCallStack => MonadTest m => ShelleyBasedEra era -> String -> Coin -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int)
-  getTxIx sbe txId amount (AnyNewEpochState sbe' newEpochState, _, _) = do
-    Refl <- H.leftFail $ assertErasEqual sbe sbe'
-    shelleyBasedEraConstraints sbe' (do
-      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)
-
 -- | @redactJsonStringFieldInFile [(k0, v0), (k1, v1), ..] sourceFilePath targetFilePath@ reads the JSON at @sourceFilePath@, and then
 -- replaces the value associated to @k0@ by @v0@, replaces the value associated to @k1@ by @v1@, etc.
 -- Then the obtained JSON is written to @targetFilePath@. This replacement is done recursively

cardano-testnet/test/cardano-testnet-test/files/calculatePlutusScriptCost1.json

@@ -0,0 +1,10 @@
+[
+    {
+        "executionUnits": {
+            "memory": 500,
+            "steps": 64100
+        },
+        "lovelaceCost": 34,
+        "scriptHash": "186e32faa80a26810392fda6d559c7ed4721a65ce1c9d4ef3e1c87b4"
+    }
+]

cardano-testnet/test/cardano-testnet-test/files/plutus/v3/always-succeeds.plutus

@@ -1,5 +1,5 @@
 {
     "type": "PlutusScriptV3",
-    "description": "",
-    "cborHex": "484701010022280001"
-}
+    "description": "Always succeeds",
+    "cborHex": "46450101002499"
+}