Issue #73: test PlutusV1 and V2 DCert\n\n- add DCert conversion helpe…

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
 

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)
 

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)
 

e2e-tests/test/Spec/AlonzoFeatures.hs

@@ -25,17 +25,17 @@ 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
 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)

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)