Skip to content

Commit b311bbc

Browse files
authored
Merge pull request #6097 from IntersectMBO/plutus-script-cost-calculation-cmd
cardano-testnet: Test plutus script cost calculation command
2 parents 420c94f + c73c057 commit b311bbc

File tree

11 files changed

+577
-91
lines changed

11 files changed

+577
-91
lines changed

cardano-testnet/cardano-testnet.cabal

+3-2
Original file line numberDiff line numberDiff line change
@@ -185,12 +185,13 @@ test-suite cardano-testnet-test
185185

186186
main-is: cardano-testnet-test.hs
187187

188-
other-modules: Cardano.Testnet.Test.Cli.Conway.Plutus
189-
Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
188+
other-modules: Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
190189
Cardano.Testnet.Test.Cli.KesPeriodInfo
191190
Cardano.Testnet.Test.Cli.LeadershipSchedule
192191
Cardano.Testnet.Test.Cli.Query
193192
Cardano.Testnet.Test.Cli.QuerySlotNumber
193+
Cardano.Testnet.Test.Cli.Plutus.Scripts
194+
Cardano.Testnet.Test.Cli.Plutus.CostCalculation
194195
Cardano.Testnet.Test.Cli.StakeSnapshot
195196
Cardano.Testnet.Test.Cli.Transaction
196197
Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress

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

+19-2
Original file line numberDiff line numberDiff line change
@@ -39,26 +39,31 @@ module Testnet.Components.Query
3939
, getGovActionLifetime
4040
, getKeyDeposit
4141
, getDelegationState
42+
, getTxIx
4243
) where
4344

4445
import Cardano.Api as Api
4546
import Cardano.Api.Ledger (Credential, DRepState, EpochInterval (..), KeyRole (DRepRole))
4647
import Cardano.Api.Shelley (ShelleyLedgerEra)
48+
import qualified Cardano.Api.Ledger as L
4749

50+
import Cardano.Crypto.Hash (hashToStringAsHex)
4851
import Cardano.Ledger.Api (ConwayGovState)
4952
import qualified Cardano.Ledger.Api as L
50-
import qualified Cardano.Ledger.Coin as L
5153
import qualified Cardano.Ledger.Conway.Governance as L
5254
import qualified Cardano.Ledger.Conway.PParams as L
5355
import qualified Cardano.Ledger.Shelley.LedgerState as L
5456
import qualified Cardano.Ledger.UMap as L
5557

58+
import Prelude
59+
5660
import Control.Exception.Safe (MonadCatch)
5761
import Control.Monad
5862
import Control.Monad.Trans.Resource
5963
import Control.Monad.Trans.State.Strict (put)
6064
import Data.IORef
6165
import Data.List (sortOn)
66+
import qualified Data.Map as Map
6267
import Data.Map.Strict (Map)
6368
import qualified Data.Map.Strict as M
6469
import Data.Maybe
@@ -74,10 +79,10 @@ import Lens.Micro (Lens', to, (^.))
7479
import Testnet.Property.Assert
7580
import Testnet.Types
7681

82+
import Hedgehog
7783
import qualified Hedgehog as H
7884
import Hedgehog.Extras (MonadAssertion)
7985
import qualified Hedgehog.Extras as H
80-
import Hedgehog.Internal.Property (MonadTest)
8186

8287
-- | Block and wait for the desired epoch.
8388
waitUntilEpoch
@@ -592,3 +597,15 @@ getDelegationState epochStateView = do
592597
. L.dsUnifiedL
593598

594599
pure $ L.toStakeCredentials pools
600+
601+
-- | Returns the transaction index of a transaction with a given amount and ID.
602+
getTxIx :: forall m era. HasCallStack => MonadTest m => ShelleyBasedEra era -> String -> L.Coin -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int)
603+
getTxIx sbe txId amount (AnyNewEpochState sbe' _ tbs, _, _) = do
604+
Refl <- H.leftFail $ assertErasEqual sbe sbe'
605+
shelleyBasedEraConstraints sbe' $ do
606+
return $ Map.foldlWithKey (\acc (TxIn (TxId thisTxId) (TxIx thisTxIx)) (TxOut _ txOutValue _ _) ->
607+
case acc of
608+
Nothing | hashToStringAsHex thisTxId == txId &&
609+
txOutValueToLovelace txOutValue == amount -> Just $ fromIntegral thisTxIx
610+
| otherwise -> Nothing
611+
x -> x) Nothing $ getLedgerTablesUTxOValues sbe' tbs

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

+65-54
Original file line numberDiff line numberDiff line change
@@ -10,9 +10,10 @@ module Testnet.Process.Cli.Transaction
1010
, retrieveTransactionId
1111
, SignedTx
1212
, TxBody
13-
, TxOutAddress(..)
13+
, TxOutAddress (..)
1414
, VoteFile
15-
) where
15+
)
16+
where
1617

1718
import Cardano.Api hiding (Certificate, TxBody)
1819
import Cardano.Api.Experimental (Some (..))
@@ -29,83 +30,93 @@ import GHC.IO.Exception (ExitCode (..))
2930
import GHC.Stack
3031
import System.FilePath ((</>))
3132

33+
import Hedgehog (MonadTest)
34+
import qualified Hedgehog.Extras as H
35+
3236
import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey)
3337
import Testnet.Process.Run (execCli')
3438
import Testnet.Start.Types (anyEraToString)
3539
import Testnet.Types
3640

37-
import Hedgehog (MonadTest)
38-
import qualified Hedgehog.Extras as H
39-
4041
-- Transaction signing
4142
data VoteFile
4243

4344
data TxBody
4445

4546
data SignedTx
4647

47-
data ReferenceScriptJSON
48+
data ScriptJSON
4849

49-
data TxOutAddress = PubKeyAddress PaymentKeyInfo
50-
| ReferenceScriptAddress (File ReferenceScriptJSON In)
51-
-- ^ The output will be created at the script address
52-
-- and the output will include the reference script.
50+
data TxOutAddress
51+
= PubKeyAddress PaymentKeyInfo
52+
| -- | The output will be created at the script address.
53+
ScriptAddress (File ScriptJSON In)
5354

5455
-- | Calls @cardano-cli@ to build a simple ADA transfer transaction to
55-
-- the specified outputs of the specified amount of ADA. In the case of
56-
-- a reference script address, the output will be created at the
57-
-- corresponding script address, and the output will contain the reference
58-
-- script.
56+
-- the specified outputs of the specified amount of ADA. Destination
57+
-- address may be specified as a 'PaymentKeyInfo' or with a script file.
58+
-- For each output, an extra optional script file may be provided, and
59+
-- if provided, the script provided will be published in that output
60+
-- as a reference script.
5961
--
6062
-- Returns the generated @File TxBody In@ file path to the created unsigned
6163
-- transaction file.
6264
mkSpendOutputsOnlyTx
63-
:: HasCallStack
64-
=> Typeable era
65-
=> H.MonadAssertion m
66-
=> MonadTest m
67-
=> MonadCatch m
68-
=> MonadIO m
69-
=> H.ExecConfig -- ^ Specifies the CLI execution configuration.
70-
-> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
71-
-- using the 'getEpochStateView' function.
72-
-> ShelleyBasedEra era -- ^ Witness for the current Cardano era.
73-
-> FilePath -- ^ Base directory path where the unsigned transaction file will be stored.
74-
-> String -- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@.
75-
-> PaymentKeyInfo -- ^ Payment key pair used for paying the transaction.
76-
-> [(TxOutAddress, Coin)] -- ^ List of pairs of transaction output addresses and amounts.
65+
:: (HasCallStack, Typeable era, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m)
66+
=> H.ExecConfig
67+
-- ^ Specifies the CLI execution configuration.
68+
-> EpochStateView
69+
-- ^ Current epoch state view for transaction building. It can be obtained
70+
-- using the 'getEpochStateView' function.
71+
-> ShelleyBasedEra era
72+
-- ^ Witness for the current Cardano era.
73+
-> FilePath
74+
-- ^ Base directory path where the unsigned transaction file will be stored.
75+
-> String
76+
-- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@.
77+
-> PaymentKeyInfo
78+
-- ^ Payment key pair used for paying the transaction.
79+
-> [(TxOutAddress, Coin, Maybe (File ScriptJSON In))]
80+
-- ^ List of tuples with transaction output addresses, amounts, and reference scripts.
7781
-> m (File TxBody In)
7882
mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet txOutputs = do
79-
8083
txIn <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet
8184
fixedTxOuts :: [String] <- computeTxOuts
82-
void $ execCli' execConfig $ mconcat
83-
[ [ anyEraToString cEra, "transaction", "build"
84-
, "--change-address", srcAddress
85-
, "--tx-in", T.unpack $ renderTxIn txIn
86-
]
87-
, fixedTxOuts
88-
, [ "--out-file", unFile txBody
89-
]
90-
]
85+
void $ execCli' execConfig $
86+
mconcat
87+
[ [ anyEraToString cEra
88+
, "transaction", "build"
89+
, "--change-address", srcAddress
90+
, "--tx-in", T.unpack $ renderTxIn txIn
91+
]
92+
, fixedTxOuts
93+
, [ "--out-file", unFile txBody
94+
]
95+
]
9196
return txBody
92-
where
93-
era = toCardanoEra sbe
94-
cEra = AnyCardanoEra era
95-
txBody = File (work </> prefix <> ".txbody")
96-
srcAddress = T.unpack $ paymentKeyInfoAddr srcWallet
97-
computeTxOuts = concat <$> sequence
97+
where
98+
era = toCardanoEra sbe
99+
cEra = AnyCardanoEra era
100+
txBody = File (work </> prefix <> ".txbody")
101+
srcAddress = T.unpack $ paymentKeyInfoAddr srcWallet
102+
computeTxOuts =
103+
concat <$> sequence
98104
[ case txOut of
99105
PubKeyAddress dstWallet ->
100-
return ["--tx-out", T.unpack (paymentKeyInfoAddr dstWallet) <> "+" ++ show (unCoin amount) ]
101-
ReferenceScriptAddress (File referenceScriptJSON) -> do
102-
scriptAddress <- execCli' execConfig [ anyEraToString cEra, "address", "build"
103-
, "--payment-script-file", referenceScriptJSON
104-
]
105-
return [ "--tx-out", scriptAddress <> "+" ++ show (unCoin amount)
106-
, "--tx-out-reference-script-file", referenceScriptJSON
107-
]
108-
| (txOut, amount) <- txOutputs
106+
return ["--tx-out", T.unpack (paymentKeyInfoAddr dstWallet) <> "+" ++ show (unCoin amount)]
107+
ScriptAddress (File referenceScriptJSON) -> do
108+
scriptAddress <-
109+
execCli'
110+
execConfig
111+
[ anyEraToString cEra
112+
, "address", "build"
113+
, "--payment-script-file", referenceScriptJSON
114+
]
115+
return
116+
( ["--tx-out", scriptAddress <> "+" ++ show (unCoin amount)]
117+
<> maybe [] (\(File newRefScript) -> ["--tx-out-reference-script-file", newRefScript]) mNewRefScript
118+
)
119+
| (txOut, amount, mNewRefScript) <- txOutputs
109120
]
110121

111122
-- | Calls @cardano-cli@ to build a simple ADA transfer transaction to
@@ -131,7 +142,7 @@ mkSimpleSpendOutputsOnlyTx
131142
-> Coin -- ^ Amount of ADA to transfer (in Lovelace).
132143
-> m (File TxBody In)
133144
mkSimpleSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount =
134-
mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet [(PubKeyAddress dstWallet, amount)]
145+
mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet [(PubKeyAddress dstWallet, amount, Nothing)]
135146

136147
-- | Calls @cardano-cli@ to signs a transaction body using the specified key pairs.
137148
--

0 commit comments

Comments
 (0)