Merge pull request #5278 from IntersectMBO/jj/alonzo-txinfo-imptest

Re-implement `TxInfoSpec` as an `ImpTest`

Author: teodanciu

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

@@ -223,7 +223,7 @@ test-suite tests
     Test.Cardano.Ledger.Alonzo.BinarySpec
     Test.Cardano.Ledger.Alonzo.GoldenSpec
     Test.Cardano.Ledger.Alonzo.GoldenTranslation
-    Test.Cardano.Ledger.Alonzo.TxInfoSpec
+    Test.Cardano.Ledger.Alonzo.Imp.TxInfoSpec
 
   default-language: Haskell2010
   ghc-options:
@@ -249,8 +249,8 @@ test-suite tests
     cardano-ledger-binary:{cardano-ledger-binary, testlib},
     cardano-ledger-core:{cardano-ledger-core, testlib},
     cardano-ledger-shelley:testlib,
-    cardano-slotting,
     cardano-strict-containers,
     containers,
+    microlens,
+    microlens-mtl,
     testlib,
-    time,

eras/alonzo/impl/test/Main.hs

@@ -11,8 +11,8 @@ import qualified Test.Cardano.Ledger.Alonzo.BinarySpec as BinarySpec
 import qualified Test.Cardano.Ledger.Alonzo.GoldenSpec as Golden
 import qualified Test.Cardano.Ledger.Alonzo.GoldenTranslation as GoldenTranslation
 import qualified Test.Cardano.Ledger.Alonzo.Imp as Imp
+import qualified Test.Cardano.Ledger.Alonzo.Imp.TxInfoSpec as TxInfoImp
 import Test.Cardano.Ledger.Alonzo.ImpTest ()
-import qualified Test.Cardano.Ledger.Alonzo.TxInfoSpec as TxInfo
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.JSON (roundTripJsonEraSpec)
 import Test.Cardano.Ledger.Shelley.JSON (roundTripJsonShelleyEraSpec)
@@ -26,7 +26,6 @@ main =
       CddlSpec.spec
       roundTripJsonEraSpec @AlonzoEra
       roundTripJsonShelleyEraSpec @AlonzoEra
-      TxInfo.spec
       GoldenTranslation.tests
       Golden.spec
       describe "Imp" $ do
@@ -35,3 +34,4 @@ main =
         CostModelsSpec.spec @AlonzoEra
       describe "TxWits" $ do
         TxWitsSpec.spec @AlonzoEra
+      TxInfoImp.spec

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

@@ -0,0 +1,78 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Cardano.Ledger.Alonzo.Imp.TxInfoSpec (spec) where
+
+import Cardano.Ledger.Address (Addr (..))
+import Cardano.Ledger.Alonzo (AlonzoEra)
+import Cardano.Ledger.Alonzo.Core (
+  EraTx (..),
+  EraTxBody (..),
+  EraTxOut (..),
+ )
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo (..), LedgerTxInfo (..))
+import Cardano.Ledger.BaseTypes
+import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Plutus (SLanguage (..))
+import qualified Data.Sequence.Strict as SSeq
+import qualified Data.Set as Set
+import Lens.Micro ((&), (.~))
+import Lens.Micro.Mtl (use)
+import Test.Cardano.Ledger.Alonzo.ImpTest
+import Test.Cardano.Ledger.Imp.Common
+
+spec :: Spec
+spec = withImpInit @(LedgerSpec AlonzoEra) $ describe "TxInfo" $ do
+  describe "PlutusV1" $ do
+    it "toPlutusTxInfo does not fail when Byron scripts are present in TxOuts" $ do
+      pv <- getProtVer
+      Globals {epochInfo, systemStart} <- use impGlobalsL
+      (_, shelleyAddr) <- freshKeyAddr
+      byronAddr <- AddrBootstrap <$> freshBootstapAddress
+      shelleyTxIn <- sendCoinTo shelleyAddr mempty
+      utxo <- getUTxO
+      let
+        byronTxOut = mkBasicTxOut byronAddr . inject $ Coin 1
+        tx =
+          mkBasicTx @AlonzoEra mkBasicTxBody
+            & bodyTxL
+              . inputsTxBodyL
+              .~ Set.singleton shelleyTxIn
+            & bodyTxL
+              . outputsTxBodyL
+              .~ SSeq.singleton byronTxOut
+        lti =
+          LedgerTxInfo
+            { ltiProtVer = pv
+            , ltiEpochInfo = epochInfo
+            , ltiSystemStart = systemStart
+            , ltiUTxO = utxo
+            , ltiTx = tx
+            }
+      void $ expectRight $ toPlutusTxInfo SPlutusV1 lti
+    it "toPlutusTxInfo does not fail when Byron scripts are present in TxIns" $ do
+      pv <- getProtVer
+      Globals {epochInfo, systemStart} <- use impGlobalsL
+      (_, shelleyAddr) <- freshKeyAddr
+      byronAddr <- AddrBootstrap <$> freshBootstapAddress
+      byronTxIn <- sendCoinTo byronAddr mempty
+      utxo <- getUTxO
+      let
+        shelleyTxOut = mkBasicTxOut shelleyAddr . inject $ Coin 1
+        tx =
+          mkBasicTx @AlonzoEra mkBasicTxBody
+            & bodyTxL
+              . inputsTxBodyL
+              .~ Set.singleton byronTxIn
+            & bodyTxL
+              . outputsTxBodyL
+              .~ SSeq.singleton shelleyTxOut
+        lti =
+          LedgerTxInfo
+            { ltiProtVer = pv
+            , ltiEpochInfo = epochInfo
+            , ltiSystemStart = systemStart
+            , ltiUTxO = utxo
+            , ltiTx = tx
+            }
+      void $ expectRight $ toPlutusTxInfo SPlutusV1 lti

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

@@ -60,7 +60,7 @@ alonzoEraSpecificSpec ::
   SpecWith (ImpInit (LedgerSpec era))
 alonzoEraSpecificSpec = do
   describe "Alonzo era specific Imp spec" $
-    describe "Certificates without deposits" $
+    describe "Certificates without deposits" $ do
       Utxow.alonzoEraSpecificSpec
 
 instance EraSpecificSpec AlonzoEra where

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

@@ -63,7 +63,7 @@ spec = do
       cddlRoundTripCborSpec @CostModels v "cost_models"
       cddlRoundTripAnnCborSpec @(Redeemers DijkstraEra) v "redeemers"
       cddlRoundTripCborSpec @(Redeemers DijkstraEra) v "redeemers"
-      xdescribe "fix TxBody" $ do
+      xdescribe "fix Tx" $ do
         cddlRoundTripAnnCborSpec @(Tx DijkstraEra) v "transaction"
         cddlRoundTripCborSpec @(Tx DijkstraEra) v "transaction"
       cddlRoundTripCborSpec @(VotingProcedure DijkstraEra) v "voting_procedure"
@@ -159,4 +159,5 @@ spec = do
         huddleDecoderEquivalenceSpec @(Script DijkstraEra) v "script"
         huddleDecoderEquivalenceSpec @(TxWits DijkstraEra) v "transaction_witness_set"
         huddleDecoderEquivalenceSpec @(Redeemers DijkstraEra) v "redeemers"
-        huddleDecoderEquivalenceSpec @(Tx DijkstraEra) v "transaction"
+        xdescribe "Fix decoder equivalence of Tx" $ do
+          huddleDecoderEquivalenceSpec @(Tx DijkstraEra) v "transaction"