Add mustPayWithDatumToPubKey (fix #146).

IntersectMBO · Nov 30, 2021 · 474afc3 · 474afc3
1 parent c457079
commit 474afc3
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 9 deletions.
diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs
@@ -594,8 +594,9 @@ processConstraint = \case
         unbalancedTx . tx . Tx.mintScripts %= Set.insert mintingPolicyScript
         unbalancedTx . tx . Tx.mint <>= value i
         mintRedeemers . at mpsHash .= Just red
-    MustPayToPubKey pk vl -> do
-        unbalancedTx . tx . Tx.outputs %= (Tx.TxOut{txOutAddress=pubKeyHashAddress pk,txOutValue=vl,txOutDatumHash=Nothing} :)
+    MustPayToPubKey pk mdv vl -> do
+        let hash = datumHash <$> mdv
+        unbalancedTx . tx . Tx.outputs %= (Tx.TxOut{txOutAddress=pubKeyHashAddress pk,txOutValue=vl,txOutDatumHash=hash} :)
         valueSpentOutputs <>= provided vl
     MustPayToOtherScript vlh dv vl -> do
         let addr = Address.scriptHashAddress vlh

diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OnChain.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OnChain.hs
@@ -85,7 +85,7 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case
     MustMintValue mps _ tn v ->
         traceIfFalse "L9" -- "Value minted not OK"
         $ Value.valueOf (txInfoMint scriptContextTxInfo) (Value.mpsSymbol mps) tn == v
-    MustPayToPubKey pk vl ->
+    MustPayToPubKey pk _ vl ->
         traceIfFalse "La" -- "MustPayToPubKey"
         $ vl `leq` V.valuePaidTo scriptContextTxInfo pk
     MustPayToOtherScript vlh dv vl ->

diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs b/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs
@@ -48,7 +48,7 @@ data TxConstraint =
     | MustSpendPubKeyOutput TxOutRef
     | MustSpendScriptOutput TxOutRef Redeemer
     | MustMintValue MintingPolicyHash Redeemer TokenName Integer
-    | MustPayToPubKey PubKeyHash Value
+    | MustPayToPubKey PubKeyHash (Maybe Datum) Value
     | MustPayToOtherScript ValidatorHash Datum Value
     | MustHashDatum DatumHash Datum
     | MustSatisfyAnyOf [TxConstraint]
@@ -73,8 +73,8 @@ instance Pretty TxConstraint where
             hang 2 $ vsep ["must spend script output:", pretty ref, pretty red]
         MustMintValue mps red tn i ->
             hang 2 $ vsep ["must mint value:", pretty mps, pretty red, pretty tn <+> pretty i]
-        MustPayToPubKey pk v ->
-            hang 2 $ vsep ["must pay to pubkey:", pretty pk, pretty v]
+        MustPayToPubKey pk datum v ->
+            hang 2 $ vsep ["must pay to pubkey:", pretty pk, pretty datum, pretty v]
         MustPayToOtherScript vlh dv vl ->
             hang 2 $ vsep ["must pay to script:", pretty vlh, pretty dv, pretty vl]
         MustHashDatum dvh dv ->
@@ -194,7 +194,12 @@ mustPayToTheScript dt vl =
 {-# INLINABLE mustPayToPubKey #-}
 -- | Lock the value with a public key
 mustPayToPubKey :: forall i o. PubKeyHash -> Value -> TxConstraints i o
-mustPayToPubKey pk = singleton . MustPayToPubKey pk
+mustPayToPubKey pk = singleton . MustPayToPubKey pk Nothing
+
+{-# INLINABLE mustPayWithDatumToPubKey #-}
+-- | Lock the value and datum with a public key
+mustPayWithDatumToPubKey :: forall i o. PubKeyHash -> Datum -> Value -> TxConstraints i o
+mustPayWithDatumToPubKey pk datum = singleton . MustPayToPubKey pk (Just datum)
 
 {-# INLINABLE mustPayToOtherScript #-}
 -- | Lock the value with a public key
@@ -265,7 +270,7 @@ pubKeyPayments :: forall i o. TxConstraints i o -> [(PubKeyHash, Value)]
 pubKeyPayments TxConstraints{txConstraints} =
     Map.toList
     $ Map.fromListWith (<>)
-      (txConstraints >>= \case { MustPayToPubKey pk vl -> [(pk, vl)]; _ -> [] })
+      (txConstraints >>= \case { MustPayToPubKey pk _ vl -> [(pk, vl)]; _ -> [] })
 
 -- | The minimum 'Value' that satisfies all 'MustSpendAtLeast' constraints
 {-# INLINABLE mustSpendAtLeastTotal #-}
@@ -310,7 +315,7 @@ modifiesUtxoSet TxConstraints{txConstraints, txOwnOutputs, txOwnInputs} =
             MustSpendPubKeyOutput{}     -> True
             MustSpendScriptOutput{}     -> True
             MustMintValue{}             -> True
-            MustPayToPubKey _ vl        -> not (isZero vl)
+            MustPayToPubKey _ _ vl      -> not (isZero vl)
             MustPayToOtherScript _ _ vl -> not (isZero vl)
             MustSatisfyAnyOf xs         -> any requiresInputOutput xs
             _                           -> False