Support registration certificates

Author: sjoerdvisscher

cardano-node-emulator/cardano-node-emulator.cabal

@@ -126,10 +126,10 @@ test-suite cardano-node-emulator-test
   -- Other IOG dependencies
   --------------------------
   build-depends:
-    , cardano-api
-    , plutus-ledger-api  >=1.0.0
-    , plutus-tx          >=1.0.0
-    , plutus-tx-plugin   >=1.0.0
+    , cardano-api:{cardano-api, gen, internal}
+    , plutus-ledger-api                         >=1.0.0
+    , plutus-tx                                 >=1.0.0
+    , plutus-tx-plugin                          >=1.0.0
 
   ------------------------
   -- Non-IOG dependencies

cardano-node-emulator/src/Cardano/Node/Emulator/API.hs

@@ -82,16 +82,17 @@ import Ledger (
   DatumHash,
   DecoratedTxOut,
   POSIXTime,
-  PaymentPrivateKey (unPaymentPrivateKey),
+  PaymentPrivateKey,
   Slot,
   TxOutRef,
   UtxoIndex,
  )
+import Ledger.Address (toWitness)
 import Ledger.AddressMap qualified as AM
 import Ledger.Index qualified as Index
 import Ledger.Tx (
   TxOut,
-  addCardanoTxSignature,
+  addCardanoTxWitness,
   cardanoTxOutValue,
   getCardanoTxData,
   getCardanoTxId,
@@ -262,13 +263,13 @@ balanceTx utxoIndex changeAddr utx = do
 -- | Sign a transaction with the given signatures.
 signTx
   :: (MonadEmulator m, Foldable f)
-  => f PaymentPrivateKey
+  => f C.ShelleyWitnessSigningKey
   -- ^ Signatures
   -> CardanoTx
   -> m CardanoTx
-signTx keys tx = do
+signTx witnesses tx = do
   logMsg L.Info $ TxBalanceMsg $ SigningTx tx
-  pure $ foldr (addCardanoTxSignature . unPaymentPrivateKey) tx keys
+  pure $ foldr addCardanoTxWitness tx witnesses
 
 -- | Balance a transaction, sign it with the given signatures, and finally queue it.
 submitUnbalancedTx
@@ -277,13 +278,13 @@ submitUnbalancedTx
   -- ^ Just the transaction inputs, not the entire 'UTxO'.
   -> CardanoAddress
   -- ^ Wallet address
-  -> f PaymentPrivateKey
+  -> f C.ShelleyWitnessSigningKey
   -- ^ Signatures
   -> CardanoBuildTx
   -> m CardanoTx
-submitUnbalancedTx utxoIndex changeAddr keys utx = do
+submitUnbalancedTx utxoIndex changeAddr witnesses utx = do
   newTx <- balanceTx utxoIndex changeAddr utx
-  signedTx <- signTx keys newTx
+  signedTx <- signTx witnesses newTx
   queueTx signedTx
   pure signedTx
 
@@ -293,12 +294,12 @@ submitTxConfirmed
   -- ^ Just the transaction inputs, not the entire 'UTxO'.
   -> CardanoAddress
   -- ^ Wallet address
-  -> f PaymentPrivateKey
+  -> f C.ShelleyWitnessSigningKey
   -- ^ Signatures
   -> CardanoBuildTx
   -> m CardanoTx
-submitTxConfirmed utxoIndex addr privateKeys utx = do
-  tx <- submitUnbalancedTx utxoIndex addr privateKeys utx
+submitTxConfirmed utxoIndex addr witnesses utx = do
+  tx <- submitUnbalancedTx utxoIndex addr witnesses utx
   nextSlot
   pure tx
 
@@ -311,7 +312,7 @@ payToAddress (sourceAddr, sourcePrivKey) targetAddr value = do
           G.emptyTxBodyContent
             { C.txOuts = [C.TxOut targetAddr (toCardanoTxOutValue value) C.TxOutDatumNone C.ReferenceScriptNone]
             }
-  getCardanoTxId <$> submitUnbalancedTx mempty sourceAddr [sourcePrivKey] buildTx
+  getCardanoTxId <$> submitUnbalancedTx mempty sourceAddr [toWitness sourcePrivKey] buildTx
 
 -- | Log any message
 logMsg :: (MonadEmulator m) => L.LogLevel -> EmulatorMsg -> m ()

cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs

@@ -102,10 +102,11 @@ import Ledger (
   ValidationErrorInPhase,
   ValidationPhase (Phase1, Phase2),
   ValidationResult (FailPhase1, FailPhase2),
-  addCardanoTxSignature,
+  addCardanoTxWitness,
   createGenesisTransaction,
   minLovelaceTxOutEstimated,
   pubKeyAddress,
+  toWitness,
   txOutValue,
  )
 import Ledger.CardanoWallet qualified as CW
@@ -123,8 +124,8 @@ import Test.Gen.Cardano.Api.Typed qualified as Gen
 -- | Attach signatures of all known private keys to a transaction.
 signAll :: CardanoTx -> CardanoTx
 signAll tx =
-  foldl' (flip addCardanoTxSignature) tx $
-    fmap unPaymentPrivateKey CW.knownPaymentPrivateKeys
+  foldl' (flip addCardanoTxWitness) tx $
+    fmap toWitness CW.knownPaymentPrivateKeys
 
 -- | The parameters for the generators in this module.
 data GeneratorModel = GeneratorModel

cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Fee.hs

@@ -25,6 +25,7 @@ import Cardano.Api.Fees (mapTxScriptWitnesses)
 import Cardano.Api.Shelley qualified as C
 import Cardano.Api.Shelley qualified as C.Api
 import Cardano.Ledger.BaseTypes (Globals (systemStart), epochInfo)
+import Cardano.Ledger.Shelley.TxCert (shelleyTotalDepositsTxCerts)
 import Cardano.Node.Emulator.Internal.Node.Params (
   EmulatorEra,
   Params (emulatorPParams),
@@ -34,6 +35,7 @@ import Cardano.Node.Emulator.Internal.Node.Params (
  )
 import Cardano.Node.Emulator.Internal.Node.Validation (
   CardanoLedgerError,
+  Coin (unCoin),
   UTxO (UTxO),
   createAndValidateTransactionBody,
   getTxExUnitsWithLogs,
@@ -248,8 +250,14 @@ handleBalanceTx params (C.UTxO txUtxo) cChangeAddr utxoProvider errorReporter fe
 
   inputValues <- traverse lookupValue txInputs
 
-  let left = Tx.getTxBodyContentMint filteredUnbalancedTxTx <> fold inputValues
-      right = lovelaceToValue fees <> foldMap (Tx.txOutValue . Tx.TxOut) (C.txOuts filteredUnbalancedTxTx)
+  let pp = emulatorPParams params
+      txDeposits = shelleyTotalDepositsTxCerts pp (const False) (Tx.getTxBodyContentCerts utx)
+      coinToValue = lovelaceToValue . C.Lovelace . unCoin
+      left = Tx.getTxBodyContentMint filteredUnbalancedTxTx <> fold inputValues
+      right =
+        lovelaceToValue fees
+          <> foldMap (Tx.txOutValue . Tx.TxOut) (C.txOuts filteredUnbalancedTxTx)
+          <> coinToValue txDeposits
       balance = left <> C.negateValue right
 
   ((neg, newInputs), (pos, mNewTxOut)) <-

cardano-node-emulator/test/Cardano/Node/Emulator/MTLSpec.hs

@@ -2,16 +2,8 @@
 
 module Cardano.Node.Emulator.MTLSpec (tests) where
 
-import Control.Monad (void)
-import Data.Map qualified as Map
-import Data.Text.Lazy qualified as LText
-import Data.Text.Lazy.Encoding qualified as Text
-import Ledger.Address (CardanoAddress, PaymentPrivateKey)
-import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx))
-import Ledger.Value.CardanoAPI qualified as Value
-import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.Golden (goldenVsString)
-
+import Cardano.Api qualified as C
+import Cardano.Api.Address qualified as C
 import Cardano.Node.Emulator.API (
   nextSlot,
   payToAddress,
@@ -26,13 +18,23 @@ import Cardano.Node.Emulator.Test (
   renderLogs,
   runEmulatorM,
  )
+import Control.Monad (void)
+import Data.Map qualified as Map
+import Data.Text.Lazy qualified as LText
+import Data.Text.Lazy.Encoding qualified as Text
+import Ledger.Address (CardanoAddress, PaymentPrivateKey, toWitness, unPaymentPubKeyHash)
+import Ledger.CardanoWallet (knownMockWallet, paymentPubKeyHash)
+import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), toCardanoStakeKeyHash)
+import Ledger.Value.CardanoAPI qualified as Value
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.Golden (goldenVsString)
 
 tests :: TestTree
 tests =
   testGroup
     "Cardano.Node.Emulator.MTL"
     [ checkPredicateOptions options "submit empty tx" (hasValidatedTransactionCountOfTotal 1 1) $ do
-        void $ submitUnbalancedTx mempty w1 [pk1] (CardanoBuildTx E.emptyTxBodyContent)
+        void $ submitUnbalancedTx mempty w1 [toWitness pk1] (CardanoBuildTx E.emptyTxBodyContent)
         nextSlot
     , checkPredicateOptions options "payToAddress" (hasValidatedTransactionCountOfTotal 1 1) $ do
         void $ payToAddress (w1, pk1) w2 (Value.adaValueOf 1)
@@ -59,6 +61,19 @@ tests =
             void $ payToAddress (w1, pk1) w2 (Value.adaValueOf 1)
             nextSlot
         )
+    , checkPredicateOptions options "submit staking tx" (hasValidatedTransactionCountOfTotal 1 1) $ do
+        let
+          Right stakeKeyHash = toCardanoStakeKeyHash . unPaymentPubKeyHash . paymentPubKeyHash $ knownMockWallet 1
+          stakeCred = C.StakeCredentialByKey stakeKeyHash
+          stakeCert =
+            C.makeStakeAddressRegistrationCertificate
+              (C.StakeAddrRegistrationPreConway C.ShelleyToBabbageEraBabbage stakeCred)
+          tx =
+            E.emptyTxBodyContent
+              { C.txCertificates = C.TxCertificates C.shelleyBasedEra [stakeCert] (C.BuildTxWith mempty)
+              }
+        void $ submitUnbalancedTx mempty w1 [toWitness pk1] (CardanoBuildTx tx)
+        nextSlot
     ]
 
 w1, w2 :: CardanoAddress

cardano-node-emulator/test/Plutus/Examples/Escrow.hs

@@ -70,6 +70,7 @@ import Cardano.Node.Emulator.Test (testnet)
 import Data.Maybe (fromJust)
 import Ledger (POSIXTime, PaymentPubKeyHash (unPaymentPubKeyHash), TxId, getCardanoTxId)
 import Ledger qualified
+import Ledger.Address (toWitness)
 import Ledger.Tx.CardanoAPI qualified as C
 import Ledger.Typed.Scripts (validatorCardanoAddress)
 import Ledger.Typed.Scripts qualified as Scripts
@@ -300,7 +301,7 @@ pay wallet privateKey escrow vl = do
   E.logInfo @String $ "Pay " <> show vl <> " to the script"
   slotConfig <- asks pSlotConfig
   let (utx, utxoIndex) = mkPayTx slotConfig escrow wallet vl
-  void $ E.submitTxConfirmed utxoIndex wallet [privateKey] utx
+  void $ E.submitTxConfirmed utxoIndex wallet [toWitness privateKey] utx
 
 newtype RedeemSuccess = RedeemSuccess TxId
   deriving (Eq, Show)
@@ -355,7 +356,7 @@ redeem
 redeem wallet privateKey escrow = do
   E.logInfo @String "Redeeming"
   (utx, utxoIndex) <- mkRedeemTx escrow
-  RedeemSuccess . getCardanoTxId <$> E.submitTxConfirmed utxoIndex wallet [privateKey] utx
+  RedeemSuccess . getCardanoTxId <$> E.submitTxConfirmed utxoIndex wallet [toWitness privateKey] utx
 
 newtype RefundSuccess = RefundSuccess TxId
   deriving newtype (Eq, Show)
@@ -408,7 +409,7 @@ refund
 refund wallet privateKey escrow = do
   E.logInfo @String "Refunding"
   (utx, utxoIndex) <- mkRefundTx escrow wallet
-  RefundSuccess . getCardanoTxId <$> E.submitTxConfirmed utxoIndex wallet [privateKey] utx
+  RefundSuccess . getCardanoTxId <$> E.submitTxConfirmed utxoIndex wallet [toWitness privateKey] utx
 
 -- Submit a transaction attempting to take the refund belonging to the given pk.
 mkBadRefundTx
@@ -449,7 +450,7 @@ badRefund
 badRefund wallet privateKey escrow pkh = do
   E.logInfo @String "Bad refund"
   (utx, utxoIndex) <- mkBadRefundTx escrow pkh
-  (void $ E.submitTxConfirmed utxoIndex wallet [privateKey] utx)
+  (void $ E.submitTxConfirmed utxoIndex wallet [toWitness privateKey] utx)
     `catchError` (\err -> E.logError $ "Caught error: " ++ show err)
 
 {- | Pay some money into the escrow contract. Then release all funds to their

cardano-node-emulator/test/Plutus/Examples/Game.hs

@@ -30,7 +30,7 @@ import Data.ByteString.Char8 qualified as C
 import Data.Map qualified as Map
 import GHC.Generics (Generic)
 import Ledger (CardanoAddress, POSIXTime, PaymentPrivateKey, UtxoIndex, Validator, getValidator)
-import Ledger.Address (mkValidatorCardanoAddress)
+import Ledger.Address (mkValidatorCardanoAddress, toWitness)
 import Ledger.Tx.CardanoAPI qualified as C
 import Ledger.Typed.Scripts qualified as Scripts
 import Plutus.Script.Utils.Typed (ScriptContextV2, Versioned)
@@ -168,11 +168,11 @@ submitLockTx :: (E.MonadEmulator m) => CardanoAddress -> PaymentPrivateKey -> Lo
 submitLockTx wallet privateKey lockArgs@LockArgs{lockArgsValue} = do
   E.logInfo @String $ "Pay " <> show lockArgsValue <> " to the script"
   let (utx, utxoIndex) = mkLockTx lockArgs
-  void $ E.submitTxConfirmed utxoIndex wallet [privateKey] utx
+  void $ E.submitTxConfirmed utxoIndex wallet [toWitness privateKey] utx
 
 submitGuessTx :: (E.MonadEmulator m) => CardanoAddress -> PaymentPrivateKey -> GuessArgs -> m ()
 submitGuessTx wallet privateKey guessArgs@GuessArgs{guessArgsGameParam} = do
   E.logInfo @String "Taking a guess"
   utxos <- E.utxosAt (mkGameAddress guessArgsGameParam)
   let (utx, utxoIndex) = mkGuessTx utxos guessArgs
-  void $ E.submitTxConfirmed utxoIndex wallet [privateKey] utx
+  void $ E.submitTxConfirmed utxoIndex wallet [toWitness privateKey] utx

plutus-ledger/src/Ledger/Address.hs

@@ -11,8 +11,10 @@ module Ledger.Address (
   PaymentPrivateKey (..),
   PaymentPubKey (..),
   PaymentPubKeyHash (..),
+  StakePrivateKey (..),
   StakePubKey (..),
   StakePubKeyHash (..),
+  ToWitness (..),
   toPlutusAddress,
   toPlutusPubKeyHash,
   cardanoAddressCredential,
@@ -143,6 +145,8 @@ makeLift ''PaymentPubKeyHash
 xprvToPaymentPubKeyHash :: Crypto.XPrv -> PaymentPubKeyHash
 xprvToPaymentPubKeyHash = PaymentPubKeyHash . pubKeyHash . toPublicKey
 
+newtype StakePrivateKey = StakePrivateKey {unStakePrivateKey :: Crypto.XPrv}
+
 newtype StakePubKey = StakePubKey {unStakePubKey :: PubKey}
   deriving stock (Eq, Ord, Generic)
   deriving anyclass (ToJSON, FromJSON, ToJSONKey, FromJSONKey)
@@ -214,3 +218,12 @@ stakePubKeyHashCredential = StakingHash . PubKeyCredential . unStakePubKeyHash
 -- | Construct a `StakingCredential` from a validator script hash.
 stakeValidatorHashCredential :: StakeValidatorHash -> StakingCredential
 stakeValidatorHashCredential (StakeValidatorHash h) = StakingHash . ScriptCredential . ScriptHash $ h
+
+class ToWitness a where
+  toWitness :: a -> C.ShelleyWitnessSigningKey
+
+instance ToWitness PaymentPrivateKey where
+  toWitness (PaymentPrivateKey xprv) = C.WitnessPaymentExtendedKey (C.PaymentExtendedSigningKey xprv)
+
+instance ToWitness StakePrivateKey where
+  toWitness (StakePrivateKey xprv) = C.WitnessStakeExtendedKey (C.StakeExtendedSigningKey xprv)

plutus-ledger/src/Ledger/Tx.hs

@@ -69,13 +69,14 @@ module Ledger.Tx (
   getCardanoTxData,
   CardanoTx (.., CardanoEmulatorEraTx),
   ToCardanoError (..),
-  addCardanoTxSignature,
+  addCardanoTxWitness,
 
   -- * TxBodyContent functions
   getTxBodyContentInputs,
   getTxBodyContentCollateralInputs,
   getTxBodyContentReturnCollateral,
   getTxBodyContentMint,
+  getTxBodyContentCerts,
   txBodyContentIns,
   txBodyContentCollateralIns,
   txBodyContentOuts,
@@ -86,8 +87,8 @@ module Ledger.Tx (
 ) where
 
 import Cardano.Api qualified as C
+import Cardano.Api.ReexposeLedger qualified as C.Ledger
 import Cardano.Api.Shelley qualified as C.Api
-import Cardano.Crypto.Wallet qualified as Crypto
 import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..))
 import Cardano.Ledger.Alonzo.TxWits (txwitsVKey)
 import Codec.Serialise (Serialise)
@@ -452,6 +453,11 @@ getCardanoTxValidityRange (CardanoTx (C.Tx (C.TxBody C.TxBodyContent{..}) _) _)
 getCardanoTxData :: CardanoTx -> Map V1.DatumHash V1.Datum
 getCardanoTxData (CardanoTx (C.Tx txBody _) _) = fst $ CardanoAPI.scriptDataFromCardanoTxBody txBody
 
+getTxBodyContentCerts :: C.TxBodyContent ctx era -> [C.Ledger.TxCert (C.Api.ShelleyLedgerEra era)]
+getTxBodyContentCerts C.TxBodyContent{..} = case txCertificates of
+  C.TxCertificatesNone -> mempty
+  C.TxCertificates _ certs _ -> C.Api.toShelleyCertificate <$> certs
+
 -- TODO: add txMetaData
 
 txBodyContentIns
@@ -484,28 +490,22 @@ getCardanoTxExtraKeyWitnesses (CardanoEmulatorEraTx (C.Tx (C.TxBody C.TxBodyCont
   C.Api.TxExtraKeyWitnessesNone -> mempty
   C.Api.TxExtraKeyWitnesses _ txwits -> txwits
 
-type PrivateKey = Crypto.XPrv
-
-addCardanoTxSignature :: PrivateKey -> CardanoTx -> CardanoTx
-addCardanoTxSignature privKey = addSignatureCardano
+addCardanoTxWitness :: C.Api.ShelleyWitnessSigningKey -> CardanoTx -> CardanoTx
+addCardanoTxWitness witness (CardanoEmulatorEraTx ctx) = CardanoEmulatorEraTx (addWitness ctx)
   where
-    addSignatureCardano :: CardanoTx -> CardanoTx
-    addSignatureCardano (CardanoEmulatorEraTx ctx) =
-      CardanoEmulatorEraTx (addSignatureCardano' ctx)
-
-    addSignatureCardano' (C.Api.ShelleyTx shelleyBasedEra (AlonzoTx body wits isValid aux)) =
+    addWitness (C.Api.ShelleyTx shelleyBasedEra (AlonzoTx body wits isValid aux)) =
       C.Api.ShelleyTx shelleyBasedEra (AlonzoTx body wits' isValid aux)
       where
         wits' = wits <> mempty{txwitsVKey = newWits}
-        newWits = case fromPaymentPrivateKey privKey body of
+        newWits = case fromShelleyWitnessSigningKey body of
           C.Api.ShelleyKeyWitness _ wit -> Set.singleton wit
           _ -> Set.empty
 
-    fromPaymentPrivateKey xprv txBody =
+    fromShelleyWitnessSigningKey txBody =
       C.Api.makeShelleyKeyWitness
         C.shelleyBasedEra
         (C.Api.ShelleyTxBody C.Api.ShelleyBasedEraBabbage txBody notUsed notUsed notUsed notUsed)
-        (C.Api.WitnessPaymentExtendedKey (C.Api.PaymentExtendedSigningKey xprv))
+        witness
       where
         notUsed = undefined -- hack so we can reuse code from cardano-api