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

Commit

Permalink
SCP-2945: Only script outputs in unbalanced transactions (#57)
Browse files Browse the repository at this point in the history
* Only script outputs in unbalanced transactions

* Don't use ScriptLookups internals in PubKey tests

* Fix merge issue
  • Loading branch information
sjoerdvisscher authored Nov 22, 2021
1 parent 7333e3c commit 0709726
Show file tree
Hide file tree
Showing 7 changed files with 45 additions and 34 deletions.
3 changes: 2 additions & 1 deletion playground-common/src/PSGenerator/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
16 changes: 7 additions & 9 deletions plutus-contract/src/Plutus/Contract/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
]
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion plutus-contract/src/Wallet/Emulator/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
38 changes: 30 additions & 8 deletions plutus-ledger/src/Ledger/Constraints/OffChain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Ledger.Constraints.OffChain(
-- * Lookups
ScriptLookups(..)
Expand All @@ -33,6 +34,9 @@ module Ledger.Constraints.OffChain(
, validityTimeRange
, emptyUnbalancedTx
, adjustUnbalancedTx
, ScriptOutput(..)
, toScriptOutput
, fromScriptOutput
, MkTxError(..)
, mkTx
, mkSomeTx
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -164,14 +163,37 @@ 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'.
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)
Expand Down Expand Up @@ -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.
Expand Down
2 changes: 0 additions & 2 deletions plutus-ledger/src/Ledger/Tx/CardanoAPI.hs
Original file line number Diff line number Diff line change
Expand Up @@ -650,7 +650,6 @@ data ToCardanoError
| MissingMintingPolicyRedeemer
| MissingMintingPolicy
| ScriptPurposeNotSupported P.ScriptTag
| PublicKeyInputsNotSupported
| Tag String ToCardanoError
deriving stock (Show, Eq, Generic)
deriving anyclass (FromJSON, ToJSON)
Expand All @@ -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
Expand Down
12 changes: 2 additions & 10 deletions plutus-use-cases/test/Spec/PubKey.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
6 changes: 3 additions & 3 deletions plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 0709726

Please sign in to comment.