WIP

Author: Soupstraw

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

@@ -118,6 +118,7 @@ library testlib
     Test.Cardano.Ledger.Alonzo.Era
     Test.Cardano.Ledger.Alonzo.Examples
     Test.Cardano.Ledger.Alonzo.Imp
+    Test.Cardano.Ledger.Alonzo.Imp.TxInfoSpec
     Test.Cardano.Ledger.Alonzo.Imp.UtxoSpec
     Test.Cardano.Ledger.Alonzo.Imp.UtxosSpec
     Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec

eras/alonzo/impl/test/Main.hs

@@ -16,6 +16,7 @@ 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)
+import qualified Test.Cardano.Ledger.Alonzo.Imp.TxInfoSpec as TxInfoImp
 
 main :: IO ()
 main =
@@ -35,3 +36,4 @@ main =
         CostModelsSpec.spec @AlonzoEra
       describe "TxWits" $ do
         TxWitsSpec.spec @AlonzoEra
+      TxInfoImp.spec

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

@@ -99,7 +99,6 @@ silentlyIgnore tx =
 
 spec :: Spec
 spec = describe "txInfo translation" $ do
-  -- TODO: convert to Imp: https://github.com/IntersectMBO/cardano-ledger/issues/5210
   describe "Plutus V1" $ do
     it "silently ignore byron txout" $
       silentlyIgnore (txEx shelleyInput byronOutput)

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

@@ -16,10 +16,9 @@ import Cardano.Ledger.Alonzo.Rules (
   AlonzoUtxowPredFailure,
  )
 import Cardano.Ledger.Shelley.Rules (
-  ShelleyDelegPredFailure,
   ShelleyPoolPredFailure,
   ShelleyUtxoPredFailure,
-  ShelleyUtxowPredFailure,
+  ShelleyUtxowPredFailure, ShelleyDelegPredFailure,
  )
 import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxoSpec as Utxo
 import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxosSpec as Utxos
@@ -60,7 +59,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/TxInfoSpec.hs

@@ -0,0 +1,73 @@
+{-# 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.Alonzo.TxBody (AlonzoTxOut (..))
+import Cardano.Ledger.BaseTypes (EpochSize (..), Inject (..), StrictMaybe (..))
+import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Plutus (SLanguage (..))
+import Cardano.Ledger.State (UTxO (..))
+import Cardano.Slotting.EpochInfo (fixedEpochInfo)
+import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
+import Data.Either (isRight)
+import qualified Data.Map.Strict as Map
+import qualified Data.Sequence.Strict as SSeq
+import qualified Data.Set as Set
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Lens.Micro ((&), (.~))
+import Test.Cardano.Ledger.Alonzo.ImpTest
+import Test.Cardano.Ledger.Imp.Common
+
+spec :: Spec
+spec = withImpInit @(LedgerSpec AlonzoEra) $ describe "TxInfoSpec" $ do
+  describe "PlutusV1" $ do
+    it "toPlutusTxInfo does not fail when Byron scripts are present in TxOuts" $ do
+      pv <- getProtVer
+      (_, shelleyAddr) <- freshKeyAddr
+      byronAddr <- AddrBootstrap <$> freshBootstapAddress
+      shelleyTxIn <- arbitrary
+      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 = fixedEpochInfo (EpochSize 100) (mkSlotLength 1)
+            , ltiSystemStart = SystemStart $ posixSecondsToUTCTime 0
+            , ltiUTxO = UTxO . Map.singleton shelleyTxIn $ AlonzoTxOut shelleyAddr (inject $ Coin 2) SNothing
+            , ltiTx = tx
+            }
+      toPlutusTxInfo SPlutusV1 lti `shouldSatisfy` isRight
+    it "toPlutusTxInfo does not fail when Byron scripts are present in TxIns" $ do
+      pv <- getProtVer
+      (_, shelleyAddr) <- freshKeyAddr
+      byronAddr <- AddrBootstrap <$> freshBootstapAddress
+      byronTxIn <- arbitrary
+      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 = fixedEpochInfo (EpochSize 100) (mkSlotLength 1)
+            , ltiSystemStart = SystemStart $ posixSecondsToUTCTime 0
+            , ltiUTxO =
+                UTxO . Map.singleton byronTxIn $
+                  AlonzoTxOut byronAddr (inject $ Coin 2) SNothing
+            , ltiTx = tx
+            }
+      toPlutusTxInfo SPlutusV1 lti `shouldSatisfy` isRight