From af6041d08f1980083bee8d4b2c46bdccf451b73a Mon Sep 17 00:00:00 2001 From: Sjoerd Visscher Date: Wed, 27 Oct 2021 15:09:35 +0200 Subject: [PATCH] Only script outputs in unbalanced transactions --- playground-common/src/PSGenerator/Common.hs | 3 +- plutus-contract/src/Plutus/Contract/Wallet.hs | 13 +++---- plutus-contract/src/Wallet/Emulator/Wallet.hs | 2 +- .../src/Ledger/Constraints/OffChain.hs | 38 +++++++++++++++---- plutus-ledger/src/Ledger/Tx/CardanoAPI.hs | 2 - .../Spec/crowdfundingEmulatorTestOutput.txt | 6 +-- 6 files changed, 42 insertions(+), 22 deletions(-) diff --git a/playground-common/src/PSGenerator/Common.hs b/playground-common/src/PSGenerator/Common.hs index 68782fe224..c5442b67be 100644 --- a/playground-common/src/PSGenerator/Common.hs +++ b/playground-common/src/PSGenerator/Common.hs @@ -25,7 +25,7 @@ import Ledger (Address, BlockId, Ch 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, @@ -422,6 +422,7 @@ ledgerTypes = , (equal <*> (genericShow <*> mkSumType)) (Proxy @WriteBalancedTxResponse) , (equal <*> (genericShow <*> mkSumType)) (Proxy @ActiveEndpoint) , (equal <*> (genericShow <*> mkSumType)) (Proxy @UnbalancedTx) + , (equal <*> (genericShow <*> mkSumType)) (Proxy @ScriptOutput) , (equal <*> (genericShow <*> mkSumType)) (Proxy @TxValidity) , (equal <*> (genericShow <*> mkSumType)) (Proxy @TxOutState) , (equal <*> (genericShow <*> mkSumType)) (Proxy @(RollbackState A)) diff --git a/plutus-contract/src/Plutus/Contract/Wallet.hs b/plutus-contract/src/Plutus/Contract/Wallet.hs index e7317d4f23..0cb90271c8 100644 --- a/plutus-contract/src/Plutus/Contract/Wallet.hs +++ b/plutus-contract/src/Plutus/Contract/Wallet.hs @@ -39,7 +39,7 @@ import GHC.Generics (Generic) import qualified Ledger as Plutus import qualified Ledger.Ada as Ada import Ledger.Constraints (mustPayToPubKey) -import Ledger.Constraints.OffChain (UnbalancedTx (..), mkTx) +import Ledger.Constraints.OffChain (ScriptOutput (..), UnbalancedTx (..), mkTx) import Ledger.Tx (CardanoTx, TxOutRef, getCardanoTxInputs, txInRef) import qualified Plutus.Contract.CardanoAPI as CardanoAPI import qualified Plutus.Contract.Request as Contract @@ -176,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 7e9396991a..46052afd34 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -267,7 +267,7 @@ validateTxAndAddFees feeCfg 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) utxoIndex 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 7f57daf28c..119cf7a08a 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(..) @@ -32,6 +33,9 @@ module Ledger.Constraints.OffChain( , utxoIndex , validityTimeRange , emptyUnbalancedTx + , ScriptOutput(..) + , toScriptOutput + , fromScriptOutput , MkTxError(..) , mkTx , mkSomeTx @@ -123,14 +127,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 @@ -163,6 +162,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'. @@ -170,7 +192,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) @@ -370,7 +392,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 c1b47b125f..3a63605c78 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/crowdfundingEmulatorTestOutput.txt b/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt index 770d5e802e..e35ab48b6f 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: ( 59787e76d53e8f04159c9773f396d4ec2328599985556ab8aa8f5238350eabe7!1 , - Value (Map [(,Map [("",100)])]) addressed to - ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) ) + 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b ) ( 60c276ac1952e6be91b4890f7d80cd466442d200a160be025556a1f2284e636e!1 , - Value (Map [(,Map [("",100)])]) addressed to - ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) ) + 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b ) ( fe1787e340b05a51c7887431d4f455bae359b3373d283a3d04784bb7dfae473b!1 , - Value (Map [(,Map [("",25)])]) addressed to - ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) ) + 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b ) Validity range: [ POSIXTime 1596059111000 , POSIXTime 1596059120999 ] Slot 20: W872cb83: Finished balancing. 204cfccb9dc69b5b6843f7f11a9c50aec9006e62c11bd8673211e88a974a86bc