Switch TxInfo golden tests to use SupportedLanguage

lehins · lehins · commit ecd0f677392a · 2025-05-07T13:15:47.000-06:00
diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md
@@ -18,6 +18,7 @@
 
 ### `testlib`
 
+* Remove `TxInfoLanguage` and `mkTxInfoLanguage`
 * Added `Era` module with `AlonzoEraTest` class
 
 ## 1.13.0.0
diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal
@@ -143,7 +143,6 @@ library testlib
 
   build-depends:
     HUnit,
-    QuickCheck,
     base,
     bytestring,
     cardano-data:{cardano-data, testlib},
diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/Golden.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/Golden.hs
@@ -8,16 +8,18 @@ module Test.Cardano.Ledger.Alonzo.Translation.Golden (
   assertTranslationResultsMatchGolden,
 ) where
 
-import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, LedgerTxInfo (..), toPlutusTxInfo)
-import Cardano.Ledger.Alonzo.Scripts (AlonzoEraScript)
+import Cardano.Ledger.Alonzo.Plutus.Context (
+  LedgerTxInfo (..),
+  SupportedLanguage (..),
+  toPlutusTxInfo,
+ )
 import Cardano.Ledger.Binary
 import Cardano.Ledger.Core
 import Control.Exception (throwIO)
 import qualified Data.ByteString.Lazy as BSL
 import Test.Cardano.Ledger.Alonzo.Binary.Annotator ()
 import Test.Cardano.Ledger.Alonzo.Translation.TranslatableGen (
   TranslatableGen (..),
-  TxInfoLanguage (..),
   epochInfo,
   systemStart,
   toVersionedTxInfo,
@@ -34,10 +36,7 @@ import Test.HUnit (Assertion, assertEqual)
 -- and serializes both arguments and result to golden/translations.cbor file
 generateGoldenFile ::
   forall era.
-  ( Show (ContextError era)
-  , AlonzoEraScript era
-  , TranslatableGen era
-  ) =>
+  TranslatableGen era =>
   FilePath ->
   IO ()
 generateGoldenFile file = do
@@ -49,7 +48,6 @@ generateGoldenFile file = do
 assertTranslationResultsMatchGolden ::
   forall era.
   ( TranslatableGen era
-  , Show (ContextError era)
   , HasCallStack
   ) =>
   IO FilePath ->
@@ -62,14 +60,13 @@ assertTranslationResultsMatchGolden file = do
 assertTranslationComparison ::
   forall era.
   ( TranslatableGen era
-  , Show (ContextError era)
   , HasCallStack
   ) =>
   TranslationInstance era ->
   Assertion
-assertTranslationComparison (TranslationInstance protVer lang utxo tx expected) =
-  case mkTxInfoLanguage @era lang of
-    TxInfoLanguage slang -> do
+assertTranslationComparison (TranslationInstance protVer supportedLanguage utxo tx expected) =
+  case supportedLanguage of
+    SupportedLanguage slang -> do
       case toPlutusTxInfo slang lti of
         Left e -> error $ show e
         Right actual -> assertEqual errorMessage expected $ toVersionedTxInfo slang actual
@@ -84,9 +81,9 @@ assertTranslationComparison (TranslationInstance protVer lang utxo tx expected)
         }
     errorMessage =
       unlines
-        [ "Unexpected txinfo with arguments: "
+        [ "Unexpected TxInfo with arguments: "
         , " ProtVer: " <> show protVer
-        , " language: " <> show lang
-        , " utxo: " <> show utxo
-        , " tx: " <> show tx
+        , " Language: " <> show supportedLanguage
+        , " UTxO: " <> show utxo
+        , " Tx: " <> show tx
         ]
diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslatableGen.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslatableGen.hs
@@ -8,7 +8,6 @@
 
 module Test.Cardano.Ledger.Alonzo.Translation.TranslatableGen (
   TranslatableGen (..),
-  TxInfoLanguage (..),
   translationInstances,
   epochInfo,
   toVersionedTxInfo,
@@ -17,42 +16,36 @@ module Test.Cardano.Ledger.Alonzo.Translation.TranslatableGen (
 
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Plutus.Context (
-  ContextError,
-  EraPlutusTxInfo,
+  EraPlutusContext,
   LedgerTxInfo (..),
   PlutusTxInfo,
+  SupportedLanguage (..),
+  supportedLanguages,
   toPlutusTxInfo,
  )
-import Cardano.Ledger.Alonzo.Scripts (AlonzoEraScript (eraMaxLanguage))
 import Cardano.Ledger.Alonzo.TxWits (Redeemers)
 import Cardano.Ledger.Core as Core
-import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..))
+import Cardano.Ledger.Plutus.Language (SLanguage (..))
 import Cardano.Ledger.State (UTxO (..))
 import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
 import Cardano.Slotting.Slot (EpochSize (..))
 import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
+import qualified Data.List.NonEmpty as NE (toList)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
-import GHC.Stack
 import Lens.Micro ((^.))
 import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Alonzo.Translation.TranslationInstance (
   TranslationInstance (..),
   VersionedTxInfo (..),
  )
-import Test.QuickCheck (Gen, arbitrary, elements, vectorOf)
-import Test.QuickCheck.Gen (Gen (MkGen))
-import Test.QuickCheck.Random (mkQCGen)
+import Test.Cardano.Ledger.Common
 
-data TxInfoLanguage era where
-  TxInfoLanguage :: EraPlutusTxInfo l era => SLanguage l -> TxInfoLanguage era
-
-class EraTx era => TranslatableGen era where
+class (EraTx era, EraPlutusContext era, Arbitrary (Script era)) => TranslatableGen era where
   tgRedeemers :: Gen (Redeemers era)
-  tgTx :: Language -> Gen (Core.Tx era)
-  tgUtxo :: Language -> Core.Tx era -> Gen (UTxO era)
-  mkTxInfoLanguage :: HasCallStack => Language -> TxInfoLanguage era
+  tgTx :: SupportedLanguage era -> Gen (Core.Tx era)
+  tgUtxo :: SupportedLanguage era -> Core.Tx era -> Gen (UTxO era)
 
 instance TranslatableGen AlonzoEra where
   tgRedeemers = arbitrary
@@ -61,24 +54,14 @@ instance TranslatableGen AlonzoEra where
     let ins = tx ^. bodyTxL ^. inputsTxBodyL
     outs <- vectorOf (length ins) (arbitrary :: Gen (TxOut AlonzoEra))
     pure $ UTxO (Map.fromList $ Set.toList ins `zip` outs)
-  mkTxInfoLanguage PlutusV1 = TxInfoLanguage SPlutusV1
-  mkTxInfoLanguage lang =
-    error $ "Language " ++ show lang ++ " is not supported in " ++ eraName @AlonzoEra
 
 translationInstances ::
-  forall era.
-  ( AlonzoEraScript era
-  , TranslatableGen era
-  , Show (ContextError era)
-  ) =>
+  TranslatableGen era =>
   Int ->
   Int ->
   [TranslationInstance era]
 translationInstances size seed =
-  generateWithSeed seed $ vectorOf size genTranslationInstance
-
-generateWithSeed :: Int -> Gen a -> a
-generateWithSeed seed (MkGen g) = g (mkQCGen seed) 30
+  runGen seed 30 $ vectorOf size genTranslationInstance
 
 toVersionedTxInfo :: SLanguage l -> PlutusTxInfo l -> VersionedTxInfo
 toVersionedTxInfo slang txInfo =
@@ -89,16 +72,13 @@ toVersionedTxInfo slang txInfo =
 
 genTranslationInstance ::
   forall era.
-  ( AlonzoEraScript era
-  , TranslatableGen era
-  , Show (ContextError era)
-  ) =>
+  TranslatableGen era =>
   Gen (TranslationInstance era)
 genTranslationInstance = do
   protVer <- arbitrary
-  lang <- elements [minBound .. eraMaxLanguage @era]
-  tx <- tgTx @era lang
-  utxo <- tgUtxo lang tx
+  supportedLanguage <- elements $ NE.toList (supportedLanguages @era)
+  tx <- tgTx @era supportedLanguage
+  utxo <- tgUtxo supportedLanguage tx
   let lti =
         LedgerTxInfo
           { ltiProtVer = protVer
@@ -107,11 +87,12 @@ genTranslationInstance = do
           , ltiUTxO = utxo
           , ltiTx = tx
           }
-  case mkTxInfoLanguage @era lang of
-    TxInfoLanguage slang -> do
+  case supportedLanguage of
+    SupportedLanguage slang -> do
       case toPlutusTxInfo slang lti of
         Left err -> error $ show err
-        Right txInfo -> pure $ TranslationInstance protVer lang utxo tx $ toVersionedTxInfo slang txInfo
+        Right txInfo ->
+          pure $ TranslationInstance protVer supportedLanguage utxo tx $ toVersionedTxInfo slang txInfo
 
 epochInfo :: EpochInfo (Either a)
 epochInfo = fixedEpochInfo (EpochSize 100) (mkSlotLength 1)
diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs
@@ -17,6 +17,7 @@ module Test.Cardano.Ledger.Alonzo.Translation.TranslationInstance (
   VersionedTxInfo (..),
 ) where
 
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext, SupportedLanguage)
 import Cardano.Ledger.BaseTypes (ProtVer)
 import Cardano.Ledger.Binary (
   DecCBOR (..),
@@ -35,11 +36,9 @@ import Cardano.Ledger.Binary.Coders (
   (<!),
  )
 import Cardano.Ledger.Core as Core
-import Cardano.Ledger.Plutus.Language (Language (..))
 import Cardano.Ledger.State (UTxO (..))
 import qualified Codec.Serialise as Cborg (Serialise (..))
 import qualified Data.ByteString.Lazy as BSL
-import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
 import qualified PlutusLedgerApi.V1 as PV1
 import qualified PlutusLedgerApi.V2 as PV2
@@ -54,7 +53,7 @@ data VersionedTxInfo
 -- | Represents arguments passed to `alonzoTxInfo` along with the produced result.
 data TranslationInstance era = TranslationInstance
   { tiProtVer :: ProtVer
-  , tiLanguage :: Language
+  , tiLanguage :: SupportedLanguage era
   , tiUtxo :: UTxO era
   , tiTx :: Core.Tx era
   , tiResult :: VersionedTxInfo
@@ -126,7 +125,7 @@ instance DecCBOR VersionedTxInfo where
   decCBOR = fromPlainDecoder Cborg.decode
 
 instance
-  ( Typeable era
+  ( Era era
   , EncCBOR (PParams era)
   , EncCBOR (UTxO era)
   , EncCBOR (Core.Tx era)
@@ -143,10 +142,10 @@ instance
         !> To r
 
 instance
-  ( Typeable era
-  , DecCBOR (PParams era)
+  ( DecCBOR (PParams era)
   , DecCBOR (UTxO era)
   , DecCBOR (Core.Tx era)
+  , EraPlutusContext era
   ) =>
   DecCBOR (TranslationInstance era)
   where
@@ -161,10 +160,10 @@ instance
 
 deserializeTranslationInstances ::
   forall era.
-  ( Era era
-  , DecCBOR (PParams era)
+  ( DecCBOR (PParams era)
   , DecCBOR (UTxO era)
   , DecCBOR (Core.Tx era)
+  , EraPlutusContext era
   ) =>
   BSL.ByteString ->
   Either DecoderError [TranslationInstance era]
diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Translation/TranslatableGen.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Translation/TranslatableGen.hs
@@ -13,6 +13,7 @@ module Test.Cardano.Ledger.Babbage.Translation.TranslatableGen (
 ) where
 
 import Cardano.Ledger.Address (Addr (..))
+import Cardano.Ledger.Alonzo.Plutus.Context (SupportedLanguage (..))
 import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose (..), ExUnits (..))
 import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..))
 import Cardano.Ledger.Alonzo.TxWits
@@ -22,7 +23,7 @@ import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..), TxBody (BabbageTxBody))
 import Cardano.Ledger.Binary (mkSized)
 import Cardano.Ledger.Credential (StakeReference (..))
 import Cardano.Ledger.Plutus.Data (Data (..), Datum (..))
-import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..))
+import Cardano.Ledger.Plutus.Language (SLanguage (..))
 import Cardano.Ledger.State (UTxO (..))
 import Cardano.Ledger.TxIn (TxIn (..))
 import qualified Data.Map.Strict as Map
@@ -31,10 +32,7 @@ import Data.Sequence.Strict (fromList)
 import qualified Data.Set as Set
 import Lens.Micro ((^.))
 import Test.Cardano.Ledger.Alonzo.Arbitrary (genScripts)
-import Test.Cardano.Ledger.Alonzo.Translation.TranslatableGen (
-  TranslatableGen (..),
-  TxInfoLanguage (..),
- )
+import Test.Cardano.Ledger.Alonzo.Translation.TranslatableGen (TranslatableGen (..))
 import Test.Cardano.Ledger.Babbage.Arbitrary ()
 import Test.Cardano.Ledger.Core.Arbitrary ()
 import Test.QuickCheck (
@@ -53,10 +51,6 @@ instance TranslatableGen BabbageEra where
   tgRedeemers = genRedeemers
   tgTx l = genTx @BabbageEra (genTxBody l)
   tgUtxo = utxoWithTx @BabbageEra
-  mkTxInfoLanguage PlutusV1 = TxInfoLanguage SPlutusV1
-  mkTxInfoLanguage PlutusV2 = TxInfoLanguage SPlutusV2
-  mkTxInfoLanguage lang =
-    error $ "Language " ++ show lang ++ " is not supported in " ++ eraName @BabbageEra
 
 utxoWithTx ::
   forall era.
@@ -65,7 +59,7 @@ utxoWithTx ::
   , Arbitrary (Script era)
   , TxOut era ~ BabbageTxOut era
   ) =>
-  Language ->
+  SupportedLanguage era ->
   Tx era ->
   Gen (UTxO era)
 utxoWithTx l tx = do
@@ -77,8 +71,6 @@ genTx ::
   forall era.
   ( TranslatableGen era
   , Arbitrary (TxAuxData era)
-  , Arbitrary (Script era)
-  , AlonzoEraScript era
   , AlonzoTxWits era ~ TxWits era
   ) =>
   Gen (TxBody era) ->
@@ -96,28 +88,28 @@ genTxOut ::
   , Arbitrary (Value era)
   , Arbitrary (Script era)
   ) =>
-  Language ->
+  SupportedLanguage era ->
   Gen (BabbageTxOut era)
-genTxOut l = do
+genTxOut (SupportedLanguage slang) = do
   addr <- genNonByronAddr
   value <- scale (`div` 15) arbitrary
-  script <- case l of
-    PlutusV1 -> pure SNothing
+  script <- case slang of
+    SPlutusV1 -> pure SNothing
     _ -> arbitrary
-  datum <- case l of
-    PlutusV1 -> oneof [pure NoDatum, DatumHash <$> (arbitrary :: Gen DataHash)]
+  datum <- case slang of
+    SPlutusV1 -> oneof [pure NoDatum, DatumHash <$> (arbitrary :: Gen DataHash)]
     _ -> arbitrary
   pure $ BabbageTxOut addr value datum script
 
-genTxBody :: Language -> Gen (TxBody BabbageEra)
-genTxBody l = do
+genTxBody :: SupportedLanguage BabbageEra -> Gen (TxBody BabbageEra)
+genTxBody l@(SupportedLanguage slang) = do
   let genTxOuts = fromList <$> listOf1 (mkSized (eraProtVerLow @BabbageEra) <$> genTxOut @BabbageEra l)
   let genTxIns = Set.fromList <$> listOf1 (arbitrary :: Gen TxIn)
   BabbageTxBody
     <$> genTxIns
     <*> arbitrary
-    <*> ( case l of -- refinputs
-            PlutusV1 -> pure Set.empty
+    <*> ( case slang of -- refinputs
+            SPlutusV1 -> pure Set.empty
             _ -> arbitrary
         )
     <*> genTxOuts
@@ -145,10 +137,7 @@ genNonByronAddr =
       ]
 
 genTxWits ::
-  ( TranslatableGen era
-  , Arbitrary (Script era)
-  , AlonzoEraScript era
-  ) =>
+  TranslatableGen era =>
   Gen (AlonzoTxWits era)
 genTxWits =
   AlonzoTxWits
diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Translation/TranslatableGen.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Translation/TranslatableGen.hs
