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, unversioned)
 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

@@ -217,7 +217,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 +227,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 +253,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