Refactor the transaction validity interval test.

* Remove the incomplete, and now redundant `transVITimeUpperBoundIsClosed`.
* Use `toPlutusTxInfo` to comprehensively test for all protocol versions.
* The new test runs for all eras: alonzo, babbage and conway.

NOTE: This test only works for PlutusV1 since we do not yet have common
accessors accross common data types from different versions of Plutus.

Author: aniketd

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -252,6 +252,5 @@ test-suite tests
     cardano-slotting,
     cardano-strict-containers,
     containers,
-    plutus-ledger-api,
     testlib,
     time,

eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/TxInfoSpec.hs

@@ -9,12 +9,7 @@ module Test.Cardano.Ledger.Alonzo.TxInfoSpec (spec) where
 import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.Alonzo (AlonzoEra, Tx (..))
 import Cardano.Ledger.Alonzo.Core
-import Cardano.Ledger.Alonzo.Plutus.Context (
-  ContextError,
-  LedgerTxInfo (..),
-  toPlutusTxInfo,
- )
-import Cardano.Ledger.Alonzo.Plutus.TxInfo (transValidityInterval)
+import Cardano.Ledger.Alonzo.Plutus.Context (LedgerTxInfo (..), toPlutusTxInfo)
 import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..))
 import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..), TxBody (..))
 import Cardano.Ledger.BaseTypes (Network (..), StrictMaybe (..))
@@ -27,14 +22,12 @@ import Cardano.Ledger.State (UTxO (..))
 import Cardano.Ledger.TxIn (TxId (..), TxIn (..), mkTxInPartial)
 import qualified Cardano.Ledger.Val as Val
 import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
-import Cardano.Slotting.Slot (EpochSize (..), SlotNo (..))
+import Cardano.Slotting.Slot (EpochSize (..))
 import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
 import qualified Data.Map.Strict as Map
-import Data.Proxy
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
-import qualified PlutusLedgerApi.V1 as PV1
 import Test.Cardano.Ledger.Binary.Random (mkDummyHash)
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkCredential, mkKeyPair)
@@ -104,20 +97,6 @@ silentlyIgnore tx =
         Right _ -> pure ()
         Left e -> expectationFailure $ "no translation error was expected, but got: " <> show e
 
--- | The test checks that the old implementation of 'transVITime' stays intentionally incorrect,
--- by returning close upper bound of the validaty interval.
-transVITimeUpperBoundIsClosed :: Expectation
-transVITimeUpperBoundIsClosed = do
-  let interval = ValidityInterval SNothing (SJust (SlotNo 40))
-  case transValidityInterval (Proxy @AlonzoEra) ei ss interval of
-    Left (e :: ContextError AlonzoEra) ->
-      expectationFailure $ "no translation error was expected, but got: " <> show e
-    Right t ->
-      t
-        `shouldBe` PV1.Interval
-          (PV1.LowerBound PV1.NegInf True)
-          (PV1.UpperBound (PV1.Finite (PV1.POSIXTime 40000)) True)
-
 spec :: Spec
 spec = describe "txInfo translation" $ do
   -- TODO: convert to Imp: https://github.com/IntersectMBO/cardano-ledger/issues/5210
@@ -126,9 +105,6 @@ spec = describe "txInfo translation" $ do
       silentlyIgnore (txEx shelleyInput byronOutput)
     it "silently ignore byron txin" $
       silentlyIgnore (txEx byronInput shelleyOutput)
-  describe "transVITime" $ do
-    it "validity interval's upper bound is closed when protocol < 9" $
-      transVITimeUpperBoundIsClosed
 
 genesisId :: TxId
 genesisId = TxId (unsafeMakeSafeHash (mkDummyHash (0 :: Int)))

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Era.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
@@ -30,6 +31,7 @@ class
   , ToExpr (PlutusPurpose AsIx era)
   , ToExpr (PlutusPurpose AsIxItem era)
   , Script era ~ AlonzoScript era
+  , EraPlutusTxInfo PlutusV1 era
   ) =>
   AlonzoEraTest era
 

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxosSpec.hs

@@ -12,6 +12,7 @@
 module Test.Cardano.Ledger.Alonzo.Imp.UtxosSpec (spec) where
 
 import Cardano.Ledger.Alonzo.Core
+import Cardano.Ledger.Alonzo.Plutus.Context (LedgerTxInfo (..), toPlutusTxInfo)
 import Cardano.Ledger.Alonzo.Plutus.Evaluate (
   CollectError (NoCostModel),
   TransactionScriptFailure (RedeemerPointsToUnknownScriptHash),
@@ -23,16 +24,26 @@ import Cardano.Ledger.Alonzo.Rules (
  )
 import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), eraLanguages)
 import Cardano.Ledger.Alonzo.TxWits (unRedeemersL)
-import Cardano.Ledger.BaseTypes (Globals (..), StrictMaybe (..))
+import Cardano.Ledger.BaseTypes (
+  Globals (..),
+  ProtVer (..),
+  SlotNo (..),
+  StrictMaybe (..),
+  natVersion,
+ )
 import Cardano.Ledger.Plutus.Data (Data (..))
 import Cardano.Ledger.Plutus.Language (hashPlutusScript, withSLanguage)
+import qualified Cardano.Ledger.Plutus.Language as L
 import Cardano.Ledger.Shelley.LedgerState (curPParamsEpochStateL, nesEsL)
+import Cardano.Slotting.Time (SystemStart (SystemStart))
 import Control.Monad.Reader (asks)
 import Data.Either (isLeft)
 import qualified Data.Map.Merge.Strict as Map
 import qualified Data.Map.Strict as Map
+import Data.Proxy (Proxy (Proxy))
 import qualified Data.Set as Set
-import Lens.Micro (set, (%~), (&), (.~), (<>~), (^.), _2)
+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
+import Lens.Micro (set, to, (%~), (&), (.~), (<>~), (^.), _2)
 import Lens.Micro.Mtl (use)
 import qualified PlutusLedgerApi.Common as P
 import qualified PlutusLedgerApi.V1 as PV1
@@ -53,7 +64,42 @@ spec ::
   , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
-spec = describe "UTXOS" $
+spec = describe "UTXOS" $ do
+  it
+    "transaction validity interval has closed upper bound when protocol version < 9 and open otherwise"
+    $ do
+      ei <- use $ impGlobalsL . to epochInfo
+      ss@(SystemStart sysStart) <- use $ impGlobalsL . to systemStart
+      SlotNo currentSlot <- use impLastTickG
+      protVer <- getProtVer
+      utxo <- getUTxO
+      let txValidity = 7200
+          -- We must provide a non-Nothing upper bound so that the "closed" vs "open" case can be tested.
+          interval = ValidityInterval SNothing $ SJust $ SlotNo $ currentSlot + txValidity
+          startPOSIX = floor $ utcTimeToPOSIXSeconds sysStart
+          expectedUpperBound = (startPOSIX + fromIntegral (currentSlot + txValidity)) * 1000
+          tx = mkBasicTx mkBasicTxBody & bodyTxL . vldtTxBodyL .~ interval
+          lti =
+            LedgerTxInfo
+              { ltiProtVer = protVer
+              , ltiEpochInfo = ei
+              , ltiSystemStart = ss
+              , ltiUTxO = utxo
+              , ltiTx = tx
+              }
+      case toPlutusTxInfo (Proxy @L.PlutusV1) lti of
+        Left e -> assertFailure $ "No translation error was expected, but got: " <> show e
+        Right txInfo ->
+          PV1.txInfoValidRange txInfo
+            `shouldBe` PV1.Interval
+              (PV1.LowerBound PV1.NegInf True)
+              ( PV1.UpperBound
+                  ( PV1.Finite
+                      (PV1.POSIXTime expectedUpperBound)
+                  )
+                  (pvMajor protVer < natVersion @9) -- The upper bound.
+              )
+
   forM_ (eraLanguages @era) $ \lang ->
     describe (show lang) $
       withSLanguage lang $ \slang -> do

eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Era.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -6,6 +8,7 @@ module Test.Cardano.Ledger.Babbage.Era (
   BabbageEraTest,
 ) where
 
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
 import Cardano.Ledger.Babbage
 import Cardano.Ledger.Babbage.Core
 import Cardano.Ledger.Plutus (Language (..))
@@ -18,6 +21,7 @@ class
   ( AlonzoEraTest era
   , BabbageEraTxBody era
   , BabbageEraPParams era
+  , EraPlutusTxInfo PlutusV2 era
   ) =>
   BabbageEraTest era
 

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Era.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -9,6 +10,7 @@ module Test.Cardano.Ledger.Conway.Era (
   conwayAccountsToUMap,
 ) where
 
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Coin
 import Cardano.Ledger.Conway
@@ -32,6 +34,7 @@ class
   , ConwayEraCertState era
   , ConwayEraGov era
   , ConwayEraAccounts era
+  , EraPlutusTxInfo PlutusV3 era
   ) =>
   ConwayEraTest era
 

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs

@@ -8,10 +8,7 @@
 
 module Test.Cardano.Ledger.Conway.Imp (spec, conwaySpec) where
 
-import Cardano.Ledger.Alonzo.Plutus.Context (
-  EraPlutusContext (ContextError),
-  EraPlutusTxInfo,
- )
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext (ContextError))
 import Cardano.Ledger.Alonzo.Rules (
   AlonzoUtxoPredFailure,
   AlonzoUtxosPredFailure,
@@ -35,7 +32,6 @@ import Cardano.Ledger.Conway.Rules (
   ConwayUtxowPredFailure,
  )
 import Cardano.Ledger.Conway.TxInfo (ConwayContextError)
-import Cardano.Ledger.Plutus (Language (..))
 import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..))
 import Cardano.Ledger.Shelley.Rules (
   ShelleyDelegPredFailure,
@@ -94,7 +90,6 @@ spec ::
   , Eq (Event (EraRule "ENACT" era))
   , Typeable (Event (EraRule "ENACT" era))
   , ToExpr (Event (EraRule "BBODY" era))
-  , EraPlutusTxInfo PlutusV2 era
   ) =>
   Spec
 spec = do
@@ -128,7 +123,6 @@ conwaySpec ::
   , Eq (Event (EraRule "ENACT" era))
   , Typeable (Event (EraRule "ENACT" era))
   , ToExpr (Event (EraRule "BBODY" era))
-  , EraPlutusTxInfo PlutusV2 era
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
 conwaySpec = do

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxowSpec.hs

@@ -9,7 +9,6 @@
 module Test.Cardano.Ledger.Conway.Imp.UtxowSpec (spec) where
 
 import Cardano.Ledger.Address (Addr (..))
-import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
 import Cardano.Ledger.Babbage.Tx (ScriptIntegrity (..), getLanguageView)
 import Cardano.Ledger.BaseTypes (
   Inject (..),
@@ -47,7 +46,6 @@ spec ::
   forall era.
   ( ConwayEraImp era
   , InjectRuleFailure "LEDGER" ConwayUtxowPredFailure era
-  , EraPlutusTxInfo PlutusV2 era
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
 spec = do

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Spec.hs

@@ -8,7 +8,7 @@
 
 module Test.Cardano.Ledger.Conway.Spec (spec) where
 
-import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext (..), EraPlutusTxInfo)
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext (..))
 import Cardano.Ledger.Alonzo.Rules (
   AlonzoUtxoPredFailure,
   AlonzoUtxosPredFailure,
@@ -45,7 +45,6 @@ import Cardano.Ledger.Conway.Rules (
  )
 import Cardano.Ledger.Conway.TxCert (ConwayTxCert)
 import Cardano.Ledger.Conway.TxInfo (ConwayContextError)
-import Cardano.Ledger.Plutus (Language (..))
 import Cardano.Ledger.Plutus.Language (SLanguage (..))
 import Cardano.Ledger.Shelley.API (ApplyTx)
 import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses)
@@ -75,10 +74,7 @@ import Test.Cardano.Ledger.Core.JSON (roundTripJsonEraSpec)
 
 spec ::
   forall era.
-  ( EraPlutusTxInfo PlutusV1 era
-  , EraPlutusTxInfo PlutusV2 era
-  , EraPlutusTxInfo PlutusV3 era
-  , RuleListEra era
+  ( RuleListEra era
   , ConwayEraImp era
   , ApplyTx era
   , DecCBOR (TxWits era)

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/TxInfoSpec.hs

@@ -12,7 +12,6 @@ module Test.Cardano.Ledger.Conway.TxInfoSpec (spec) where
 
 import Cardano.Ledger.Alonzo.Plutus.Context (
   EraPlutusContext (ContextError),
-  EraPlutusTxInfo,
   toPlutusTxCert,
  )
 import Cardano.Ledger.BaseTypes
@@ -38,7 +37,6 @@ import Test.Cardano.Ledger.Conway.Genesis ()
 spec ::
   forall era.
   ( ConwayEraTest era
-  , EraPlutusTxInfo PlutusV3 era
   , TxCert era ~ ConwayTxCert era
   ) =>
   Spec