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

Remove unnecessary/unused PaymentPubKey from ScriptLookups in plutus-ledger-constraints #432

Merged
merged 1 commit into from
Apr 27, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 9 additions & 3 deletions plutus-contract/src/Plutus/Contract/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -243,16 +243,22 @@ 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
<*> mkRedeemers unBalancedTxTx

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]
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 @@ -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
Expand Down
33 changes: 11 additions & 22 deletions plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
--
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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]
]
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
}
Expand All @@ -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)
}
Expand All @@ -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)
}
Expand All @@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
}
Expand All @@ -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)
}
Expand All @@ -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)
}
Expand All @@ -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