{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Babbage.TxInfo where

import Cardano.Ledger.Address (Addr (..), BootstrapAddress (..))
import Cardano.Ledger.Alonzo.Plutus.Context (
  ContextError,
  EraPlutusTxInfo (toPlutusTxInfo),
  LedgerTxInfo (..),
  PlutusTxInfo,
 )
import Cardano.Ledger.Alonzo.Plutus.TxInfo (AlonzoContextError (..), TxOutSource (..))
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.TxInfo (BabbageContextError (..), transTxInInfoV2, transTxOutV2)
import Cardano.Ledger.BaseTypes (
  Inject (..),
  Network (..),
  ProtVer (..),
  StrictMaybe (..),
  natVersion,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (StakeReference (..))
import Cardano.Ledger.Mary.Value (MaryValue)
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData)
import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..))
import Cardano.Ledger.State (UTxO (..))
import Cardano.Ledger.TxIn (TxIn (..), mkTxInPartial)
import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
import Cardano.Slotting.Slot (EpochSize (..))
import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import GHC.Stack
import Lens.Micro
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceeds)
import Test.Cardano.Ledger.Shelley.Address.Bootstrap (aliceByronAddr)
import Test.Cardano.Ledger.Shelley.Examples.Cast (alicePHK)
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))

byronAddr :: Addr
byronAddr :: Addr
byronAddr = BootstrapAddress -> Addr
AddrBootstrap (Address -> BootstrapAddress
BootstrapAddress Address
aliceByronAddr)

shelleyAddr :: Addr
shelleyAddr :: Addr
shelleyAddr = Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet PaymentCredential
alicePHK StakeReference
StakeRefNull

ei :: EpochInfo (Either a)
ei :: forall a. EpochInfo (Either a)
ei = EpochSize -> SlotLength -> EpochInfo (Either a)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (Word64 -> EpochSize
EpochSize Word64
100) (POSIXTime -> SlotLength
mkSlotLength POSIXTime
1)

ss :: SystemStart
ss :: SystemStart
ss = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0

-- This input is only a "Byron input" in the sense
-- that we attach it to a Byron output in the UTxO created below.
byronInput :: TxIn
byronInput :: TxIn
byronInput = HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
0

-- This input is only unknown in the sense
-- that it is not present in the UTxO created below.
unknownInput :: TxIn
unknownInput :: TxIn
unknownInput = HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1

byronOutput :: forall era. EraTxOut era => TxOut era
byronOutput :: forall era. EraTxOut era => TxOut era
byronOutput = Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
byronAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)

shelleyOutput :: forall era. EraTxOut era => TxOut era
shelleyOutput :: forall era. EraTxOut era => TxOut era
shelleyOutput = Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Addr
shelleyAddr) (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2)

datumEx :: forall era. Era era => Datum era
datumEx :: forall era. Era era => Datum era
datumEx = BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Integer -> BinaryData era) -> Integer -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> BinaryData era)
-> (Integer -> Data era) -> Integer -> BinaryData era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> Data era
forall era. Era era => Data -> Data era
Data (Data -> Data era) -> (Integer -> Data) -> Integer -> Data era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Data
PV1.I (Integer -> Datum era) -> Integer -> Datum era
forall a b. (a -> b) -> a -> b
$ Integer
123

inlineDatumOutput ::
  forall era.
  ( BabbageEraTxOut era
  , Value era ~ MaryValue
  ) =>
  TxOut era
inlineDatumOutput :: forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
inlineDatumOutput =
  Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Addr
shelleyAddr) (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3)
    TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Datum era -> Identity (Datum era))
-> TxOut era -> Identity (TxOut era)
forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
Lens' (TxOut era) (Datum era)
datumTxOutL ((Datum era -> Identity (Datum era))
 -> TxOut era -> Identity (TxOut era))
-> Datum era -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Datum era
forall era. Era era => Datum era
datumEx

refScriptOutput :: (BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era) => TxOut era
refScriptOutput :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era) =>
TxOut era
refScriptOutput =
  Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Addr
shelleyAddr) (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3)
    TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (Script era -> StrictMaybe (Script era))
-> Script era -> StrictMaybe (Script era)
forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
3)

-- This input is only a "Shelley input" in the sense
-- that we attach it to a Shelley output in the UTxO created below.
shelleyInput :: TxIn
shelleyInput :: TxIn
shelleyInput = HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
2

inputWithInlineDatum :: TxIn
inputWithInlineDatum :: TxIn
inputWithInlineDatum = HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
3

inputWithRefScript :: TxIn
inputWithRefScript :: TxIn
inputWithRefScript = HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
4

utxo ::
  ( BabbageEraTxOut era
  , EraPlutusTxInfo 'PlutusV2 era
  , Value era ~ MaryValue
  ) =>
  UTxO era
utxo :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
UTxO era
utxo =
  Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$
    [(TxIn, TxOut era)] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (TxIn
byronInput, TxOut era
forall era. EraTxOut era => TxOut era
byronOutput)
      , (TxIn
shelleyInput, TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
      , (TxIn
inputWithInlineDatum, TxOut era
forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
inlineDatumOutput)
      , (TxIn
inputWithRefScript, TxOut era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era) =>
TxOut era
refScriptOutput)
      ]

txb ::
  forall era.
  BabbageEraTxBody era =>
  TxIn ->
  Maybe TxIn ->
  TxOut era ->
  TxBody era
txb :: forall era.
BabbageEraTxBody era =>
TxIn -> Maybe TxIn -> TxOut era -> TxBody era
txb TxIn
i Maybe TxIn
mRefInp TxOut era
o =
  TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
    TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
i
    TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn -> (TxIn -> Set TxIn) -> Maybe TxIn -> Set TxIn
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set TxIn
forall a. Monoid a => a
mempty TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton Maybe TxIn
mRefInp
    TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut era -> StrictSeq (TxOut era)
forall a. a -> StrictSeq a
StrictSeq.singleton TxOut era
o
    TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
2

txBare ::
  forall era.
  (EraTx era, BabbageEraTxBody era) =>
  TxIn ->
  TxOut era ->
  Tx era
txBare :: forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
i TxOut era
o = TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TxIn -> Maybe TxIn -> TxOut era -> TxBody era
forall era.
BabbageEraTxBody era =>
TxIn -> Maybe TxIn -> TxOut era -> TxBody era
txb TxIn
i Maybe TxIn
forall a. Maybe a
Nothing TxOut era
o)

txRefInput :: forall era. (EraTx era, BabbageEraTxBody era) => TxIn -> Tx era
txRefInput :: forall era. (EraTx era, BabbageEraTxBody era) => TxIn -> Tx era
txRefInput TxIn
refInput = TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TxIn -> Maybe TxIn -> TxOut era -> TxBody era
forall era.
BabbageEraTxBody era =>
TxIn -> Maybe TxIn -> TxOut era -> TxBody era
txb TxIn
shelleyInput (TxIn -> Maybe TxIn
forall a. a -> Maybe a
Just TxIn
refInput) TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)

hasReferenceInput :: SLanguage l -> PlutusTxInfo l -> Bool
hasReferenceInput :: forall (l :: Language). SLanguage l -> PlutusTxInfo l -> Bool
hasReferenceInput SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> Bool
False
    SLanguage l
SPlutusV2 -> TxInfo -> [TxInInfo]
PV2.txInfoReferenceInputs PlutusTxInfo l
TxInfo
txInfo [TxInInfo] -> [TxInInfo] -> Bool
forall a. Eq a => a -> a -> Bool
/= [TxInInfo]
forall a. Monoid a => a
mempty
    SLanguage l
SPlutusV3 -> TxInfo -> [TxInInfo]
PV3.txInfoReferenceInputs PlutusTxInfo l
TxInfo
txInfo [TxInInfo] -> [TxInInfo] -> Bool
forall a. Eq a => a -> a -> Bool
/= [TxInInfo]
forall a. Monoid a => a
mempty

expectOneInput :: PV2.TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneInput :: forall (l :: Language).
TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneInput TxInInfo
i SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> Bool
False
    SLanguage l
SPlutusV2 -> TxInfo -> [TxInInfo]
PV2.txInfoInputs PlutusTxInfo l
TxInfo
txInfo [TxInInfo] -> [TxInInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [TxInInfo
i]
    SLanguage l
SPlutusV3 -> Bool
False

expectOneOutput :: PV2.TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneOutput :: forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneOutput TxOut
o SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> Bool
False
    SLanguage l
SPlutusV2 -> TxInfo -> [TxOut]
PV2.txInfoOutputs PlutusTxInfo l
TxInfo
txInfo [TxOut] -> [TxOut] -> Bool
forall a. Eq a => a -> a -> Bool
== [TxOut
o]
    SLanguage l
SPlutusV3 -> TxInfo -> [TxOut]
PV3.txInfoOutputs PlutusTxInfo l
TxInfo
txInfo [TxOut] -> [TxOut] -> Bool
forall a. Eq a => a -> a -> Bool
== [TxOut
o]

successfulTranslation ::
  forall era l.
  ( BabbageEraTxOut era
  , EraPlutusTxInfo l era
  , EraPlutusTxInfo 'PlutusV2 era
  , Value era ~ MaryValue
  ) =>
  SLanguage l ->
  Tx era ->
  (SLanguage l -> PlutusTxInfo l -> Bool) ->
  Assertion
successfulTranslation :: forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation SLanguage l
slang Tx era
tx SLanguage l -> PlutusTxInfo l -> Bool
f =
  let lti :: LedgerTxInfo era
lti =
        LedgerTxInfo
          { ltiProtVer :: ProtVer
ltiProtVer = Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Natural
0
          , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
forall a. EpochInfo (Either a)
ei
          , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
ss
          , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
UTxO era
utxo
          , ltiTx :: Tx era
ltiTx = Tx era
tx
          }
   in case SLanguage l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
lti of
        Right PlutusTxInfo l
txInfo -> HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"unexpected transaction info" (SLanguage l -> PlutusTxInfo l -> Bool
f SLanguage l
slang PlutusTxInfo l
txInfo)
        Left ContextError era
e -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"no translation error was expected, but got: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ContextError era -> String
forall a. Show a => a -> String
show ContextError era
e

expectTranslationError ::
  forall era l.
  ( BabbageEraTxOut era
  , EraPlutusTxInfo l era
  , EraPlutusTxInfo 'PlutusV2 era
  , Value era ~ MaryValue
  ) =>
  SLanguage l ->
  Tx era ->
  ContextError era ->
  Assertion
expectTranslationError :: forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError SLanguage l
slang Tx era
tx ContextError era
expected =
  let lti :: LedgerTxInfo era
lti =
        LedgerTxInfo
          { ltiProtVer :: ProtVer
ltiProtVer = Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Natural
0
          , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
forall a. EpochInfo (Either a)
ei
          , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
ss
          , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
UTxO era
utxo
          , ltiTx :: Tx era
ltiTx = Tx era
tx
          }
   in case SLanguage l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
lti of
        Right PlutusTxInfo l
_ -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure String
"This translation was expected to fail, but it succeeded."
        Left ContextError era
e -> ContextError era
e ContextError era -> ContextError era -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ContextError era
expected

expectV1TranslationError ::
  ( BabbageEraTxOut era
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  , Value era ~ MaryValue
  ) =>
  Tx era ->
  ContextError era ->
  Assertion
expectV1TranslationError :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError = SLanguage 'PlutusV1 -> Tx era -> ContextError era -> Assertion
forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError SLanguage 'PlutusV1
SPlutusV1

errorTranslate ::
  forall era b.
  (HasCallStack, Show (ContextError era)) =>
  String ->
  Either (ContextError era) b ->
  b
errorTranslate :: forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate String
exampleName =
  (ContextError era -> b)
-> (b -> b) -> Either (ContextError era) b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ContextError era
err -> String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
exampleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ContextError era -> String
forall a. Show a => a -> String
show ContextError era
err) b -> b
forall a. a -> a
id

translatedInputEx1 ::
  forall era.
  ( BabbageEraTxOut era
  , Value era ~ MaryValue
  , EraPlutusTxInfo 'PlutusV2 era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxInInfo
translatedInputEx1 :: forall era.
(BabbageEraTxOut era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV2 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxInInfo
translatedInputEx1 Proxy era
_ =
  forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate @era String
"translatedInputEx1" (Either (ContextError era) TxInInfo -> TxInInfo)
-> Either (ContextError era) TxInInfo -> TxInInfo
forall a b. (a -> b) -> a -> b
$ forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV2 @era UTxO era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
UTxO era
utxo TxIn
inputWithInlineDatum

translatedInputEx2 ::
  forall era.
  ( BabbageEraTxOut era
  , Value era ~ MaryValue
  , EraPlutusTxInfo 'PlutusV2 era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxInInfo
translatedInputEx2 :: forall era.
(BabbageEraTxOut era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV2 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxInInfo
translatedInputEx2 Proxy era
_ =
  forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate @era String
"translatedInputEx2" (Either (ContextError era) TxInInfo -> TxInInfo)
-> Either (ContextError era) TxInInfo -> TxInInfo
forall a b. (a -> b) -> a -> b
$ forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV2 @era UTxO era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
UTxO era
utxo TxIn
inputWithRefScript

translatedOutputEx1 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxOut
translatedOutputEx1 :: forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxOut
translatedOutputEx1 Proxy era
_ =
  forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate @era String
"translatedOutputEx1" (Either (ContextError era) TxOut -> TxOut)
-> Either (ContextError era) TxOut -> TxOut
forall a b. (a -> b) -> a -> b
$
    forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 @era (TxIx -> TxOutSource
TxOutFromOutput TxIx
forall a. Bounded a => a
minBound) TxOut era
forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
inlineDatumOutput

translatedOutputEx2 ::
  forall era.
  ( BabbageEraTxOut era
  , EraPlutusTxInfo 'PlutusV2 era
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxOut
translatedOutputEx2 :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxOut
translatedOutputEx2 Proxy era
_ =
  forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate @era String
"translatedOutputEx2" (Either (ContextError era) TxOut -> TxOut)
-> Either (ContextError era) TxOut -> TxOut
forall a b. (a -> b) -> a -> b
$
    forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 @era (TxIx -> TxOutSource
TxOutFromOutput TxIx
forall a. Bounded a => a
minBound) TxOut era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era) =>
TxOut era
refScriptOutput

txInfoTestsV1 ::
  forall era.
  ( EraTx era
  , BabbageEraTxBody era
  , Value era ~ MaryValue
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  TestTree
txInfoTestsV1 :: forall era.
(EraTx era, BabbageEraTxBody era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TestTree
txInfoTestsV1 Proxy era
_ =
  String -> [TestTree] -> TestTree
testGroup
    String
"Plutus V1"
    ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [ String -> Assertion -> TestTree
testCase String
"translation error on byron txout" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
shelleyInput TxOut era
forall era. EraTxOut era => TxOut era
byronOutput)
            (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext @era (TxIx -> TxOutSource
TxOutFromOutput TxIx
forall a. Bounded a => a
minBound))
      , String -> Assertion -> TestTree
testCase String
"translation error on byron txin" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
byronInput TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
            (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext @era (TxIn -> TxOutSource
TxOutFromInput TxIn
byronInput))
      , String -> Assertion -> TestTree
testCase String
"translation error on unknown txin (logic error)" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
unknownInput TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
            (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ AlonzoContextError era -> BabbageContextError era
forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError (AlonzoContextError era -> BabbageContextError era)
-> AlonzoContextError era -> BabbageContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxIn -> AlonzoContextError era
forall {k} (era :: k). TxIn -> AlonzoContextError era
TranslationLogicMissingInput @era TxIn
unknownInput)
      , String -> Assertion -> TestTree
testCase String
"translation error on inline datum in input" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
inputWithInlineDatum TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
            (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
InlineDatumsNotSupported @era (TxIn -> TxOutSource
TxOutFromInput TxIn
inputWithInlineDatum))
      , String -> Assertion -> TestTree
testCase String
"translation error on inline datum in output" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
shelleyInput TxOut era
forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
inlineDatumOutput)
            (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
InlineDatumsNotSupported @era (TxIx -> TxOutSource
TxOutFromOutput TxIx
forall a. Bounded a => a
minBound))
      ]
      [TestTree] -> [TestTree] -> [TestTree]
forall a. [a] -> [a] -> [a]
++ if forall era. Era era => Version
eraProtVerLow @era Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9
        then
          [ String -> Assertion -> TestTree
testCase String
"translation error on reference script in input" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
              forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
                (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
inputWithRefScript TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
                (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ReferenceScriptsNotSupported @era (TxIn -> TxOutSource
TxOutFromInput TxIn
inputWithRefScript))
          , String -> Assertion -> TestTree
testCase String
"translation error on reference script in output" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
              forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
                (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
shelleyInput TxOut era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era) =>
TxOut era
refScriptOutput)
                (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ReferenceScriptsNotSupported @era (TxIx -> TxOutSource
TxOutFromOutput TxIx
forall a. Bounded a => a
minBound))
          , String -> Assertion -> TestTree
testCase String
"translation error on reference input" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
              forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
                (TxIn -> Tx era
forall era. (EraTx era, BabbageEraTxBody era) => TxIn -> Tx era
txRefInput TxIn
shelleyInput)
                (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. Set TxIn -> BabbageContextError era
ReferenceInputsNotSupported @era (TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
shelleyInput))
          ]
        else []

txInfoTestsV2 ::
  forall era l.
  ( EraTx era
  , EraPlutusTxInfo l era
  , EraPlutusTxInfo 'PlutusV2 era
  , BabbageEraTxBody era
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  SLanguage l ->
  TestTree
txInfoTestsV2 :: forall era (l :: Language).
(EraTx era, EraPlutusTxInfo l era, EraPlutusTxInfo 'PlutusV2 era,
 BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> SLanguage l -> TestTree
txInfoTestsV2 Proxy era
p SLanguage l
lang =
  String -> [TestTree] -> TestTree
testGroup
    (SLanguage l -> String
forall a. Show a => a -> String
show SLanguage l
lang)
    [ String -> Assertion -> TestTree
testCase String
"translation error on byron txout" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError @era
          SLanguage l
lang
          (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
shelleyInput TxOut era
forall era. EraTxOut era => TxOut era
byronOutput)
          (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext @era (TxIx -> TxOutSource
TxOutFromOutput TxIx
forall a. Bounded a => a
minBound))
    , String -> Assertion -> TestTree
testCase String
"translation error on byron txin" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError @era
          SLanguage l
lang
          (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
byronInput TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
          (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext @era (TxIn -> TxOutSource
TxOutFromInput TxIn
byronInput))
    , String -> Assertion -> TestTree
testCase String
"translation error on unknown txin (logic error)" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError @era
          SLanguage l
lang
          (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
unknownInput TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
          (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ AlonzoContextError era -> BabbageContextError era
forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError (AlonzoContextError era -> BabbageContextError era)
-> AlonzoContextError era -> BabbageContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxIn -> AlonzoContextError era
forall {k} (era :: k). TxIn -> AlonzoContextError era
TranslationLogicMissingInput @era TxIn
unknownInput)
    , String -> Assertion -> TestTree
testCase String
"use reference input starting in Babbage" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (TxIn -> Tx era
forall era. (EraTx era, BabbageEraTxBody era) => TxIn -> Tx era
txRefInput TxIn
shelleyInput)
          SLanguage l -> PlutusTxInfo l -> Bool
forall (l :: Language). SLanguage l -> PlutusTxInfo l -> Bool
hasReferenceInput
    , String -> Assertion -> TestTree
testCase String
"use inline datum in input" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
inputWithInlineDatum TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
          (TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
forall (l :: Language).
TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneInput (Proxy era -> TxInInfo
forall era.
(BabbageEraTxOut era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV2 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxInInfo
translatedInputEx1 Proxy era
p))
    , String -> Assertion -> TestTree
testCase String
"use inline datum in output" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
shelleyInput TxOut era
forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
inlineDatumOutput)
          (TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneOutput (Proxy era -> TxOut
forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxOut
translatedOutputEx1 Proxy era
p))
    , String -> Assertion -> TestTree
testCase String
"use reference script in input" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
inputWithRefScript TxOut era
forall era. EraTxOut era => TxOut era
shelleyOutput)
          (TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
forall (l :: Language).
TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneInput (Proxy era -> TxInInfo
forall era.
(BabbageEraTxOut era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV2 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxInInfo
translatedInputEx2 Proxy era
p))
    , String -> Assertion -> TestTree
testCase String
"use reference script in output" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (TxIn -> TxOut era -> Tx era
forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn -> TxOut era -> Tx era
txBare TxIn
shelleyInput TxOut era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era) =>
TxOut era
refScriptOutput)
          (TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneOutput (Proxy era -> TxOut
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxOut
translatedOutputEx2 Proxy era
p))
    ]

txInfoTests ::
  forall era.
  ( EraTx era
  , BabbageEraTxBody era
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  ) =>
  Proxy era ->
  TestTree
txInfoTests :: forall era.
(EraTx era, BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era),
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
Proxy era -> TestTree
txInfoTests Proxy era
p = String -> [TestTree] -> TestTree
testGroup String
"txInfo translation" [Proxy era -> TestTree
forall era.
(EraTx era, BabbageEraTxBody era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TestTree
txInfoTestsV1 Proxy era
p, Proxy era -> SLanguage 'PlutusV2 -> TestTree
forall era (l :: Language).
(EraTx era, EraPlutusTxInfo l era, EraPlutusTxInfo 'PlutusV2 era,
 BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> SLanguage l -> TestTree
txInfoTestsV2 Proxy era
p SLanguage 'PlutusV2
SPlutusV2]