Skip to content
This repository has been archived by the owner on Dec 2, 2024. It is now read-only.

Commit

Permalink
PLT-807 Change behavior of MustPayToPubKeyAddress and MustPayToOtherS…
Browse files Browse the repository at this point in the history
…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.
  • Loading branch information
koslambrou committed Sep 28, 2022
1 parent 37ed125 commit 9763fad
Show file tree
Hide file tree
Showing 52 changed files with 1,877 additions and 72,051 deletions.
2 changes: 1 addition & 1 deletion plutus-chain-index-core/src/Plutus/Contract/CardanoAPI.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down
22 changes: 21 additions & 1 deletion plutus-contract/src/Plutus/Contract/Oracle.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 #-}
Expand Down
11 changes: 7 additions & 4 deletions plutus-contract/src/Plutus/Contract/StateMachine.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
53 changes: 42 additions & 11 deletions plutus-contract/test/Spec/Balancing.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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

Expand All @@ -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

Expand Down
16 changes: 12 additions & 4 deletions plutus-contract/test/Spec/Contract/TxConstraints.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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
Expand Down
6 changes: 4 additions & 2 deletions plutus-contract/test/Spec/ErrorChecking.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 9763fad

Please sign in to comment.