{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# 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 (..), toAsPurpose)
import Cardano.Ledger.Alonzo.TxWits (unRedeemersL)
import Cardano.Ledger.Babbage.TxInfo (BabbageContextError (..))
import Cardano.Ledger.BaseTypes (
  Globals (..),
  Inject (..),
  Network (..),
  ProtVer (..),
  TxIx (..),
 )
import Cardano.Ledger.Credential (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 (..),
  TxOutSource (..),
  getPlutusData,
  hashPlutusScript,
  plutusLanguage,
  transCoinToValue,
  transCred,
  transSafeHash,
  transScriptHash,
 )
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import qualified Cardano.Ledger.Val as Val
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.NonEmpty as NEM
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import qualified Data.OSet.Strict as OSet
import Data.Proxy (Proxy (..))
import qualified Data.Set.NonEmpty as NES
import Lens.Micro ((&), (.~))
import qualified PlutusLedgerApi.V4 as PV4
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Utils (testGlobals)
import Test.Cardano.Ledger.Dijkstra.Arbitrary ()
import qualified Test.Cardano.Ledger.Plutus.Examples as Plutus

spec ::
  forall era.
  ( EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  , EraPlutusTxInfo PlutusV3 era
  , EraPlutusTxInfo PlutusV4 era
  , Inject (DijkstraContextError era) (ContextError era)
  , Inject (BabbageContextError era) (ContextError era)
  , DijkstraEraTxBody era
  , EraTx era
  , Arbitrary (Value era)
  , AlonzoEraTxWits era
  ) =>
  Spec
spec :: forall era.
(EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 EraPlutusTxInfo 'PlutusV3 era, EraPlutusTxInfo 'PlutusV4 era,
 Inject (DijkstraContextError era) (ContextError era),
 Inject (BabbageContextError era) (ContextError era),
 DijkstraEraTxBody era, EraTx era, Arbitrary (Value era),
 AlonzoEraTxWits 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 <- oneof [StakeRefBase <$> arbitrary, pure StakeRefNull]
      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 -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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 (NES.singleton . TxOutFromOutput $ TxIx 0))
    String -> Gen Expectation -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Collects all Ptr sources when multiple outputs have pointers" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
      pc0 <- Gen (Credential Payment)
forall a. Arbitrary a => Gen a
arbitrary
      pc1 <- arbitrary
      pc2 <- arbitrary
      ptr0 <- arbitrary
      ptr2 <- arbitrary
      stakeCred <- arbitrary
      val0 <- arbitrary
      val1 <- arbitrary
      val2 <- arbitrary
      let
        txOuts =
          [ 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
pc0 (Ptr -> StakeReference
StakeRefPtr Ptr
ptr0)) Value era
val0
          , 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
pc1 (Credential Staking -> StakeReference
StakeRefBase Credential Staking
stakeCred)) Value era
val1
          , 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
pc2 (Ptr -> StakeReference
StakeRefPtr Ptr
ptr2)) Value era
val2
          ]
        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
.~ StrictSeq (TxOut era)
txOuts
        ledgerTxInfo =
          LedgerTxInfo
            { ltiProtVer :: ProtVer
ltiProtVer = Version -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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
            }
      pure $
        (($ SpendingPurpose AsPurpose) <$> unPlutusTxInfoResult (toPlutusTxInfo SPlutusV4 ledgerTxInfo))
          `shouldBeLeft` inject
            ( PointerPresentInOutput @era . fromJust $
                NES.fromSet [TxOutFromOutput $ TxIx 0, TxOutFromOutput $ TxIx 2]
            )
    String -> Gen Expectation -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Fails translation when Byron addresses present in outputs" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
      ba0 <- Gen BootstrapAddress
forall a. Arbitrary a => Gen a
arbitrary
      ba2 <- arbitrary
      paymentCred <- arbitrary
      val0 <- arbitrary
      val1 <- arbitrary
      val2 <- arbitrary
      let
        txOuts =
          [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (BootstrapAddress -> Addr
AddrBootstrap BootstrapAddress
ba0) Value era
val0
          , 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 StakeReference
StakeRefNull) Value era
val1
          , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (BootstrapAddress -> Addr
AddrBootstrap BootstrapAddress
ba2) Value era
val2
          ]
        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
.~ StrictSeq (TxOut era)
txOuts
        ledgerTxInfo =
          LedgerTxInfo
            { ltiProtVer :: ProtVer
ltiProtVer = Version -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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
            }
      pure $
        (($ SpendingPurpose AsPurpose) <$> unPlutusTxInfoResult (toPlutusTxInfo SPlutusV4 ledgerTxInfo))
          `shouldBeLeft` inject (ByronTxOutInContext @era (TxOutFromOutput $ TxIx 0))
    String -> Gen Expectation -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Reports the first error kind when Ptr and Byron outputs are mixed" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
      pc0 <- Gen (Credential Payment)
forall a. Arbitrary a => Gen a
arbitrary
      pc2 <- arbitrary
      ptr0 <- arbitrary
      ptr2 <- arbitrary
      bootstrapAddr <- arbitrary
      val0 <- arbitrary
      val1 <- arbitrary
      val2 <- arbitrary
      let
        txOuts =
          [ 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
pc0 (Ptr -> StakeReference
StakeRefPtr Ptr
ptr0)) Value era
val0
          , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (BootstrapAddress -> Addr
AddrBootstrap BootstrapAddress
bootstrapAddr) Value era
val1
          , 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
pc2 (Ptr -> StakeReference
StakeRefPtr Ptr
ptr2)) Value era
val2
          ]
        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
.~ StrictSeq (TxOut era)
txOuts
        ledgerTxInfo =
          LedgerTxInfo
            { ltiProtVer :: ProtVer
ltiProtVer = Version -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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
            }
      pure $
        (($ SpendingPurpose AsPurpose) <$> unPlutusTxInfoResult (toPlutusTxInfo SPlutusV4 ledgerTxInfo))
          `shouldBeLeft` inject
            ( PointerPresentInOutput @era . fromJust $
                NES.fromSet [TxOutFromOutput $ TxIx 0, TxOutFromOutput $ TxIx 2]
            )
    String -> Gen Expectation -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Translates outputs in the order they appear in the TxBody" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
      pc0 <- Gen (Credential Payment)
forall a. Arbitrary a => Gen a
arbitrary
      pc1 <- arbitrary
      pc2 <- arbitrary
      val0 <- arbitrary
      val1 <- arbitrary
      val2 <- arbitrary
      let
        txOuts =
          [ 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
pc0 StakeReference
StakeRefNull) Value era
val0
          , 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
pc1 StakeReference
StakeRefNull) Value era
val1
          , 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
pc2 StakeReference
StakeRefNull) Value era
val2
          ]
        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
.~ StrictSeq (TxOut era)
txOuts
        ledgerTxInfo =
          LedgerTxInfo
            { ltiProtVer :: ProtVer
ltiProtVer = Version -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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
            }
      pure $
        case ($ SpendingPurpose AsPurpose) <$> unPlutusTxInfoResult (toPlutusTxInfo SPlutusV4 ledgerTxInfo) of
          Right (Right TxInfo
txInfo) ->
            (TxOut -> Address) -> [TxOut] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map TxOut -> Address
PV4.txOutAddress (TxInfo -> [TxOut]
PV4.txInfoOutputs TxInfo
txInfo)
              [Address] -> [Address] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Credential -> Maybe AccountId -> Address
PV4.Address (Credential Payment -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Payment
pc) Maybe AccountId
forall a. Maybe a
Nothing | Credential Payment
pc <- [Item [Credential Payment]
Credential Payment
pc0, Item [Credential Payment]
Credential Payment
pc1, Item [Credential Payment]
Credential Payment
pc2]]
          Either (ContextError era) (Either (ContextError era) TxInfo)
err -> HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ String
"Failed to translate TxInfo: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Either (ContextError era) (Either (ContextError era) TxInfo)
-> String
forall a. Show a => a -> String
show Either (ContextError era) (Either (ContextError era) TxInfo)
err
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"toPlutusTxInfo" (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
"succeeds when purpose points at a script hash" (Gen Expectation -> Spec) -> Gen Expectation -> Spec
forall a b. (a -> b) -> a -> b
$ do
        pv <- [Version] -> Gen Version
forall a. HasCallStack => [a] -> Gen a
elements ([Version] -> Gen Version) -> [Version] -> Gen Version
forall a b. (a -> b) -> a -> b
$ forall era. Era era => [Version]
eraProtVersions @era
        paymentCred1 <- arbitrary
        stakeRef1 <- oneof [StakeRefBase <$> arbitrary, pure StakeRefNull]
        stakeRef2 <- oneof [StakeRefBase <$> arbitrary, pure StakeRefNull]
        coin1 <- arbitrary
        coin2 <- arbitrary
        txIn <- arbitrary
        redeemer <- arbitrary
        exUnits <- arbitrary
        let
          proxy = forall {k} (t :: k). Proxy t
forall (t :: Language). Proxy t
Proxy @PlutusV4
          script = SLanguage 'PlutusV4 -> Plutus 'PlutusV4
forall (l :: Language). SLanguage l -> Plutus l
Plutus.alwaysSucceedsNoDatum SLanguage 'PlutusV4
SPlutusV4
          scriptHash = Plutus 'PlutusV4 -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript Plutus 'PlutusV4
script
          paymentCred2 = ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
scriptHash
          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
paymentCred1 StakeReference
stakeRef1) (Coin -> Value era
forall t s. Inject t s => t -> s
Val.inject Coin
coin1)
          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
forall {kr :: KeyRole}. Credential kr
paymentCred2 StakeReference
stakeRef2) (Coin -> Value era
forall t s. Inject t s => t -> s
Val.inject Coin
coin2)
                )
              ]
          tx =
            forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @TopTx
              ( 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]
              )
              Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Identity (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> TxWits era -> Identity (TxWits era))
-> (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
    -> Identity (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Identity (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> Redeemers era -> Identity (Redeemers era))
-> (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
    -> Identity (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> TxWits era
-> Identity (TxWits era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> Identity (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> Redeemers era -> Identity (Redeemers era)
forall era.
AlonzoEraScript era =>
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
unRedeemersL
                ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
  -> Identity (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Tx TopTx era
-> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusPurpose AsIx era
-> (Data era, ExUnits)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. k -> a -> Map k a
Map.singleton (AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose (AsIx Word32 TxIn -> PlutusPurpose AsIx era)
-> AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0) (Data era
redeemer, ExUnits
exUnits)
          protVer = Version -> Word32 -> ProtVer
ProtVer Version
pv Word32
0
          lti =
            LedgerTxInfo
              { ltiUTxO :: UTxO era
ltiUTxO = UTxO era
utxo
              , ltiTx :: Tx TopTx era
ltiTx = Tx TopTx era
tx
              , ltiSystemStart :: SystemStart
ltiSystemStart = Globals -> SystemStart
systemStart Globals
testGlobals
              , ltiProtVer :: ProtVer
ltiProtVer = ProtVer
protVer
              , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
              , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = Globals -> EpochInfo (Either Text)
epochInfo Globals
testGlobals
              }
          purpose = forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose @era (AsIxItem Word32 TxIn -> PlutusPurpose AsIxItem era)
-> AsIxItem Word32 TxIn -> PlutusPurpose AsIxItem era
forall a b. (a -> b) -> a -> b
$ Word32 -> TxIn -> AsIxItem Word32 TxIn
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
0 TxIn
txIn
          TxIn (TxId txIdHash) (TxIx txIx) = txIn
          TxId txBodyHash = txIdTx tx
          txInRef = TxId -> Integer -> TxOutRef
PV4.TxOutRef (BuiltinByteString -> TxId
PV4.TxId (BuiltinByteString -> TxId) -> BuiltinByteString -> TxId
forall a b. (a -> b) -> a -> b
$ SafeHash EraIndependentTxBody -> BuiltinByteString
forall i. SafeHash i -> BuiltinByteString
transSafeHash SafeHash EraIndependentTxBody
txIdHash) (Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger Word16
txIx)
          transStakeRef (StakeRefBase Credential Staking
cred) = AccountId -> Maybe AccountId
forall a. a -> Maybe a
Just (AccountId -> Maybe AccountId)
-> (Credential -> AccountId) -> Credential -> Maybe AccountId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> AccountId
PV4.AccountId (Credential -> Maybe AccountId) -> Credential -> Maybe AccountId
forall a b. (a -> b) -> a -> b
$ Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
cred
          transStakeRef StakeReference
_ = Maybe AccountId
forall a. Maybe a
Nothing
          addr1 = Credential -> Maybe AccountId -> Address
PV4.Address (Credential Payment -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Payment
paymentCred1) (StakeReference -> Maybe AccountId
transStakeRef StakeReference
stakeRef1)
          addr2 = Credential -> Maybe AccountId -> Address
PV4.Address (Credential (ZonkAny MinVersion) -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential (ZonkAny MinVersion)
forall {kr :: KeyRole}. Credential kr
paymentCred2) (StakeReference -> Maybe AccountId
transStakeRef StakeReference
stakeRef2)
        pure $ case toPlutusTxInfo proxy lti of
          PlutusTxInfoResult (Right PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo 'PlutusV4)
f) ->
            PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo 'PlutusV4)
f ((forall ix it. AsIxItem ix it -> AsPurpose ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsPurpose era
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsPurpose ix it
forall ix it. AsIxItem ix it -> AsPurpose ix it
forall (f :: * -> * -> *) ix it. f ix it -> AsPurpose ix it
toAsPurpose PlutusPurpose AsIxItem era
purpose)
              Either (ContextError era) TxInfo -> TxInfo -> Expectation
forall a b.
(HasCallStack, Show a, Show b, Eq b) =>
Either a b -> b -> Expectation
`shouldBeRight` PV4.TxInfo
                { txInfoWithdrawals :: Map AccountId Lovelace
PV4.txInfoWithdrawals = [(AccountId, Lovelace)] -> Map AccountId Lovelace
forall k v. [(k, v)] -> Map k v
PV4.unsafeFromList []
                , txInfoVotes :: Map Voter (Map GovernanceActionId Vote)
PV4.txInfoVotes = [(Voter, Map GovernanceActionId Vote)]
-> Map Voter (Map GovernanceActionId Vote)
forall k v. [(k, v)] -> Map k v
PV4.unsafeFromList []
                , txInfoValidRange :: POSIXTimeRange
PV4.txInfoValidRange = POSIXTimeRange
forall a. Interval a
PV4.always
                , txInfoTxCerts :: [TxCert]
PV4.txInfoTxCerts = []
                , txInfoTreasuryDonation :: Lovelace
PV4.txInfoTreasuryDonation = Integer -> Lovelace
PV4.Lovelace Integer
0
                , txInfoSubTxIx :: Maybe Integer
PV4.txInfoSubTxIx = Maybe Integer
forall a. Maybe a
Nothing
                , txInfoRequiredTopLevelGuards :: Map Credential (Maybe Datum)
PV4.txInfoRequiredTopLevelGuards = [(Credential, Maybe Datum)] -> Map Credential (Maybe Datum)
forall k v. [(k, v)] -> Map k v
PV4.unsafeFromList []
                , txInfoReferenceInputs :: [TxInInfo]
PV4.txInfoReferenceInputs = []
                , txInfoRedeemers :: Map ScriptPurpose Redeemer
PV4.txInfoRedeemers =
                    [(ScriptPurpose, Redeemer)] -> Map ScriptPurpose Redeemer
forall k v. [(k, v)] -> Map k v
PV4.unsafeFromList
                      [
                        ( ScriptHash -> TxOutRef -> ScriptPurpose
PV4.Spending (ScriptHash -> ScriptHash
transScriptHash ScriptHash
scriptHash) TxOutRef
txInRef
                        , BuiltinData -> Redeemer
PV4.Redeemer (BuiltinData -> Redeemer)
-> (Data -> BuiltinData) -> Data -> Redeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
PV4.dataToBuiltinData (Data -> Redeemer) -> Data -> Redeemer
forall a b. (a -> b) -> a -> b
$ Data era -> Data
forall era. Data era -> Data
getPlutusData Data era
redeemer
                        )
                      ]
                , txInfoProposalProcedures :: [ProposalProcedure]
PV4.txInfoProposalProcedures = []
                , txInfoOutputs :: [TxOut]
PV4.txInfoOutputs =
                    [ Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PV4.TxOut
                        Address
addr1
                        (Coin -> Value
transCoinToValue Coin
coin1)
                        OutputDatum
PV4.NoOutputDatum
                        Maybe ScriptHash
forall a. Maybe a
Nothing
                    ]
                , txInfoMint :: MintValue
PV4.txInfoMint = MintValue
PV4.emptyMintValue
                , txInfoInputs :: [TxInInfo]
PV4.txInfoInputs =
                    [ TxOutRef -> TxOut -> TxInInfo
PV4.TxInInfo
                        TxOutRef
txInRef
                        ( Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PV4.TxOut
                            Address
addr2
                            (Coin -> Value
transCoinToValue Coin
coin2)
                            OutputDatum
PV4.NoOutputDatum
                            Maybe ScriptHash
forall a. Maybe a
Nothing
                        )
                    ]
                , txInfoId :: TxId
PV4.txInfoId = BuiltinByteString -> TxId
PV4.TxId (BuiltinByteString -> TxId) -> BuiltinByteString -> TxId
forall a b. (a -> b) -> a -> b
$ SafeHash EraIndependentTxBody -> BuiltinByteString
forall i. SafeHash i -> BuiltinByteString
transSafeHash SafeHash EraIndependentTxBody
txBodyHash
                , txInfoGuards :: [Credential]
PV4.txInfoGuards = []
                , txInfoFee :: Lovelace
PV4.txInfoFee = Integer -> Lovelace
PV4.Lovelace Integer
0
                , txInfoDirectDeposits :: Map AccountId Lovelace
PV4.txInfoDirectDeposits = [(AccountId, Lovelace)] -> Map AccountId Lovelace
forall k v. [(k, v)] -> Map k v
PV4.unsafeFromList []
                , txInfoData :: Map DatumHash Datum
PV4.txInfoData = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k v. [(k, v)] -> Map k v
PV4.unsafeFromList []
                , txInfoCurrentTreasuryAmount :: Maybe Lovelace
PV4.txInfoCurrentTreasuryAmount = Maybe Lovelace
forall a. Maybe a
Nothing
                , txInfoAccountBalanceIntervals :: AccountBalanceIntervals
PV4.txInfoAccountBalanceIntervals =
                    Map AccountId AccountBalanceInterval -> AccountBalanceIntervals
PV4.AccountBalanceIntervals (Map AccountId AccountBalanceInterval -> AccountBalanceIntervals)
-> Map AccountId AccountBalanceInterval -> AccountBalanceIntervals
forall a b. (a -> b) -> a -> b
$ [(AccountId, AccountBalanceInterval)]
-> Map AccountId AccountBalanceInterval
forall k v. [(k, v)] -> Map k v
PV4.unsafeFromList []
                }
          PlutusTxInfoResult 'PlutusV4 era
_ -> HasCallStack => String -> Expectation
String -> Expectation
expectationFailure String
"Failed to translate TxInfo"
  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 -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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 -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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 -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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 -> (ScriptHash -> Expectation) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"GuardScriptHashesNotSupported" ((ScriptHash -> Expectation) -> Spec)
-> (ScriptHash -> Expectation) -> Spec
forall a b. (a -> b) -> a -> b
$ \(ScriptHash
scriptHash :: ScriptHash) ->
        let
          neScriptHashes :: NonEmpty ScriptHash
neScriptHashes = ScriptHash
scriptHash ScriptHash -> [ScriptHash] -> NonEmpty ScriptHash
forall a. a -> [a] -> NonEmpty a
:| []
          guards :: OSet (Credential kr)
guards = [Credential kr] -> OSet (Credential kr)
forall a. Ord a => [a] -> OSet a
OSet.fromList [ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
scriptHash]
          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
& (OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (OSet (Credential Guard))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (Credential Guard))
guardsTxBodyL ((OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OSet (Credential Guard) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OSet (Credential Guard)
forall {kr :: KeyRole}. OSet (Credential kr)
guards
          ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
            LedgerTxInfo
              { ltiProtVer :: ProtVer
ltiProtVer = Version -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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. NonEmpty ScriptHash -> DijkstraContextError era
GuardScriptHashesNotSupported @era NonEmpty ScriptHash
neScriptHashes)
      String
-> (NonEmptyMap (Credential Guard) (StrictMaybe (Data era))
    -> Expectation)
-> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"RequiredTopLevelGuardsNotSupported" ((NonEmptyMap (Credential Guard) (StrictMaybe (Data era))
  -> Expectation)
 -> Spec)
-> (NonEmptyMap (Credential Guard) (StrictMaybe (Data era))
    -> Expectation)
-> Spec
forall a b. (a -> b) -> a -> b
$ \NonEmptyMap (Credential Guard) (StrictMaybe (Data era))
neRequiredTopLevelGuards ->
        let
          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
& (Map (Credential Guard) (StrictMaybe (Data era))
 -> Identity (Map (Credential Guard) (StrictMaybe (Data era))))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens'
  (TxBody l era) (Map (Credential Guard) (StrictMaybe (Data era)))
forall (l :: TxLevel).
Lens'
  (TxBody l era) (Map (Credential Guard) (StrictMaybe (Data era)))
requiredTopLevelGuardsL ((Map (Credential Guard) (StrictMaybe (Data era))
  -> Identity (Map (Credential Guard) (StrictMaybe (Data era))))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Map (Credential Guard) (StrictMaybe (Data era))
-> TxBody TopTx era
-> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonEmptyMap (Credential Guard) (StrictMaybe (Data era))
-> Map (Credential Guard) (StrictMaybe (Data era))
forall k v. NonEmptyMap k v -> Map k v
NEM.toMap NonEmptyMap (Credential Guard) (StrictMaybe (Data era))
neRequiredTopLevelGuards
          ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
            LedgerTxInfo
              { ltiProtVer :: ProtVer
ltiProtVer = Version -> Word32 -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Word32
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.
NonEmptyMap (Credential Guard) (StrictMaybe (Data era))
-> DijkstraContextError era
RequiredTopLevelGuardsNotSupported @era NonEmptyMap (Credential Guard) (StrictMaybe (Data era))
neRequiredTopLevelGuards)