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

Commit

Permalink
Add inline datum supports for mustPayToPubKey and mustPayToOtherScript (
Browse files Browse the repository at this point in the history
#721)

* Incremental change for datum

* Work but no inlining

* First working inline datum with V2

* Add tests for inline datum

* add smart constructors for inline datum

* fix PAB

* fixing tx-constraints

* clean up tests

* Address some of Konstantinos' comments

* Separate test group for plutus v2

* Refactor tests in MustPayToPubKeyAddress to ease version handling

* Code clean up

* Code clean up

* Fix unused imports

* Add a way to switch to cardano constraints in MustPayToOtherAddress tests

* more clean up

* PR feedbacks

* Remove dead code

* Add refactoring for MustPayToOtherScript tests

* typo

* clean test suites

* Clean up imports
  • Loading branch information
berewt authored Sep 28, 2022
1 parent e25565a commit 37ed125
Show file tree
Hide file tree
Showing 23 changed files with 783 additions and 338 deletions.
8 changes: 4 additions & 4 deletions plutus-contract/src/Plutus/Contract/StateMachine.hs
Original file line number Diff line number Diff line change
Expand Up @@ -90,8 +90,8 @@ import Plutus.Contract.StateMachine.OnChain qualified as SM
import Plutus.Contract.StateMachine.ThreadToken (ThreadToken (ThreadToken), curPolicy, ttOutRef)
import Plutus.Contract.Wallet (getUnspentOutput)
import Plutus.Script.Utils.V1.Scripts (scriptCurrencySymbol)
import Plutus.Script.Utils.V1.Typed.Scripts qualified as Typed
import Plutus.V1.Ledger.Tx qualified as V1
import Plutus.Script.Utils.V2.Typed.Scripts qualified as Typed
import Plutus.V2.Ledger.Tx qualified as V2
import PlutusTx qualified
import PlutusTx.Monoid (inv)

Expand Down Expand Up @@ -199,7 +199,7 @@ threadTokenChooser ::
-> [OnChainState state input]
-> Either SMContractError (OnChainState state input)
threadTokenChooser val states =
let hasToken OnChainState{ocsTxOutRef} = val `Value.leq` (V1.txOutValue $ Typed.tyTxOutTxOut $ Typed.tyTxOutRefOut ocsTxOutRef) in
let hasToken OnChainState{ocsTxOutRef} = val `Value.leq` (V2.txOutValue $ Typed.tyTxOutTxOut $ Typed.tyTxOutRefOut ocsTxOutRef) in
case filter hasToken states of
[x] -> Right x
xs ->
Expand Down Expand Up @@ -531,7 +531,7 @@ mkStep client@StateMachineClient{scInstance} input = do
oldState = State
{ stateData = getStateData onChainState
-- Hide the thread token value from the client code
, stateValue = V1.txOutValue (Typed.tyTxOutTxOut $ Typed.tyTxOutRefOut ocsTxOutRef) <> inv (SM.threadTokenValueOrZero scInstance)
, stateValue = V2.txOutValue (Typed.tyTxOutTxOut $ Typed.tyTxOutRefOut ocsTxOutRef) <> inv (SM.threadTokenValueOrZero scInstance)
}
inputConstraints = [ScriptInputConstraint{icRedeemer=input, icTxOutRef = Typed.tyTxOutRefRef ocsTxOutRef }]

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -343,13 +343,13 @@ doubleSatisfactionCounterexamples dsc = do
datum = Datum . mkB $ "<this is a unique string>"
datumEmpty = Datum . mkB $ ""
redeemerEmpty = Redeemer . mkB $ ""
withDatumOut = out & outDatumHash .~ toCardanoTxOutDatumInTx (Just datum)
withDatumOut = out & outDatumHash .~ toCardanoTxOutDatumInTx datum
-- Creating TxOut is ugly at the moment because we don't use Cardano addresses, values and datum in the
-- emulator yet
newFakeTxScriptOut = TxOut $ C.TxOut
scriptCardanoAddress
(C.TxOutValue C.MultiAssetInBabbageEra $ adaToCardanoValue $ Ada.fromValue $ txOutValue out)
(toCardanoTxOutDatumInline $ Just datumEmpty)
(toCardanoTxOutDatumInline datumEmpty)
C.ReferenceScriptNone
newFakeTxOutRef = TxOutRef { txOutRefId = TxId "very sha 256 hash I promise"
, txOutRefIdx = 1
Expand Down
7 changes: 4 additions & 3 deletions plutus-contract/src/Wallet/Emulator/MultiAgent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,12 +39,13 @@ import Ledger hiding (to, value)
import Ledger.Ada qualified as Ada
import Ledger.AddressMap qualified as AM
import Ledger.Index qualified as Index
import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatumHash)
import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatum)
import Ledger.Value qualified as Value
import Plutus.ChainIndex.Emulator qualified as ChainIndex
import Plutus.Contract.Error (AssertionError (GenericAssertion))
import Plutus.Trace.Emulator.Types (ContractInstanceLog, EmulatedWalletEffects, EmulatedWalletEffects', UserThreadMsg)
import Plutus.Trace.Scheduler qualified as Scheduler
import Plutus.V2.Ledger.Tx qualified as V2
import Wallet.API qualified as WAPI
import Wallet.Emulator.Chain qualified as Chain
import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg)
Expand Down Expand Up @@ -292,7 +293,7 @@ we create 10 Ada-only outputs per wallet here.
-- creates the initial distribution of funds to public key addresses.
emulatorStateInitialDist :: NetworkId -> Map PaymentPubKeyHash Value -> Either ToCardanoError EmulatorState
emulatorStateInitialDist networkId mp = do
outs <- traverse (toCardanoTxOut networkId toCardanoTxOutDatumHash) $ Map.toList mp >>= mkOutputs
outs <- traverse (toCardanoTxOut networkId toCardanoTxOutDatum) $ Map.toList mp >>= mkOutputs
pure $ emulatorStatePool $ pure $ EmulatorTx $
Tx
{ txInputs = mempty
Expand All @@ -319,7 +320,7 @@ emulatorStateInitialDist networkId mp = do
-- Make sure we don't make the outputs too small
count = min 10 $ ada `div` minAdaTxOut
remainder = [ vl <> Ada.toValue (-ada) | not (Value.isAdaOnlyValue vl) ]
mkOutput key vl = pubKeyHashTxOut vl (unPaymentPubKeyHash key)
mkOutput key vl = V2.pubKeyHashTxOut vl (unPaymentPubKeyHash key)

type MultiAgentEffs =
'[ State EmulatorState
Expand Down
16 changes: 8 additions & 8 deletions plutus-contract/src/Wallet/Emulator/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,11 +57,11 @@ import Ledger.Constraints.OffChain (UnbalancedTx)
import Ledger.Constraints.OffChain qualified as U
import Ledger.Credential (Credential (PubKeyCredential, ScriptCredential))
import Ledger.Fee (estimateTransactionFee, makeAutoBalancedTransaction)
import Ledger.Index (UtxoIndex (UtxoIndex, getIndex))
import Ledger.Index.Internal (UtxoIndex (UtxoIndex, getIndex))
import Ledger.Params (Params (Params, pNetworkId, pProtocolParams, pSlotConfig))
import Ledger.Tx (CardanoTx, ChainIndexTxOut, SomeCardanoApiTx, Tx (txFee, txMint), TxOut (TxOut))
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (makeTransactionBody, toCardanoTxOut, toCardanoTxOutDatumHash)
import Ledger.Tx.CardanoAPI.Internal (makeTransactionBody, toCardanoTxOut, toCardanoTxOutDatum)
import Ledger.Validation (addSignature, fromPlutusIndex, fromPlutusTx, getRequiredSigners)
import Ledger.Value qualified as Value
import Plutus.ChainIndex (PageQuery)
Expand All @@ -71,18 +71,18 @@ import Plutus.ChainIndex.Emulator (ChainIndexEmulatorState, ChainIndexQueryEffec
import Plutus.Contract.Checkpoint (CheckpointLogMsg)
import Plutus.Contract.Wallet (finalize)
import Plutus.V1.Ledger.Api (PubKeyHash, TxOutRef, ValidatorHash, Value)
import Plutus.V1.Ledger.Tx qualified as V1
import PlutusTx.Prelude qualified as PlutusTx
import Prettyprinter (Pretty (pretty))
import Servant.API (FromHttpApiData (parseUrlPiece), ToHttpApiData (toUrlPiece))
import Wallet.API (WalletAPIError)
import Wallet.Effects qualified as WAPI (getClientParams)
import Wallet.Error qualified as WAPI (WalletAPIError (InsufficientFunds, PaymentPrivateKeyNotFound, ToCardanoError, ValidationError),
throwOtherError)
import Wallet.Emulator.Error qualified as WAPI (WalletAPIError (InsufficientFunds, PaymentPrivateKeyNotFound, ToCardanoError, ValidationError),
throwOtherError)
import Wallet.Error (WalletAPIError)

import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Ledger qualified
import Plutus.V2.Ledger.Tx qualified as PV2
import Wallet.Effects (NodeClientEffect,
WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx),
publishTx)
Expand Down Expand Up @@ -323,7 +323,7 @@ handleBalance utx' = do
let utx = finalize pSlotConfig utx'
requiredSigners = Set.toList (U.unBalancedTxRequiredSignatories utx)
eitherTx = U.unBalancedTxTx utx
plUtxo = traverse (toCardanoTxOut pNetworkId toCardanoTxOutDatumHash . Tx.toTxOut) utxo
plUtxo = traverse (toCardanoTxOut pNetworkId toCardanoTxOutDatum . Tx.toTxOut) utxo
mappedUtxo <- either (throwError . WAPI.ToCardanoError) (pure . fmap TxOut) plUtxo
cUtxoIndex <- handleError eitherTx $ fromPlutusIndex $ UtxoIndex $ U.unBalancedTxUtxoIndex utx <> mappedUtxo
case eitherTx of
Expand Down Expand Up @@ -500,7 +500,7 @@ calculateTxChanges params addr utxos (neg, pos) = do
txOut <- either
(throwError . WAPI.ToCardanoError)
(pure . TxOut)
$ toCardanoTxOut (pNetworkId params) toCardanoTxOutDatumHash $ V1.TxOut addr pos Nothing
$ toCardanoTxOut (pNetworkId params) toCardanoTxOutDatum $ PV2.TxOut addr pos PV2.NoOutputDatum Nothing
(missing, extraTxOut) <-
either (throwError . WAPI.ToCardanoError) pure
$ U.adjustTxOut params txOut
Expand Down
6 changes: 3 additions & 3 deletions plutus-contract/test/Spec/Balancing.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,10 @@ import Data.Map qualified as Map
import Data.Void (Void)
import Test.Tasty (TestTree, testGroup)

import Ledger (unitDatum, unitRedeemer)
import Ledger qualified
import Ledger.Ada qualified as Ada
import Ledger.Constraints qualified as L.Constraints
import Ledger.Scripts (unitDatum, unitRedeemer)
import Ledger.Test
import Ledger.Tx.Constraints qualified as Tx.Constraints
import Ledger.Value qualified as Value
Expand Down Expand Up @@ -90,10 +90,10 @@ balanceTxnMinAda2 =
wallet2Contract :: Contract () EmptySchema ContractError ()
wallet2Contract = do
utxos <- utxosAt someAddress
let txOutRef = case (Map.keys utxos) of
let txOutRef = case Map.keys utxos of
(x:_) -> x
[] -> error $ "there's no utxo at the address " <> show someAddress
lookups = L.Constraints.unspentOutputs utxos
lookups = L.Constraints.unspentOutputs utxos
<> L.Constraints.plutusV1OtherScript someValidator
<> L.Constraints.plutusV1MintingPolicy mps
constraints = L.Constraints.mustSpendScriptOutput txOutRef unitRedeemer -- spend utxo1
Expand Down
7 changes: 4 additions & 3 deletions plutus-contract/test/Spec/Emulator.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,14 +35,15 @@ import Ledger.Generators (Mockchain (Mockchain), TxInputWitnessed (TxInputWitnes
import Ledger.Generators qualified as Gen
import Ledger.Index qualified as Index
import Ledger.Params (Params (Params, pNetworkId))
import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatumHash)
import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatum)
import Ledger.Value qualified as Value
import Plutus.Contract.Test hiding (not)
import Plutus.Script.Utils.V1.Tx (scriptTxOut)
import Plutus.Script.Utils.V1.Address (mkValidatorAddress)
import Plutus.Script.Utils.V1.Typed.Scripts (mkUntypedValidator)
import Plutus.Trace (EmulatorTrace, PrintEffect (PrintLn))
import Plutus.Trace qualified as Trace
import Plutus.V1.Ledger.Contexts (ScriptContext)
import Plutus.V2.Ledger.Api qualified as PV2
import PlutusTx qualified
import PlutusTx.Numeric qualified as P
import PlutusTx.Prelude qualified as PlutusTx
Expand Down Expand Up @@ -217,7 +218,7 @@ invalidScript = property $ do
index <- forAll $ Gen.int (Range.linear 0 ((length $ getCardanoTxOutputs txn1) - 1))
let emulatorTx = onCardanoTx id (\_ -> error "Unexpected Cardano.Api.Tx") txn1
let setOutputs o = either (const Hedgehog.failure) (pure . TxOut) $
toCardanoTxOut pNetworkId toCardanoTxOutDatumHash $ scriptTxOut failValidator (txOutValue o) unitDatum
toCardanoTxOut pNetworkId toCardanoTxOutDatum $ PV2.TxOut (mkValidatorAddress failValidator) (txOutValue o) (PV2.OutputDatum unitDatum) Nothing
outs <- traverse setOutputs $ emulatorTx ^. outputs
let scriptTxn = EmulatorTx $
emulatorTx
Expand Down
8 changes: 3 additions & 5 deletions plutus-contract/test/Spec/TxConstraints/MustIncludeDatum.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,12 +13,10 @@ import Test.Tasty (TestTree, testGroup)

import Ledger qualified
import Ledger.Ada qualified as Ada
import Ledger.Constraints.OffChain qualified as Constraints (plutusV1MintingPolicy, typedValidatorLookups,
unspentOutputs)
import Ledger.Constraints qualified as Constraints (collectFromTheScript, mustIncludeDatum, mustMintValueWithRedeemer,
mustPayToOtherScript, mustPayToTheScript, mustPayWithDatumToPubKey,
plutusV1MintingPolicy, typedValidatorLookups, unspentOutputs)
import Ledger.Constraints.OnChain.V1 qualified as Constraints (checkScriptContext)
import Ledger.Constraints.TxConstraints qualified as Constraints (collectFromTheScript, mustIncludeDatum,
mustMintValueWithRedeemer, mustPayToOtherScript,
mustPayToTheScript, mustPayWithDatumToPubKey)
import Ledger.Tx qualified as Tx
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Contract as Con
Expand Down
Loading

0 comments on commit 37ed125

Please sign in to comment.