{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} module Test.Cardano.Ledger.Dijkstra.TxInfoSpec (spec) where import Cardano.Ledger.Alonzo.Plutus.Context ( EraPlutusContext (..), EraPlutusTxInfo (..), PlutusTxInfoResult (..), SupportedLanguage (..), toPlutusTxInfoForPurpose, ) import Cardano.Ledger.Alonzo.Scripts (AsPurpose (..), toAsPurpose) import Cardano.Ledger.Alonzo.TxWits (unRedeemersL) import Cardano.Ledger.Alonzo.UTxO 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.State (EraUTxO (..)) import Cardano.Ledger.TxIn (TxId (..), TxIn (..)) import qualified Cardano.Ledger.Val as Val import Control.Monad.Trans.Fail.String (errorFail) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map.NonEmpty as NEM import qualified Data.Map.Strict as Map import qualified Data.OSet.Strict as OSet import Data.Proxy (Proxy (..)) import Lens.Micro ((&), (.~)) import qualified PlutusLedgerApi.V4 as PV4 import Test.Cardano.Ledger.Alonzo.Era (mkTestLedgerTxInfo) 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 , EraUTxO era , Arbitrary (Value era) , AlonzoEraTxWits era , ScriptsNeeded era ~ AlonzoScriptsNeeded 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, EraUTxO era, Arbitrary (Value era), AlonzoEraTxWits era, ScriptsNeeded era ~ AlonzoScriptsNeeded 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 let mkLocalLedgerTxInfo :: UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era utxo Tx level era tx = let ei :: EpochInfo (Either Text) ei = Globals -> EpochInfo (Either Text) epochInfo Globals testGlobals ss :: SystemStart ss = Globals -> SystemStart systemStart Globals testGlobals in ProtVer -> EpochInfo (Either Text) -> SystemStart -> UTxO era -> Tx level era -> LedgerTxInfo era forall era (level :: TxLevel). (EraUTxO era, EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era) => ProtVer -> EpochInfo (Either Text) -> SystemStart -> UTxO era -> Tx level era -> LedgerTxInfo era mkTestLedgerTxInfo (Version -> Word32 -> ProtVer ProtVer (forall era. Era era => Version eraProtVerLow @era) Word32 0) EpochInfo (Either Text) ei SystemStart ss UTxO era utxo Tx level era tx 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 = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era utxo Tx TopTx era tx pure $ toPlutusTxInfoForPurpose SPlutusV4 ledgerTxInfo (SpendingPurpose AsPurpose) `shouldBeLeft` inject (PointerPresentInOutput @era (TxOutFromOutput $ TxIx 0)) 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 = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era forall a. Monoid a => a mempty Tx TopTx era tx pure $ toPlutusTxInfoForPurpose SPlutusV4 ledgerTxInfo (SpendingPurpose AsPurpose) `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 = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era forall a. Monoid a => a mempty Tx TopTx era tx pure $ toPlutusTxInfoForPurpose SPlutusV4 ledgerTxInfo (SpendingPurpose AsPurpose) `shouldBeLeft` inject (PointerPresentInOutput @era (TxOutFromOutput $ TxIx 0)) 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 = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era forall a. Monoid a => a mempty Tx TopTx era tx pure $ case toPlutusTxInfoForPurpose SPlutusV4 ledgerTxInfo (SpendingPurpose AsPurpose) of Right PlutusTxInfo 'PlutusV4 txInfo -> (TxOut -> Address) -> [TxOut] -> [Address] forall a b. (a -> b) -> [a] -> [b] map TxOut -> Address PV4.txOutAddress (TxInfo -> [TxOut] PV4.txInfoOutputs PlutusTxInfo 'PlutusV4 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) (PlutusTxInfo 'PlutusV4) 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) TxInfo -> String forall a. Show a => a -> String show Either (ContextError era) (PlutusTxInfo 'PlutusV4) 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 paymentCred1 <- Gen (Credential Payment) forall a. Arbitrary a => Gen a arbitrary stakeRef1 <- oneof [StakeRefBase <$> arbitrary, pure StakeRefNull] stakeRef2 <- oneof [StakeRefBase <$> arbitrary, pure StakeRefNull] coin1 <- arbitrary coin2 <- arbitrary txIn <- arbitrary redeemer <- arbitrary exUnits <- arbitrary let plutusScript = SLanguage 'PlutusV4 -> Plutus 'PlutusV4 forall (l :: Language). SLanguage l -> Plutus l Plutus.alwaysSucceedsNoDatum SLanguage 'PlutusV4 SPlutusV4 script = Fail (PlutusScript era) -> PlutusScript era forall a. HasCallStack => Fail a -> a errorFail (Fail (PlutusScript era) -> PlutusScript era) -> Fail (PlutusScript era) -> PlutusScript era forall a b. (a -> b) -> a -> b $ Plutus 'PlutusV4 -> Fail (PlutusScript era) forall era (l :: Language) (m :: * -> *). (AlonzoEraScript era, PlutusLanguage l, MonadFail m) => Plutus l -> m (PlutusScript era) forall (l :: Language) (m :: * -> *). (PlutusLanguage l, MonadFail m) => Plutus l -> m (PlutusScript era) mkPlutusScript Plutus 'PlutusV4 plutusScript let proxy = forall {k} (t :: k). Proxy t forall (t :: Language). Proxy t Proxy @PlutusV4 scriptHash = Plutus 'PlutusV4 -> ScriptHash forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash hashPlutusScript Plutus 'PlutusV4 plutusScript 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) 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 ScriptHash (Script era) -> Identity (Map ScriptHash (Script era))) -> TxWits era -> Identity (TxWits era)) -> (Map ScriptHash (Script era) -> Identity (Map ScriptHash (Script era))) -> Tx TopTx era -> Identity (Tx TopTx era) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Map ScriptHash (Script era) -> Identity (Map ScriptHash (Script era))) -> TxWits era -> Identity (TxWits era) forall era. EraTxWits era => Lens' (TxWits era) (Map ScriptHash (Script era)) Lens' (TxWits era) (Map ScriptHash (Script era)) scriptTxWitsL ((Map ScriptHash (Script era) -> Identity (Map ScriptHash (Script era))) -> Tx TopTx era -> Identity (Tx TopTx era)) -> Map ScriptHash (Script era) -> Tx TopTx era -> Tx TopTx era forall s t a b. ASetter s t a b -> b -> s -> t .~ ScriptHash -> Script era -> Map ScriptHash (Script era) forall k a. k -> a -> Map k a Map.singleton ScriptHash scriptHash (PlutusScript era -> Script era forall era. AlonzoEraScript era => PlutusScript era -> Script era fromPlutusScript PlutusScript era script) lti = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era utxo Tx TopTx era tx 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 toPlutusTxInfoForPurpose proxy lti (hoistPlutusPurpose toAsPurpose purpose) of Right PlutusTxInfo 'PlutusV4 txInfo -> PlutusTxInfo 'PlutusV4 TxInfo txInfo TxInfo -> TxInfo -> Expectation forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` PV4.TxInfo { txInfoWithdrawals :: Map Credential Lovelace PV4.txInfoWithdrawals = [(Credential, Lovelace)] -> Map Credential 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 = Maybe POSIXTime -> Maybe POSIXTime -> POSIXTimeRange PV4.POSIXTimeRange Maybe POSIXTime forall a. Maybe a Nothing Maybe POSIXTime forall a. Maybe a Nothing , 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 = [] , txInfoDirectDeposits :: Map Credential Lovelace PV4.txInfoDirectDeposits = [(Credential, Lovelace)] -> Map Credential 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 [] } Left ContextError era failure -> 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 <> ContextError era -> String forall a. Show a => a -> String show ContextError era failure 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 = UTxO era -> Tx SubTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era forall a. Monoid a => a mempty Tx SubTx era tx 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 = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era forall a. Monoid a => a mempty Tx TopTx era tx 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 AccountAddress (AccountBalanceInterval era) -> Expectation) -> Spec forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "AccountBalanceIntervalsNotSupported" ((NonEmptyMap AccountAddress (AccountBalanceInterval era) -> Expectation) -> Spec) -> (NonEmptyMap AccountAddress (AccountBalanceInterval era) -> Expectation) -> Spec forall a b. (a -> b) -> a -> b $ \NonEmptyMap AccountAddress (AccountBalanceInterval era) neAccountBalanceIntervals -> let abi :: AccountBalanceIntervals era abi = Map AccountAddress (AccountBalanceInterval era) -> AccountBalanceIntervals era forall era. Map AccountAddress (AccountBalanceInterval era) -> AccountBalanceIntervals era AccountBalanceIntervals (Map AccountAddress (AccountBalanceInterval era) -> AccountBalanceIntervals era) -> Map AccountAddress (AccountBalanceInterval era) -> AccountBalanceIntervals era forall a b. (a -> b) -> a -> b $ NonEmptyMap AccountAddress (AccountBalanceInterval era) -> Map AccountAddress (AccountBalanceInterval era) forall k v. NonEmptyMap k v -> Map k v NEM.toMap NonEmptyMap AccountAddress (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 = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era forall a. Monoid a => a mempty Tx TopTx era tx 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 = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era forall a. Monoid a => a mempty Tx TopTx era tx 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 = UTxO era -> Tx TopTx era -> LedgerTxInfo era forall {era} {level :: TxLevel}. (ScriptsNeeded era ~ AlonzoScriptsNeeded era, Assert (OrdCond (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False) (TypeError ...), Assert (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False) (TypeError ...), EraUTxO era, EraPlutusContext era) => UTxO era -> Tx level era -> LedgerTxInfo era mkLocalLedgerTxInfo UTxO era forall a. Monoid a => a mempty Tx TopTx era tx 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)