diff --git a/e2e-tests/test/Helpers/TypeConverters.hs b/e2e-tests/test/Helpers/TypeConverters.hs index 15f2bf2..6eba633 100644 --- a/e2e-tests/test/Helpers/TypeConverters.hs +++ b/e2e-tests/test/Helpers/TypeConverters.hs @@ -201,6 +201,29 @@ fromCardanoValue (C.valueToList -> list) = fromSingleton (fromCardanoAssetId -> assetClass, C.Quantity quantity) = Value.assetClassValue assetClass quantity +-- | Convert a Cardano API 'Certificate' into the corresponding Plutus +-- 'DCert' value. The conversion is accomplished by serialising the +-- certificate to generic 'Data' (via the 'ToPlutusData' instance provided by +-- 'cardano-api') and then deserialising that 'Data' into the appropriate +-- Plutus type. This works because the on‑chain encoding of certificates is +-- identical between the ledger and the Plutus types. +-- +-- We expose two flavours targeted at the versions used in our e2e tests. +-- The functions live here so they can be shared between multiple spec +-- modules without duplicating the ugly boilerplate. + +fromCardanoDCertV1 :: C.Certificate era -> PV1.DCert +fromCardanoDCertV1 = + PlutusTx.unsafeFromBuiltinData + . PV1.dataToBuiltinData + . C.toPlutusData + +fromCardanoDCertV2 :: C.Certificate era -> PV2.DCert +fromCardanoDCertV2 = + PlutusTx.unsafeFromBuiltinData + . PV2.dataToBuiltinData + . C.toPlutusData + coinToLovelace :: L.Coin -> PV3.Lovelace coinToLovelace (L.Coin l) = PV3.Lovelace l diff --git a/e2e-tests/test/PlutusScripts/V1TxInfo.hs b/e2e-tests/test/PlutusScripts/V1TxInfo.hs index aa0e5ac..32e670e 100644 --- a/e2e-tests/test/PlutusScripts/V1TxInfo.hs +++ b/e2e-tests/test/PlutusScripts/V1TxInfo.hs @@ -17,6 +17,7 @@ module PlutusScripts.V1TxInfo ( txInfoMint, txInfoSigs, txInfoData, + txInfoDCert, checkV1TxInfoScriptV1, checkV1TxInfoAssetIdV1, checkV1TxInfoRedeemer, @@ -34,6 +35,7 @@ import Helpers.TypeConverters ( fromCardanoTxOutToPV1TxInfoTxOut, fromCardanoTxOutToPV1TxInfoTxOut', fromCardanoValue, + fromCardanoDCertV1, ) import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode) import PlutusLedgerApi.V1 qualified as V1 @@ -104,6 +106,9 @@ txInfoFee = fromCardanoValue . C.lovelaceToValue txInfoMint :: C.Value -> V1.Value txInfoMint = fromCardanoValue +txInfoDCert :: [C.Certificate era] -> [V1.DCert] +txInfoDCert = map fromCardanoDCertV1 + txInfoSigs :: [C.VerificationKey C.PaymentKey] -> [V1.PubKeyHash] txInfoSigs = map (fromCardanoPaymentKeyHash . C.verificationKeyHash) diff --git a/e2e-tests/test/PlutusScripts/V2TxInfo.hs b/e2e-tests/test/PlutusScripts/V2TxInfo.hs index 0c14137..3c6b6db 100644 --- a/e2e-tests/test/PlutusScripts/V2TxInfo.hs +++ b/e2e-tests/test/PlutusScripts/V2TxInfo.hs @@ -17,6 +17,7 @@ module PlutusScripts.V2TxInfo ( txInfoMint, txInfoSigs, txInfoData, + txInfoDCert, checkV2TxInfoScriptV2, checkV2TxInfoAssetIdV2, checkV2TxInfoRedeemer, @@ -36,6 +37,7 @@ import Helpers.TypeConverters ( fromCardanoTxOutToPV2TxInfoTxOut, fromCardanoTxOutToPV2TxInfoTxOut', fromCardanoValue, + fromCardanoDCertV2, ) import PlutusCore.Pretty (Render (render), prettyPlcClassicSimple) import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode) @@ -144,6 +146,9 @@ txInfoFee = Value.lovelaceValue . coinToLovelace txInfoMint :: C.Value -> V2.Value txInfoMint = fromCardanoValue +txInfoDCert :: [C.Certificate era] -> [V2.DCert] +txInfoDCert = map fromCardanoDCertV2 + txInfoSigs :: [C.VerificationKey C.PaymentKey] -> [V2.PubKeyHash] txInfoSigs = map (fromCardanoPaymentKeyHash . C.verificationKeyHash) diff --git a/e2e-tests/test/Spec/AlonzoFeatures.hs b/e2e-tests/test/Spec/AlonzoFeatures.hs index 5029745..84e6e07 100644 --- a/e2e-tests/test/Spec/AlonzoFeatures.hs +++ b/e2e-tests/test/Spec/AlonzoFeatures.hs @@ -25,8 +25,10 @@ import Data.Time.Clock.POSIX qualified as Time import GHC.IsList (fromList) import Hedgehog (MonadTest) import Hedgehog qualified as H -import Helpers.Common (makeAddress, toShelleyBasedEra) +import Helpers.Common (makeAddress, toConwayEraOnwards, toShelleyBasedEra) import Helpers.Query qualified as Q +import Helpers.Staking (generateStakeKeyCredentialAndCertificate) +import Helpers.StakePool (generateStakePoolKeyCredentialsAndCertificate) import Helpers.Test (assert, success) import Helpers.TestData (TestInfo (..), TestParams (..)) import Helpers.Testnet qualified as TN @@ -34,8 +36,6 @@ import Helpers.Tx qualified as Tx import Helpers.Utils qualified as U import Numeric.Natural (Natural) import PlutusLedgerApi.V1 as PlutusV1 hiding (lowerBound, upperBound) -import PlutusLedgerApi.V1.Interval as P hiding (lowerBound, upperBound) -import PlutusLedgerApi.V1.Time as P import PlutusScripts.Basic.V_1_0 qualified as PS_1_0 import PlutusScripts.Basic.V_1_1 qualified as PS_1_1 import PlutusScripts.Helpers qualified as PS @@ -76,6 +76,11 @@ checkTxInfoV1Test networkOptions params = do startTime <- liftIO Time.getPOSIXTime (w1SKey, w1VKey, w1Address) <- TN.w1All tempAbsPath networkId let sbe = toShelleyBasedEra era + ceo = toConwayEraOnwards era + + -- Generate a stake key for the certificate + stakePool <- generateStakePoolKeyCredentialsAndCertificate ceo networkId + staking <- generateStakeKeyCredentialAndCertificate ceo stakePool -- build a transaction @@ -128,7 +133,8 @@ checkTxInfoV1Test networkOptions params = do expTxInfoOutputs = PS.txInfoOutputs era [txOut1, txOut2] expTxInfoFee = PS.txInfoFee fee expTxInfoMint = PS.txInfoMint tokenValues - expDCert = [] -- not testing any staking registration certificate + -- Include the stake registration certificate in the test + expDCert = PS.txInfoDCert [Helpers.Staking.stakeRegCert staking] expWdrl = [] -- not testing any staking reward withdrawal expTxInfoSigs = PS.txInfoSigs [w1VKey] expTxInfoData = PS.txInfoData [datum] @@ -159,6 +165,7 @@ checkTxInfoV1Test networkOptions params = do , -- \^ ~9min range (200ms slots) -- \^ Babbage era onwards cannot have upper slot beyond epoch boundary (10_000 slot epoch) C.txExtraKeyWits = Tx.txExtraKeyWits era [w1VKey] + , C.txCertificates = Tx.txCertificates era [Helpers.Staking.stakeRegCert staking] [Helpers.Staking.stakeCred staking] } txbody <- Tx.buildRawTx sbe txBodyContent kw <- Tx.signTx sbe txbody (C.WitnessPaymentKey w1SKey) diff --git a/e2e-tests/test/Spec/BabbageFeatures.hs b/e2e-tests/test/Spec/BabbageFeatures.hs index 3dfcee2..0e93ed4 100644 --- a/e2e-tests/test/Spec/BabbageFeatures.hs +++ b/e2e-tests/test/Spec/BabbageFeatures.hs @@ -22,8 +22,10 @@ import Data.Time.Clock.POSIX qualified as Time import GHC.IsList (fromList) import Hedgehog qualified as H import Hedgehog.Internal.Property (MonadTest) -import Helpers.Common (makeAddress, toShelleyBasedEra) +import Helpers.Common (makeAddress, toConwayEraOnwards, toShelleyBasedEra) import Helpers.Query qualified as Q +import Helpers.Staking (generateStakeKeyCredentialAndCertificate) +import Helpers.StakePool (generateStakePoolKeyCredentialsAndCertificate) import Helpers.Test (assert) import Helpers.TestData (TestInfo (..), TestParams (..)) import Helpers.Testnet qualified as TN @@ -40,6 +42,7 @@ import PlutusScripts.V2TxInfo qualified as PS ( checkV2TxInfoMintWitnessV2, checkV2TxInfoRedeemer, txInfoData, + txInfoDCert, txInfoFee, txInfoInputs, txInfoMint, @@ -72,6 +75,11 @@ checkTxInfoV2Test networkOptions testParams = do startTime <- liftIO Time.getPOSIXTime (wSKey, wVKey, wAddress) <- TN.w1All tempAbsPath networkId let sbe = toShelleyBasedEra era + ceo = toConwayEraOnwards era + + -- Generate a stake key for the certificate + stakePool <- generateStakePoolKeyCredentialsAndCertificate ceo networkId + staking <- generateStakeKeyCredentialAndCertificate ceo stakePool -- build a transaction @@ -130,7 +138,8 @@ checkTxInfoV2Test networkOptions testParams = do expTxInfoOutputs = PS.txInfoOutputs era [txOut1, txOut2] expTxInfoFee = PS.txInfoFee fee expTxInfoMint = PS.txInfoMint tokenValues - expDCert = [] -- not testing any staking registration certificate + -- Include the stake registration certificate in the test + expDCert = PS.txInfoDCert [Helpers.Staking.stakeRegCert staking] expWdrl = PlutusV2.unsafeFromList [] -- not testing any staking reward withdrawal expTxInfoSigs = PS.txInfoSigs [wVKey] expTxInfoRedeemers = PS_1_0.alwaysSucceedPolicyTxInfoRedeemerV2 @@ -169,6 +178,7 @@ checkTxInfoV2Test networkOptions testParams = do , -- \^ ~9min range (200ms slots) -- \^ Babbage era onwards cannot have upper slot beyond epoch boundary (10_000 slot epoch) C.txExtraKeyWits = Tx.txExtraKeyWits era [wVKey] + , C.txCertificates = Tx.txCertificates era [Helpers.Staking.stakeRegCert staking] [Helpers.Staking.stakeCred staking] } txbody <- Tx.buildRawTx sbe txBodyContent kw <- Tx.signTx sbe txbody (C.WitnessPaymentKey wSKey)