PLT-807 Change behavior of MustPayToPubKeyAddress and MustPayToOtherS…

…cript w.r.t datum in transaction body * Changed `MustPayToPubKeyAddress` and `MustPayToOtherScript` so that the user needs to explicitly specify if he wants: * the datum to only be included as a hash in the transaction output * the datum to be included as a hash in the transaction output as well as in the transaction body * the datum to be inlined in the transaction output * Changed the name of the constraint `MustIncludeDatum` to `MustIncludeDatumInTx` and `MustHashDatum` to `MustIncludeDatumInTxWithHash`. These constraint don't modify the transaction anymore, but simply check that the datum is part of the transaction body. * Added a note on the 'Plutus.Contract.Oracle' module explaining why it doesn't work in it's current form. * Commented out failing test cases in `plutus-use-cases` that use the 'Plutus.Contract.Oracle' module.
IntersectMBO · Sep 29, 2022 · c40e1a2 · c40e1a2
1 parent 37ed125
commit c40e1a2
Show file tree

Hide file tree

Showing 49 changed files with 1,877 additions and 809 deletions.
diff --git a/plutus-chain-index-core/src/Plutus/Contract/CardanoAPI.hs b/plutus-chain-index-core/src/Plutus/Contract/CardanoAPI.hs
@@ -22,7 +22,7 @@ import Cardano.Api qualified as C
 import Cardano.Api.Shelley qualified as C
 import Data.List (sort)
 import Ledger qualified as P
-import Ledger.Tx.CardanoAPI as Export hiding (fromCardanoTxOut)
+import Ledger.Tx.CardanoAPI as Export
 import Plutus.ChainIndex.Types (ChainIndexTx (..), ChainIndexTxOut (..), ChainIndexTxOutputs (..), ReferenceScript (..))
 
 fromCardanoBlock :: C.BlockInMode C.CardanoMode -> [ChainIndexTx]

diff --git a/plutus-contract/src/Plutus/Contract/Oracle.hs b/plutus-contract/src/Plutus/Contract/Oracle.hs
@@ -6,10 +6,30 @@
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeApplications   #-}
+
 {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 {-# OPTIONS_GHC -fno-specialise #-}
 {-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
+
+{- Note [Oracle incorrect implementation]
+
+This current Oracle implementation uses the
+'Constraints.mustIncludeDatumInTxWithHash' constraint which used to add a datum
+in transaction body. However, cardano-ledger enforces a rule (rewording the
+rule here..) in which a datum in the transaction body needs to have the same
+hash as a datum in one of the transaction's outputs.
+
+However, now that we have fixed the bug in
+'Constraints.mustIncludeDatumInTxWithHash' so work with this ledger rule, the
+Oracle implementation does not work anymore, and examples in the
+plutus-use-cases Haskell package now fail because of this.
+
+Therefore, for now, we will comment out the failing test cases until we rewrite
+this Oracle module to work with inline datums instead of datums in the
+transaction body. This implies upgrades some of the examples in
+`plutus-use-cases` to PlutusV2.
+-}
 module Plutus.Contract.Oracle(
   -- * Signed messages
   -- $oracles
@@ -145,7 +165,7 @@ checkHashConstraints ::
 checkHashConstraints SignedMessage{osmMessageHash, osmDatum=Datum dt} =
     maybe
         (trace "Li" {-"DecodingError"-} $ Left DecodingError)
-        (\a -> pure (a, Constraints.mustHashDatum osmMessageHash (Datum dt)))
+        (\a -> pure (a, Constraints.mustIncludeDatumInTxWithHash osmMessageHash (Datum dt)))
         (fromBuiltinData dt)
 
 {-# INLINABLE verifySignedMessageConstraints #-}

diff --git a/plutus-contract/src/Plutus/Contract/StateMachine.hs b/plutus-contract/src/Plutus/Contract/StateMachine.hs
@@ -66,8 +66,8 @@ import Data.Void (Void, absurd)
 import GHC.Generics (Generic)
 import Ledger (POSIXTime, Slot, TxOutRef, Value)
 import Ledger qualified
-import Ledger.Constraints (ScriptLookups, TxConstraints, mustMintValueWithRedeemer, mustPayToTheScript,
-                           mustSpendPubKeyOutput, plutusV1MintingPolicy)
+import Ledger.Constraints (ScriptLookups, TxConstraints, TxOutDatum (TxOutDatumInTx), mustMintValueWithRedeemer,
+                           mustPayToTheScriptWithDatumInTx, mustSpendPubKeyOutput, plutusV1MintingPolicy)
 import Ledger.Constraints.OffChain (UnbalancedTx)
 import Ledger.Constraints.OffChain qualified as Constraints
 import Ledger.Constraints.TxConstraints (ScriptInputConstraint (ScriptInputConstraint, icRedeemer, icTxOutRef),
@@ -434,7 +434,10 @@ runInitialiseWith customLookups customConstraints StateMachineClient{scInstance}
     mapError (review _SMContractError) $ do
       utxo <- ownUtxos
       let StateMachineInstance{stateMachine, typedValidator} = scInstance
-          constraints = mustPayToTheScript initialState (initialValue <> SM.threadTokenValueOrZero scInstance)
+          constraints =
+              mustPayToTheScriptWithDatumInTx
+                initialState
+                (initialValue <> SM.threadTokenValueOrZero scInstance)
               <> foldMap ttConstraints (smThreadToken stateMachine)
               <> customConstraints
           red = Ledger.Redeemer (PlutusTx.toBuiltinData (Scripts.validatorHash typedValidator, Mint))
@@ -546,7 +549,7 @@ mkStep client@StateMachineClient{scInstance} input = do
                         unmint = if isFinal then mustMintValueWithRedeemer red (inv $ SM.threadTokenValueOrZero scInstance) else mempty
                         outputConstraints =
                             [ ScriptOutputConstraint
-                                { ocDatum = stateData newState
+                                { ocDatum = TxOutDatumInTx $ stateData newState
                                   -- Add the thread token value back to the output
                                 , ocValue = stateValue newState <> SM.threadTokenValueOrZero scInstance
                                 , ocReferenceScriptHash = Nothing

diff --git a/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs b/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs
@@ -29,7 +29,7 @@ import Data.Aeson (FromJSON, ToJSON)
 import Data.Void (Void)
 import GHC.Generics (Generic)
 import Ledger.Constraints (ScriptOutputConstraint (ScriptOutputConstraint, ocDatum, ocReferenceScriptHash, ocValue),
-                           TxConstraints (txOwnOutputs))
+                           TxConstraints (txOwnOutputs), TxOutDatum (TxOutDatumInTx))
 import Ledger.Constraints.OnChain.V1 (checkScriptContext)
 import Ledger.Typed.Scripts (DatumType, RedeemerType, TypedValidator, ValidatorType, ValidatorTypes, validatorAddress,
                              validatorHash)
@@ -131,7 +131,7 @@ mkValidator (StateMachine step isFinal check threadToken) currentState input ptx
                             newConstraints
                                 { txOwnOutputs =
                                     [ ScriptOutputConstraint
-                                        { ocDatum = newData
+                                        { ocDatum = TxOutDatumInTx newData
                                           -- Check that the thread token value is still there
                                         , ocValue = newValue <> threadTokenValueInner threadToken (ownHash ptx)
                                         , ocReferenceScriptHash = Nothing

diff --git a/plutus-contract/src/Plutus/Contract/Test/ContractModel/DoubleSatisfaction.hs b/plutus-contract/src/Plutus/Contract/Test/ContractModel/DoubleSatisfaction.hs
@@ -54,8 +54,8 @@ import Ledger.Index as Index
 import Ledger.Scripts
 import Ledger.Slot
 import Ledger.Tx hiding (mint)
-import Ledger.Tx.CardanoAPI (adaToCardanoValue, fromCardanoTxOut, toCardanoAddressInEra, toCardanoTxOutDatumInTx,
-                             toCardanoTxOutDatumInline)
+import Ledger.Tx.CardanoAPI (adaToCardanoValue, fromCardanoTxOutToPV1TxInfoTxOut, toCardanoAddressInEra,
+                             toCardanoTxOutDatumInTx, toCardanoTxOutDatumInline)
 import Ledger.Validation qualified as Validation
 import Plutus.Contract.Test hiding (not)
 import Plutus.Contract.Test.ContractModel.Internal
@@ -324,7 +324,7 @@ doubleSatisfactionCounterexamples dsc = do
    -- For each output in the candidate tx
    (idx, out) <- zip [0..] (dsc ^. dsTx . outputs)
    -- Is it a pubkeyout?
-   guard $ isPubKeyOut $ fromCardanoTxOut $ P.getTxOut out
+   guard $ isPubKeyOut $ fromCardanoTxOutToPV1TxInfoTxOut $ P.getTxOut out
    -- Whose key is not in the signatories?
    key <- maybeToList . txOutPubKey $ out
    let signatories = dsc ^. dsTx . signatures . to Map.keys

diff --git a/plutus-contract/test/Spec/Balancing.hs b/plutus-contract/test/Spec/Balancing.hs
@@ -49,22 +49,40 @@ balanceTxnMinAda =
 
         contract :: Contract () EmptySchema ContractError ()
         contract = do
-            let constraints1 = L.Constraints.mustPayToOtherScript vHash unitDatum (Value.scale 100 ff <> Ada.toValue Ledger.minAdaTxOut)
+            let constraints1 =
+                    L.Constraints.mustPayToOtherScriptWithDatumInTx
+                        vHash
+                        unitDatum
+                        (Value.scale 100 ff <> Ada.toValue Ledger.minAdaTxOut)
+                 <> L.Constraints.mustIncludeDatumInTx unitDatum
                 utx1 = either (error . show) id $ L.Constraints.mkTx @Void mempty constraints1
             submitTxConfirmed utx1
             utxo <- utxosAt someAddress
             let txOutRef = head (Map.keys utxo)
-                constraints2 = L.Constraints.mustSpendScriptOutput txOutRef unitRedeemer
-                    <> L.Constraints.mustPayToOtherScript vHash unitDatum (Value.scale 200 ee)
-                lookups2 = L.Constraints.unspentOutputs utxo <> L.Constraints.plutusV1OtherScript someValidator
-            utx2 <- Con.adjustUnbalancedTx $ either (error . show) id $ L.Constraints.mkTx @Void lookups2 constraints2
+                constraints2 =
+                    L.Constraints.mustSpendScriptOutput txOutRef unitRedeemer
+                    <> L.Constraints.mustPayToOtherScriptWithDatumInTx
+                         vHash
+                         unitDatum
+                         (Value.scale 200 ee)
+                    <> L.Constraints.mustIncludeDatumInTx unitDatum
+                lookups2 =
+                    L.Constraints.unspentOutputs utxo
+                    <> L.Constraints.plutusV1OtherScript someValidator
+            utx2 <- Con.adjustUnbalancedTx
+                  $ either (error . show) id
+                  $ L.Constraints.mkTx @Void lookups2 constraints2
             submitTxConfirmed utx2
 
         trace = do
             void $ Trace.activateContractWallet w1 contract
             void $ Trace.waitNSlots 2
 
-    in checkPredicateOptions options "balancing doesn't create outputs with no Ada" (assertValidatedTransactionCount 2) (void trace)
+    in checkPredicateOptions
+         options
+         "balancing doesn't create outputs with no Ada"
+         (assertValidatedTransactionCount 2)
+         (void trace)
 
 balanceTxnMinAda2 :: TestTree
 balanceTxnMinAda2 =
@@ -76,14 +94,24 @@ balanceTxnMinAda2 =
             & changeInitialWalletValue w1 (<> vA 1 <> vB 2)
         vHash = Scripts.validatorHash someValidator
         payToWallet w = L.Constraints.mustPayToPubKey (EM.mockWalletPaymentPubKeyHash w)
-        mkTx lookups constraints = Con.adjustUnbalancedTx . either (error . show) id $ L.Constraints.mkTx @Void lookups constraints
+        mkTx lookups constraints =
+            Con.adjustUnbalancedTx . either (error . show) id
+            $ L.Constraints.mkTx @Void lookups constraints
 
         setupContract :: Contract () EmptySchema ContractError ()
         setupContract = do
             -- Make sure there is a utxo with 1 A, 1 B, and 4 ada at w2
-            submitTxConfirmed =<< mkTx mempty (payToWallet w2 (vA 1 <> vB 1 <> Value.scale 2 (Ada.toValue Ledger.minAdaTxOut)))
+            submitTxConfirmed
+              =<< mkTx mempty
+                       (payToWallet w2 ( vA 1
+                                      <> vB 1
+                                      <> Value.scale 2 (Ada.toValue Ledger.minAdaTxOut)
+                                       ))
             -- Make sure there is a UTxO with 1 B and datum () at the script
-            submitTxConfirmed =<< mkTx mempty (L.Constraints.mustPayToOtherScript vHash unitDatum (vB 1))
+            submitTxConfirmed
+              =<< mkTx mempty ( L.Constraints.mustPayToOtherScriptWithDatumInTx vHash unitDatum (vB 1)
+                             <> L.Constraints.mustIncludeDatumInTx unitDatum
+                              )
             -- utxo0 @ wallet2 = 1 A, 1 B, 4 Ada
             -- utxo1 @ script  = 1 B, 2 Ada
 
@@ -96,9 +124,12 @@ balanceTxnMinAda2 =
                 lookups =  L.Constraints.unspentOutputs utxos
                         <> L.Constraints.plutusV1OtherScript someValidator
                         <> L.Constraints.plutusV1MintingPolicy mps
+                datum = Datum $ PlutusTx.toBuiltinData (0 :: Integer)
                 constraints = L.Constraints.mustSpendScriptOutput txOutRef unitRedeemer                                        -- spend utxo1
-                            <> L.Constraints.mustPayToOtherScript vHash unitDatum (vB 1)                                       -- 2 ada and 1 B to script
-                            <> L.Constraints.mustPayToOtherScript vHash (Datum $ PlutusTx.toBuiltinData (0 :: Integer)) (vB 1) -- 2 ada and 1 B to script (different datum)
+                            <> L.Constraints.mustPayToOtherScriptWithDatumInTx vHash unitDatum (vB 1)                                       -- 2 ada and 1 B to script
+                            <> L.Constraints.mustPayToOtherScriptWithDatumInTx vHash datum (vB 1) -- 2 ada and 1 B to script (different datum)
+                            <> L.Constraints.mustIncludeDatumInTx unitDatum
+                            <> L.Constraints.mustIncludeDatumInTx datum
                             <> L.Constraints.mustMintValue (vL 1) -- 1 L and 2 ada to wallet2
             submitTxConfirmed =<< mkTx lookups constraints
 

diff --git a/plutus-contract/test/Spec/Contract/TxConstraints.hs b/plutus-contract/test/Spec/Contract/TxConstraints.hs
@@ -128,7 +128,9 @@ mustReferenceOutputV1ConTest = do
     let ((utxoRef, utxo), (utxoRefForBalance1, _), (utxoRefForBalance2, _)) = get3 $ Map.toList utxos
         vh = fromJust $ Addr.toValidatorHash mustReferenceOutputV1ValidatorAddress
         lookups = TC.unspentOutputs utxos
-        tx = TC.mustPayToOtherScript vh (Datum $ PlutusTx.toBuiltinData utxoRef) (Ada.adaValueOf 5)
+        datum = Datum $ PlutusTx.toBuiltinData utxoRef
+        tx = TC.mustIncludeDatumInTx datum
+          <> TC.mustPayToOtherScriptWithDatumInTx vh datum (Ada.adaValueOf 5)
           <> TC.mustSpendPubKeyOutput utxoRefForBalance1
     mkTxConstraints @Void lookups tx >>= submitTxConfirmed
 
@@ -152,7 +154,9 @@ mustReferenceOutputTxV1ConTest = do
     let ((utxoRef, utxo), (utxoRefForBalance1, _), (utxoRefForBalance2, _)) = get3 $ Map.toList utxos
         vh = fromJust $ Addr.toValidatorHash mustReferenceOutputV1ValidatorAddress
         lookups = Tx.Constraints.unspentOutputs utxos
-        tx = Tx.Constraints.mustPayToOtherScript vh (Datum $ PlutusTx.toBuiltinData utxoRef) (Ada.adaValueOf 5)
+        datum = Datum $ PlutusTx.toBuiltinData utxoRef
+        tx = Tx.Constraints.mustPayToOtherScriptWithDatumInTx vh datum (Ada.adaValueOf 5)
+          <> Tx.Constraints.mustIncludeDatumInTx datum
           <> Tx.Constraints.mustSpendPubKeyOutput utxoRefForBalance1
           <> Tx.Constraints.mustUseOutputAsCollateral utxoRefForBalance1
     submitTxConfirmed $ mkTx lookups tx
@@ -197,7 +201,9 @@ mustReferenceOutputV2ConTest = do
     let ((utxoRef, utxo), (utxoRefForBalance1, _), (utxoRefForBalance2, _)) = get3 $ Map.toList utxos
         vh = fromJust $ Addr.toValidatorHash mustReferenceOutputV2ValidatorAddress
         lookups = TC.unspentOutputs utxos
-        tx = TC.mustPayToOtherScript vh (Datum $ PlutusTx.toBuiltinData utxoRef) (Ada.adaValueOf 5)
+        datum = Datum $ PlutusTx.toBuiltinData utxoRef
+        tx = TC.mustPayToOtherScriptWithDatumInTx vh datum (Ada.adaValueOf 5)
+          <> TC.mustIncludeDatumInTx datum
           <> TC.mustSpendPubKeyOutput utxoRefForBalance1
     mkTxConstraints @Void lookups tx >>= submitTxConfirmed
 
@@ -221,7 +227,9 @@ mustReferenceOutputTxV2ConTest = do
     let ((utxoRef, utxo), (utxoRefForBalance1, _), (utxoRefForBalance2, _)) = get3 $ Map.toList utxos
         vh = fromJust $ Addr.toValidatorHash mustReferenceOutputV2ValidatorAddress
         lookups = Tx.Constraints.unspentOutputs utxos
-        tx = Tx.Constraints.mustPayToOtherScript vh (Datum $ PlutusTx.toBuiltinData utxoRef) (Ada.adaValueOf 5)
+        datum = Datum $ PlutusTx.toBuiltinData utxoRef
+        tx = Tx.Constraints.mustPayToOtherScriptWithDatumInTx vh datum (Ada.adaValueOf 5)
+          <> Tx.Constraints.mustIncludeDatumInTx datum
           <> Tx.Constraints.mustSpendPubKeyOutput utxoRefForBalance1
           <> Tx.Constraints.mustUseOutputAsCollateral utxoRefForBalance1
     submitTxConfirmed $ mkTx lookups tx

diff --git a/plutus-contract/test/Spec/ErrorChecking.hs b/plutus-contract/test/Spec/ErrorChecking.hs
@@ -19,7 +19,7 @@ import Data.Row
 import Test.Tasty
 
 import Ledger.Ada qualified as Ada
-import Ledger.Constraints (collectFromTheScript, mustPayToOtherScript)
+import Ledger.Constraints (collectFromTheScript, mustIncludeDatumInTx, mustPayToOtherScriptWithDatumInTx)
 import Ledger.Tx (getCardanoTxId)
 import Ledger.Typed.Scripts qualified as Scripts hiding (validatorHash)
 import Plutus.Contract as Contract
@@ -141,7 +141,9 @@ contract = selectList [failFalseC, failHeadNilC, divZeroC, divZeroTraceC, succes
     run validator = void $ do
       let addr = mkValidatorAddress (validatorScript validator)
           hash = validatorHash (validatorScript validator)
-          tx = mustPayToOtherScript hash (Datum $ toBuiltinData ()) (Ada.adaValueOf 10)
+          datum = Datum $ toBuiltinData ()
+          tx = mustPayToOtherScriptWithDatumInTx hash datum (Ada.adaValueOf 10)
+            <> mustIncludeDatumInTx datum
       r <- submitTx tx
       awaitTxConfirmed (getCardanoTxId r)
       utxos <- utxosAt addr