{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Cardano.Ledger.Conway.Binary.Regression where import Cardano.Ledger.BaseTypes (Inject (..), StrictMaybe (..), TxIx (..)) import Cardano.Ledger.Binary ( EncCBOR (..), decCBOR, decodeFull, decodeFullAnnotatorFromHexText, mkVersion, serialize, ) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway (ConwayEra) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Rules ( ConwayLedgerPredFailure (..), ConwayUtxoPredFailure (..), ConwayUtxowPredFailure (..), ) import Cardano.Ledger.Plutus.Language (SLanguage (..), hashPlutusScript) import Cardano.Ledger.TxIn (TxIn (..)) import Control.Monad ((<=<)) import qualified Data.Sequence.Strict as SSeq import qualified Data.Set as Set import Lens.Micro ((%~), (&), (.~)) import Test.Cardano.Ledger.Conway.ImpTest import Test.Cardano.Ledger.Imp.Common import Test.Cardano.Ledger.Plutus.Examples (redeemerSameAsDatum) spec :: forall era. EraTx era => Spec spec :: forall era. EraTx era => Spec spec = String -> Spec -> Spec forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Regression" (Spec -> Spec) -> Spec -> Spec forall a b. (a -> b) -> a -> b $ do String -> IO () -> SpecWith (Arg (IO ())) forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "DeserialiseFailure on resubmitting Conway Tx with invalid plutus script #4198" (IO () -> SpecWith (Arg (IO ()))) -> IO () -> SpecWith (Arg (IO ())) forall a b. (a -> b) -> a -> b $ do IO () -> IO () forall a. IO a -> IO a io (IO () -> IO ()) -> (Either DecoderError (Tx era) -> IO ()) -> Either DecoderError (Tx era) -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . Either DecoderError (Tx era) -> IO () forall a b (m :: * -> *). (HasCallStack, Show a, NFData b, MonadIO m) => Either a b -> m () expectRightDeep_ (Either DecoderError (Tx era) -> IO ()) -> Either DecoderError (Tx era) -> IO () forall a b. (a -> b) -> a -> b $ forall a. Version -> Text -> (forall s. Decoder s (Annotator a)) -> Text -> Either DecoderError a decodeFullAnnotatorFromHexText @(Tx era) (forall era. Era era => Version eraProtVerLow @era) Text "Unwitnessed Tx" Decoder s (Annotator (Tx era)) forall s. Decoder s (Annotator (Tx era)) forall a s. DecCBOR a => Decoder s a decCBOR (Text -> Either DecoderError (Tx era)) -> Text -> Either DecoderError (Tx era) forall a b. (a -> b) -> a -> b $ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text "84a700d9010282825820745f04573e7429be1404f9b936d208b81159f3fc4b300" , Text "37b9d630187eec1875600825820745f04573e7429be1404f9b936d208b81159f3" , Text "fc4b30037b9d630187eec18756020dd9010281825820745f04573e7429be1404f" , Text "9b936d208b81159f3fc4b30037b9d630187eec1875601018282581d60fdfaa525" , Text "1e9ed2186a52eeea05ac1d39834eeef09b3e41dc151577a01a001e848082581d6" , Text "0fe920c980dbc1113a01db0156955479f3b91f6fb6a51bdc0c383c1b91a3b586d" , Text "e61082581d60fe920c980dbc1113a01db0156955479f3b91f6fb6a51bdc0c383c" , Text "1b91a001a65b0111a00041ed0021a0002bf350b5820878c73eb6ec7171b23396f" , Text "71d7e5adee98b3f72cfc1c0662453ea724a4e27ad5a303d9010281581e581c010" , Text "0003322323222235004007123500235300300149849848004800504d9010281d8" , Text "799f182aff0581840000d8799f182aff820000f4f6" ] Either DecoderError (Tx era) -> IO () forall a b (m :: * -> *). (HasCallStack, Show a, NFData b, MonadIO m) => Either a b -> m () expectRightDeep_ (Either DecoderError (Tx era) -> IO ()) -> Either DecoderError (Tx era) -> IO () forall a b. (a -> b) -> a -> b $ forall a. Version -> Text -> (forall s. Decoder s (Annotator a)) -> Text -> Either DecoderError a decodeFullAnnotatorFromHexText @(Tx era) (forall era. Era era => Version eraProtVerLow @era) Text "Witnessed Tx" Decoder s (Annotator (Tx era)) forall s. Decoder s (Annotator (Tx era)) forall a s. DecCBOR a => Decoder s a decCBOR (Text -> Either DecoderError (Tx era)) -> Text -> Either DecoderError (Tx era) forall a b. (a -> b) -> a -> b $ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text "84a700d9010282825820745f04573e7429be1404f9b936d208b81159f3fc4b300" , Text "37b9d630187eec1875600825820745f04573e7429be1404f9b936d208b81159f3" , Text "fc4b30037b9d630187eec18756020dd9010281825820745f04573e7429be1404f" , Text "9b936d208b81159f3fc4b30037b9d630187eec1875601018282581d60fdfaa525" , Text "1e9ed2186a52eeea05ac1d39834eeef09b3e41dc151577a01a001e848082581d6" , Text "0fe920c980dbc1113a01db0156955479f3b91f6fb6a51bdc0c383c1b91a3b586d" , Text "e61082581d60fe920c980dbc1113a01db0156955479f3b91f6fb6a51bdc0c383c" , Text "1b91a001a65b0111a00041ed0021a0002bf350b5820878c73eb6ec7171b23396f" , Text "71d7e5adee98b3f72cfc1c0662453ea724a4e27ad5a400d9010282825820119ca" , Text "69d7aadd28f1e182176cbaa35f4e08d580b79ee749103f4106768594343584057" , Text "de8c067f7b806001e94f740c9c96c51f884e264dd0b2d0cff501ad67f1d269b7a" , Text "7af5adf92148f4a10855fe3b2090bc88f045603cfe14c8a5f3fed6c4008038258" , Text "20468ed75ae68f72233e33b0a869ae5f00cfabe477f186184782e5a1994d189a9" , Text "b58408395b8e91540804ce1860272ac72b4ecc682f567a33c33da8e835d736f1f" , Text "c039ff86ee5aae0ac0e9c9d50506132e209f62a02fe04906b66a3392d48d4d627" , Text "d0403d9010281581e581c01000033223232222350040071235002353003001498" , Text "49848004800504d9010281d8799f182aff0581840000d8799f182aff820000f4f6" ] String -> Spec -> Spec forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "ImpTest" (Spec -> Spec) -> Spec -> Spec forall a b. (a -> b) -> a -> b $ forall t. ImpSpec t => SpecWith (ImpInit t) -> Spec withImpInit @(LedgerSpec ConwayEra) (SpecWith (ImpInit (LedgerSpec ConwayEra)) -> Spec) -> SpecWith (ImpInit (LedgerSpec ConwayEra)) -> Spec forall a b. (a -> b) -> a -> b $ String -> ImpM (LedgerSpec ConwayEra) () -> SpecWith (Arg (ImpM (LedgerSpec ConwayEra) ())) forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "InsufficientCollateral is not encoded with negative coin #4198" (ImpM (LedgerSpec ConwayEra) () -> SpecWith (Arg (ImpM (LedgerSpec ConwayEra) ()))) -> ImpM (LedgerSpec ConwayEra) () -> SpecWith (Arg (ImpM (LedgerSpec ConwayEra) ())) forall a b. (a -> b) -> a -> b $ do Addr collateralAddress <- ImpM (LedgerSpec ConwayEra) Addr forall s (m :: * -> *) g. (HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) => m Addr freshKeyAddr_ KeyHash 'Staking stakingKeyHash <- forall (r :: KeyRole) s g (m :: * -> *). (HasKeyPairs s, MonadState s m, HasStatefulGen g m) => m (KeyHash r) freshKeyHash @'Staking let plutusVersion :: SLanguage 'PlutusV2 plutusVersion = SLanguage 'PlutusV2 SPlutusV2 scriptHash :: ScriptHash scriptHash = Plutus 'PlutusV2 -> ScriptHash forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash hashPlutusScript (Plutus 'PlutusV2 -> ScriptHash) -> Plutus 'PlutusV2 -> ScriptHash forall a b. (a -> b) -> a -> b $ SLanguage 'PlutusV2 -> Plutus 'PlutusV2 forall (l :: Language). SLanguage l -> Plutus l redeemerSameAsDatum SLanguage 'PlutusV2 plutusVersion lockScriptAddress :: Addr lockScriptAddress = ScriptHash -> KeyHash 'Staking -> Addr forall p s. (MakeCredential p 'Payment, MakeStakeReference s) => p -> s -> Addr mkAddr ScriptHash scriptHash KeyHash 'Staking stakingKeyHash Addr collateralReturnAddr <- ImpM (LedgerSpec ConwayEra) Addr forall s (m :: * -> *) g. (HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) => m Addr freshKeyAddr_ AlonzoTx ConwayEra lockedTx <- forall era. (HasCallStack, ShelleyEraImp era) => String -> Tx era -> ImpTestM era (Tx era) submitTxAnn @ConwayEra String "Script locked tx" (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra)) -> Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra) forall a b. (a -> b) -> a -> b $ TxBody ConwayEra -> Tx ConwayEra forall era. EraTx era => TxBody era -> Tx era mkBasicTx TxBody ConwayEra forall era. EraTxBody era => TxBody era mkBasicTxBody Tx ConwayEra -> (Tx ConwayEra -> Tx ConwayEra) -> Tx ConwayEra forall a b. a -> (a -> b) -> b & (TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall era. EraTx era => Lens' (Tx era) (TxBody era) Lens' (Tx ConwayEra) (TxBody ConwayEra) bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> ((StrictSeq (TxOut ConwayEra) -> Identity (StrictSeq (TxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> (StrictSeq (TxOut ConwayEra) -> Identity (StrictSeq (TxOut ConwayEra))) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall b c a. (b -> c) -> (a -> b) -> a -> c . (StrictSeq (TxOut ConwayEra) -> Identity (StrictSeq (TxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra) forall era. EraTxBody era => Lens' (TxBody era) (StrictSeq (TxOut era)) Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra)) outputsTxBodyL ((StrictSeq (TxOut ConwayEra) -> Identity (StrictSeq (TxOut ConwayEra))) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> StrictSeq (TxOut ConwayEra) -> Tx ConwayEra -> Tx ConwayEra forall s t a b. ASetter s t a b -> b -> s -> t .~ [TxOut ConwayEra] -> StrictSeq (TxOut ConwayEra) forall a. [a] -> StrictSeq a SSeq.fromList [ Addr -> Value ConwayEra -> TxOut ConwayEra forall era. (EraTxOut era, HasCallStack) => Addr -> Value era -> TxOut era mkBasicTxOut Addr lockScriptAddress Value ConwayEra forall a. Monoid a => a mempty , Addr -> Value ConwayEra -> TxOut ConwayEra forall era. (EraTxOut era, HasCallStack) => Addr -> Value era -> TxOut era mkBasicTxOut Addr collateralAddress Value ConwayEra forall a. Monoid a => a mempty ] Tx ConwayEra -> (Tx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra forall a b. a -> (a -> b) -> b & (TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra) (TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra) forall era. EraTx era => Lens' (Tx era) (TxBody era) Lens' (Tx ConwayEra) (TxBody ConwayEra) bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra)) -> ((StrictMaybe (BabbageTxOut ConwayEra) -> Identity (StrictMaybe (BabbageTxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> (StrictMaybe (BabbageTxOut ConwayEra) -> Identity (StrictMaybe (BabbageTxOut ConwayEra))) -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra) forall b c a. (b -> c) -> (a -> b) -> a -> c . (StrictMaybe (TxOut ConwayEra) -> Identity (StrictMaybe (TxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra) (StrictMaybe (BabbageTxOut ConwayEra) -> Identity (StrictMaybe (BabbageTxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra) forall era. BabbageEraTxBody era => Lens' (TxBody era) (StrictMaybe (TxOut era)) Lens' (TxBody ConwayEra) (StrictMaybe (TxOut ConwayEra)) collateralReturnTxBodyL ((StrictMaybe (BabbageTxOut ConwayEra) -> Identity (StrictMaybe (BabbageTxOut ConwayEra))) -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra)) -> StrictMaybe (BabbageTxOut ConwayEra) -> Tx ConwayEra -> AlonzoTx ConwayEra forall s t a b. ASetter s t a b -> b -> s -> t .~ BabbageTxOut ConwayEra -> StrictMaybe (BabbageTxOut ConwayEra) forall a. a -> StrictMaybe a SJust (Addr -> Value ConwayEra -> TxOut ConwayEra forall era. (EraTxOut era, HasCallStack) => Addr -> Value era -> TxOut era mkBasicTxOut Addr collateralReturnAddr (Value ConwayEra -> BabbageTxOut ConwayEra) -> (Coin -> Value ConwayEra) -> Coin -> BabbageTxOut ConwayEra forall b c a. (b -> c) -> (a -> b) -> a -> c . Coin -> Value ConwayEra forall t s. Inject t s => t -> s inject (Coin -> BabbageTxOut ConwayEra) -> Coin -> BabbageTxOut ConwayEra forall a b. (a -> b) -> a -> b $ Integer -> Coin Coin Integer 862000) let modifyRootCoin :: TxOut ConwayEra -> TxOut ConwayEra modifyRootCoin = (Coin -> Identity Coin) -> TxOut ConwayEra -> Identity (TxOut ConwayEra) forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin Lens' (TxOut ConwayEra) Coin coinTxOutL ((Coin -> Identity Coin) -> TxOut ConwayEra -> Identity (TxOut ConwayEra)) -> Coin -> TxOut ConwayEra -> TxOut ConwayEra forall s t a b. ASetter s t a b -> b -> s -> t .~ Integer -> Coin Coin Integer 989482376 modifyRootTxOut :: StrictSeq (TxOut ConwayEra) -> StrictSeq (TxOut ConwayEra) modifyRootTxOut (TxOut ConwayEra x SSeq.:<| StrictSeq (TxOut ConwayEra) SSeq.Empty) = TxOut ConwayEra -> TxOut ConwayEra modifyRootCoin TxOut ConwayEra x TxOut ConwayEra -> StrictSeq (TxOut ConwayEra) -> StrictSeq (TxOut ConwayEra) forall a. a -> StrictSeq a -> StrictSeq a SSeq.:<| StrictSeq (TxOut ConwayEra) forall a. StrictSeq a SSeq.Empty modifyRootTxOut (TxOut ConwayEra x SSeq.:<| StrictSeq (TxOut ConwayEra) xs) = TxOut ConwayEra x TxOut ConwayEra -> StrictSeq (TxOut ConwayEra) -> StrictSeq (TxOut ConwayEra) forall a. a -> StrictSeq a -> StrictSeq a SSeq.:<| StrictSeq (TxOut ConwayEra) -> StrictSeq (TxOut ConwayEra) modifyRootTxOut StrictSeq (TxOut ConwayEra) xs modifyRootTxOut (StrictSeq (TxOut ConwayEra) xs SSeq.:|> TxOut ConwayEra x) = StrictSeq (TxOut ConwayEra) xs StrictSeq (TxOut ConwayEra) -> TxOut ConwayEra -> StrictSeq (TxOut ConwayEra) forall a. StrictSeq a -> a -> StrictSeq a SSeq.:|> TxOut ConwayEra -> TxOut ConwayEra modifyRootCoin TxOut ConwayEra x modifyRootTxOut StrictSeq (TxOut ConwayEra) SSeq.Empty = StrictSeq (TxOut ConwayEra) forall a. StrictSeq a SSeq.Empty breakCollaterals :: Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra) breakCollaterals Tx ConwayEra tx = Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra) forall a. a -> ImpM (LedgerSpec ConwayEra) a forall (f :: * -> *) a. Applicative f => a -> f a pure (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra)) -> Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra) forall a b. (a -> b) -> a -> b $ Tx ConwayEra tx Tx ConwayEra -> (Tx ConwayEra -> Tx ConwayEra) -> Tx ConwayEra forall a b. a -> (a -> b) -> b & (TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall era. EraTx era => Lens' (Tx era) (TxBody era) Lens' (Tx ConwayEra) (TxBody ConwayEra) bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> ((StrictMaybe (TxOut ConwayEra) -> Identity (StrictMaybe (TxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> (StrictMaybe (TxOut ConwayEra) -> Identity (StrictMaybe (TxOut ConwayEra))) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall b c a. (b -> c) -> (a -> b) -> a -> c . (StrictMaybe (TxOut ConwayEra) -> Identity (StrictMaybe (TxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra) forall era. BabbageEraTxBody era => Lens' (TxBody era) (StrictMaybe (TxOut era)) Lens' (TxBody ConwayEra) (StrictMaybe (TxOut ConwayEra)) collateralReturnTxBodyL ((StrictMaybe (TxOut ConwayEra) -> Identity (StrictMaybe (TxOut ConwayEra))) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> StrictMaybe (TxOut ConwayEra) -> Tx ConwayEra -> Tx ConwayEra forall s t a b. ASetter s t a b -> b -> s -> t .~ TxOut ConwayEra -> StrictMaybe (TxOut ConwayEra) forall a. a -> StrictMaybe a SJust (Addr -> Value ConwayEra -> TxOut ConwayEra forall era. (EraTxOut era, HasCallStack) => Addr -> Value era -> TxOut era mkBasicTxOut Addr collateralReturnAddr (Value ConwayEra -> TxOut ConwayEra) -> (Coin -> Value ConwayEra) -> Coin -> TxOut ConwayEra forall b c a. (b -> c) -> (a -> b) -> a -> c . Coin -> Value ConwayEra forall t s. Inject t s => t -> s inject (Coin -> TxOut ConwayEra) -> Coin -> TxOut ConwayEra forall a b. (a -> b) -> a -> b $ Integer -> Coin Coin Integer 1_000_000_000) Tx ConwayEra -> (Tx ConwayEra -> Tx ConwayEra) -> Tx ConwayEra forall a b. a -> (a -> b) -> b & (TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall era. EraTx era => Lens' (Tx era) (TxBody era) Lens' (Tx ConwayEra) (TxBody ConwayEra) bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> ((Coin -> Identity Coin) -> TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> (Coin -> Identity Coin) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Coin -> Identity Coin) -> TxBody ConwayEra -> Identity (TxBody ConwayEra) forall era. EraTxBody era => Lens' (TxBody era) Coin Lens' (TxBody ConwayEra) Coin feeTxBodyL ((Coin -> Identity Coin) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> Coin -> Tx ConwayEra -> Tx ConwayEra forall s t a b. ASetter s t a b -> b -> s -> t .~ Integer -> Coin Coin Integer 178349 Tx ConwayEra -> (Tx ConwayEra -> Tx ConwayEra) -> Tx ConwayEra forall a b. a -> (a -> b) -> b & (TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall era. EraTx era => Lens' (Tx era) (TxBody era) Lens' (Tx ConwayEra) (TxBody ConwayEra) bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> ((StrictSeq (TxOut ConwayEra) -> Identity (StrictSeq (TxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> (StrictSeq (TxOut ConwayEra) -> Identity (StrictSeq (TxOut ConwayEra))) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall b c a. (b -> c) -> (a -> b) -> a -> c . (StrictSeq (TxOut ConwayEra) -> Identity (StrictSeq (TxOut ConwayEra))) -> TxBody ConwayEra -> Identity (TxBody ConwayEra) forall era. EraTxBody era => Lens' (TxBody era) (StrictSeq (TxOut era)) Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra)) outputsTxBodyL ((StrictSeq (TxOut ConwayEra) -> Identity (StrictSeq (TxOut ConwayEra))) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> (StrictSeq (TxOut ConwayEra) -> StrictSeq (TxOut ConwayEra)) -> Tx ConwayEra -> Tx ConwayEra forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ StrictSeq (TxOut ConwayEra) -> StrictSeq (TxOut ConwayEra) modifyRootTxOut Tx ConwayEra -> (Tx ConwayEra -> Tx ConwayEra) -> Tx ConwayEra forall a b. a -> (a -> b) -> b & (TxWits ConwayEra -> Identity (TxWits ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall era. EraTx era => Lens' (Tx era) (TxWits era) Lens' (Tx ConwayEra) (TxWits ConwayEra) witsTxL ((TxWits ConwayEra -> Identity (TxWits ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness))) -> TxWits ConwayEra -> Identity (TxWits ConwayEra)) -> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness))) -> Tx ConwayEra -> Identity (Tx ConwayEra) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness))) -> TxWits ConwayEra -> Identity (TxWits ConwayEra) forall era. EraTxWits era => Lens' (TxWits era) (Set (WitVKey 'Witness)) Lens' (TxWits ConwayEra) (Set (WitVKey 'Witness)) addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness))) -> Tx ConwayEra -> Identity (Tx ConwayEra)) -> Set (WitVKey 'Witness) -> Tx ConwayEra -> Tx ConwayEra forall s t a b. ASetter s t a b -> b -> s -> t .~ Set (WitVKey 'Witness) forall a. Monoid a => a mempty Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra) res <- String -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) forall a t. NFData a => String -> ImpM t a -> ImpM t a impAnn String "Consume the script locked output" (ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra))) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) forall a b. (a -> b) -> a -> b $ (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra)) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) forall era a. (Tx era -> ImpTestM era (Tx era)) -> ImpTestM era a -> ImpTestM era a withPostFixup (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra) Tx ConwayEra -> ImpM (LedgerSpec ConwayEra) (AlonzoTx ConwayEra) forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> ImpTestM era (Tx era) updateAddrTxWits (Tx ConwayEra -> ImpM (LedgerSpec ConwayEra) (AlonzoTx ConwayEra)) -> (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra)) -> Tx ConwayEra -> ImpM (LedgerSpec ConwayEra) (AlonzoTx ConwayEra) forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra) breakCollaterals) (ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra))) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) -> ImpM (LedgerSpec ConwayEra) (Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra)) forall a b. (a -> b) -> a -> b $ do forall era. (ShelleyEraImp era, HasCallStack) => Tx era -> ImpTestM era (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era) (Tx era)) trySubmitTx @ConwayEra (Tx ConwayEra -> ImpTestM ConwayEra (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" ConwayEra)), Tx ConwayEra) (Tx ConwayEra))) -> Tx ConwayEra -> ImpTestM ConwayEra (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" ConwayEra)), Tx ConwayEra) (Tx ConwayEra)) forall a b. (a -> b) -> a -> b $ TxBody ConwayEra -> Tx ConwayEra forall era. EraTx era => TxBody era -> Tx era mkBasicTx TxBody ConwayEra forall era. EraTxBody era => TxBody era mkBasicTxBody Tx ConwayEra -> (Tx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra forall a b. a -> (a -> b) -> b & (TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (Tx ConwayEra) (TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra) forall era. EraTx era => Lens' (Tx era) (TxBody era) Lens' (Tx ConwayEra) (TxBody ConwayEra) bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra)) -> ((Set TxIn -> Identity (Set TxIn)) -> TxBody ConwayEra -> Identity (TxBody ConwayEra)) -> (Set TxIn -> Identity (Set TxIn)) -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Set TxIn -> Identity (Set TxIn)) -> TxBody ConwayEra -> Identity (TxBody ConwayEra) forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn) Lens' (TxBody ConwayEra) (Set TxIn) inputsTxBodyL ((Set TxIn -> Identity (Set TxIn)) -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra)) -> Set TxIn -> Tx ConwayEra -> AlonzoTx ConwayEra forall s t a b. ASetter s t a b -> b -> s -> t .~ TxIn -> Set TxIn forall a. a -> Set a Set.singleton (TxId -> TxIx -> TxIn TxIn (Tx ConwayEra -> TxId forall era. EraTx era => Tx era -> TxId txIdTx Tx ConwayEra AlonzoTx ConwayEra lockedTx) (TxIx -> TxIn) -> TxIx -> TxIn forall a b. (a -> b) -> a -> b $ Word16 -> TxIx TxIx Word16 0) (NonEmpty (ConwayLedgerPredFailure ConwayEra) pFailure, AlonzoTx ConwayEra _) <- String -> ImpM (LedgerSpec ConwayEra) (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) -> ImpM (LedgerSpec ConwayEra) (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) forall a t. NFData a => String -> ImpM t a -> ImpM t a impAnn String "Expecting failure" (ImpM (LedgerSpec ConwayEra) (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) -> ImpM (LedgerSpec ConwayEra) (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra)) -> ImpM (LedgerSpec ConwayEra) (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) -> ImpM (LedgerSpec ConwayEra) (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) forall a b. (a -> b) -> a -> b $ Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra) -> ImpM (LedgerSpec ConwayEra) (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) forall b a (m :: * -> *). (HasCallStack, ToExpr b, NFData a, MonadIO m) => Either a b -> m a expectLeftDeepExpr Either (NonEmpty (ConwayLedgerPredFailure ConwayEra), AlonzoTx ConwayEra) (AlonzoTx ConwayEra) res let hasInsufficientCollateral :: ConwayLedgerPredFailure era -> Bool hasInsufficientCollateral (ConwayUtxowFailure (UtxoFailure (InsufficientCollateral DeltaCoin _ Coin _))) = Bool True hasInsufficientCollateral ConwayLedgerPredFailure era _ = Bool False String -> ImpM (LedgerSpec ConwayEra) () -> ImpM (LedgerSpec ConwayEra) () forall a t. NFData a => String -> ImpM t a -> ImpM t a impAnn String "Fails with InsufficientCollateral" (ImpM (LedgerSpec ConwayEra) () -> ImpM (LedgerSpec ConwayEra) ()) -> ImpM (LedgerSpec ConwayEra) () -> ImpM (LedgerSpec ConwayEra) () forall a b. (a -> b) -> a -> b $ NonEmpty (ConwayLedgerPredFailure ConwayEra) pFailure NonEmpty (ConwayLedgerPredFailure ConwayEra) -> (NonEmpty (ConwayLedgerPredFailure ConwayEra) -> Bool) -> ImpM (LedgerSpec ConwayEra) () forall (m :: * -> *) a. (HasCallStack, MonadIO m, ToExpr a) => a -> (a -> Bool) -> m () `shouldSatisfyExpr` (ConwayLedgerPredFailure ConwayEra -> Bool) -> NonEmpty (ConwayLedgerPredFailure ConwayEra) -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any ConwayLedgerPredFailure ConwayEra -> Bool forall {era} {era} {era}. (PredicateFailure (EraRule "UTXO" era) ~ ConwayUtxoPredFailure era, PredicateFailure (EraRule "UTXOW" era) ~ ConwayUtxowPredFailure era) => ConwayLedgerPredFailure era -> Bool hasInsufficientCollateral let encoding :: Encoding encoding = NonEmpty (ConwayLedgerPredFailure ConwayEra) -> Encoding forall a. EncCBOR a => a -> Encoding encCBOR NonEmpty (ConwayLedgerPredFailure ConwayEra) pFailure Version version <- Int -> ImpM (LedgerSpec ConwayEra) Version forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version mkVersion (Int 11 :: Int) let bs :: ByteString bs = Version -> Encoding -> ByteString forall a. EncCBOR a => Version -> a -> ByteString serialize Version version Encoding encoding decoded :: Either DecoderError (NonEmpty (ConwayLedgerPredFailure ConwayEra)) decoded = Version -> ByteString -> Either DecoderError (NonEmpty (ConwayLedgerPredFailure ConwayEra)) forall a. DecCBOR a => Version -> ByteString -> Either DecoderError a decodeFull Version version ByteString bs String -> ImpM (LedgerSpec ConwayEra) () -> ImpM (LedgerSpec ConwayEra) () forall a t. NFData a => String -> ImpM t a -> ImpM t a impAnn String "Expecting deserialization of predicate failure to succeed" (ImpM (LedgerSpec ConwayEra) () -> ImpM (LedgerSpec ConwayEra) ()) -> ImpM (LedgerSpec ConwayEra) () -> ImpM (LedgerSpec ConwayEra) () forall a b. (a -> b) -> a -> b $ Either DecoderError (NonEmpty (ConwayLedgerPredFailure ConwayEra)) decoded Either DecoderError (NonEmpty (ConwayLedgerPredFailure ConwayEra)) -> Either DecoderError (NonEmpty (ConwayLedgerPredFailure ConwayEra)) -> ImpM (LedgerSpec ConwayEra) () forall (m :: * -> *) a. (HasCallStack, MonadIO m, Show a, Eq a) => a -> a -> m () `shouldBe` NonEmpty (ConwayLedgerPredFailure ConwayEra) -> Either DecoderError (NonEmpty (ConwayLedgerPredFailure ConwayEra)) forall a b. b -> Either a b Right NonEmpty (ConwayLedgerPredFailure ConwayEra) pFailure