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

module Test.Cardano.Ledger.Babbage.TxInfoSpec (txInfoSpec, spec) where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo.Plutus.Context (
  ContextError,
  EraPlutusTxInfo (..),
  LedgerTxInfo (..),
  PlutusTxInInfo,
  PlutusTxInfo,
 )
import Cardano.Ledger.Alonzo.Plutus.TxInfo (AlonzoContextError (..), TxOutSource (..))
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.TxInfo (
  BabbageContextError (..),
  transTxOutV2,
 )
import Cardano.Ledger.BaseTypes (
  Inject (..),
  Network (..),
  ProtVer (..),
  StrictMaybe (..),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (StakeReference (..))
import Cardano.Ledger.Hashes (unsafeMakeSafeHash)
import Cardano.Ledger.Mary.Value (MaryValue)
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData)
import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..), plutusLanguage)
import Cardano.Ledger.State (UTxO (..))
import Cardano.Ledger.TxIn (TxId (..), 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 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.Binary.Random (mkDummyHash)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkCredential, mkKeyPair)
import Test.Cardano.Ledger.Shelley.Examples (exampleByronAddress)

shelleyAddr :: Addr
shelleyAddr :: Addr
shelleyAddr = Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet PaymentCredential
pk StakeReference
StakeRefNull
  where
    pk :: PaymentCredential
pk = KeyPair 'Payment -> PaymentCredential
forall c (r :: KeyRole). MakeCredential c r => c -> Credential r
mkCredential (Int -> KeyPair 'Payment
forall (r :: KeyRole). Int -> KeyPair r
mkKeyPair Int
0 :: KeyPair 'Payment)

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
exampleByronAddress (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

exampleUTxO ::
  ( BabbageEraTxOut era
  , EraPlutusTxInfo 'PlutusV2 era
  , Value era ~ MaryValue
  ) =>
  UTxO era
exampleUTxO :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
UTxO era
exampleUTxO =
  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 -> Expectation
hasReferenceInput :: forall (l :: Language).
SLanguage l -> PlutusTxInfo l -> Expectation
hasReferenceInput SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> HasCallStack => String -> Expectation
String -> Expectation
expectationFailure String
"PlutusV1 does not have reference inputs"
    SLanguage l
SPlutusV2 -> TxInfo -> [TxInInfo]
PV2.txInfoReferenceInputs PlutusTxInfo l
TxInfo
txInfo [TxInInfo] -> [TxInInfo] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldNotBe` [TxInInfo]
forall a. Monoid a => a
mempty
    SLanguage l
SPlutusV3 -> TxInfo -> [TxInInfo]
PV3.txInfoReferenceInputs PlutusTxInfo l
TxInfo
txInfo [TxInInfo] -> [TxInInfo] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldNotBe` [TxInInfo]
forall a. Monoid a => a
mempty
    SLanguage l
SPlutusV4 -> TxInfo -> [TxInInfo]
PV3.txInfoReferenceInputs PlutusTxInfo l
TxInfo
txInfo [TxInInfo] -> [TxInInfo] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldNotBe` [TxInInfo]
forall a. Monoid a => a
mempty

plutusTxInInfoInputs ::
  forall era l. HasCallStack => SLanguage l -> PlutusTxInfo l -> [PlutusTxInInfo era l]
plutusTxInInfoInputs :: forall era (l :: Language).
HasCallStack =>
SLanguage l -> PlutusTxInfo l -> [PlutusTxInInfo era l]
plutusTxInInfoInputs SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> String -> [PlutusTxInInfo era 'PlutusV1]
forall a. HasCallStack => String -> a
error String
"PlutusV1 not supported"
    SLanguage l
SPlutusV2 -> TxInfo -> [TxInInfo]
PV2.txInfoInputs PlutusTxInfo l
TxInfo
txInfo
    SLanguage l
SPlutusV3 -> TxInfo -> [TxInInfo]
PV3.txInfoInputs PlutusTxInfo l
TxInfo
txInfo
    SLanguage l
SPlutusV4 -> TxInfo -> [TxInInfo]
PV3.txInfoInputs PlutusTxInfo l
TxInfo
txInfo

expectOneInput ::
  forall era l.
  ( HasCallStack
  , Show (PlutusTxInInfo era l)
  , Eq (PlutusTxInInfo era l)
  ) =>
  SLanguage l ->
  PlutusTxInInfo era l ->
  PlutusTxInfo l ->
  Expectation
expectOneInput :: forall era (l :: Language).
(HasCallStack, Show (PlutusTxInInfo era l),
 Eq (PlutusTxInInfo era l)) =>
SLanguage l
-> PlutusTxInInfo era l -> PlutusTxInfo l -> Expectation
expectOneInput SLanguage l
l PlutusTxInInfo era l
i PlutusTxInfo l
txInfo = forall era (l :: Language).
HasCallStack =>
SLanguage l -> PlutusTxInfo l -> [PlutusTxInInfo era l]
plutusTxInInfoInputs @era SLanguage l
l PlutusTxInfo l
txInfo [PlutusTxInInfo era l] -> [PlutusTxInInfo era l] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [PlutusTxInInfo era l
i]

expectOneOutput :: PV2.TxOut -> SLanguage l -> PlutusTxInfo l -> Expectation
expectOneOutput :: forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Expectation
expectOneOutput TxOut
o SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> HasCallStack => String -> Expectation
String -> Expectation
expectationFailure String
"PlutusV1 not supported"
    SLanguage l
SPlutusV2 -> TxInfo -> [TxOut]
PV2.txInfoOutputs PlutusTxInfo l
TxInfo
txInfo [TxOut] -> [TxOut] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [TxOut
o]
    SLanguage l
SPlutusV3 -> TxInfo -> [TxOut]
PV3.txInfoOutputs PlutusTxInfo l
TxInfo
txInfo [TxOut] -> [TxOut] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [TxOut
o]
    SLanguage l
SPlutusV4 -> TxInfo -> [TxOut]
PV3.txInfoOutputs PlutusTxInfo l
TxInfo
txInfo [TxOut] -> [TxOut] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [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 -> Expectation) ->
  Expectation
successfulTranslation :: forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l
-> Tx era
-> (SLanguage l -> PlutusTxInfo l -> Expectation)
-> Expectation
successfulTranslation SLanguage l
slang Tx era
tx SLanguage l -> PlutusTxInfo l -> Expectation
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
exampleUTxO
          , 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 -> SLanguage l -> PlutusTxInfo l -> Expectation
f SLanguage l
slang PlutusTxInfo l
txInfo
        Left ContextError era
e -> String -> Expectation
forall a. HasCallStack => String -> IO a
assertFailure (String -> Expectation) -> String -> Expectation
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 ->
  Expectation
expectTranslationError :: forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l -> Tx era -> ContextError era -> Expectation
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
exampleUTxO
          , 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 -> Expectation
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 -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` ContextError era
expected

expectV1TranslationError ::
  ( BabbageEraTxOut era
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  , Value era ~ MaryValue
  ) =>
  Tx era ->
  ContextError era ->
  Expectation
expectV1TranslationError :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Expectation
expectV1TranslationError = SLanguage 'PlutusV1 -> Tx era -> ContextError era -> Expectation
forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
SLanguage l -> Tx era -> ContextError era -> Expectation
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

translatedOutputEx1 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  PV2.TxOut
translatedOutputEx1 :: forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
TxOut
translatedOutputEx1 =
  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)
  ) =>
  PV2.TxOut
translatedOutputEx2 :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
TxOut
translatedOutputEx2 =
  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

txInfoSpecV1 ::
  forall era.
  ( EraTx era
  , BabbageEraTxBody era
  , Value era ~ MaryValue
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Spec
txInfoSpecV1 :: forall era.
(EraTx era, BabbageEraTxBody era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Spec
txInfoSpecV1 =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Plutus V1" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"translation error on byron txout" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Expectation
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 -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"translation error on byron txin" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Expectation
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 -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"translation error on unknown txin (logic error)" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Expectation
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 -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"translation error on inline datum in input" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Expectation
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 -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"translation error on inline datum in output" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
Tx era -> ContextError era -> Expectation
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))

txInfoSpec ::
  forall era l.
  ( EraTx era
  , EraPlutusTxInfo l era
  , EraPlutusTxInfo 'PlutusV2 era
  , BabbageEraTxBody era
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  , Show (PlutusTxInInfo era l)
  , Eq (PlutusTxInInfo era l)
  ) =>
  SLanguage l ->
  Spec
txInfoSpec :: forall era (l :: Language).
(EraTx era, EraPlutusTxInfo l era, EraPlutusTxInfo 'PlutusV2 era,
 BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era),
 Show (PlutusTxInInfo era l), Eq (PlutusTxInInfo era l)) =>
SLanguage l -> Spec
txInfoSpec SLanguage l
lang =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (SLanguage l -> String
forall a. Show a => a -> String
show SLanguage l
lang) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"translation error on byron txout" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
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 -> Expectation
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 -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"translation error on byron txin" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
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 -> Expectation
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 -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"translation error on unknown txin (logic error)" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
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 -> Expectation
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)
    -- This test will fail in PlutusV3 because of ReferenceInputsNotDisjointFromInputs
    Bool -> Spec -> Spec
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
lang Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== Language
PlutusV2) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"use reference input starting in Babbage" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
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 -> Expectation)
-> Expectation
successfulTranslation @era
          SLanguage l
lang
          (TxIn -> Tx era
forall era. (EraTx era, BabbageEraTxBody era) => TxIn -> Tx era
txRefInput TxIn
shelleyInput)
          SLanguage l -> PlutusTxInfo l -> Expectation
forall (l :: Language).
SLanguage l -> PlutusTxInfo l -> Expectation
hasReferenceInput
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"use inline datum in input" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
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 -> Expectation)
-> Expectation
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)
        ( \SLanguage l
l PlutusTxInfo l
txInfo -> do
            PlutusTxInInfo era l
txInInfo <- Either (ContextError era) (PlutusTxInInfo era l)
-> IO (PlutusTxInInfo era l)
forall a b. (HasCallStack, Show a) => Either a b -> IO b
expectRight (Either (ContextError era) (PlutusTxInInfo era l)
 -> IO (PlutusTxInInfo era l))
-> Either (ContextError era) (PlutusTxInInfo era l)
-> IO (PlutusTxInInfo era l)
forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> UTxO era
-> TxIn
-> Either (ContextError era) (PlutusTxInInfo era l)
toPlutusTxInInfo @_ @era SLanguage l
l UTxO era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
UTxO era
exampleUTxO TxIn
inputWithInlineDatum
            forall era (l :: Language).
(HasCallStack, Show (PlutusTxInInfo era l),
 Eq (PlutusTxInInfo era l)) =>
SLanguage l
-> PlutusTxInInfo era l -> PlutusTxInfo l -> Expectation
expectOneInput @era SLanguage l
l PlutusTxInInfo era l
txInInfo PlutusTxInfo l
txInfo
        )
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"use inline datum in output" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
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 -> Expectation)
-> Expectation
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 -> Expectation
forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Expectation
expectOneOutput (forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
TxOut
translatedOutputEx1 @era))
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"use reference script in input" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
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 -> Expectation)
-> Expectation
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)
        ( \SLanguage l
l PlutusTxInfo l
txInfo -> do
            PlutusTxInInfo era l
txInInfo <- Either (ContextError era) (PlutusTxInInfo era l)
-> IO (PlutusTxInInfo era l)
forall a b. (HasCallStack, Show a) => Either a b -> IO b
expectRight (Either (ContextError era) (PlutusTxInInfo era l)
 -> IO (PlutusTxInInfo era l))
-> Either (ContextError era) (PlutusTxInInfo era l)
-> IO (PlutusTxInInfo era l)
forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> UTxO era
-> TxIn
-> Either (ContextError era) (PlutusTxInInfo era l)
toPlutusTxInInfo @_ @era SLanguage l
l UTxO era
forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
UTxO era
exampleUTxO TxIn
inputWithRefScript
            forall era (l :: Language).
(HasCallStack, Show (PlutusTxInInfo era l),
 Eq (PlutusTxInInfo era l)) =>
SLanguage l
-> PlutusTxInInfo era l -> PlutusTxInfo l -> Expectation
expectOneInput @era SLanguage l
l PlutusTxInInfo era l
txInInfo PlutusTxInfo l
txInfo
        )
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"use reference script in output" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
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 -> Expectation)
-> Expectation
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 -> Expectation
forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Expectation
expectOneOutput (forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era)) =>
TxOut
translatedOutputEx2 @era))

spec ::
  forall era.
  ( EraTx era
  , BabbageEraTxBody era
  , Value era ~ MaryValue
  , Inject (BabbageContextError era) (ContextError era)
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  ) =>
  Spec
spec :: forall era.
(EraTx era, BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era),
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
Spec
spec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"txInfo translation" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era.
(EraTx era, BabbageEraTxBody era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Spec
txInfoSpecV1 @era
    forall era (l :: Language).
(EraTx era, EraPlutusTxInfo l era, EraPlutusTxInfo 'PlutusV2 era,
 BabbageEraTxBody era, Value era ~ MaryValue,
 Inject (BabbageContextError era) (ContextError era),
 Show (PlutusTxInInfo era l), Eq (PlutusTxInInfo era l)) =>
SLanguage l -> Spec
txInfoSpec @era SLanguage 'PlutusV2
SPlutusV2

genesisId :: TxId
genesisId :: TxId
genesisId = SafeHash EraIndependentTxBody -> TxId
TxId (Hash HASH EraIndependentTxBody -> SafeHash EraIndependentTxBody
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (Int -> Hash HASH EraIndependentTxBody
forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash (Int
0 :: Int)))