{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Dijkstra.TxInfoSpec (spec) where

import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusContext (..),
  EraPlutusTxInfo (..),
  LedgerTxInfo (..),
  PlutusTxInfoResult (..),
  SupportedLanguage (..),
 )
import Cardano.Ledger.Alonzo.Scripts (AsPurpose (..))
import Cardano.Ledger.BaseTypes (Globals (..), Inject (..), Network (..), ProtVer (..))
import Cardano.Ledger.Credential (StakeReference (..))
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Scripts (AccountBalanceIntervals (..))
import Cardano.Ledger.Dijkstra.State (UTxO (..))
import Cardano.Ledger.Dijkstra.TxInfo (DijkstraContextError (..))
import Cardano.Ledger.Plutus (Language (..), SLanguage (..), plutusLanguage)
import qualified Data.Map.NonEmpty as NEM
import qualified Data.Map.Strict as Map
import qualified Data.OMap.Strict as OMap
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Utils (testGlobals)
import Test.Cardano.Ledger.Dijkstra.Arbitrary ()

spec ::
  forall era.
  ( EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  , EraPlutusTxInfo PlutusV3 era
  , EraPlutusTxInfo PlutusV4 era
  , Inject (DijkstraContextError era) (ContextError era)
  , DijkstraEraTxBody era
  , EraTx era
  , Arbitrary (Value era)
  ) =>
  Spec
spec :: forall era.
(EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 EraPlutusTxInfo 'PlutusV3 era, EraPlutusTxInfo 'PlutusV4 era,
 Inject (DijkstraContextError era) (ContextError era),
 DijkstraEraTxBody era, EraTx era, Arbitrary (Value era)) =>
Spec
spec = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxInfo" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"PlutusV4" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Gen Expectation -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Fails translation when Ptr present in outputs" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
      paymentCred <- Gen (Credential Payment)
forall a. Arbitrary a => Gen a
arbitrary
      ptr <- arbitrary
      val <- arbitrary
      let
        txOut = Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Network -> Credential Payment -> StakeReference -> Addr
Addr Network
Testnet Credential Payment
paymentCred (Ptr -> StakeReference
StakeRefPtr Ptr
ptr)) Value era
val
      txIn <- arbitrary
      paymentCred2 <- arbitrary
      stakeRef <- arbitrary
      let
        utxo =
          Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO
            [ (TxIn
txIn, Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Network -> Credential Payment -> StakeReference -> Addr
Addr Network
Testnet Credential Payment
paymentCred2 StakeReference
stakeRef) Value era
val)
            ]
        tx =
          forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @TopTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
            TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictSeq (TxOut era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (StrictSeq (TxOut era))
TxOut era
txOut]
              TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Set TxIn -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
txIn]
        ledgerTxInfo =
          LedgerTxInfo
            { ltiProtVer :: ProtVer
ltiProtVer = Version -> Nat -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Nat
0
            , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = Globals -> EpochInfo (Either Text)
epochInfo Globals
testGlobals
            , ltiSystemStart :: SystemStart
ltiSystemStart = Globals -> SystemStart
systemStart Globals
testGlobals
            , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
utxo
            , ltiTx :: Tx TopTx era
ltiTx = Tx TopTx era
tx
            , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
            }
      pure $
        (($ SpendingPurpose AsPurpose) <$> unPlutusTxInfoResult (toPlutusTxInfo SPlutusV4 ledgerTxInfo))
          `shouldBeLeft` inject (PointerPresentInOutput @era [txOut])
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"PlutusV1-V3" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    let plutusV1toV3 :: [SupportedLanguage era]
        plutusV1toV3 :: [SupportedLanguage era]
plutusV1toV3 =
          [ SLanguage 'PlutusV1 -> SupportedLanguage era
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV1
SPlutusV1
          , SLanguage 'PlutusV2 -> SupportedLanguage era
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV2
SPlutusV2
          , SLanguage 'PlutusV3 -> SupportedLanguage era
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV3
SPlutusV3
          ]
    [SupportedLanguage era] -> (SupportedLanguage era -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SupportedLanguage era]
plutusV1toV3 ((SupportedLanguage era -> Spec) -> Spec)
-> (SupportedLanguage era -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(SupportedLanguage SLanguage l
slang) -> do
      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"UnsupportedScriptInSubTx" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
        let
          tx :: Tx SubTx era
tx = forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @SubTx TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
          ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
            LedgerTxInfo
              { ltiProtVer :: ProtVer
ltiProtVer = Version -> Nat -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Nat
0
              , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = Globals -> EpochInfo (Either Text)
epochInfo Globals
testGlobals
              , ltiSystemStart :: SystemStart
ltiSystemStart = Globals -> SystemStart
systemStart Globals
testGlobals
              , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
forall a. Monoid a => a
mempty
              , ltiTx :: Tx SubTx era
ltiTx = Tx SubTx era
tx
              , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
              }
          txInfoResult :: Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
txInfoResult =
            ((PlutusPurpose AsPurpose era
 -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ AsPurpose Word32 TxIn -> PlutusPurpose AsPurpose era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose AsPurpose Word32 TxIn
forall ix it. AsPurpose ix it
AsPurpose)
              ((PlutusPurpose AsPurpose era
  -> Either (ContextError era) (PlutusTxInfo l))
 -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
forall (l :: Language) era.
PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
unPlutusTxInfoResult (SLanguage l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (proxy :: Language -> *).
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
ledgerTxInfo)
        Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
txInfoResult
          Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
-> ContextError era -> Expectation
forall a b.
(HasCallStack, Show a, Eq a, Show b) =>
Either a b -> a -> Expectation
`shouldBeLeft` DijkstraContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (forall era. Language -> TxId -> DijkstraContextError era
UnsupportedScriptInSubTx @era (SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
slang) (Tx SubTx era -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
txIdTx Tx SubTx era
tx))
      String -> Gen Expectation -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"DirectDepositsNotSupported" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
        accountAddr <- Gen AccountAddress
forall a. Arbitrary a => Gen a
arbitrary
        coin <- arbitrary
        let
          dd = Map AccountAddress Coin -> DirectDeposits
DirectDeposits (AccountAddress -> Coin -> Map AccountAddress Coin
forall k a. k -> a -> Map k a
Map.singleton AccountAddress
accountAddr Coin
coin)
          tx =
            forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @TopTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
              TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (DirectDeposits -> Identity DirectDeposits)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> DirectDeposits -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DirectDeposits
dd
          ledgerTxInfo =
            LedgerTxInfo
              { ltiProtVer :: ProtVer
ltiProtVer = Version -> Nat -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Nat
0
              , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = Globals -> EpochInfo (Either Text)
epochInfo Globals
testGlobals
              , ltiSystemStart :: SystemStart
ltiSystemStart = Globals -> SystemStart
systemStart Globals
testGlobals
              , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
forall a. Monoid a => a
mempty
              , ltiTx :: Tx TopTx era
ltiTx = Tx TopTx era
tx
              , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
              }
          txInfoResult =
            ((PlutusPurpose AsPurpose era
 -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ AsPurpose Word32 TxIn -> PlutusPurpose AsPurpose era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose AsPurpose Word32 TxIn
forall ix it. AsPurpose ix it
AsPurpose)
              ((PlutusPurpose AsPurpose era
  -> Either (ContextError era) (PlutusTxInfo l))
 -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
forall (l :: Language) era.
PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
unPlutusTxInfoResult (SLanguage l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (proxy :: Language -> *).
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
ledgerTxInfo)
        pure $
          txInfoResult `shouldBeLeft` inject (DirectDepositsNotSupported @era dd)
      String
-> (NonEmptyMap AccountId (AccountBalanceInterval era)
    -> Expectation)
-> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"AccountBalanceIntervalsNotSupported" ((NonEmptyMap AccountId (AccountBalanceInterval era)
  -> Expectation)
 -> Spec)
-> (NonEmptyMap AccountId (AccountBalanceInterval era)
    -> Expectation)
-> Spec
forall a b. (a -> b) -> a -> b
$ \NonEmptyMap AccountId (AccountBalanceInterval era)
neAccountBalanceIntervals ->
        let
          abi :: AccountBalanceIntervals era
abi = Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall era.
Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
AccountBalanceIntervals (Map AccountId (AccountBalanceInterval era)
 -> AccountBalanceIntervals era)
-> Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall a b. (a -> b) -> a -> b
$ NonEmptyMap AccountId (AccountBalanceInterval era)
-> Map AccountId (AccountBalanceInterval era)
forall k v. NonEmptyMap k v -> Map k v
NEM.toMap NonEmptyMap AccountId (AccountBalanceInterval era)
neAccountBalanceIntervals
          tx :: Tx TopTx era
tx =
            forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @TopTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
              TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (AccountBalanceIntervals era)
forall (l :: TxLevel).
Lens' (TxBody l era) (AccountBalanceIntervals era)
accountBalanceIntervalsTxBodyL ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> AccountBalanceIntervals era
-> TxBody TopTx era
-> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AccountBalanceIntervals era
abi
          ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
            LedgerTxInfo
              { ltiProtVer :: ProtVer
ltiProtVer = Version -> Nat -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Nat
0
              , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = Globals -> EpochInfo (Either Text)
epochInfo Globals
testGlobals
              , ltiSystemStart :: SystemStart
ltiSystemStart = Globals -> SystemStart
systemStart Globals
testGlobals
              , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
forall a. Monoid a => a
mempty
              , ltiTx :: Tx TopTx era
ltiTx = Tx TopTx era
tx
              , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
              }
          txInfoResult :: Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
txInfoResult =
            ((PlutusPurpose AsPurpose era
 -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ AsPurpose Word32 TxIn -> PlutusPurpose AsPurpose era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose AsPurpose Word32 TxIn
forall ix it. AsPurpose ix it
AsPurpose)
              ((PlutusPurpose AsPurpose era
  -> Either (ContextError era) (PlutusTxInfo l))
 -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
forall (l :: Language) era.
PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
unPlutusTxInfoResult (SLanguage l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (proxy :: Language -> *).
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
ledgerTxInfo)
         in
          Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
txInfoResult Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
-> ContextError era -> Expectation
forall a b.
(HasCallStack, Show a, Eq a, Show b) =>
Either a b -> a -> Expectation
`shouldBeLeft` DijkstraContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (forall era. AccountBalanceIntervals era -> DijkstraContextError era
AccountBalanceIntervalsNotSupported @era AccountBalanceIntervals era
abi)
      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"SubTxsAreNotSupported" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
        let
          subTx :: Tx SubTx era
subTx = forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @SubTx TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
          tx :: Tx TopTx era
tx =
            forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @TopTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
              TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tx SubTx era -> OMap TxId (Tx SubTx era)
forall k v. HasOKey k v => v -> OMap k v
OMap.singleton Tx SubTx era
subTx
          ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
            LedgerTxInfo
              { ltiProtVer :: ProtVer
ltiProtVer = Version -> Nat -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Nat
0
              , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = Globals -> EpochInfo (Either Text)
epochInfo Globals
testGlobals
              , ltiSystemStart :: SystemStart
ltiSystemStart = Globals -> SystemStart
systemStart Globals
testGlobals
              , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
forall a. Monoid a => a
mempty
              , ltiTx :: Tx TopTx era
ltiTx = Tx TopTx era
tx
              , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
              }
          txInfoResult :: Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
txInfoResult =
            ((PlutusPurpose AsPurpose era
 -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ AsPurpose Word32 TxIn -> PlutusPurpose AsPurpose era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose AsPurpose Word32 TxIn
forall ix it. AsPurpose ix it
AsPurpose)
              ((PlutusPurpose AsPurpose era
  -> Either (ContextError era) (PlutusTxInfo l))
 -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
forall (l :: Language) era.
PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
unPlutusTxInfoResult (SLanguage l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (proxy :: Language -> *).
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
ledgerTxInfo)
        Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
txInfoResult
          Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
-> ContextError era -> Expectation
forall a b.
(HasCallStack, Show a, Eq a, Show b) =>
Either a b -> a -> Expectation
`shouldBeLeft` DijkstraContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (forall era. NonEmpty TxId -> DijkstraContextError era
SubTxsAreNotSupported @era (TxId -> NonEmpty TxId
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx SubTx era -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
txIdTx Tx SubTx era
subTx)))