{-# 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 = 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 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
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
mkTxInPartial TxId
genesisId Integer
1

byronOutput :: forall era. EraTxOut era => TxOut era
byronOutput :: forall era. EraTxOut era => TxOut era
byronOutput = forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
byronAddr (forall t s. Inject t s => t -> s
inject 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 = forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Addr
shelleyAddr) (forall t s. Inject t s => t -> s
inject 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 = forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Data era -> BinaryData era
dataToBinaryData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data -> Data era
Data forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Data
PV1.I 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 =
  forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Addr
shelleyAddr) (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3)
    forall a b. a -> (a -> b) -> b
& forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
datumTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era. Era era => Datum era
datumEx

refScriptOutput :: BabbageEraTxOut era => TxOut era
refScriptOutput :: forall era. BabbageEraTxOut era => TxOut era
refScriptOutput =
  forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Addr
shelleyAddr) (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3)
    forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript 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
mkTxInPartial TxId
genesisId Integer
2

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

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

utxo ::
  ( BabbageEraTxOut era
  , Value era ~ MaryValue
  ) =>
  UTxO era
utxo :: forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
UTxO era
utxo =
  forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (TxIn
byronInput, forall era. EraTxOut era => TxOut era
byronOutput)
      , (TxIn
shelleyInput, forall era. EraTxOut era => TxOut era
shelleyOutput)
      , (TxIn
inputWithInlineDatum, forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
inlineDatumOutput)
      , (TxIn
inputWithRefScript, forall era. BabbageEraTxOut 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 =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Set a
Set.singleton TxIn
i
    forall a b. a -> (a -> b) -> b
& forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Set a
Set.singleton Maybe TxIn
mRefInp
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
StrictSeq.singleton TxOut era
o
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL 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 = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era.
BabbageEraTxBody era =>
TxIn -> Maybe TxIn -> TxOut era -> TxBody era
txb TxIn
i 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 = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era.
BabbageEraTxBody era =>
TxIn -> Maybe TxIn -> TxOut era -> TxBody era
txb TxIn
shelleyInput (forall a. a -> Maybe a
Just TxIn
refInput) 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 forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty
    SLanguage l
SPlutusV3 -> TxInfo -> [TxInInfo]
PV3.txInfoReferenceInputs PlutusTxInfo l
txInfo forall a. Eq a => a -> a -> Bool
/= 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 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 forall a. Eq a => a -> a -> Bool
== [TxOut
o]
    SLanguage l
SPlutusV3 -> TxInfo -> [TxOut]
PV3.txInfoOutputs PlutusTxInfo l
txInfo forall a. Eq a => a -> a -> Bool
== [TxOut
o]

successfulTranslation ::
  forall era l.
  ( BabbageEraTxOut era
  , EraPlutusTxInfo l era
  , Value era ~ MaryValue
  ) =>
  SLanguage l ->
  Tx era ->
  (SLanguage l -> PlutusTxInfo l -> Bool) ->
  Assertion
successfulTranslation :: forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l 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 = forall a. EpochInfo (Either a)
ei
          , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
ss
          , ltiUTxO :: UTxO era
ltiUTxO = forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
UTxO era
utxo
          , ltiTx :: Tx era
ltiTx = Tx era
tx
          }
   in case forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
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
assertBool String
"unexpected transaction info" (SLanguage l -> PlutusTxInfo l -> Bool
f SLanguage l
slang PlutusTxInfo l
txInfo)
        Left ContextError era
e -> forall a. HasCallStack => String -> IO a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"no translation error was expected, but got: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ContextError era
e

expectTranslationError ::
  forall era l.
  ( BabbageEraTxOut era
  , EraPlutusTxInfo l era
  , Value era ~ MaryValue
  ) =>
  SLanguage l ->
  Tx era ->
  ContextError era ->
  Assertion
expectTranslationError :: forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l 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 = forall a. EpochInfo (Either a)
ei
          , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
ss
          , ltiUTxO :: UTxO era
ltiUTxO = forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
UTxO era
utxo
          , ltiTx :: Tx era
ltiTx = Tx era
tx
          }
   in case forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
lti of
        Right PlutusTxInfo l
_ -> forall a. HasCallStack => String -> IO a
assertFailure String
"This translation was expected to fail, but it succeeded."
        Left ContextError era
e -> ContextError era
e forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ContextError era
expected

expectV1TranslationError ::
  ( BabbageEraTxOut era
  , EraPlutusTxInfo 'PlutusV1 era
  , Value era ~ MaryValue
  ) =>
  Tx era ->
  ContextError era ->
  Assertion
expectV1TranslationError :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError = forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l 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 =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ContextError era
err -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
exampleName forall a. [a] -> [a] -> [a]
++ String
" failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ContextError era
err) forall a. a -> a
id

translatedInputEx1 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxInInfo
translatedInputEx1 :: forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue,
 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" 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 forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
UTxO era
utxo TxIn
inputWithInlineDatum

translatedInputEx2 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxInInfo
translatedInputEx2 :: forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue,
 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" 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 forall era.
(BabbageEraTxOut 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" 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 forall a. Bounded a => a
minBound) forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
inlineDatumOutput

translatedOutputEx2 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxOut
translatedOutputEx2 :: forall era.
(BabbageEraTxOut era, Show (ContextError 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" 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 forall a. Bounded a => a
minBound) forall era. BabbageEraTxOut era => TxOut era
refScriptOutput

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

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