PLT-713: must mint value with reference (#758)

* Add must mint with reference input test and implementation.

fix

Merge two cases of toCardanoScriptWitness into one

Rename txMintingScripts to txMintingWitnesses. Use it for references.

nits

fix

wip

Apply James's patch

Update plutus-use-cases golden files

* plutus-use-cases set the limit of successful tests to 50

plutus-contract/test/Spec/Contract/TxConstraints.hs

@@ -41,6 +41,7 @@ import Plutus.Contract.Test (TracePredicate, assertValidatedTransactionCount, as
                              minLogLevel, valueAtAddress, w1, walletFundsChange, (.&&.))
 import Plutus.Script.Utils.Typed (Any)
 import Plutus.Script.Utils.V1.Address qualified as PV1
+import Plutus.Script.Utils.V1.Scripts qualified as PV1
 import Plutus.Script.Utils.V1.Typed.Scripts qualified as PV1
 import Plutus.Script.Utils.V2.Address qualified as PV2
 import Plutus.Script.Utils.V2.Typed.Scripts qualified as PV2

plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs

@@ -765,8 +765,7 @@ processConstraint = \case
     MustReferenceOutput txo -> do
         unbalancedTx . tx . Tx.referenceInputs <>= [Tx.pubKeyTxInput txo]
 
-    MustMintValue mpsHash@(MintingPolicyHash mpsHashBytes) red tn i -> do
-        mintingPolicyScript <- lookupMintingPolicy mpsHash
+    MustMintValue mpsHash@(MintingPolicyHash mpsHashBytes) red tn i mref -> do
         -- See note [Mint and Fee fields must have ada symbol].
         let value = (<>) (Ada.lovelaceValueOf 0) . Value.singleton (Value.mpsSymbol mpsHash) tn
         -- If i is negative we are burning tokens. The tokens burned must
@@ -777,10 +776,21 @@ processConstraint = \case
             then valueSpentInputs <>= provided (value (negate i))
             else valueSpentOutputs <>= provided (value i)
 
-        unbalancedTx . tx . Tx.mintScripts %= Map.insert mpsHash red
-        unbalancedTx . tx . Tx.scriptWitnesses %= Map.insert (ScriptHash mpsHashBytes) (fmap getMintingPolicy mintingPolicyScript)
+        unbalancedTx . tx . Tx.mintScripts %= Map.insert mpsHash (red, flip Versioned PlutusV2 <$> mref)
         unbalancedTx . tx . Tx.mint <>= value i
 
+        case mref of
+            Just ref -> do
+                refTxOut <- lookupTxOutRef ref
+                case _ciTxOutReferenceScript refTxOut of
+                    Just _ -> do
+                        unbalancedTx . tx . Tx.referenceInputs <>= [Tx.pubKeyTxInput ref]
+                    _        -> throwError (TxOutRefNoReferenceScript ref)
+            Nothing -> do
+                mintingPolicyScript <- lookupMintingPolicy mpsHash
+                unbalancedTx . tx . Tx.scriptWitnesses %= Map.insert (ScriptHash mpsHashBytes) (fmap getMintingPolicy mintingPolicyScript)
+
+
     MustPayToPubKeyAddress pk skhM mdv refScriptHashM vl -> do
         forM_ mdv $ \case
             TxOutDatumInTx d -> do

plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs

@@ -111,7 +111,7 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case
         -- gives us the redeemer's hash, but 'MustSpendScriptOutput' gives
         -- us the full redeemer
         $ isJust (V.findTxInByTxOutRef txOutRef scriptContextTxInfo)
-    MustMintValue mps _ tn v ->
+    MustMintValue mps _ tn v _ ->
         traceIfFalse "L9" -- "Value minted not OK"
         $ Value.valueOf (txInfoMint scriptContextTxInfo) (Value.mpsSymbol mps) tn == v
     MustPayToPubKeyAddress (PaymentPubKeyHash pk) _ mdv refScript vl ->

plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V2.hs

@@ -122,9 +122,10 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case
         $ Just rdmr == AMap.lookup (Spending txOutRef) (txInfoRedeemers scriptContextTxInfo)
         && isJust (PV2.findTxInByTxOutRef txOutRef scriptContextTxInfo)
         && maybe True (\ref -> isJust (PV2.findTxRefInByTxOutRef ref scriptContextTxInfo)) mRefTxOutRef
-    MustMintValue mps _ tn v ->
+    MustMintValue mps _ tn v mRefTxOutRef ->
         traceIfFalse "L9" -- "Value minted not OK"
         $ Value.valueOf (txInfoMint scriptContextTxInfo) (Value.mpsSymbol mps) tn == v
+        && maybe True (\ref -> isJust (PV2.findTxRefInByTxOutRef ref scriptContextTxInfo)) mRefTxOutRef
     MustPayToPubKeyAddress (PaymentPubKeyHash pk) _skh mdv _refScript vl ->
         let outs = PV2.txInfoOutputs scriptContextTxInfo
             hsh dv = PV2.findDatumHash dv scriptContextTxInfo

plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs

@@ -133,7 +133,7 @@ data TxConstraint =
     -- ^ The transaction must include the utxo as collateral input.
     | MustReferenceOutput TxOutRef
     -- ^ The transaction must reference (not spend) the given unspent transaction output.
-    | MustMintValue MintingPolicyHash Redeemer TokenName Integer
+    | MustMintValue MintingPolicyHash Redeemer TokenName Integer (Maybe TxOutRef)
     -- ^ The transaction must mint the given token and amount.
     | MustPayToPubKeyAddress PaymentPubKeyHash (Maybe StakePubKeyHash) (Maybe (TxOutDatum Datum)) (Maybe ScriptHash) Value
     -- ^ The transaction must create a transaction output with a public key address.
@@ -165,8 +165,8 @@ instance Pretty TxConstraint where
             hang 2 $ vsep ["must spend script output:", pretty ref, pretty red, pretty mref]
         MustReferenceOutput ref ->
             hang 2 $ vsep ["must reference output:", pretty ref]
-        MustMintValue mps red tn i ->
-            hang 2 $ vsep ["must mint value:", pretty mps, pretty red, pretty tn <+> pretty i]
+        MustMintValue mps red tn i mref ->
+            hang 2 $ vsep ["must mint value:", pretty mps, pretty red, pretty tn <+> pretty i, pretty mref]
         MustPayToPubKeyAddress pkh skh datum refScript v ->
             hang 2 $ vsep ["must pay to pubkey address:", pretty pkh, pretty skh, pretty datum, pretty refScript, pretty v]
         MustPayToOtherScript vlh skh dv refScript vl ->
@@ -609,19 +609,30 @@ mustPayToOtherScriptAddressWithInlineDatum vh svh dv vl =
 mustMintValue :: forall i o. Value -> TxConstraints i o
 mustMintValue = mustMintValueWithRedeemer unitRedeemer
 
+{-# INLINABLE mustMintValueWithReference #-}
+-- | Same as 'mustMintValueWithRedeemerAndReference', but sets the redeemer to the unit
+-- redeemer.
+mustMintValueWithReference :: forall i o. TxOutRef -> Value -> TxConstraints i o
+mustMintValueWithReference = mustMintValueWithRedeemerAndReference unitRedeemer . Just
+
 {-# INLINABLE mustMintValueWithRedeemer #-}
--- | Same as 'mustMintCurrencyWithRedeemer', but uses the minting policy hash,
+-- | Same as 'mustMintValueWithRedeemerAndReference', but sets the reference to 'Nothing'.
+mustMintValueWithRedeemer :: forall i o. Redeemer -> Value -> TxConstraints i o
+mustMintValueWithRedeemer red = mustMintValueWithRedeemerAndReference red Nothing
+
+{-# INLINABLE mustMintValueWithRedeemerAndReference #-}
+-- | Same as 'mustMintCurrencyWithRedeemerAndReference', but uses the minting policy hash,
 -- token name and amount provided by 'Value'.
 --
 -- Note that we can derive the 'MintingPolicyHash' from the 'Value'\'s currency
 -- symbol.
-mustMintValueWithRedeemer :: forall i o. Redeemer -> Value -> TxConstraints i o
-mustMintValueWithRedeemer red =
+mustMintValueWithRedeemerAndReference :: forall i o. Redeemer -> (Maybe TxOutRef) -> Value -> TxConstraints i o
+mustMintValueWithRedeemerAndReference red mref =
     foldMap valueConstraint . (AssocMap.toList . Value.getValue)
     where
         valueConstraint (currencySymbol, mp) =
             let hs = Value.currencyMPSHash currencySymbol in
-            foldMap (Haskell.uncurry (mustMintCurrencyWithRedeemer hs red))
+            foldMap (Haskell.uncurry (mustMintCurrencyWithRedeemerAndReference mref hs red))
                     (AssocMap.toList mp)
 
 {-# INLINABLE mustMintCurrency #-}
@@ -635,29 +646,54 @@ mustMintCurrency
     -> TxConstraints i o
 mustMintCurrency mps = mustMintCurrencyWithRedeemer mps unitRedeemer
 
+{-# INLINABLE mustMintCurrencyWithReference #-}
+-- | Same as 'mustMintCurrencyWithRedeemerAndReference', but sets the redeemer to the unit
+-- redeemer.
+mustMintCurrencyWithReference
+    :: forall i o
+     . TxOutRef
+    -> MintingPolicyHash
+    -> TokenName
+    -> Integer
+    -> TxConstraints i o
+mustMintCurrencyWithReference ref mps = mustMintCurrencyWithRedeemerAndReference (Just ref) mps unitRedeemer
+
 {-# INLINABLE mustMintCurrencyWithRedeemer #-}
--- | @mustMintCurrencyWithRedeemer mph r tn a@ creates the given amount @a@ of
--- the currency specified with @mph@, @r@ and @tn@.
+-- | Same as 'mustMintCurrencyWithRedeemerAndReference', but sets the reference to 'Nothing'.
+mustMintCurrencyWithRedeemer
+    :: forall i o
+     . MintingPolicyHash
+    -> Redeemer
+    -> TokenName
+    -> Integer
+    -> TxConstraints i o
+mustMintCurrencyWithRedeemer = mustMintCurrencyWithRedeemerAndReference Nothing
+
+{-# INLINABLE mustMintCurrencyWithRedeemerAndReference #-}
+-- | @mustMintCurrencyWithRedeemerAndReference mref mph r tn a@ creates the given amount @a@ of
+-- the currency specified with @mph@, @r@ and @tn@. The minting policy script can be specified
+-- with a reference script @mref@.
 --
 -- If used in 'Ledger.Constraints.OffChain', this constraint mints a currency
--- using @mph@, @r@, @tn@ and @a@, adds @mph@ in the transaction's minting
+-- using @mref@, @mph@, @r@, @tn@ and @a@, adds @mph@ in the transaction's minting
 -- policy witness set and adds @r@ in the transaction's redeemer witness set.
 -- The minting policy must be provided in the
 -- 'Ledger.Constraints.OffChain.ScriptLookups' with
 -- 'Ledger.Constraints.OffChain.typedValidatorLookups' or
 -- 'Ledger.Constraints.OffChain.plutusV1MintingPolicy'.
 --
 -- If used in 'Ledger.Constraints.OnChain', this constraint verifies that the
--- minted currenty @mph@, @tn@ and @a@ is part of the transaction's minting
+-- minted currenty @mref@, @mph@, @tn@ and @a@ is part of the transaction's minting
 -- information.
-mustMintCurrencyWithRedeemer
+mustMintCurrencyWithRedeemerAndReference
     :: forall i o
-     . MintingPolicyHash
+     . (Maybe TxOutRef)
+    -> MintingPolicyHash
     -> Redeemer
     -> TokenName
     -> Integer
     -> TxConstraints i o
-mustMintCurrencyWithRedeemer mps red tn a = if a == 0 then mempty else singleton $ MustMintValue mps red tn a
+mustMintCurrencyWithRedeemerAndReference mref mph red tn a = if a == 0 then mempty else singleton $ MustMintValue mph red tn a mref
 
 {-# INLINABLE mustSpendAtLeast #-}
 -- | @mustSpendAtLeast v@ requires the sum of the transaction's inputs value to
@@ -846,8 +882,8 @@ requiredSignatories = foldMap f . txConstraints where
 {-# INLINABLE requiredMonetaryPolicies #-}
 requiredMonetaryPolicies :: forall i o. TxConstraints i o -> [MintingPolicyHash]
 requiredMonetaryPolicies = foldMap f . txConstraints where
-    f (MustMintValue mps _ _ _) = [mps]
-    f _                         = []
+    f (MustMintValue mps _ _ _ _) = [mps]
+    f _                           = []
 
 {-# INLINABLE requiredDatums #-}
 requiredDatums :: forall i o. TxConstraints i o -> [Datum]

plutus-ledger/src/Ledger/Generators.hs

@@ -263,7 +263,7 @@ genValidTransactionSpending' g ins totalVal = do
                         , txData = Map.fromList (map (\d -> (datumHash d, d)) datums)
                         , txScripts = Map.fromList (map ((\s -> (scriptHash s, s)) . fmap getValidator) scripts)
                         }
-                    & addMintingPolicy (Versioned ScriptGen.alwaysSucceedPolicy PlutusV1) Script.unitRedeemer
+                    & addMintingPolicy (Versioned ScriptGen.alwaysSucceedPolicy PlutusV1) (Script.unitRedeemer, Nothing)
                     & EmulatorTx
 
                 -- sign the transaction with all known wallets

plutus-ledger/src/Ledger/Test.hs

@@ -10,8 +10,9 @@ import Ledger qualified
 import Ledger.Typed.Scripts qualified as Scripts
 import Plutus.Script.Utils.Typed as PSU
 import Plutus.Script.Utils.V1.Scripts qualified as PV1
-import Plutus.Script.Utils.V1.Typed.Scripts.MonetaryPolicies qualified as MPS
+import Plutus.Script.Utils.V1.Typed.Scripts.MonetaryPolicies qualified as MPS1
 import Plutus.Script.Utils.V2.Scripts qualified as PV2
+import Plutus.Script.Utils.V2.Typed.Scripts.MonetaryPolicies qualified as MPS2
 import Plutus.V1.Ledger.Api (Address, Validator)
 import Plutus.V1.Ledger.Api qualified as PV1
 import Plutus.V1.Ledger.Value qualified as Value
@@ -50,16 +51,30 @@ someAddressV2 = Ledger.scriptValidatorHashAddress someValidatorHashV2 Nothing
 mkPolicy :: () -> Ledger.ScriptContext -> Bool
 mkPolicy _ _ = True
 
+{-# INLINABLE mkPolicyV2 #-}
+mkPolicyV2 :: () -> PV2.ScriptContext -> Bool
+mkPolicyV2 _ _ = True
+
 coinMintingPolicy :: Ledger.MintingPolicy
 coinMintingPolicy = Ledger.mkMintingPolicyScript
-    $$(PlutusTx.compile [|| MPS.mkUntypedMintingPolicy mkPolicy ||])
+    $$(PlutusTx.compile [|| MPS1.mkUntypedMintingPolicy mkPolicy ||])
 
 coinMintingPolicyHash :: Ledger.MintingPolicyHash
 coinMintingPolicyHash = PV1.mintingPolicyHash coinMintingPolicy
 
+coinMintingPolicyV2 :: Ledger.MintingPolicy
+coinMintingPolicyV2 = Ledger.mkMintingPolicyScript
+    $$(PlutusTx.compile [|| MPS2.mkUntypedMintingPolicy mkPolicyV2 ||])
+
+coinMintingPolicyHashV2 :: Ledger.MintingPolicyHash
+coinMintingPolicyHashV2 = PV2.mintingPolicyHash coinMintingPolicyV2
+
 coinMintingPolicyCurrencySymbol :: Ledger.CurrencySymbol
 coinMintingPolicyCurrencySymbol = Value.mpsSymbol coinMintingPolicyHash
 
+coinMintingPolicyCurrencySymbolV2 :: Ledger.CurrencySymbol
+coinMintingPolicyCurrencySymbolV2 = Value.mpsSymbol coinMintingPolicyHashV2
+
 someToken :: Ledger.Value
 someToken = Value.singleton coinMintingPolicyCurrencySymbol "someToken" 1
 

plutus-ledger/src/Ledger/Tx.hs

@@ -244,7 +244,7 @@ instance Pretty CardanoTx where
                 ++ [ "mint:" <+> pretty (getCardanoTxMint tx)
                 , "fee:" <+> pretty (getCardanoTxFee tx)
                 ] ++ onCardanoTx (\tx' ->
-                    [ hang 2 (vsep ("mps:": fmap pretty (Map.toList (txMintingScripts tx'))))
+                    [ hang 2 (vsep ("mps:": fmap pretty (Map.toList (txMintingWitnesses tx'))))
                     , hang 2 (vsep ("signatures:": fmap (pretty . fst) (Map.toList (txSignatures tx'))))
                     ]) (const []) tx ++
                 [ "validity range:" <+> viaShow (getCardanoTxValidityRange tx)

plutus-ledger/src/Ledger/Tx/CardanoAPI.hs

@@ -34,7 +34,6 @@ module Ledger.Tx.CardanoAPI(
 import Cardano.Api qualified as C
 import Cardano.Api.Shelley qualified as C
 import Data.Bitraversable (bisequence)
-import Data.Map (Map)
 import Data.Map qualified as Map
 import Ledger.Address qualified as P
 import Ledger.Params qualified as P
@@ -87,7 +86,7 @@ toCardanoTxBodyContent P.Params{P.pProtocolParams, P.pNetworkId} sigs tx@P.Tx{..
         , txUpdateProposal = C.TxUpdateProposalNone
         }
 
-toWithdrawals :: Map P.ScriptHash (P.Versioned P.Script)
+toWithdrawals :: P.ScriptsMap
   -> C.NetworkId
   -> [P.Withdrawal]
   -> Either ToCardanoError (C.TxWithdrawals C.BuildTx C.BabbageEra)
@@ -104,29 +103,39 @@ toWithdrawals txScripts networkId = \case
     toStakeWitness withdrawalRedeemer cred = case cred of
       PV1.PubKeyCredential _pkh -> pure $ C.BuildTxWith $ C.KeyWitness C.KeyWitnessForStakeAddr
       PV1.ScriptCredential _vh -> case (,) <$> withdrawalRedeemer <*> P.lookupValidator txScripts _vh of
-        Just (redeemer, script) -> C.BuildTxWith . C.ScriptWitness C.ScriptWitnessForStakeAddr <$> toCardanoScriptWitness C.NoScriptDatumForStake redeemer (fmap P.getValidator script)
+        Just (redeemer, script) -> C.BuildTxWith . C.ScriptWitness C.ScriptWitnessForStakeAddr <$> toCardanoScriptWitness C.NoScriptDatumForStake redeemer (Left $ fmap P.getValidator script)
         Nothing                    -> Left MissingStakeValidator
 
-toCardanoMintWitness :: PV1.Redeemer -> Maybe (P.Versioned PV1.MintingPolicy) -> Either ToCardanoError (C.ScriptWitness C.WitCtxMint C.BabbageEra)
-toCardanoMintWitness _ Nothing = Left MissingMintingPolicy
-toCardanoMintWitness redeemer (Just script) =
-  toCardanoScriptWitness C.NoScriptDatumForMint redeemer (fmap P.getMintingPolicy script)
+toCardanoMintWitness :: PV1.Redeemer -> Maybe (P.Versioned PV1.TxOutRef) -> Maybe (P.Versioned PV1.MintingPolicy) -> Either ToCardanoError (C.ScriptWitness C.WitCtxMint C.BabbageEra)
+toCardanoMintWitness _ Nothing Nothing = Left MissingMintingPolicy
+toCardanoMintWitness redeemer (Just ref) _ =
+  toCardanoScriptWitness C.NoScriptDatumForMint redeemer (Right ref)
+toCardanoMintWitness redeemer _ (Just script) =
+  toCardanoScriptWitness C.NoScriptDatumForMint redeemer (Left (fmap P.getMintingPolicy script))
 
 toCardanoScriptWitness :: PV1.ToData a =>
   C.ScriptDatum witctx
   -> a
-  -> P.Versioned PV1.Script
+  -> Either (P.Versioned PV1.Script) (P.Versioned PV1.TxOutRef)
   -> Either ToCardanoError (C.ScriptWitness witctx C.BabbageEra)
-toCardanoScriptWitness datum redeemer (P.Versioned script lang) = (case lang of
+toCardanoScriptWitness datum redeemer scriptOrRef = (case lang of
     P.PlutusV1 ->
       C.PlutusScriptWitness C.PlutusScriptV1InBabbage C.PlutusScriptV1
-          <$> fmap C.PScript (toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV1) script)
+          <$> (case scriptOrRef of
+            Left (P.Versioned script _) -> fmap C.PScript (toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV1) script)
+            Right (P.Versioned ref _) -> flip C.PReferenceScript Nothing <$> (toCardanoTxIn ref)
+          )
     P.PlutusV2 ->
       C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2
-          <$> fmap C.PScript (toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV2) script)
+          <$> (case scriptOrRef of
+            Left (P.Versioned script _) -> fmap C.PScript (toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV2) script)
+            Right (P.Versioned ref _) -> flip C.PReferenceScript Nothing <$> (toCardanoTxIn ref)
+          )
   ) <*> pure datum
     <*> pure (C.fromPlutusData $ PV1.toData redeemer)
     <*> pure zeroExecutionUnits
+  where
+    lang = either P.version P.version scriptOrRef
 
 toCardanoStakeAddress :: C.NetworkId -> PV1.Credential -> Either ToCardanoError C.StakeAddress
 toCardanoStakeAddress networkId credential =
@@ -203,10 +212,10 @@ toCardanoTxInScriptWitnessHeader (P.Versioned script lang) =
 
 toCardanoMintValue :: P.Tx -> Either ToCardanoError (C.TxMintValue C.BuildTx C.BabbageEra)
 toCardanoMintValue tx@P.Tx{..} =
-    let indexedMps = Map.assocs txMintingScripts
+    let indexedMps = Map.assocs txMintingWitnesses
     in C.TxMintValue C.MultiAssetInBabbageEra
        <$> toCardanoValue txMint
        <*> fmap (C.BuildTxWith . Map.fromList)
-             (traverse (\(mph, rd) ->
-                bisequence (toCardanoPolicyId mph, toCardanoMintWitness rd (P.lookupMintingPolicy (P.txScripts tx) mph)))
+             (traverse (\(mph, (rd, mTxOutRef)) ->
+                bisequence (toCardanoPolicyId mph, toCardanoMintWitness rd mTxOutRef (P.lookupMintingPolicy (P.txScripts tx) mph)))
                 indexedMps)

plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs

@@ -89,7 +89,6 @@ import Cardano.Api.Shelley qualified as C
 import Cardano.BM.Data.Tracer (ToObject)
 import Cardano.Chain.Common (addrToBase58)
 import Cardano.Ledger.Alonzo.Language qualified as Alonzo
-import Cardano.Ledger.Alonzo.Language qualified as P
 import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo
 import Cardano.Ledger.Alonzo.TxWitness qualified as Alonzo
 import Cardano.Ledger.Core qualified as Ledger