Remove unnecessary/unused PaymentPubKey from ScriptLookups in plutus-…

…ledger-constraints (#432)
IntersectMBO · Apr 27, 2022 · f56fcfb · f56fcfb
1 parent 957b79c
commit f56fcfb
Show file tree

Hide file tree

Showing 5 changed files with 33 additions and 36 deletions.
diff --git a/plutus-contract/src/Plutus/Contract/Wallet.hs b/plutus-contract/src/Plutus/Contract/Wallet.hs
@@ -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]

diff --git 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
@@ -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
@@ -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
@@ -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