1919module Ledger.Constraints.OffChain (
2020 -- * Lookups
2121 ScriptLookups (.. )
22- , plutusV1TypedValidatorLookups
22+ , typedValidatorLookups
2323 , generalise
2424 , unspentOutputs
2525 , plutusV1MintingPolicy
@@ -104,7 +104,6 @@ import Ledger.Tx qualified as Tx
104104import Ledger.Tx.CardanoAPI qualified as C
105105import Ledger.Typed.Scripts (Any , ConnectionError (UnknownRef ), TypedValidator ,
106106 ValidatorTypes (DatumType , RedeemerType ))
107- import Ledger.Typed.Scripts qualified as Scripts
108107import Ledger.Typed.Scripts qualified as Typed
109108import Ledger.Validation (evaluateMinLovelaceOutput , fromPlutusTxOutUnsafe )
110109import Plutus.Script.Utils.Scripts qualified as P
@@ -120,29 +119,29 @@ import PlutusTx.Numeric qualified as N
120119
121120data ScriptLookups a =
122121 ScriptLookups
123- { slMPS :: Map MintingPolicyHash MintingPolicy
122+ { slMPS :: Map MintingPolicyHash MintingPolicy
124123 -- ^ Minting policies that the script interacts with
125- , slTxOutputs :: Map TxOutRef ChainIndexTxOut
124+ , slTxOutputs :: Map TxOutRef ChainIndexTxOut
126125 -- ^ Unspent outputs that the script may want to spend
127- , slOtherScripts :: Map ValidatorHash (Validator , Language )
126+ , slOtherScripts :: Map ValidatorHash (Validator , Language )
128127 -- ^ Validators of scripts other than "our script"
129- , slOtherData :: Map DatumHash Datum
128+ , slOtherData :: Map DatumHash Datum
130129 -- ^ Datums that we might need
131- , slPaymentPubKeyHashes :: Set PaymentPubKeyHash
130+ , slPaymentPubKeyHashes :: Set PaymentPubKeyHash
132131 -- ^ Public keys that we might need
133- , slTypedPlutusV1Validator :: Maybe TypedValidator a )
132+ , slTypedValidator :: Maybe TypedValidator a )
134133 -- ^ The script instance with the typed validator hash & actual compiled program
135- , slOwnPaymentPubKeyHash :: Maybe PaymentPubKeyHash
134+ , slOwnPaymentPubKeyHash :: Maybe PaymentPubKeyHash
136135 -- ^ The contract's payment public key hash, used for depositing tokens etc.
137- , slOwnStakePubKeyHash :: Maybe StakePubKeyHash
136+ , slOwnStakePubKeyHash :: Maybe StakePubKeyHash
138137 -- ^ The contract's stake public key hash (optional)
139138 } deriving stock (Show , Generic )
140139 deriving anyclass (ToJSON , FromJSON )
141140
142141generalise :: ScriptLookups a -> ScriptLookups Any
143142generalise sl =
144- let validator = fmap Scripts .slTypedPlutusV1Validator sl)
145- in sl{slTypedPlutusV1Validator = validator}
143+ let validator = fmap Typed .slTypedValidator sl)
144+ in sl{slTypedValidator = validator}
146145
147146instance Semigroup (ScriptLookups a ) where
148147 l <> r =
@@ -153,7 +152,7 @@ instance Semigroup (ScriptLookups a) where
153152 , slOtherData = slOtherData l <> slOtherData r
154153 , slPaymentPubKeyHashes = slPaymentPubKeyHashes l <> slPaymentPubKeyHashes r
155154 -- 'First' to match the semigroup instance of Map (left-biased)
156- , slTypedPlutusV1Validator = fmap getFirst $ (First <$> slTypedPlutusV1Validator l) <> (First <$> slTypedPlutusV1Validator r)
155+ , slTypedValidator = fmap getFirst $ (First <$> slTypedValidator l) <> (First <$> slTypedValidator r)
157156 , slOwnPaymentPubKeyHash =
158157 fmap getFirst $ (First <$> slOwnPaymentPubKeyHash l)
159158 <> (First <$> slOwnPaymentPubKeyHash r)
@@ -173,14 +172,14 @@ instance Monoid (ScriptLookups a) where
173172-- If called multiple times, only the first typed validator is kept:
174173--
175174-- @
176- -- plutusV1TypedValidatorLookups tv1 <> plutusV1TypedValidatorLookups tv2 <> ...
177- -- == plutusV1TypedValidatorLookups tv1
175+ -- typedValidatorLookups tv1 <> typedValidatorLookups tv2 <> ...
176+ -- == typedValidatorLookups tv1
178177-- @
179- plutusV1TypedValidatorLookups :: TypedValidator a -> ScriptLookups a
180- plutusV1TypedValidatorLookups inst =
178+ typedValidatorLookups :: TypedValidator a -> ScriptLookups a
179+ typedValidatorLookups inst =
181180 mempty
182- { slMPS = Map. singleton (Scripts .Scripts .
183- , slTypedPlutusV1Validator = Just inst
181+ { slMPS = Map. singleton (Typed .Typed .
182+ , slTypedValidator = Just inst
184183 }
185184
186185-- | A script lookups value that uses the map of unspent outputs to resolve
@@ -518,8 +517,8 @@ addOwnInput
518517 => ScriptInputConstraint (RedeemerType a )
519518 -> m ()
520519addOwnInput ScriptInputConstraint {icRedeemer, icTxOutRef} = do
521- ScriptLookups {slTxOutputs, slTypedPlutusV1Validator } <- ask
522- inst <- maybe (throwError TypedValidatorMissing ) pure slTypedPlutusV1Validator
520+ ScriptLookups {slTxOutputs, slTypedValidator } <- ask
521+ inst <- maybe (throwError TypedValidatorMissing ) pure slTypedValidator
523522 typedOutRef <-
524523 either (throwError . TypeCheckFailed ) pure
525524 $ runExcept @ Typed. ConnectionError
@@ -529,8 +528,7 @@ addOwnInput ScriptInputConstraint{icRedeemer, icTxOutRef} = do
529528 datum <- ciTxOut ^? Tx. ciTxOutScriptDatum . _2 . _Just
530529 pure (Tx. toTxOut ciTxOut, datum)
531530 Typed. typeScriptTxOutRef inst icTxOutRef txOut datum
532- -- TODO Needs to work with PlutusV1 AND PlutusV2.
533- let txIn = Scripts. makeTypedScriptTxIn PlutusV1 inst icRedeemer typedOutRef
531+ let txIn = Typed. makeTypedScriptTxIn inst icRedeemer typedOutRef
534532 vl = Tx. txOutValue $ Typed. tyTxOutTxOut $ Typed. tyTxOutRefOut typedOutRef
535533 unbalancedTx . tx . Tx. inputs %= (Typed. tyTxInTxIn txIn : )
536534 valueSpentInputs <>= provided vl
@@ -546,8 +544,8 @@ addOwnOutput
546544 => ScriptOutputConstraint (DatumType a )
547545 -> m ()
548546addOwnOutput ScriptOutputConstraint {ocDatum, ocValue} = do
549- ScriptLookups {slTypedPlutusV1Validator } <- ask
550- inst <- maybe (throwError TypedValidatorMissing ) pure slTypedPlutusV1Validator
547+ ScriptLookups {slTypedValidator } <- ask
548+ inst <- maybe (throwError TypedValidatorMissing ) pure slTypedValidator
551549 let txOut = Typed. makeTypedScriptTxOut inst ocDatum ocValue
552550 dsV = Datum (toBuiltinData ocDatum)
553551 unbalancedTx . tx . Tx. outputs %= (Typed. tyTxOutTxOut txOut : )
@@ -752,13 +750,12 @@ resolveScriptTxOut
752750 => ChainIndexTxOut -> m (Maybe ValidatorHash , Validator , Language ), (DatumHash , Datum ), Value ))
753751resolveScriptTxOut
754752 Tx. ScriptChainIndexTxOut
755- { Tx. _ciTxOutValidator = (vh, v )
753+ { Tx. _ciTxOutValidator = (vh, _ )
756754 , Tx. _ciTxOutScriptDatum = (dh, d)
757755 , Tx. _ciTxOutValue
758756 } = do
759- -- first check in the 'ChainIndexTx' for the validator, then
760- -- look for it in the 'slOtherScripts map.
761- (validator, pv) <- maybe (lookupValidator vh) (pure . (, PlutusV1 )) v
757+ -- Look for the validator in the 'slOtherScripts map so we also get the language.
758+ (validator, pv) <- lookupValidator vh
762759
763760 -- first check in the 'ChainIndexTxOut' for the datum, then
764761 -- look for it in the 'slOtherData' map.
0 commit comments