PLT-445 Add mustReferencePubKeyOutput in constraints library

playground-common/src/PSGenerator/Common.hs

@@ -36,6 +36,7 @@ import Ledger.TimeSlot (SlotConfig, SlotConversionError)
 import Ledger.Tx.CardanoAPI (FromCardanoError, ToCardanoError)
 import Ledger.Value (AssetClass, CurrencySymbol, TokenName, Value)
 import Playground.Types (ContractCall, FunctionSchema, KnownCurrency)
+import Plutus.ApiCommon (LedgerPlutusVersion)
 import Plutus.ChainIndex.Api (IsUtxoResponse, QueryResponse, TxosResponse, UtxosResponse)
 import Plutus.ChainIndex.ChainIndexError (ChainIndexError)
 import Plutus.ChainIndex.ChainIndexLog (ChainIndexLog)
@@ -334,7 +335,8 @@ scriptAnyLangType = SumType (
 ------------------------------------------------------------
 ledgerTypes :: [SumType 'Haskell]
 ledgerTypes =
-    [ equal . genericShow . argonaut $ mkSumType @Slot
+    [ order . genericShow . argonaut $ mkSumType @LedgerPlutusVersion
+    , equal . genericShow . argonaut $ mkSumType @Slot
     , equal . genericShow . argonaut $ mkSumType @Ada
     , equal . genericShow . argonaut $ mkSumType @SlotConfig
     , equal . genericShow . argonaut $ mkSumType @SlotConversionError

playground-common/src/Schema.hs

@@ -62,6 +62,7 @@ import Ledger (Ada, AssetClass, CurrencySymbol, Interval, POSIXTime, POSIXTimeRa
                PubKey, PubKeyHash, Signature, Slot, StakePubKey, StakePubKeyHash, TokenName, TxId, TxOutRef, Value)
 import Ledger.Bytes (LedgerBytes)
 import Ledger.CardanoWallet (WalletNumber)
+import Plutus.ApiCommon (LedgerPlutusVersion)
 import Plutus.Contract.Secrets (SecretArgument (EndpointSide, UserSide))
 import Plutus.Contract.StateMachine.ThreadToken (ThreadToken)
 import Plutus.V1.Ledger.Api (DatumHash, RedeemerHash, ValidatorHash)
@@ -403,6 +404,8 @@ deriving anyclass instance ToSchema PaymentPubKey
 
 deriving anyclass instance ToSchema PaymentPubKeyHash
 
+deriving anyclass instance ToSchema LedgerPlutusVersion
+
 deriving anyclass instance ToSchema StakePubKey
 
 deriving anyclass instance ToSchema StakePubKeyHash

plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs

@@ -42,16 +42,14 @@ import Cardano.Api (NetworkId)
 import Data.List (sort)
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Data.Set (Set)
-import Data.Set qualified as Set
 import Data.Tuple (swap)
 import Ledger (OnChainTx (..), SomeCardanoApiTx (SomeTx), Tx (..), TxIn (..), TxInType (..), TxOutRef (..), onCardanoTx,
                txId)
 import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatumHash)
 import Plutus.ChainIndex.Types
 import Plutus.Contract.CardanoAPI (fromCardanoTx, fromCardanoTxOut, setValidity)
 import Plutus.Script.Utils.Scripts (datumHash, redeemerHash)
-import Plutus.Script.Utils.V1.Scripts (mintingPolicyHash, validatorHash)
+import Plutus.Script.Utils.V1.Scripts (validatorHash)
 import Plutus.V1.Ledger.Api (Datum, DatumHash, MintingPolicy (getMintingPolicy), MintingPolicyHash (MintingPolicyHash),
                              Redeemer, RedeemerHash, Script, Validator (getValidator), ValidatorHash (ValidatorHash))
 import Plutus.V1.Ledger.Scripts (ScriptHash (ScriptHash))
@@ -125,17 +123,19 @@ fromOnChainCardanoTx :: Bool -> SomeCardanoApiTx -> ChainIndexTx
 fromOnChainCardanoTx validity (SomeTx tx era) =
     either (error . ("Plutus.ChainIndex.Tx.fromOnChainCardanoTx: " ++) . show) id $ fromCardanoTx era $ setValidity validity tx
 
-mintingPolicies :: Set MintingPolicy -> Map ScriptHash Script
-mintingPolicies = Map.fromList . fmap withHash . Set.toList
+mintingPolicies :: Map MintingPolicyHash MintingPolicy -> Map ScriptHash Script
+mintingPolicies = Map.fromList . fmap toScript . Map.toList
   where
-    withHash mp = let (MintingPolicyHash mph) = mintingPolicyHash mp
-                   in (ScriptHash mph, getMintingPolicy mp)
+    toScript (MintingPolicyHash mph, mp) = (ScriptHash mph, getMintingPolicy mp)
 
 validators :: [TxIn] -> (Map ScriptHash Script, Map DatumHash Datum, Redeemers)
 validators = foldMap (\(ix, txIn) -> maybe mempty (withHash ix) $ txInType txIn) . zip [0..] . sort
   -- we sort the inputs to make sure that the indices match with redeemer pointers
   where
-    withHash ix (ConsumeScriptAddress val red dat) =
+    -- TODO: the index of the txin is probably incorrect as we take it from the set.
+    -- To determine the proper index we have to convert the plutus's `TxIn` to cardano-api `TxIn` and
+    -- sort them by using the standard `Ord` instance.
+    withHash ix (ConsumeScriptAddress _lang val red dat) =
       let (ValidatorHash vh) = validatorHash val
        in ( Map.singleton (ScriptHash vh) (getValidator val)
           , Map.singleton (datumHash dat) dat

plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs

@@ -144,7 +144,7 @@ instance OpenApi.ToSchema C.ScriptInAnyLang where
 
 fromReferenceScript :: ReferenceScript -> Maybe Script
 fromReferenceScript ReferenceScriptNone             = Nothing
-fromReferenceScript (ReferenceScriptInAnyLang sial) = fromCardanoScriptInAnyLang sial
+fromReferenceScript (ReferenceScriptInAnyLang sial) = fst <$> fromCardanoScriptInAnyLang sial
 
 data ChainIndexTxOut = ChainIndexTxOut
   { citoAddress   :: Address -- ^ We can't use AddressInAnyEra here because of missing FromJson instance for Byron era

plutus-contract/plutus-contract.cabal

@@ -234,6 +234,7 @@ test-suite plutus-contract-test
   other-modules:
     Spec.Balancing
     Spec.Contract
+    Spec.Contract.TxConstraints
     Spec.Emulator
     Spec.ErrorChecking
     Spec.Plutus.Contract.Oracle

plutus-contract/src/Plutus/Contract/Test.hs

@@ -36,6 +36,7 @@ module Plutus.Contract.Test(
     , assertInstanceLog
     , assertNoFailedTransactions
     , assertValidatedTransactionCount
+    , assertValidatedTransactionCountOfTotal
     , assertFailedTransaction
     , assertHooks
     , assertResponses
@@ -111,7 +112,6 @@ import Test.Tasty.Providers (TestTree)
 
 import Ledger.Ada qualified as Ada
 import Ledger.Constraints.OffChain (UnbalancedTx)
-import Ledger.Tx (Tx, onCardanoTx)
 import Plutus.Contract.Effects qualified as Requests
 import Plutus.Contract.Request qualified as Request
 import Plutus.Contract.Resumable (Request (..), Response (..))
@@ -632,13 +632,13 @@ assertChainEvents' logMsg predicate = TracePredicate $
 
 -- | Assert that at least one transaction failed to validate, and that all
 --   transactions that failed meet the predicate.
-assertFailedTransaction :: (Tx -> ValidationError -> [ScriptValidationEvent] -> Bool) -> TracePredicate
+assertFailedTransaction :: (Ledger.CardanoTx -> ValidationError -> [ScriptValidationEvent] -> Bool) -> TracePredicate
 assertFailedTransaction predicate = TracePredicate $
     flip postMapM (L.generalize $ Folds.failedTransactions Nothing) $ \case
         [] -> do
             tell @(Doc Void) $ "No transactions failed to validate."
             pure False
-        xs -> pure (all (\(_, t, e, evts, _) -> onCardanoTx (\t' -> predicate t' e evts) (const True) t) xs)
+        xs -> pure (all (\(_, t, e, evts, _) -> predicate t e evts) xs)
 
 -- | Assert that no transaction failed to validate.
 assertNoFailedTransactions :: TracePredicate
@@ -652,14 +652,22 @@ assertNoFailedTransactions = TracePredicate $
 
 -- | Assert that n transactions validated, and no transaction failed to validate.
 assertValidatedTransactionCount :: Int -> TracePredicate
-assertValidatedTransactionCount expected =
-    assertNoFailedTransactions
-    .&&.
+assertValidatedTransactionCount expected = assertValidatedTransactionCountOfTotal expected expected
+
+-- | Assert that n transactions validated, and the rest failed.
+assertValidatedTransactionCountOfTotal :: Int -> Int -> TracePredicate
+assertValidatedTransactionCountOfTotal expectedValid expectedTotal =
     TracePredicate (flip postMapM (L.generalize Folds.validatedTransactions) $ \xs ->
         let actual = length xs - 1 in -- ignore the initial wallet distribution transaction
-        if actual == expected then pure True else do
+        if actual == expectedValid then pure True else do
             tell @(Doc Void) $ "Unexpected number of validated transactions:" <+> pretty actual
             pure False
+    ) .&&.
+    TracePredicate (flip postMapM (L.generalize $ Folds.failedTransactions Nothing) $ \xs ->
+        let actual = length xs in
+        if actual == expectedTotal - expectedValid then pure True else do
+            tell @(Doc Void) $ "Unexpected number of invalid transactions:" <+> pretty actual
+            pure False
     )
 
 assertInstanceLog ::

plutus-contract/src/Plutus/Contract/Test/ContractModel/DoubleSatisfaction.hs

@@ -358,7 +358,8 @@ doubleSatisfactionCounterexamples dsc =
                                    , txOutRefIdx = 1
                                    }
         newFakeTxIn = TxIn { txInRef = newFakeTxOutRef
-                           , txInType = Just $ ConsumeScriptAddress alwaysOkValidator
+                           , txInType = Just $ ConsumeScriptAddress PlutusV1
+                                                                    alwaysOkValidator
                                                                     redeemerEmpty
                                                                     datumEmpty
                            }

plutus-contract/src/Plutus/Contract/Wallet.hs

@@ -53,13 +53,12 @@ import Ledger.Constraints.OffChain (UnbalancedTx (UnbalancedTx, unBalancedTxRequ
                                     mkTx)
 import Ledger.Constraints.OffChain qualified as U
 import Ledger.TimeSlot (SlotConfig, posixTimeRangeToContainedSlotRange)
-import Ledger.Tx (CardanoTx, TxId (TxId), TxOutRef, getCardanoTxInputs, txInRef)
+import Ledger.Tx (CardanoTx, TxId (TxId), TxIn (..), TxInType (..), TxOutRef, getCardanoTxInputs, txInRef)
 import Ledger.Validation (CardanoLedgerError, fromPlutusIndex, makeTransactionBody)
 import Plutus.Contract.CardanoAPI qualified as CardanoAPI
 import Plutus.Contract.Error (AsContractError (_ConstraintResolutionContractError, _OtherContractError))
 import Plutus.Contract.Request qualified as Contract
 import Plutus.Contract.Types (Contract)
-import Plutus.Script.Utils.V1.Scripts qualified as PV1
 import Plutus.V1.Ledger.Api qualified as Plutus
 import Plutus.V1.Ledger.Scripts (MintingPolicyHash)
 import Plutus.V1.Ledger.Tx qualified as PV1
@@ -284,14 +283,14 @@ mkRedeemers tx = (++) <$> mkSpendingRedeemers tx <*> mkMintingRedeemers tx
 
 mkSpendingRedeemers :: P.Tx -> Either CardanoAPI.ToCardanoError [ExportTxRedeemer]
 mkSpendingRedeemers P.Tx{P.txInputs} = fmap join (traverse extract txInputs) where
-    extract PV1.TxIn{PV1.txInType=Just (PV1.ConsumeScriptAddress _ redeemer _), PV1.txInRef} =
+    extract TxIn{txInType=Just (ConsumeScriptAddress _ _ redeemer _), txInRef} =
         pure [SpendingRedeemer{redeemer, redeemerOutRef=txInRef}]
     extract _ = pure []
 
 mkMintingRedeemers :: P.Tx -> Either CardanoAPI.ToCardanoError [ExportTxRedeemer]
 mkMintingRedeemers P.Tx{P.txRedeemers, P.txMintScripts} = traverse extract $ Map.toList txRedeemers where
-    indexedMintScripts = Map.fromList $ zip [0..] $ Set.toList txMintScripts
+    indexedMintScriptHashes = Map.fromList $ zip [0..] $ Map.keys txMintScripts
     extract (PV1.RedeemerPtr PV1.Mint idx, redeemer) = do
-        redeemerPolicyId <- maybe (Left CardanoAPI.MissingMintingPolicy) (Right . PV1.mintingPolicyHash) (Map.lookup idx indexedMintScripts)
+        redeemerPolicyId <- maybe (Left CardanoAPI.MissingMintingPolicy) Right (Map.lookup idx indexedMintScriptHashes)
         pure MintingRedeemer{redeemer, redeemerPolicyId}
     extract (PV1.RedeemerPtr tag _, _) = Left (CardanoAPI.ScriptPurposeNotSupported tag)

plutus-contract/src/Wallet/Emulator/MultiAgent.hs

@@ -291,6 +291,7 @@ emulatorStateInitialDist :: Map PaymentPubKeyHash Value -> EmulatorState
 emulatorStateInitialDist mp = emulatorStatePool [EmulatorTx tx] where
     tx = Tx
             { txInputs = mempty
+            , txReferenceInputs = mempty
             , txCollateral = mempty
             , txOutputs = Map.toList mp >>= mkOutputs
             , txMint = foldMap snd $ Map.toList mp

plutus-contract/src/Wallet/Emulator/Stream.hs

@@ -45,7 +45,7 @@ import Data.Set qualified as Set
 import Ledger.AddressMap qualified as AM
 import Ledger.Blockchain (Block, OnChainTx (Valid))
 import Ledger.Slot (Slot)
-import Ledger.Tx (CardanoTx (..), Tx)
+import Ledger.Tx (CardanoTx (..))
 import Ledger.Value (Value)
 import Plutus.ChainIndex (ChainIndexError)
 import Streaming (Stream)
@@ -141,11 +141,11 @@ data EmulatorConfig =
         , _params            :: Params -- ^ Set the protocol parameters, network ID and slot configuration for the emulator.
         } deriving (Eq, Show)
 
-type InitialChainState = Either InitialDistribution [Tx]
+type InitialChainState = Either InitialDistribution [CardanoTx]
 
 -- | The wallets' initial funds
 initialDist :: InitialChainState -> InitialDistribution
-initialDist = either id (walletFunds . map (Valid . EmulatorTx)) where
+initialDist = either id (walletFunds . map Valid) where
     walletFunds :: Block -> Map Wallet Value
     walletFunds theBlock =
         let values = AM.values $ AM.fromChain [theBlock]
@@ -162,7 +162,7 @@ initialState :: EmulatorConfig -> EM.EmulatorState
 initialState EmulatorConfig{_initialChainState} =
     either
         (EM.emulatorStateInitialDist . Map.mapKeys EM.mockWalletPaymentPubKeyHash)
-        (EM.emulatorStatePool . map EmulatorTx)
+        EM.emulatorStatePool
         _initialChainState
 
 data EmulatorErr =

plutus-contract/src/Wallet/Emulator/Wallet.hs

@@ -71,7 +71,6 @@ import Plutus.Contract (WalletAPIError)
 import Plutus.Contract.Checkpoint (CheckpointLogMsg)
 import Plutus.Contract.Wallet (finalize)
 import Plutus.V1.Ledger.Api (PubKeyHash, TxOutRef, ValidatorHash, Value)
-import Plutus.V1.Ledger.Tx (TxIn (TxIn, txInRef))
 import PlutusTx.Prelude qualified as PlutusTx
 import Prettyprinter (Pretty (pretty))
 import Servant.API (FromHttpApiData (parseUrlPiece), ToHttpApiData (toUrlPiece))
@@ -417,7 +416,7 @@ lookupValue ::
     )
     => Tx.TxIn
     -> Eff effs Value
-lookupValue outputRef@TxIn {txInRef} = do
+lookupValue outputRef@Tx.TxIn {Tx.txInRef} = do
     txoutMaybe <- ChainIndex.unspentTxOutFromRef txInRef
     case txoutMaybe of
         Just txout -> pure $ view Ledger.ciTxOutValue txout

plutus-contract/src/Wallet/Rollup/Render.hs

@@ -284,9 +284,9 @@ instance Render TxIn where
     render (TxIn txInRef Nothing) = render txInRef
 
 instance Render TxInType where
-    render (ConsumeScriptAddress validator _ _) = render validator
-    render ConsumePublicKeyAddress              = pure mempty
-    render ConsumeSimpleScriptAddress           = pure mempty
+    render (ConsumeScriptAddress _ validator _ _) = render validator
+    render ConsumePublicKeyAddress                = pure mempty
+    render ConsumeSimpleScriptAddress             = pure mempty
 
 instance Render TxOutRef where
     render TxOutRef {txOutRefId, txOutRefIdx} =

plutus-contract/src/Wallet/Rollup/Types.hs

@@ -14,10 +14,9 @@ import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
 import Data.Map (Map)
 import Data.OpenApi.Schema qualified as OpenApi
 import GHC.Generics
-import Ledger (PaymentPubKeyHash (PaymentPubKeyHash), Tx)
+import Ledger (PaymentPubKeyHash (PaymentPubKeyHash), Tx, TxIn)
 import Plutus.V1.Ledger.Api (Address (Address, addressCredential), Credential (PubKeyCredential, ScriptCredential),
                              TxId, TxOut (TxOut, txOutAddress), ValidatorHash, Value)
-import Plutus.V1.Ledger.Tx (TxIn)
 import Prettyprinter (Pretty, pretty, viaShow)
 
 data TxKey =

plutus-contract/test/Spec.hs

@@ -3,6 +3,7 @@ module Main(main) where
 
 import Spec.Balancing qualified
 import Spec.Contract qualified
+import Spec.Contract.TxConstraints qualified
 import Spec.Emulator qualified
 import Spec.ErrorChecking qualified
 import Spec.Plutus.Contract.Oracle qualified
@@ -20,6 +21,7 @@ main = defaultMain tests
 tests :: TestTree
 tests = testGroup "plutus-contract" [
     Spec.Contract.tests,
+    Spec.Contract.TxConstraints.tests,
     Spec.Emulator.tests,
     Spec.State.tests,
     Spec.Rows.tests,