PLT-454: mustUseOutputAsCollateral (#690)

* Finish mustUseOutputAsCollateral implementation

* Add testcase

* Add documentation

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

@@ -693,10 +693,10 @@ processConstraint = \case
             unbalancedTx . tx . Tx.redeemers . at (RedeemerPtr Spend (fromIntegral idx)) .= Just red
             valueSpentInputs <>= provided value
           _ -> throwError (TxOutRefWrongType txo)
-    MustUseOutputAsCollateral _ -> do
-        pure () -- TODO
+    MustUseOutputAsCollateral txo -> do
+        unbalancedTx . tx . Tx.collateralInputs <>= [Tx.pubKeyTxIn txo]
     MustReferenceOutput txo -> do
-        unbalancedTx . tx . Tx.referenceInputs %= (Tx.pubKeyTxIn txo :)
+        unbalancedTx . tx . Tx.referenceInputs <>= [Tx.pubKeyTxIn txo]
     MustMintValue mpsHash red tn i -> do
         mintingPolicyScript <- lookupMintingPolicy mpsHash
         -- See note [Mint and Fee fields must have ada symbol].

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

@@ -137,7 +137,7 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case
         traceIfFalse "Ld" -- "MustSatisfyAnyOf"
         $ any (all (checkTxConstraint ctx)) xs
     MustUseOutputAsCollateral _ ->
-        True -- TODO
+        True -- TxInfo does not have the collateral inputs
     MustReferenceOutput _ ->
         traceIfFalse "Lf" -- "Cannot use reference inputs in PlutusV1.ScriptContext"
         False

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

@@ -152,7 +152,7 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case
         traceIfFalse "Ld" -- "MustSatisfyAnyOf"
         $ any (all (checkTxConstraint ctx)) xs
     MustUseOutputAsCollateral _ ->
-        True -- TODO
+        True -- TxInfo does not have the collateral inputs
     MustReferenceOutput txOutRef ->
         traceIfFalse "Lf" -- "Output not referenced"
         $ isJust (PV2.findTxRefInByTxOutRef txOutRef scriptContextTxInfo)

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

@@ -577,18 +577,23 @@ mustSpendScriptOutputWithMatchingDatumAndValue vh datumPred valuePred red =
     }
 
 {-# INLINABLE mustUseOutputAsCollateral #-}
--- | TODO
+-- | @mustUseOutputAsCollateral utxo@ must use the given unspent transaction output
+-- reference as collateral input.
+--
+-- If used in 'Ledger.Constraints.OffChain', this constraint adds @utxo@ as a
+-- collateral input to the transaction.
+--
+-- In 'Ledger.Constraints.OnChain' this constraint has no effect, since
+-- no information about collateral inputs is passed to the scripts.
 mustUseOutputAsCollateral :: forall i o. TxOutRef -> TxConstraints i o
 mustUseOutputAsCollateral = singleton . MustUseOutputAsCollateral
 
 {-# INLINABLE mustReferenceOutput #-}
 -- | @mustReferenceOutput utxo@ must reference (not spend!) the given
--- unspent transaction output.
+-- unspent transaction output reference.
 --
 -- If used in 'Ledger.Constraints.OffChain', this constraint adds @utxo@ as a
--- reference input to the transaction. Information about this @utxo@ must be
--- provided in the 'Ledger.Constraints.OffChain.ScriptLookups' with
--- 'Ledger.Constraints.OffChain.unspentOutputs'.
+-- reference input to the transaction.
 --
 -- If used in 'Ledger.Constraints.OnChain', this constraint verifies that the
 -- transaction references this @utxo@.

plutus-ledger-constraints/test/Spec.hs

@@ -21,8 +21,8 @@ import Hedgehog qualified
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
 import Language.Haskell.TH.Syntax
-import Ledger qualified (ChainIndexTxOut (ScriptChainIndexTxOut), inputs, paymentPubKeyHash, toTxOut, unitDatum,
-                         unitRedeemer)
+import Ledger qualified (ChainIndexTxOut (ScriptChainIndexTxOut), inputs, paymentPubKeyHash, toTxOut, txInRef,
+                         unitDatum, unitRedeemer)
 import Ledger.Ada qualified as Ada
 import Ledger.Address (StakePubKeyHash (StakePubKeyHash), addressStakingCredential)
 import Ledger.Constraints qualified as Constraints
@@ -33,7 +33,7 @@ import Ledger.Crypto (PubKeyHash (PubKeyHash))
 import Ledger.Generators qualified as Gen
 import Ledger.Index qualified as Ledger
 import Ledger.Params ()
-import Ledger.Tx (Tx (txOutputs), TxOut (TxOut, txOutAddress))
+import Ledger.Tx (Tx (txCollateral, txOutputs), TxOut (TxOut, txOutAddress))
 import Ledger.Value (CurrencySymbol, Value (Value))
 import Ledger.Value qualified as Value
 import Plutus.Script.Utils.V2.Generators qualified as Gen
@@ -56,6 +56,7 @@ tests = testGroup "all tests"
     , testPropertyNamed "mustPayToPubKeyAddress should create output addresses with stake pub key hash" "mustPayToPubKeyAddressStakePubKeyNotNothingProp" mustPayToPubKeyAddressStakePubKeyNotNothingProp
     , testPropertyNamed "mustSpendScriptOutputWithMatchingDatumAndValue" "testMustSpendScriptOutputWithMatchingDatumAndValue" testMustSpendScriptOutputWithMatchingDatumAndValue
     , testPropertyNamed "mustPayToOtherScriptAddress should create output addresses with stake validator hash" "mustPayToOtherScriptAddressStakeValidatorHashNotNothingProp" mustPayToOtherScriptAddressStakeValidatorHashNotNothingProp
+    , testPropertyNamed "mustUseOutputAsCollateral should add a collateral input" "mustUseOutputAsCollateralProp" mustUseOutputAsCollateralProp
     ]
 
 -- | Reduce one of the elements in a 'Value' by one.
@@ -148,6 +149,20 @@ mustPayToOtherScriptAddressStakeValidatorHashNotNothingProp = property $ do
             StakingHash (ScriptCredential (Ledger.ValidatorHash svh)) -> Just $ Ledger.StakeValidatorHash svh
             _                                                         -> Nothing
 
+mustUseOutputAsCollateralProp :: Property
+mustUseOutputAsCollateralProp = property $ do
+    pkh <- forAll $ Ledger.paymentPubKeyHash <$> Gen.element Gen.knownPaymentPublicKeys
+    let txOutRef = Ledger.TxOutRef (Ledger.TxId "123") 0
+        txE = Constraints.mkTx @Void mempty (Constraints.mustUseOutputAsCollateral txOutRef)
+    case txE of
+        Left e -> do
+            Hedgehog.annotateShow e
+            Hedgehog.failure
+        Right utx -> do
+            let coll = txCollateral (view OC.tx utx)
+            Hedgehog.assert $ length coll == 1
+            Hedgehog.assert $ Ledger.txInRef (head coll) == txOutRef
+
 -- | Make a transaction with the given constraints and check the validity of the inputs of that transaction.
 testScriptInputs
     :: ( PlutusTx.FromData (Scripts.DatumType a)