From 0709726797168dc1a33f4cedbfa0ea1a821581d8 Mon Sep 17 00:00:00 2001 From: Sjoerd Visscher Date: Mon, 22 Nov 2021 10:34:17 +0100 Subject: [PATCH] SCP-2945: Only script outputs in unbalanced transactions (#57) * Only script outputs in unbalanced transactions * Don't use ScriptLookups internals in PubKey tests * Fix merge issue --- playground-common/src/PSGenerator/Common.hs | 3 +- plutus-contract/src/Plutus/Contract/Wallet.hs | 16 ++++---- plutus-contract/src/Wallet/Emulator/Wallet.hs | 2 +- .../src/Ledger/Constraints/OffChain.hs | 38 +++++++++++++++---- plutus-ledger/src/Ledger/Tx/CardanoAPI.hs | 2 - plutus-use-cases/test/Spec/PubKey.hs | 12 +----- .../Spec/crowdfundingEmulatorTestOutput.txt | 6 +-- 7 files changed, 45 insertions(+), 34 deletions(-) diff --git a/playground-common/src/PSGenerator/Common.hs b/playground-common/src/PSGenerator/Common.hs index 50fea3ca10..be10608981 100644 --- a/playground-common/src/PSGenerator/Common.hs +++ b/playground-common/src/PSGenerator/Common.hs @@ -22,7 +22,7 @@ import Ledger (Address, BlockId, ChainIndexTxOut, DatumHash, MintingPolicy, OnCh ScriptTag, Signature, StakeValidator, Tx, TxId, TxIn, TxInType, TxOut, TxOutRef, TxOutTx, UtxoIndex, ValidationPhase, Validator) import Ledger.Ada (Ada) -import Ledger.Constraints.OffChain (MkTxError, UnbalancedTx) +import Ledger.Constraints.OffChain (MkTxError, ScriptOutput, UnbalancedTx) import Ledger.Credential (Credential, StakingCredential) import Ledger.DCert (DCert) import Ledger.Index (ExCPU, ExMemory, ScriptType, ScriptValidationEvent, ValidationError) @@ -379,6 +379,7 @@ ledgerTypes = , equal . genericShow . argonaut $ mkSumType @WriteBalancedTxResponse , equal . genericShow . argonaut $ mkSumType @ActiveEndpoint , equal . genericShow . argonaut $ mkSumType @UnbalancedTx + , equal . genericShow . argonaut $ mkSumType @ScriptOutput , order . equal . genericShow . argonaut $ mkSumType @TxValidity , equal . genericShow . argonaut $ mkSumType @TxOutState , equal . genericShow . argonaut $ mkSumType @(RollbackState A) diff --git a/plutus-contract/src/Plutus/Contract/Wallet.hs b/plutus-contract/src/Plutus/Contract/Wallet.hs index eed928ca0a..00adafede5 100644 --- a/plutus-contract/src/Plutus/Contract/Wallet.hs +++ b/plutus-contract/src/Plutus/Contract/Wallet.hs @@ -28,7 +28,6 @@ import Control.Monad.Error.Lens (throwing) import Control.Monad.Freer (Eff, Member) import Control.Monad.Freer.Error (Error, throwError) import Data.Aeson (ToJSON (..), Value (String), object, (.=)) -import Data.Aeson.Extras qualified as Aeson.Extras import Data.Aeson.Extras qualified as JSON import Data.Map (Map) import Data.Map qualified as Map @@ -40,7 +39,7 @@ import GHC.Generics (Generic) import Ledger qualified as Plutus import Ledger.Ada qualified as Ada import Ledger.Constraints (mustPayToPubKey) -import Ledger.Constraints.OffChain (UnbalancedTx (..), adjustUnbalancedTx, mkTx) +import Ledger.Constraints.OffChain (ScriptOutput (..), UnbalancedTx (..), adjustUnbalancedTx, mkTx) import Ledger.Tx (CardanoTx, TxOutRef, getCardanoTxInputs, txInRef) import Plutus.Contract.CardanoAPI qualified as CardanoAPI import Plutus.Contract.Request qualified as Contract @@ -161,7 +160,7 @@ instance ToJSON ExportTxInput where instance ToJSON ExportTx where toJSON ExportTx{partialTx, lookups, redeemers} = object - [ "transaction" .= Aeson.Extras.encodeByteString (C.serialiseToCBOR partialTx) + [ "transaction" .= JSON.encodeByteString (C.serialiseToCBOR partialTx) , "inputs" .= lookups , "redeemers" .= redeemers ] @@ -177,21 +176,20 @@ export params networkId UnbalancedTx{unBalancedTxTx, unBalancedTxUtxoIndex, unBa mkPartialTx :: [WAPI.PubKeyHash] -> C.ProtocolParameters -> C.NetworkId -> Plutus.Tx -> Either CardanoAPI.ToCardanoError (C.Tx C.AlonzoEra) mkPartialTx requiredSigners params networkId = fmap (C.makeSignedTransaction []) . CardanoAPI.toCardanoTxBody requiredSigners (Just params) networkId -mkInputs :: C.NetworkId -> Map Plutus.TxOutRef Plutus.TxOut -> Either CardanoAPI.ToCardanoError [ExportTxInput] +mkInputs :: C.NetworkId -> Map Plutus.TxOutRef ScriptOutput -> Either CardanoAPI.ToCardanoError [ExportTxInput] mkInputs networkId = traverse (uncurry (toExportTxInput networkId)) . Map.toList -toExportTxInput :: C.NetworkId -> Plutus.TxOutRef -> Plutus.TxOut -> Either CardanoAPI.ToCardanoError ExportTxInput -toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} Plutus.TxOut{Plutus.txOutAddress, Plutus.txOutValue, Plutus.txOutDatumHash=Just dh} = do - cardanoValue <- CardanoAPI.toCardanoValue txOutValue +toExportTxInput :: C.NetworkId -> Plutus.TxOutRef -> ScriptOutput -> Either CardanoAPI.ToCardanoError ExportTxInput +toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} (ScriptOutput vh value dh) = do + cardanoValue <- CardanoAPI.toCardanoValue value let otherQuantities = mapMaybe (\case { (C.AssetId policyId assetName, quantity) -> Just (policyId, assetName, quantity); _ -> Nothing }) $ C.valueToList cardanoValue ExportTxInput <$> CardanoAPI.toCardanoTxId txOutRefId <*> pure (C.TxIx $ fromInteger txOutRefIdx) - <*> CardanoAPI.toCardanoAddress networkId txOutAddress + <*> CardanoAPI.toCardanoAddress networkId (Plutus.scriptHashAddress vh) <*> pure (C.selectLovelace cardanoValue) <*> CardanoAPI.toCardanoScriptDataHash dh <*> pure otherQuantities -toExportTxInput _ _ _ = Left CardanoAPI.PublicKeyInputsNotSupported mkRedeemers :: Plutus.Tx -> Either CardanoAPI.ToCardanoError [ExportTxRedeemer] mkRedeemers tx = (++) <$> mkSpendingRedeemers tx <*> mkMintingRedeemers tx diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index 68f1cbe735..c557517892 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -268,7 +268,7 @@ validateTxAndAddFees feeCfg slotCfg ownTxOuts utx = do -- Balance and sign just for validation tx <- handleBalanceTx ownTxOuts utx signedTx <- handleAddSignature tx - let utxoIndex = Ledger.UtxoIndex $ unBalancedTxUtxoIndex utx <> (toTxOut <$> ownTxOuts) + let utxoIndex = Ledger.UtxoIndex $ fmap toTxOut $ (U.fromScriptOutput <$> unBalancedTxUtxoIndex utx) <> ownTxOuts ((e, _), events) = Ledger.runValidation (Ledger.validateTransactionOffChain signedTx) (Ledger.ValidationCtx utxoIndex slotCfg) for_ e $ \(phase, ve) -> do logWarn $ ValidationFailed phase (txId tx) tx ve events diff --git a/plutus-ledger/src/Ledger/Constraints/OffChain.hs b/plutus-ledger/src/Ledger/Constraints/OffChain.hs index 3f50e465ca..22e7608758 100644 --- a/plutus-ledger/src/Ledger/Constraints/OffChain.hs +++ b/plutus-ledger/src/Ledger/Constraints/OffChain.hs @@ -14,6 +14,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} module Ledger.Constraints.OffChain( -- * Lookups ScriptLookups(..) @@ -33,6 +34,9 @@ module Ledger.Constraints.OffChain( , validityTimeRange , emptyUnbalancedTx , adjustUnbalancedTx + , ScriptOutput(..) + , toScriptOutput + , fromScriptOutput , MkTxError(..) , mkTx , mkSomeTx @@ -124,14 +128,9 @@ instance Monoid (ScriptLookups a) where -- instance's validator. typedValidatorLookups :: TypedValidator a -> ScriptLookups a typedValidatorLookups inst = - ScriptLookups + mempty { slMPS = Map.singleton (Scripts.forwardingMintingPolicyHash inst) (Scripts.forwardingMintingPolicy inst) - , slTxOutputs = Map.empty - , slOtherScripts = Map.empty - , slOtherData = Map.empty - , slPubKeyHashes = Map.empty , slTypedValidator = Just inst - , slOwnPubkeyHash = Nothing } -- | A script lookups value that uses the map of unspent outputs to resolve @@ -164,6 +163,29 @@ pubKey pk = mempty { slPubKeyHashes = Map.singleton (pubKeyHash pk) pk } ownPubKeyHash :: PubKeyHash -> ScriptLookups a ownPubKeyHash ph = mempty { slOwnPubkeyHash = Just ph} +data ScriptOutput = + ScriptOutput + { scriptOutputValidatorHash :: ValidatorHash + , scriptOutputValue :: Value + , scriptOutputDatumHash :: DatumHash + } + deriving stock (Eq, Generic, Show) + deriving anyclass (FromJSON, ToJSON, OpenApi.ToSchema) + +toScriptOutput :: ChainIndexTxOut -> Maybe ScriptOutput +toScriptOutput (Tx.ScriptChainIndexTxOut _ validatorOrHash datumOrHash v) + = Just $ ScriptOutput (either id validatorHash validatorOrHash) v (either id datumHash datumOrHash) +toScriptOutput Tx.PublicKeyChainIndexTxOut{} + = Nothing + +fromScriptOutput :: ScriptOutput -> ChainIndexTxOut +fromScriptOutput (ScriptOutput vh v dh) = + Tx.ScriptChainIndexTxOut (Address.scriptHashAddress vh) (Left vh) (Left dh) v + +instance Pretty ScriptOutput where + pretty ScriptOutput{scriptOutputValidatorHash, scriptOutputValue} = + hang 2 $ vsep ["-" <+> pretty scriptOutputValue <+> "addressed to", pretty scriptOutputValidatorHash] + -- | An unbalanced transaction. It needs to be balanced and signed before it -- can be submitted to the ledeger. See note [Submitting transactions from -- Plutus contracts] in 'Plutus.Contract.Wallet'. @@ -171,7 +193,7 @@ data UnbalancedTx = UnbalancedTx { unBalancedTxTx :: Tx , unBalancedTxRequiredSignatories :: Map PubKeyHash (Maybe PubKey) - , unBalancedTxUtxoIndex :: Map TxOutRef TxOut + , unBalancedTxUtxoIndex :: Map TxOutRef ScriptOutput , unBalancedTxValidityTimeRange :: POSIXTimeRange } deriving stock (Eq, Generic, Show) @@ -386,7 +408,7 @@ updateUtxoIndex => m () updateUtxoIndex = do ScriptLookups{slTxOutputs} <- ask - unbalancedTx . utxoIndex <>= fmap Tx.toTxOut slTxOutputs + unbalancedTx . utxoIndex <>= Map.mapMaybe toScriptOutput slTxOutputs -- | Add a typed input, checking the type of the output it spends. Return the value -- of the spent output. diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs index 0c9f8d9625..42337f01af 100644 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs +++ b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs @@ -650,7 +650,6 @@ data ToCardanoError | MissingMintingPolicyRedeemer | MissingMintingPolicy | ScriptPurposeNotSupported P.ScriptTag - | PublicKeyInputsNotSupported | Tag String ToCardanoError deriving stock (Show, Eq, Generic) deriving anyclass (FromJSON, ToJSON) @@ -667,7 +666,6 @@ instance Pretty ToCardanoError where pretty MissingMintingPolicyRedeemer = "Missing minting policy redeemer" pretty MissingMintingPolicy = "Missing minting policy" pretty (ScriptPurposeNotSupported p) = "Script purpose not supported:" <+> viaShow p - pretty PublicKeyInputsNotSupported = "Public key inputs not supported" pretty (Tag t err) = pretty t <> colon <+> pretty err zeroExecutionUnits :: C.ExecutionUnits diff --git a/plutus-use-cases/test/Spec/PubKey.hs b/plutus-use-cases/test/Spec/PubKey.hs index 04878a4326..c2bcd7f537 100644 --- a/plutus-use-cases/test/Spec/PubKey.hs +++ b/plutus-use-cases/test/Spec/PubKey.hs @@ -5,7 +5,6 @@ import Control.Monad (void) import Data.Map qualified as Map import Ledger.Ada qualified as Ada -import Ledger.Constraints (ScriptLookups (..)) import Ledger.Constraints qualified as Constraints import Ledger.Scripts (unitRedeemer) import Ledger.Typed.Scripts as Scripts @@ -20,15 +19,8 @@ import Test.Tasty theContract :: Contract () EmptySchema PubKeyError () theContract = do (txOutRef, ciTxOut, pkInst) <- pubKeyContract (walletPubKeyHash w1) (Ada.adaValueOf 10) - let lookups = ScriptLookups - { slMPS = Map.empty - , slTxOutputs = maybe mempty (Map.singleton txOutRef) ciTxOut - , slOtherScripts = Map.singleton (Scripts.validatorHash pkInst) (Scripts.validatorScript pkInst) - , slOtherData = Map.empty - , slPubKeyHashes = Map.empty - , slTypedValidator = Nothing - , slOwnPubkeyHash = Nothing - } + let lookups = maybe mempty (Constraints.unspentOutputs . Map.singleton txOutRef) ciTxOut + <> Constraints.otherScript (Scripts.validatorScript pkInst) void $ submitTxConstraintsWith @Scripts.Any lookups (Constraints.mustSpendScriptOutput txOutRef unitRedeemer) tests :: TestTree diff --git a/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt b/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt index d2d7ca2214..5a9d305edb 100644 --- a/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt +++ b/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt @@ -116,13 +116,13 @@ Slot 20: W872cb83: Balancing an unbalanced transaction: Utxo index: ( 2f869889c09e76fb2cbfe2a3a0d512bfc86fe515d0cee53ecea4a79d3e695029!1 , - Value (Map [(,Map [("",10000000)])]) addressed to - ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) ) + 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b ) ( c351875a8d5d26a87f1cf365f007f8a543040e9d8d182d608223edd245c5ea9e!1 , - Value (Map [(,Map [("",2500000)])]) addressed to - ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) ) + 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b ) ( e9628f4a7231fbe76f221ae02309b0d44df8d902154ab1bd93e38a274d52f370!1 , - Value (Map [(,Map [("",10000000)])]) addressed to - ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) ) + 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b ) Validity range: [ POSIXTime 1596059111000 , POSIXTime 1596059120999 ] Slot 20: W872cb83: Finished balancing. 3a20125dbda70ddc4408207505e362966252b6941ec7eb334ca11f11fc96ac35