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

Commit 172873e

Browse files
sjoerdvisschersjoerdvisscher
authored
PLT-658: inline datum witnesses (#765)
* Support empty witness for inline datum reference * Add test * Fix merge issues * Fix PureScript * Clean up and documentation * Replace (Datum, Bool) with DatumWithOrigin
1 parent 8e33348 commit 172873e

File tree

24 files changed

+246
-155
lines changed

24 files changed

+246
-155
lines changed

‎pab-blockfrost/src/Plutus/Blockfrost/Responses.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,8 @@ import Blockfrost.Client
3131
import Cardano.Api hiding (Block, Script, ScriptDatum, ScriptHash, TxIn, TxOut)
3232
import Cardano.Api.Shelley qualified as Shelley
3333
import Ledger.Slot qualified as Ledger (Slot)
34-
import Ledger.Tx (ChainIndexTxOut (..), Language (PlutusV1), RedeemerPtr (..), TxIn (..), TxOutRef (..),
35-
Versioned (Versioned, unversioned), pubKeyTxIn, scriptTxIn)
34+
import Ledger.Tx (ChainIndexTxOut (..), DatumFromQuery (DatumUnknown), Language (PlutusV1), RedeemerPtr (..), TxIn (..),
35+
TxOutRef (..), Versioned (Versioned, unversioned), pubKeyTxIn, scriptTxIn)
3636
import Plutus.ChainIndex.Api (IsUtxoResponse (..), QueryResponse (..), TxosResponse (..), UtxosResponse (..))
3737
import Plutus.ChainIndex.Types (BlockId (..), BlockNumber (..), ChainIndexTx (..), ChainIndexTxOutputs (..), Tip (..))
3838
import Plutus.V1.Ledger.Address qualified as Ledger
@@ -120,7 +120,7 @@ processUnspentTxOut (Just utxo) = buildResponse utxo
120120
buildScriptTxOut :: Ledger.Address -> UtxoOutput -> ValidatorHash -> ChainIndexTxOut
121121
buildScriptTxOut addr utxoOut val = ScriptChainIndexTxOut { _ciTxOutAddress=addr
122122
, _ciTxOutValue=utxoValue utxoOut
123-
, _ciTxOutScriptDatum=(utxoDatumHash utxoOut, Nothing)
123+
, _ciTxOutScriptDatum=(utxoDatumHash utxoOut, DatumUnknown)
124124
, _ciTxOutReferenceScript=Nothing
125125
, _ciTxOutValidator=(val, Nothing)
126126
}
@@ -196,7 +196,7 @@ processUnspentTxOutSetAtAddress _ cred xs =
196196
buildScriptTxOut :: Ledger.Address -> AddressUtxo -> ValidatorHash -> ChainIndexTxOut
197197
buildScriptTxOut addr utxo val = ScriptChainIndexTxOut { _ciTxOutAddress=addr
198198
, _ciTxOutValue=utxoValue utxo
199-
, _ciTxOutScriptDatum=(utxoDatumHash utxo, Nothing)
199+
, _ciTxOutScriptDatum=(utxoDatumHash utxo, DatumUnknown)
200200
, _ciTxOutValidator=(val, Nothing)
201201
, _ciTxOutReferenceScript=Nothing
202202
}
@@ -278,7 +278,7 @@ processGetTxFromTxId (Just TxResponse{..}) = do
278278
where
279279
toPlutusTxIn :: UtxoInput -> Integer -> TxIn
280280
toPlutusTxIn utxoIn idx = case addr utxoIn of
281-
ScriptCredential (ValidatorHash bbs) -> scriptTxIn (txoToRef utxoIn) (Versioned (val bbs) PlutusV1) (red idx) (dat utxoIn)
281+
ScriptCredential (ValidatorHash bbs) -> scriptTxIn (txoToRef utxoIn) (Versioned (val bbs) PlutusV1) (red idx) (Just $ dat utxoIn)
282282
PubKeyCredential _ -> pubKeyTxIn $ txoToRef utxoIn
283283

284284
addr :: UtxoInput -> Credential

‎playground-common/src/PSGenerator/Common.hs‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -24,9 +24,10 @@ import Language.PureScript.Bridge.Builder (BridgeData)
2424
import Language.PureScript.Bridge.PSTypes (psInt, psNumber, psString)
2525
import Language.PureScript.Bridge.SumType (sigConstructor, sigValues, sumTypeConstructors)
2626
import Language.PureScript.Bridge.TypeParameters (A)
27-
import Ledger (Address, BlockId, CardanoTx, Certificate, ChainIndexTxOut, OnChainTx, PaymentPubKey, PaymentPubKeyHash,
28-
PubKey, PubKeyHash, RedeemerPtr, ScriptTag, Signature, StakePubKey, StakePubKeyHash, Tx, TxId, TxIn,
29-
TxInType, TxInput, TxInputType, TxOut, TxOutRef, TxOutTx, UtxoIndex, ValidationPhase, Withdrawal)
27+
import Ledger (Address, BlockId, CardanoTx, Certificate, ChainIndexTxOut, DatumFromQuery, OnChainTx, PaymentPubKey,
28+
PaymentPubKeyHash, PubKey, PubKeyHash, RedeemerPtr, ScriptTag, Signature, StakePubKey, StakePubKeyHash,
29+
Tx, TxId, TxIn, TxInType, TxInput, TxInputType, TxOut, TxOutRef, TxOutTx, UtxoIndex, ValidationPhase,
30+
Withdrawal)
3031
import Ledger.Ada (Ada)
3132
import Ledger.Constraints.OffChain (MkTxError, UnbalancedTx)
3233
import Ledger.Credential (Credential, StakingCredential)
@@ -421,6 +422,7 @@ ledgerTypes =
421422
, equal . genericShow . argonaut $ mkSumType @UtxoIndex
422423
, equal . genericShow . argonaut $ mkSumType @Value
423424
, equal . genericShow . argonaut $ mkSumType @Withdrawal
425+
, equal . genericShow . argonaut $ mkSumType @DatumFromQuery
424426
-- v2
425427
, equal . genericShow . argonaut $ mkSumType @PV2.OutputDatum
426428
, equal . genericShow . argonaut $ mkSumType @ReferenceScript

‎plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ import GHC.Generics (Generic)
3838
import Ledger.Address (Address (addressCredential))
3939
import Ledger.Scripts (ScriptHash (ScriptHash))
4040
import Ledger.Tx (TxId, TxOutRef (..), Versioned)
41-
import Ledger.Tx qualified as L (ChainIndexTxOut (PublicKeyChainIndexTxOut, ScriptChainIndexTxOut))
41+
import Ledger.Tx qualified as L (ChainIndexTxOut (PublicKeyChainIndexTxOut, ScriptChainIndexTxOut), DatumFromQuery (..))
4242
import Plutus.ChainIndex.Api (IsUtxoResponse (IsUtxoResponse), QueryResponse (QueryResponse),
4343
TxosResponse (TxosResponse), UtxosResponse (UtxosResponse))
4444
import Plutus.ChainIndex.ChainIndexError (ChainIndexError (..))
@@ -154,13 +154,13 @@ makeChainIndexTxOut txout@(ChainIndexTxOut address value datum refScript) = do
154154
logWarn $ NoDatumScriptAddr txout
155155
pure Nothing
156156
where
157-
getDatumWithHash :: OutputDatum -> Eff effs (Maybe (DatumHash, Maybe Datum))
157+
getDatumWithHash :: OutputDatum -> Eff effs (Maybe (DatumHash, L.DatumFromQuery))
158158
getDatumWithHash NoOutputDatum = pure Nothing
159159
getDatumWithHash (OutputDatumHash dh) = do
160160
d <- getDatumFromHash dh
161-
pure $ Just (dh, d)
161+
pure $ Just (dh, maybe L.DatumUnknown L.DatumInBody d)
162162
getDatumWithHash (OutputDatum d) = do
163-
pure $ Just (datumHash d, Just d)
163+
pure $ Just (datumHash d, L.DatumInline d)
164164

165165
script = fromReferenceScript refScript
166166

‎plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
{-# LANGUAGE NamedFieldPuns #-}
66
{-# LANGUAGE QuantifiedConstraints #-}
77
{-# LANGUAGE RankNTypes #-}
8+
{-# LANGUAGE TupleSections #-}
89
{-# LANGUAGE TypeApplications #-}
910
{-# LANGUAGE TypeOperators #-}
1011
{-# LANGUAGE UndecidableInstances #-}
@@ -209,13 +210,13 @@ makeChainIndexTxOut txout@(ChainIndexTxOut address value datum refScript) = do
209210
logWarn $ NoDatumScriptAddr txout
210211
pure Nothing
211212
where
212-
getDatumWithHash :: OutputDatum -> Eff effs (Maybe (DatumHash, Maybe Datum))
213+
getDatumWithHash :: OutputDatum -> Eff effs (Maybe (DatumHash, L.DatumFromQuery))
213214
getDatumWithHash NoOutputDatum = pure Nothing
214215
getDatumWithHash (OutputDatumHash dh) = do
215216
d <- getDatumFromHash dh
216-
pure $ Just (dh, d)
217+
pure $ Just (dh, maybe L.DatumUnknown L.DatumInBody d)
217218
getDatumWithHash (OutputDatum d) = do
218-
pure $ Just (datumHash d, Just d)
219+
pure $ Just (datumHash d, L.DatumInline d)
219220

220221
script = fromReferenceScript refScript
221222

‎plutus-contract/src/Plutus/Contract/StateMachine.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@ module Plutus.Contract.StateMachine(
5353
, Void
5454
) where
5555

56-
import Control.Lens (_2, _Just, makeClassyPrisms, review, (^?))
56+
import Control.Lens (_2, makeClassyPrisms, review, (^?))
5757
import Control.Monad (unless)
5858
import Control.Monad.Error.Lens
5959
import Data.Aeson (FromJSON, ToJSON)
@@ -141,7 +141,7 @@ getStates
141141
getStates (SM.StateMachineInstance _ si) refMap =
142142
flip mapMaybe (Map.toList refMap) $ \(txOutRef, ciTxOut) -> do
143143
let txOut = Tx.toTxInfoTxOut ciTxOut
144-
datum <- ciTxOut ^? Tx.ciTxOutScriptDatum . _2 . _Just
144+
datum <- ciTxOut ^? Tx.ciTxOutScriptDatum . _2 . Tx.datumInDatumFromQuery
145145
ocsTxOutRef <- either (const Nothing) Just $ Typed.typeScriptTxOutRef si txOutRef txOut datum
146146
pure OnChainState{ocsTxOutRef}
147147

‎plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -31,12 +31,12 @@ import GHC.Generics (Generic)
3131
import Ledger.Constraints (ScriptOutputConstraint (ScriptOutputConstraint, ocDatum, ocReferenceScriptHash, ocValue),
3232
TxConstraints (txOwnOutputs), TxOutDatum (TxOutDatumInTx))
3333
import Ledger.Constraints.OnChain.V1 (checkScriptContext)
34-
import Ledger.Typed.Scripts (DatumType, RedeemerType, TypedValidator, ValidatorType, ValidatorTypes, validatorAddress,
35-
validatorHash)
34+
import Ledger.Typed.Scripts (DatumType, RedeemerType, TypedValidator, ValidatorTypes, validatorAddress, validatorHash)
3635
import Ledger.Value (Value, isZero)
36+
import Plutus.Script.Utils.V1.Typed.Scripts qualified as PV1
3737
import Plutus.V1.Ledger.Api (Address, ValidatorHash)
3838
import Plutus.V1.Ledger.Contexts (ScriptContext, TxInInfo (txInInfoResolved), findOwnInput, ownHash)
39-
import Plutus.V1.Ledger.Tx qualified as V1
39+
import Plutus.V1.Ledger.Tx qualified as PV1
4040
import PlutusTx qualified
4141
import PlutusTx.Prelude hiding (check)
4242
import Prelude qualified as Haskell
@@ -110,9 +110,9 @@ machineAddress = validatorAddress . typedValidator
110110

111111
{-# INLINABLE mkValidator #-}
112112
-- | Turn a state machine into a validator script.
113-
mkValidator :: forall s i. (PlutusTx.ToData s) => StateMachine s i -> ValidatorType (StateMachine s i)
113+
mkValidator :: forall s i. (PlutusTx.ToData s) => StateMachine s i -> PV1.ValidatorType (StateMachine s i)
114114
mkValidator (StateMachine step isFinal check threadToken) currentState input ptx =
115-
let vl = maybe (traceError "S0" {-"Can't find validation input"-}) (V1.txOutValue . txInInfoResolved) (findOwnInput ptx)
115+
let vl = maybe (traceError "S0" {-"Can't find validation input"-}) (PV1.txOutValue . txInInfoResolved) (findOwnInput ptx)
116116
checkOk =
117117
traceIfFalse "S1" {-"State transition invalid - checks failed"-} (check currentState input ptx)
118118
&& traceIfFalse "S2" {-"Thread token not found"-} (TT.checkThreadToken threadToken (ownHash ptx) vl 1)

‎plutus-contract/src/Plutus/Contract/Test/ContractModel/DoubleSatisfaction.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -364,7 +364,7 @@ doubleSatisfactionCounterexamples dsc = do
364364
& dsTx .~ tx
365365
valueStolen0 = dsc & l . outAddress .~ stealerCardanoAddress
366366
& dsTx . outputs %~ (withDatumOut:)
367-
& dsTx %~ addScriptTxInput newFakeTxOutRef alwaysOkValidator redeemerEmpty datumEmpty
367+
& dsTx %~ addScriptTxInput newFakeTxOutRef alwaysOkValidator redeemerEmpty (Just datumEmpty)
368368
& dsUtxoIndex %~
369369
(\ (UtxoIndex m) -> UtxoIndex $ Map.insert newFakeTxOutRef
370370
newFakeTxScriptOut m)

‎plutus-contract/test/Spec/Emulator.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -229,7 +229,7 @@ invalidScript = property $ do
229229
let invalidTxnUtxo = [(snd outToSpend, fst outToSpend)]
230230
invalidTxn <- forAll
231231
$ Gen.genValidTransactionSpending
232-
[Gen.TxInputWitnessed (snd outToSpend) (ScriptAddress (Left failValidator) unitRedeemer unitDatum)]
232+
[Gen.TxInputWitnessed (snd outToSpend) (ScriptAddress (Left failValidator) unitRedeemer (Just unitDatum))]
233233
totalVal
234234
Hedgehog.annotateShow invalidTxn
235235

‎plutus-contract/test/Spec/TxConstraints/MustSpendScriptOutput.hs‎

Lines changed: 60 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -33,11 +33,13 @@ import Ledger.Constraints.OnChain.V2 qualified as Cons.V2
3333
import Ledger.Constraints.TxConstraints qualified as Cons (TxConstraints, mustMintValueWithRedeemer,
3434
mustPayToAddressWithReferenceValidator,
3535
mustPayToOtherScriptWithDatumInTx,
36-
mustPayToTheScriptWithDatumInTx, mustReferenceOutput,
36+
mustPayToTheScriptWithDatumInTx,
37+
mustPayToTheScriptWithInlineDatum, mustReferenceOutput,
3738
mustSpendPubKeyOutput, mustSpendScriptOutput,
3839
mustSpendScriptOutputWithMatchingDatumAndValue,
3940
mustSpendScriptOutputWithReference)
40-
import Ledger.Test (asDatum, asRedeemer, someAddress, someTypedValidator, someValidatorHash)
41+
import Ledger.Test (asDatum, asRedeemer, someAddress, someAddressV2, someTypedValidator, someTypedValidatorV2,
42+
someValidatorHash)
4143
import Ledger.Tx qualified as Tx
4244

4345
import Plutus.Contract as Cont (Contract, ContractError, Empty, _ConstraintResolutionContractError, awaitTxConfirmed,
@@ -68,7 +70,9 @@ makeClassyPrisms ''ScriptError
6870
tests :: TestTree
6971
tests = testGroup "MustSpendScriptOutput"
7072
[ testGroup "ledger constraints" [v1Tests, v2Tests]
73+
, mustSpendScriptOutputsInlineDatumHasNoDataInTx
7174
]
75+
7276
v1Tests :: TestTree
7377
v1Tests = testGroup "Plutus V1" $
7478
[ v1FeaturesTests
@@ -571,7 +575,47 @@ phase2ErrorWhenMustSpendScriptOutputWithReferenceScriptFailsToValidateItsScript
571575
(assertFailedTransaction $ const $ evaluationError "L8")
572576
in check $ traceN 3 contract
573577

574-
578+
-- | Check that when spending an output with an inline datum, the transaction does not contain a witness for this datum.
579+
mustSpendScriptOutputsInlineDatumContract :: Bool -> Contract () Empty ContractError ()
580+
mustSpendScriptOutputsInlineDatumContract useInlineDatum = do
581+
let versionedMintingPolicy = PSU.Versioned mustSpendScriptOutputWithDataLengthPolicyV2 PlutusV2
582+
lookups1 = Cons.typedValidatorLookups someTypedValidatorV2
583+
mkCons = if useInlineDatum then Cons.mustPayToTheScriptWithInlineDatum else Cons.mustPayToTheScriptWithDatumInTx
584+
tx1 = mkCons (PlutusTx.toBuiltinData (0::Integer)) utxoValue
585+
ledgerTx1 <- submitTxConstraintsWith lookups1 tx1
586+
awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx1
587+
588+
scriptUtxos <- utxosAt someAddressV2
589+
let scriptUtxosToSpend = M.keys scriptUtxos
590+
expectedRedeemers = L.map asRedeemer scriptUtxosToSpend
591+
dataCount = if useInlineDatum then 0 else 1 :: Integer
592+
policyRedeemer = asRedeemer (zip scriptUtxosToSpend expectedRedeemers, dataCount)
593+
lookups2 = Cons.typedValidatorLookups someTypedValidatorV2
594+
<> Cons.mintingPolicy versionedMintingPolicy
595+
<> Cons.unspentOutputs scriptUtxos
596+
tx2 = mconcat (mustSpendScriptOutputs scriptUtxosToSpend)
597+
<> Cons.mustMintValueWithRedeemer policyRedeemer (tokenValue versionedMintingPolicy)
598+
ledgerTx4 <- submitTxConstraintsWith lookups2 tx2
599+
awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx4
600+
where
601+
mustSpendScriptOutputs :: [Tx.TxOutRef] -> [TxConstraints P.BuiltinData P.BuiltinData]
602+
mustSpendScriptOutputs scriptTxOutRefs = fmap (\txOutRef -> Cons.mustSpendScriptOutput txOutRef (asRedeemer txOutRef)) scriptTxOutRefs
603+
604+
mustSpendScriptOutputsInlineDatumHasNoDataInTx :: TestTree
605+
mustSpendScriptOutputsInlineDatumHasNoDataInTx =
606+
testGroup "mustSpendScriptOutput spending a ref with ot without inline datum"
607+
608+
[ checkPredicateOptions
609+
defaultCheckOptions
610+
"mustSpendScriptOutput does not include datum in tx when spending a ref with inline datum"
611+
(assertValidatedTransactionCount 2)
612+
(void $ trace $ mustSpendScriptOutputsInlineDatumContract True)
613+
, checkPredicateOptions
614+
defaultCheckOptions
615+
"mustSpendScriptOutput does include datum in tx when spending a ref with datum hash"
616+
(assertValidatedTransactionCount 2)
617+
(void $ trace $ mustSpendScriptOutputsInlineDatumContract False)
618+
]
575619

576620
mkMustSpendScriptOutputPolicy :: (Cons.TxConstraints () () -> sc -> Bool) -> [(Tx.TxOutRef, L.Redeemer)] -> sc -> Bool
577621
mkMustSpendScriptOutputPolicy checkScriptContext constraintParams ctx =
@@ -691,6 +735,19 @@ mustSpendScriptOutputPolicyV2 = PV2.mkMintingPolicyScript $$(PlutusTx.compile [|
691735
mkMustSpendScriptOutputPolicyV2 = mkMustSpendScriptOutputPolicy Cons.V2.checkScriptContext
692736
wrap = PSU.V2.mkUntypedMintingPolicy mkMustSpendScriptOutputPolicyV2
693737

738+
-----
739+
740+
{-# INLINEABLE mustSpendScriptOutputWithDataLengthPolicyV2 #-}
741+
mustSpendScriptOutputWithDataLengthPolicyV2 :: PV2.MintingPolicy
742+
mustSpendScriptOutputWithDataLengthPolicyV2 = PV2.mkMintingPolicyScript $$(PlutusTx.compile [||wrap||])
743+
where
744+
mkMustSpendScriptOutputWithDataLengthPolicyV2 (constraintParams, len) ctx =
745+
mkMustSpendScriptOutputPolicy Cons.V2.checkScriptContext constraintParams ctx
746+
P.&& P.length (PV2.txInfoData (PV2.scriptContextTxInfo ctx)) P.== len
747+
wrap = PSU.V2.mkUntypedMintingPolicy mkMustSpendScriptOutputWithDataLengthPolicyV2
748+
749+
-----
750+
694751
{-# INLINEABLE mustSpendScriptOutputWithMatchingDatumAndValuePolicyV2 #-}
695752
mustSpendScriptOutputWithMatchingDatumAndValuePolicyV2 :: PV2.MintingPolicy
696753
mustSpendScriptOutputWithMatchingDatumAndValuePolicyV2 = PV2.mkMintingPolicyScript $$(PlutusTx.compile [||wrap||])

0 commit comments

Comments
 (0)