Support registration certificates

cabal.project

@@ -13,8 +13,8 @@ repository cardano-haskell-packages
 
 -- See CONTRIBUTING.adoc for how to update index-state
 index-state:
-  , hackage.haskell.org 2024-01-01T00:00:00Z
-  , cardano-haskell-packages 2024-01-01T00:00:00Z
+  , hackage.haskell.org 2024-02-14T00:00:00Z
+  , cardano-haskell-packages 2024-02-14T00:00:00Z
 
 packages: plutus-ledger
           plutus-script-utils
@@ -47,5 +47,13 @@ package cardano-crypto-praos
   flags: -external-libsodium-vrf
 
 constraints:
-  cardano-api ^>= 8.36
-  , quickcheck-contractmodel ^>= 0.1.6
+  cardano-api ^>= 8.38
+
+source-repository-package
+    type: git
+    location: https://github.com/input-output-hk/quickcheck-contractmodel
+    tag: 266b94017e24aff37c9d57cd8d4bafe4237f56df
+    --sha256: sha256-na8LEzjUcycdQecwfyiGcP7C2xCtBv+MXEtzK76YB+E=
+    subdir:
+      quickcheck-contractmodel
+      quickcheck-threatmodel

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

@@ -1,4 +1,4 @@
-cabal-version: 3.0
+cabal-version: 3.8
 name:          cardano-node-emulator
 version:       1.3.0.0
 
@@ -114,6 +114,10 @@ test-suite cardano-node-emulator-test
     Plutus.Examples.Game
     Plutus.Examples.GameSpec
 
+  -- The limitation of plutus-tx-plugin
+  if (impl(ghc <9.6) || impl(ghc >=9.7))
+    buildable: False
+
   --------------------
   -- Local components
   --------------------
@@ -126,10 +130,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

@@ -67,7 +67,7 @@ import Cardano.Node.Emulator.Internal.API (
   modifySlot,
   processBlock,
  )
-import Control.Lens (use, (%~), (&), (<>~), (^.))
+import Control.Lens (use, (%~), (&), (.~), (<>~), (^.))
 import Control.Monad (void)
 import Control.Monad.Error.Class (throwError)
 import Control.Monad.Freer.Extras.Log qualified as L
@@ -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,
@@ -101,6 +102,7 @@ import Ledger.Tx (
 import Ledger.Tx.CardanoAPI (
   CardanoBuildTx (CardanoBuildTx),
   fromCardanoTxIn,
+  fromPlutusIndex,
   toCardanoTxIn,
   toCardanoTxOutValue,
  )
@@ -117,29 +119,32 @@ import Cardano.Node.Emulator.Internal.Node.Chain qualified as E (
   emptyChainState,
   getCurrentSlot,
   index,
+  ledgerState,
   queueTx,
  )
 import Cardano.Node.Emulator.Internal.Node.Fee qualified as E (
   makeAutoBalancedTransactionWithUtxoProvider,
   utxoProviderFromWalletOutputs,
  )
 import Cardano.Node.Emulator.Internal.Node.Params qualified as E (Params)
-import Cardano.Node.Emulator.Internal.Node.Validation (unsafeMakeValid)
+import Cardano.Node.Emulator.Internal.Node.Validation qualified as E (setUtxo, unsafeMakeValid)
 import Cardano.Node.Emulator.LogMessages (
   EmulatorMsg (ChainEvent, GenericMsg, TxBalanceMsg),
   TxBalanceMsg (BalancingUnbalancedTx, FinishedBalancing, SigningTx, SubmittingTx),
  )
 
-emptyEmulatorState :: EmulatorState
-emptyEmulatorState = EmulatorState E.emptyChainState mempty mempty
+emptyEmulatorState :: E.Params -> EmulatorState
+emptyEmulatorState params = EmulatorState (E.emptyChainState params) mempty mempty
 
-emptyEmulatorStateWithInitialDist :: Map CardanoAddress C.Value -> EmulatorState
-emptyEmulatorStateWithInitialDist initialDist =
+emptyEmulatorStateWithInitialDist :: E.Params -> Map CardanoAddress C.Value -> EmulatorState
+emptyEmulatorStateWithInitialDist params initialDist =
   let tx = Index.createGenesisTransaction initialDist
-      vtx = unsafeMakeValid tx
-   in emptyEmulatorState
+      vtx = E.unsafeMakeValid tx
+      index = Index.insertBlock [vtx] mempty
+   in emptyEmulatorState params
         & esChainState . E.chainNewestFirst %~ ([vtx] :)
-        & esChainState . E.index %~ Index.insertBlock [vtx]
+        & esChainState . E.index .~ index
+        & esChainState . E.ledgerState %~ E.setUtxo params (fromPlutusIndex index)
         & esAddressMap %~ AM.updateAllAddresses vtx
         & esDatumMap <>~ getCardanoTxData tx
 
@@ -262,13 +267,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 +282,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 +298,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 +316,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

@@ -68,7 +68,7 @@ import Cardano.Crypto.Wallet qualified as Crypto
 import Cardano.Node.Emulator.Internal.Node.Params (Params (pSlotConfig), testnet)
 import Cardano.Node.Emulator.Internal.Node.TimeSlot (SlotConfig)
 import Cardano.Node.Emulator.Internal.Node.TimeSlot qualified as TimeSlot
-import Cardano.Node.Emulator.Internal.Node.Validation (validateCardanoTx)
+import Cardano.Node.Emulator.Internal.Node.Validation (initialState, setUtxo, validateCardanoTx)
 import Control.Monad (guard, replicateM)
 import Data.Bifunctor (Bifunctor (first))
 import Data.ByteString qualified as BS
@@ -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
@@ -342,8 +343,9 @@ pubKeyTxOut v pk sk = do
 validateMockchain :: Mockchain -> CardanoTx -> Maybe Ledger.ValidationErrorInPhase
 validateMockchain (Mockchain _ utxo params) tx = result
   where
-    cUtxoIndex = C.UTxO $ Tx.toCtxUTxOTxOut <$> utxo
-    result = case validateCardanoTx params 1 cUtxoIndex tx of
+    cUtxoIndex = C.fromPlutusIndex $ C.UTxO $ Tx.toCtxUTxOTxOut <$> utxo
+    ledgerState = setUtxo params cUtxoIndex (initialState params)
+    result = case snd $ validateCardanoTx params 1 ledgerState tx of
       FailPhase1 _ err -> Just (Phase1, err)
       FailPhase2 _ err _ -> Just (Phase2, err)
       _ -> Nothing

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

@@ -28,7 +28,7 @@ import Control.Monad.State qualified as S
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Foldable (traverse_)
 import Data.List ((\\))
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Traversable (for)
 import GHC.Generics (Generic)
 import Ledger (
@@ -77,17 +77,18 @@ data ChainState = ChainState
   -- ^ The current slot number
   , _coverageData :: CoverageData
   -- ^ coverage data of validation scripts
+  , _ledgerState :: Validation.EmulatedLedgerState
   }
   deriving (Show, Generic)
 
 makeLenses ''ChainState
 
-emptyChainState :: ChainState
-emptyChainState = ChainState [] [] mempty 0 mempty
+emptyChainState :: Params -> ChainState
+emptyChainState params = ChainState [] [] mempty 0 mempty (Validation.initialState params)
 
-fromBlockchain :: Blockchain -> ChainState
-fromBlockchain bc =
-  emptyChainState
+fromBlockchain :: Params -> Blockchain -> ChainState
+fromBlockchain params bc =
+  emptyChainState params
     & chainNewestFirst .~ bc
     & index .~ Index.initialise bc
 
@@ -125,12 +126,14 @@ handleControlChain params = \case
     pool <- gets $ view txPool
     slot <- gets $ view chainCurrentSlot
     idx <- gets $ view index
+    ls <- gets $ view ledgerState
 
-    let ValidatedBlock block events idx' =
-          validateBlock params slot idx pool
+    let ValidatedBlock block events idx' ls' =
+          validateBlock params slot idx ls pool
 
     modify $ txPool .~ []
     modify $ index .~ idx'
+    modify $ ledgerState .~ ls'
     modify $ addBlock block
     modify $ coverageData <>~ foldMap getChainEventCoverageData events
 
@@ -163,19 +166,25 @@ data ValidatedBlock = ValidatedBlock
   -- ^ Transaction validation events for the transactions in this block.
   , vlbIndex :: !Index.UtxoIndex
   -- ^ The updated UTxO index after processing the block
+  , vlbLedgerState :: !Validation.EmulatedLedgerState
   }
 
-data ValidationCtx = ValidationCtx {vctxIndex :: !Index.UtxoIndex, vctxParams :: !Params}
+data ValidationCtx = ValidationCtx
+  { vctxIndex :: !Index.UtxoIndex
+  , vctxParams :: !Params
+  , vctxLedgerState :: Validation.EmulatedLedgerState
+  }
 
 {- | Validate a block given the current slot and UTxO index, returning the valid
   transactions, success/failure events and the updated UTxO set.
 -}
-validateBlock :: Params -> Slot -> Index.UtxoIndex -> TxPool -> ValidatedBlock
-validateBlock params slot@(Slot s) idx txns =
+validateBlock
+  :: Params -> Slot -> Index.UtxoIndex -> Validation.EmulatedLedgerState -> TxPool -> ValidatedBlock
+validateBlock params slot@(Slot s) idx ls txns =
   let
     -- Validate transactions, updating the UTXO index each time
-    (results, ValidationCtx idx' _) =
-      flip S.runState (ValidationCtx idx params) $ for txns $ validateEm slot
+    (results, ValidationCtx idx' _ ls') =
+      flip S.runState (ValidationCtx idx params ls) $ for txns $ validateEm slot
 
     -- The new block contains all transaction that were validated
     -- successfully
@@ -186,7 +195,7 @@ validateBlock params slot@(Slot s) idx txns =
     nextSlot = Slot (s + 1)
     events = (TxnValidation <$> results) ++ [SlotAdd nextSlot]
    in
-    ValidatedBlock block events idx'
+    ValidatedBlock block events idx' ls'
 
 -- | Validate a transaction in the current emulator state.
 validateEm
@@ -195,14 +204,14 @@ validateEm
   -> CardanoTx
   -> m Index.ValidationResult
 validateEm h txn = do
-  ctx@(ValidationCtx idx params) <- S.get
+  ctx@(ValidationCtx idx params ls) <- S.get
   let
-    res = Validation.validateCardanoTx params h idx txn
+    (ls', res) = Validation.validateCardanoTx params h ls txn
     idx' = case res of
       Index.FailPhase1{} -> idx
       Index.FailPhase2{} -> Index.insertCollateral txn idx
       Index.Success{} -> Index.insert txn idx
-  _ <- S.put ctx{vctxIndex = idx'}
+  _ <- S.put ctx{vctxIndex = idx', vctxLedgerState = fromMaybe ls ls'}
   pure res
 
 -- | Adds a block to ChainState, without validation.