Push Versioned inside Either

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 <$>

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"
 

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."
 
 

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.

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 }

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

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