From ec634b12a171e91c52f91ccb6e9f00bc20090a79 Mon Sep 17 00:00:00 2001 From: Konstantinos Lambrou-Latreille Date: Tue, 26 Apr 2022 20:19:18 -0400 Subject: [PATCH] Remove unnecessary/unused PaymentPubKey from ScriptLookups in plutus-ledger-constraints --- plutus-contract/src/Plutus/Contract/Wallet.hs | 12 +++++-- plutus-contract/src/Wallet/Emulator/Wallet.hs | 2 +- .../src/Ledger/Constraints/OffChain.hs | 33 +++++++------------ .../Ledger/Constraints/OffChain.purs | 11 ++++--- .../Ledger/Constraints/OffChain.purs | 11 ++++--- 5 files changed, 33 insertions(+), 36 deletions(-) diff --git a/plutus-contract/src/Plutus/Contract/Wallet.hs b/plutus-contract/src/Plutus/Contract/Wallet.hs index ca0b39c41c..af41b0372f 100644 --- a/plutus-contract/src/Plutus/Contract/Wallet.hs +++ b/plutus-contract/src/Plutus/Contract/Wallet.hs @@ -243,8 +243,12 @@ export -> UnbalancedTx -> Either CardanoAPI.ToCardanoError ExportTx export params networkId slotConfig utx = - let UnbalancedTx{unBalancedTxTx, unBalancedTxUtxoIndex, unBalancedTxRequiredSignatories} = finalize slotConfig utx - requiredSigners = Map.keys unBalancedTxRequiredSignatories + let UnbalancedTx + { unBalancedTxTx + , unBalancedTxUtxoIndex + , unBalancedTxRequiredSignatories + } = finalize slotConfig utx + requiredSigners = Set.toList unBalancedTxRequiredSignatories in ExportTx <$> mkPartialTx requiredSigners params networkId unBalancedTxTx <*> mkInputs networkId unBalancedTxUtxoIndex @@ -252,7 +256,9 @@ export params networkId slotConfig utx = finalize :: SlotConfig -> UnbalancedTx -> UnbalancedTx finalize slotConfig utx = - utx & U.tx . Plutus.validRange .~ posixTimeRangeToContainedSlotRange slotConfig (utx ^. U.validityTimeRange) + utx & U.tx + . Plutus.validRange + .~ posixTimeRangeToContainedSlotRange slotConfig (utx ^. U.validityTimeRange) mkPartialTx :: [Plutus.PaymentPubKeyHash] diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index c0bd481bd0..34bc3a2b1a 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -308,7 +308,7 @@ handleBalance utx' = do utxo <- get >>= ownOutputs slotConfig <- WAPI.getClientSlotConfig let utx = finalize slotConfig utx' - let requiredSigners = Map.keys (U.unBalancedTxRequiredSignatories utx) + let requiredSigners = Set.toList (U.unBalancedTxRequiredSignatories utx) cUtxoIndex <- handleError (view U.tx utx) $ fromPlutusIndex $ UtxoIndex $ U.unBalancedTxUtxoIndex utx <> fmap Tx.toTxOut utxo -- Find the fixed point of fee calculation, trying maximally n times to prevent an infinite loop let calcFee n fee = do diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs index 1a497b9d44..46dbfd1a8e 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs @@ -68,6 +68,7 @@ import PlutusTx.Lattice (BoundedMeetSemiLattice (top), JoinSemiLattice ((\/)), M import PlutusTx.Numeric qualified as N import Data.Semigroup (First (First, getFirst)) +import Data.Set (Set) import Ledger qualified import Ledger.Address (PaymentPubKey (PaymentPubKey), PaymentPubKeyHash (PaymentPubKeyHash), StakePubKeyHash, pubKeyHashAddress) @@ -104,7 +105,7 @@ data ScriptLookups a = -- ^ Validators of scripts other than "our script" , slOtherData :: Map DatumHash Datum -- ^ Datums that we might need - , slPaymentPubKeyHashes :: Map PaymentPubKeyHash PaymentPubKey + , slPaymentPubKeyHashes :: Set PaymentPubKeyHash -- ^ Public keys that we might need , slTypedValidator :: Maybe (TypedValidator a) -- ^ The script instance with the typed validator hash & actual compiled program @@ -184,8 +185,8 @@ otherData dt = -- | A script lookups value with a payment public key paymentPubKey :: PaymentPubKey -> ScriptLookups a -paymentPubKey ppk@(PaymentPubKey pk) = - mempty { slPaymentPubKeyHashes = Map.singleton (PaymentPubKeyHash $ pubKeyHash pk) ppk } +paymentPubKey (PaymentPubKey pk) = + mempty { slPaymentPubKeyHashes = Set.singleton (PaymentPubKeyHash $ pubKeyHash pk) } -- | A script lookups value with a payment public key hash. -- @@ -215,7 +216,7 @@ ownStakePubKeyHash skh = mempty { slOwnStakePubKeyHash = Just skh } data UnbalancedTx = UnbalancedTx { unBalancedTxTx :: Tx - , unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey) + , unBalancedTxRequiredSignatories :: Set PaymentPubKeyHash -- ^ These are all the payment public keys that should be used to request the -- signatories from the user's wallet. The signatories are what is required to -- sign the transaction before submitting it to the blockchain. Transaction @@ -249,7 +250,7 @@ instance Pretty UnbalancedTx where pretty (UnbalancedTx utx rs utxo vr) = vsep [ hang 2 $ vsep ["Tx:", pretty utx] - , hang 2 $ vsep $ "Requires signatures:" : (pretty . fst <$> Map.toList rs) + , hang 2 $ vsep $ "Requires signatures:" : (pretty <$> Set.toList rs) , hang 2 $ vsep $ "Utxo index:" : (pretty <$> Map.toList utxo) , hang 2 $ vsep ["Validity range:", pretty vr] ] @@ -568,25 +569,14 @@ lookupValidator vh = let err = throwError (ValidatorHashNotFound vh) in asks slOtherScripts >>= maybe err pure . view (at vh) --- | Get the 'Map.Map PaymentPubKeyHash (Maybe PaymentPubKey)' for a payment pub --- key hash, associating the pub key hash with the public key (if known). --- This value that can be added to the 'unBalancedTxRequiredSignatories' field. -getSignatories - :: ( MonadReader (ScriptLookups a) m - ) - => PaymentPubKeyHash - -> m (Map.Map PaymentPubKeyHash (Maybe PaymentPubKey)) -getSignatories pkh = - asks (Map.singleton pkh . Map.lookup pkh . slPaymentPubKeyHashes) - -- | Modify the 'UnbalancedTx' so that it satisfies the constraints, if -- possible. Fails if a hash is missing from the lookups, or if an output -- of the wrong type is spent. processConstraint :: ( MonadReader (ScriptLookups a) m - , MonadError MkTxError m - , MonadState ConstraintProcessingState m - ) + , MonadError MkTxError m + , MonadState ConstraintProcessingState m + ) => TxConstraint -> m () processConstraint = \case @@ -595,9 +585,8 @@ processConstraint = \case unbalancedTx . tx . Tx.datumWitnesses . at theHash .= Just dv MustValidateIn timeRange -> unbalancedTx . validityTimeRange %= (timeRange /\) - MustBeSignedBy pk -> do - sigs <- getSignatories pk - unbalancedTx . requiredSignatories <>= sigs + MustBeSignedBy pk -> + unbalancedTx . requiredSignatories <>= Set.singleton pk MustSpendAtLeast vl -> valueSpentInputs <>= required vl MustProduceAtLeast vl -> valueSpentOutputs <>= required vl MustSpendPubKeyOutput txo -> do diff --git a/plutus-pab-executables/demo/pab-nami/client/generated/Ledger/Constraints/OffChain.purs b/plutus-pab-executables/demo/pab-nami/client/generated/Ledger/Constraints/OffChain.purs index 39d50b6303..4717cd2d12 100644 --- a/plutus-pab-executables/demo/pab-nami/client/generated/Ledger/Constraints/OffChain.purs +++ b/plutus-pab-executables/demo/pab-nami/client/generated/Ledger/Constraints/OffChain.purs @@ -16,9 +16,10 @@ import Data.Lens.Record (prop) import Data.Map (Map) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, unwrap) +import Data.Set (Set) import Data.Show.Generic (genericShow) import Data.Tuple.Nested ((/\)) -import Ledger.Address (PaymentPubKey, PaymentPubKeyHash) +import Ledger.Address (PaymentPubKeyHash) import Ledger.Typed.Tx (ConnectionError) import Plutus.V1.Ledger.Interval (Interval) import Plutus.V1.Ledger.Scripts (DatumHash) @@ -149,7 +150,7 @@ _MultipleMatchingOutputsFound = prism' MultipleMatchingOutputsFound case _ of newtype UnbalancedTx = UnbalancedTx { unBalancedTxTx :: Tx - , unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey) + , unBalancedTxRequiredSignatories :: Set PaymentPubKeyHash , unBalancedTxUtxoIndex :: Map TxOutRef TxOut , unBalancedTxValidityTimeRange :: Interval POSIXTime } @@ -163,7 +164,7 @@ instance EncodeJson UnbalancedTx where encodeJson = defer \_ -> E.encode $ unwrap >$< ( E.record { unBalancedTxTx: E.value :: _ Tx - , unBalancedTxRequiredSignatories: (E.dictionary E.value (E.maybe E.value)) :: _ (Map PaymentPubKeyHash (Maybe PaymentPubKey)) + , unBalancedTxRequiredSignatories: E.value :: _ (Set PaymentPubKeyHash) , unBalancedTxUtxoIndex: (E.dictionary E.value E.value) :: _ (Map TxOutRef TxOut) , unBalancedTxValidityTimeRange: E.value :: _ (Interval POSIXTime) } @@ -173,7 +174,7 @@ instance DecodeJson UnbalancedTx where decodeJson = defer \_ -> D.decode $ ( UnbalancedTx <$> D.record "UnbalancedTx" { unBalancedTxTx: D.value :: _ Tx - , unBalancedTxRequiredSignatories: (D.dictionary D.value (D.maybe D.value)) :: _ (Map PaymentPubKeyHash (Maybe PaymentPubKey)) + , unBalancedTxRequiredSignatories: D.value :: _ (Set PaymentPubKeyHash) , unBalancedTxUtxoIndex: (D.dictionary D.value D.value) :: _ (Map TxOutRef TxOut) , unBalancedTxValidityTimeRange: D.value :: _ (Interval POSIXTime) } @@ -185,5 +186,5 @@ derive instance Newtype UnbalancedTx _ -------------------------------------------------------------------------------- -_UnbalancedTx :: Iso' UnbalancedTx { unBalancedTxTx :: Tx, unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey), unBalancedTxUtxoIndex :: Map TxOutRef TxOut, unBalancedTxValidityTimeRange :: Interval POSIXTime } +_UnbalancedTx :: Iso' UnbalancedTx { unBalancedTxTx :: Tx, unBalancedTxRequiredSignatories :: Set PaymentPubKeyHash, unBalancedTxUtxoIndex :: Map TxOutRef TxOut, unBalancedTxValidityTimeRange :: Interval POSIXTime } _UnbalancedTx = _Newtype diff --git a/plutus-playground-client/generated/Ledger/Constraints/OffChain.purs b/plutus-playground-client/generated/Ledger/Constraints/OffChain.purs index 39d50b6303..4717cd2d12 100644 --- a/plutus-playground-client/generated/Ledger/Constraints/OffChain.purs +++ b/plutus-playground-client/generated/Ledger/Constraints/OffChain.purs @@ -16,9 +16,10 @@ import Data.Lens.Record (prop) import Data.Map (Map) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, unwrap) +import Data.Set (Set) import Data.Show.Generic (genericShow) import Data.Tuple.Nested ((/\)) -import Ledger.Address (PaymentPubKey, PaymentPubKeyHash) +import Ledger.Address (PaymentPubKeyHash) import Ledger.Typed.Tx (ConnectionError) import Plutus.V1.Ledger.Interval (Interval) import Plutus.V1.Ledger.Scripts (DatumHash) @@ -149,7 +150,7 @@ _MultipleMatchingOutputsFound = prism' MultipleMatchingOutputsFound case _ of newtype UnbalancedTx = UnbalancedTx { unBalancedTxTx :: Tx - , unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey) + , unBalancedTxRequiredSignatories :: Set PaymentPubKeyHash , unBalancedTxUtxoIndex :: Map TxOutRef TxOut , unBalancedTxValidityTimeRange :: Interval POSIXTime } @@ -163,7 +164,7 @@ instance EncodeJson UnbalancedTx where encodeJson = defer \_ -> E.encode $ unwrap >$< ( E.record { unBalancedTxTx: E.value :: _ Tx - , unBalancedTxRequiredSignatories: (E.dictionary E.value (E.maybe E.value)) :: _ (Map PaymentPubKeyHash (Maybe PaymentPubKey)) + , unBalancedTxRequiredSignatories: E.value :: _ (Set PaymentPubKeyHash) , unBalancedTxUtxoIndex: (E.dictionary E.value E.value) :: _ (Map TxOutRef TxOut) , unBalancedTxValidityTimeRange: E.value :: _ (Interval POSIXTime) } @@ -173,7 +174,7 @@ instance DecodeJson UnbalancedTx where decodeJson = defer \_ -> D.decode $ ( UnbalancedTx <$> D.record "UnbalancedTx" { unBalancedTxTx: D.value :: _ Tx - , unBalancedTxRequiredSignatories: (D.dictionary D.value (D.maybe D.value)) :: _ (Map PaymentPubKeyHash (Maybe PaymentPubKey)) + , unBalancedTxRequiredSignatories: D.value :: _ (Set PaymentPubKeyHash) , unBalancedTxUtxoIndex: (D.dictionary D.value D.value) :: _ (Map TxOutRef TxOut) , unBalancedTxValidityTimeRange: D.value :: _ (Interval POSIXTime) } @@ -185,5 +186,5 @@ derive instance Newtype UnbalancedTx _ -------------------------------------------------------------------------------- -_UnbalancedTx :: Iso' UnbalancedTx { unBalancedTxTx :: Tx, unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey), unBalancedTxUtxoIndex :: Map TxOutRef TxOut, unBalancedTxValidityTimeRange :: Interval POSIXTime } +_UnbalancedTx :: Iso' UnbalancedTx { unBalancedTxTx :: Tx, unBalancedTxRequiredSignatories :: Set PaymentPubKeyHash, unBalancedTxUtxoIndex :: Map TxOutRef TxOut, unBalancedTxValidityTimeRange :: Interval POSIXTime } _UnbalancedTx = _Newtype