From 4a232c93478db04bc7fee644a01eaec932cd71fa Mon Sep 17 00:00:00 2001 From: Sjoerd Visscher Date: Thu, 22 Sep 2022 12:22:16 +0000 Subject: [PATCH] Push Versioned inside Either --- plutus-contract/src/Wallet/Rollup/Render.hs | 15 ++++++++++--- plutus-contract/test/Spec/Emulator.hs | 13 ++++++------ .../src/Ledger/Constraints/OffChain.hs | 8 +++---- plutus-ledger/src/Ledger/Generators.hs | 9 ++++---- plutus-ledger/src/Ledger/Index.hs | 21 +++++++------------ plutus-ledger/src/Ledger/Tx/Internal.hs | 12 +++++------ plutus-ledger/src/Ledger/Typed/Scripts.hs | 2 +- 7 files changed, 41 insertions(+), 39 deletions(-) diff --git a/plutus-contract/src/Wallet/Rollup/Render.hs b/plutus-contract/src/Wallet/Rollup/Render.hs index f34e2a24fd..abe575b280 100644 --- a/plutus-contract/src/Wallet/Rollup/Render.hs +++ b/plutus-contract/src/Wallet/Rollup/Render.hs @@ -38,8 +38,8 @@ import Ledger (Address, Blockchain, PaymentPubKey, PaymentPubKeyHash, Tx (Tx), T import Ledger.Ada (Ada (Lovelace)) import Ledger.Ada qualified as Ada import Ledger.Crypto (PubKey, PubKeyHash, Signature) -import Ledger.Scripts (Datum (getDatum), Script, Validator, ValidatorHash (ValidatorHash), unValidatorScript, - unversioned) +import Ledger.Scripts (Datum (getDatum), Language, Script, Validator, ValidatorHash (ValidatorHash), + Versioned (Versioned), unValidatorScript) import Ledger.Value (CurrencySymbol (CurrencySymbol), TokenName (TokenName)) import Ledger.Value qualified as Value import PlutusTx qualified @@ -288,10 +288,19 @@ instance Render TxIn where render (TxIn txInRef Nothing) = render txInRef instance Render TxInType where - render (ScriptAddress validator _ _) = render (unversioned validator) + render (ScriptAddress validator _ _) = render validator render ConsumePublicKeyAddress = pure mempty render ConsumeSimpleScriptAddress = pure mempty +instance Render a => Render (Versioned a) where + render (Versioned a lang) = do + rlang <- render lang + ra <- render a + pure $ parens rlang <+> ra + +instance Render Language where + render = pure . viaShow + instance Render TxOutRef where render TxOutRef {txOutRefId, txOutRefIdx} = vsep <$> diff --git a/plutus-contract/test/Spec/Emulator.hs b/plutus-contract/test/Spec/Emulator.hs index 402346e497..c6c3159907 100644 --- a/plutus-contract/test/Spec/Emulator.hs +++ b/plutus-contract/test/Spec/Emulator.hs @@ -28,8 +28,9 @@ import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Ledger (CardanoTx (..), Language (PlutusV1), OnChainTx (Valid), PaymentPubKeyHash, ScriptError (EvaluationError), Tx (txMint), TxInType (ScriptAddress), TxOut (TxOut), ValidationError (ScriptFailure), Validator, Value, - Versioned (Versioned), cardanoTxMap, getCardanoTxFee, getCardanoTxOutRefs, getCardanoTxOutputs, - mkValidatorScript, onCardanoTx, outputs, txOutValue, unitDatum, unitRedeemer, unspentOutputs) + Versioned (Versioned, unversioned), cardanoTxMap, getCardanoTxFee, getCardanoTxOutRefs, + getCardanoTxOutputs, mkValidatorScript, onCardanoTx, outputs, txOutValue, unitDatum, unitRedeemer, + unspentOutputs) import Ledger.Ada qualified as Ada import Ledger.Generators (Mockchain (Mockchain), TxInputWitnessed (TxInputWitnessed)) import Ledger.Generators qualified as Gen @@ -217,7 +218,7 @@ invalidScript = property $ do index <- forAll $ Gen.int (Range.linear 0 ((length $ getCardanoTxOutputs txn1) - 1)) let emulatorTx = onCardanoTx id (\_ -> error "Unexpected Cardano.Api.Tx") txn1 let setOutputs o = either (const Hedgehog.failure) (pure . TxOut) $ - toCardanoTxOut pNetworkId toCardanoTxOutDatumHash $ scriptTxOut failValidator (txOutValue o) unitDatum + toCardanoTxOut pNetworkId toCardanoTxOutDatumHash $ scriptTxOut (unversioned failValidator) (txOutValue o) unitDatum outs <- traverse setOutputs $ emulatorTx ^. outputs let scriptTxn = EmulatorTx $ emulatorTx @@ -227,7 +228,7 @@ invalidScript = property $ do let totalVal = txOutValue (fst outToSpend) -- try and spend the script output - invalidTxn <- forAll $ Gen.genValidTransactionSpending [TxInputWitnessed (snd outToSpend) (ScriptAddress (Versioned (Left failValidator) PlutusV1) unitRedeemer unitDatum)] totalVal + invalidTxn <- forAll $ Gen.genValidTransactionSpending [TxInputWitnessed (snd outToSpend) (ScriptAddress (Left failValidator) unitRedeemer unitDatum)] totalVal Hedgehog.annotateShow invalidTxn let options = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Right m @@ -253,8 +254,8 @@ invalidScript = property $ do checkPredicateInner options (assertChainEvents pred .&&. walletPaidFees wallet1 (getCardanoTxFee scriptTxn)) trace Hedgehog.annotate Hedgehog.assert (const $ pure ()) where - failValidator :: Validator - failValidator = mkValidatorScript $$(PlutusTx.compile [|| mkUntypedValidator validator ||]) + failValidator :: Versioned Validator + failValidator = Versioned (mkValidatorScript $$(PlutusTx.compile [|| mkUntypedValidator validator ||])) PlutusV1 validator :: () -> () -> ScriptContext -> Bool validator _ _ _ = PlutusTx.traceError "I always fail everything" diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs index 81a613546a..1008df3223 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs @@ -547,10 +547,10 @@ addOwnInput ScriptInputConstraint{icRedeemer, icTxOutRef} = do valueSpentInputs <>= provided vl case Typed.tyTxInTxIn txIn of -- this is what makeTypedScriptTxIn makes - Tx.TxIn outRef (Just (Tx.ScriptAddress (Versioned (Left val) lang) rs dt)) -> do - unbalancedTx . tx %= Tx.addScriptTxInput outRef (Versioned val lang) rs dt - Tx.TxIn outRef (Just (Tx.ScriptAddress (Versioned (Right ref) lang) rs dt)) -> do - unbalancedTx . tx %= Tx.addReferenceTxInput outRef (Versioned ref lang) rs dt + Tx.TxIn outRef (Just (Tx.ScriptAddress (Left val) rs dt)) -> do + unbalancedTx . tx %= Tx.addScriptTxInput outRef val rs dt + Tx.TxIn outRef (Just (Tx.ScriptAddress (Right ref) rs dt)) -> do + unbalancedTx . tx %= Tx.addReferenceTxInput outRef ref rs dt _ -> error "Impossible txIn in addOwnInput." diff --git a/plutus-ledger/src/Ledger/Generators.hs b/plutus-ledger/src/Ledger/Generators.hs index 0b66f3322f..5f5c7a93fe 100644 --- a/plutus-ledger/src/Ledger/Generators.hs +++ b/plutus-ledger/src/Ledger/Generators.hs @@ -269,11 +269,10 @@ genValidTransactionSpending' g ins totalVal = do txInToTxInput (TxInputWitnessed outref txInType) = case txInType of Ledger.ConsumePublicKeyAddress -> (TxInput outref TxConsumePublicKeyAddress, (Nothing, Nothing)) Ledger.ConsumeSimpleScriptAddress -> (TxInput outref Ledger.TxConsumeSimpleScriptAddress, (Nothing, Nothing)) - Ledger.ScriptAddress (Versioned (Left vl) lang) rd dt -> - let vvl = Versioned vl lang in - (TxInput outref (Ledger.TxScriptAddress rd (Left $ validatorHash vvl) (datumHash dt)), (Just vvl, Just dt)) - Ledger.ScriptAddress (Versioned (Right ref) lang) rd dt -> - (TxInput outref (Ledger.TxScriptAddress rd (Right $ Versioned ref lang) (datumHash dt)), (Nothing, Just dt)) + Ledger.ScriptAddress (Left vl) rd dt -> + (TxInput outref (Ledger.TxScriptAddress rd (Left $ validatorHash vl) (datumHash dt)), (Just vl, Just dt)) + Ledger.ScriptAddress (Right ref) rd dt -> + (TxInput outref (Ledger.TxScriptAddress rd (Right ref) (datumHash dt)), (Nothing, Just dt)) -- | Generate an 'Interval where the lower bound if less or equal than the -- upper bound. diff --git a/plutus-ledger/src/Ledger/Index.hs b/plutus-ledger/src/Ledger/Index.hs index 2c2c46ed45..ae52ec16d7 100644 --- a/plutus-ledger/src/Ledger/Index.hs +++ b/plutus-ledger/src/Ledger/Index.hs @@ -74,13 +74,12 @@ import Ledger.Crypto import Ledger.Index.Internal import Ledger.Orphans () import Ledger.Params (Params (pSlotConfig)) -import Ledger.Scripts (mintingPolicyHash) +import Ledger.Scripts (mintingPolicyHash, validatorHash) import Ledger.Slot qualified as Slot import Ledger.TimeSlot qualified as TimeSlot import Ledger.Tx import Ledger.Tx.CardanoAPI (fromCardanoTxOut) import Ledger.Validation (evaluateMinLovelaceOutput, fromPlutusTxOut) -import Plutus.Script.Utils.V1.Scripts qualified as PV1 import Plutus.Script.Utils.V2.Scripts qualified as PV2 import Plutus.V1.Ledger.Address (Address (Address, addressCredential)) import Plutus.V1.Ledger.Api qualified as PV1 @@ -269,9 +268,8 @@ checkMintingScripts tx = do -- | A matching pair of transaction input and transaction output, ensuring that they are of matching types also. data InOutMatch = ScriptMatch - Language TxOutRef - Validator + (Versioned Validator) Redeemer Datum | PubKeyMatch TxId PubKey Signature @@ -290,15 +288,10 @@ matchInputOutput :: ValidationMonad m -- ^ The unspent transaction output we are trying to unlock -> m InOutMatch matchInputOutput txid mp txin txo = case (txInType txin, txOutDatumHash txo, txOutAddress txo) of - (Just (ScriptAddress (Versioned (Left v) lang) r d), Just dh, Address{addressCredential=ScriptCredential vh}) -> do + (Just (ScriptAddress (Left v) r d), Just dh, Address{addressCredential=ScriptCredential vh}) -> do unless (PV2.datumHash d == dh) $ throwError $ InvalidDatumHash d dh - case lang of - PlutusV1 -> - unless (PV1.validatorHash v == vh) $ throwError $ InvalidScriptHash v vh - PlutusV2 -> - unless (PV2.validatorHash v == vh) $ throwError $ InvalidScriptHash v vh - - pure $ ScriptMatch lang (txInRef txin) v r d + unless (validatorHash v == vh) $ throwError $ InvalidScriptHash (unversioned v) vh + pure $ ScriptMatch (txInRef txin) v r d (Just ConsumePublicKeyAddress, _, Address{addressCredential=PubKeyCredential pkh}) -> let sigMatches = flip fmap (Map.toList mp) $ \(pk,sig) -> if pubKeyHash pk == pkh @@ -316,7 +309,7 @@ matchInputOutput txid mp txin txo = case (txInType txin, txOutDatumHash txo, txO -- locks it. checkMatch :: ValidationMonad m => Tx -> InOutMatch -> m () checkMatch tx = \case - ScriptMatch PlutusV1 txOutRef vl r d -> do + ScriptMatch txOutRef (Versioned vl PlutusV1) r d -> do txInfo <- mkPV1TxInfo tx let ptx' = PV1.ScriptContext { PV1.scriptContextTxInfo = txInfo, PV1.scriptContextPurpose = PV1.Spending txOutRef } @@ -326,7 +319,7 @@ checkMatch tx = \case tell [validatorScriptValidationEvent vd vl d r (Left e)] throwError $ ScriptFailure e res -> tell [validatorScriptValidationEvent vd vl d r res] - ScriptMatch PlutusV2 txOutRef vl r d -> do + ScriptMatch txOutRef (Versioned vl PlutusV2) r d -> do txInfo <- mkPV2TxInfo tx let ptx' = PV2.ScriptContext { PV2.scriptContextTxInfo = txInfo, PV2.scriptContextPurpose = PV2.Spending txOutRef } diff --git a/plutus-ledger/src/Ledger/Tx/Internal.hs b/plutus-ledger/src/Ledger/Tx/Internal.hs index e6031cb0b2..09ecc8a3b5 100644 --- a/plutus-ledger/src/Ledger/Tx/Internal.hs +++ b/plutus-ledger/src/Ledger/Tx/Internal.hs @@ -60,7 +60,7 @@ import Prettyprinter (Pretty (..), hang, viaShow, vsep, (<+>)) -- | The type of a transaction input. data TxInType = - ScriptAddress !(Versioned (Either Validator TxOutRef)) !Redeemer !Datum + ScriptAddress !(Either (Versioned Validator) (Versioned TxOutRef)) !Redeemer !Datum -- ^ A transaction input that consumes a script address with the given the language type, validator, redeemer, and datum. | ConsumePublicKeyAddress -- ^ A transaction input that consumes a public key address. | ConsumeSimpleScriptAddress -- ^ Consume a simple script @@ -91,7 +91,7 @@ pubKeyTxIn r = TxIn r (Just ConsumePublicKeyAddress) -- | A transaction input that spends a "pay to script" output, given witnesses. scriptTxIn :: TxOutRef -> Versioned Validator -> Redeemer -> Datum -> TxIn -scriptTxIn ref v r d = TxIn ref . Just $ ScriptAddress (fmap Left v) r d +scriptTxIn ref v r d = TxIn ref . Just $ ScriptAddress (Left v) r d -- | The type of a transaction input. Contains redeemer if consumes a script. data TxInputType = @@ -157,8 +157,8 @@ instance Pretty Certificate where -- "pay to script" output. inScripts :: TxIn -> Maybe (Versioned Validator, Redeemer, Datum) inScripts TxIn{ txInType = t } = case t of - Just (ScriptAddress (Versioned (Left v) lang) r d) -> Just (Versioned v lang, r, d) - _ -> Nothing + Just (ScriptAddress (Left v) r d) -> Just (v, r, d) + _ -> Nothing -- | The 'TxOutRef' spent by a transaction input. inRef :: L.Lens' TxInput TxOutRef @@ -495,10 +495,10 @@ fillTxInputWitnesses tx (TxInput outRef _inType) = case _inType of TxScriptAddress redeemer (Left vlh) dh -> TxIn outRef $ do datum <- Map.lookup dh (txData tx) validator <- lookupValidator (txScripts tx) vlh - Just $ ScriptAddress (fmap Left validator) redeemer datum + Just $ ScriptAddress (Left validator) redeemer datum TxScriptAddress redeemer (Right ref) dh -> TxIn outRef $ do datum <- Map.lookup dh (txData tx) - Just $ ScriptAddress (fmap Right ref) redeemer datum + Just $ ScriptAddress (Right ref) redeemer datum pubKeyTxInput :: TxOutRef -> TxInput pubKeyTxInput outRef = TxInput outRef TxConsumePublicKeyAddress diff --git a/plutus-ledger/src/Ledger/Typed/Scripts.hs b/plutus-ledger/src/Ledger/Typed/Scripts.hs index 73a7a90d00..6b3c2dbce7 100644 --- a/plutus-ledger/src/Ledger/Typed/Scripts.hs +++ b/plutus-ledger/src/Ledger/Typed/Scripts.hs @@ -41,5 +41,5 @@ makeTypedScriptTxIn si r tyRef = vs = vValidatorScript si rs = Redeemer (toBuiltinData r) ds = Datum (toBuiltinData d) - txInT = ScriptAddress (fmap Left vs) rs ds + txInT = ScriptAddress (Left vs) rs ds in TypedScriptTxIn @inn (TxIn (Export.tyTxOutRefRef tyRef) (Just txInT)) tyRef