{-# 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_
        Tx 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 (BabbageTxOut ConwayEra)
     -> Identity (StrictSeq (BabbageTxOut ConwayEra)))
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (StrictSeq (BabbageTxOut ConwayEra)
    -> Identity (StrictSeq (BabbageTxOut 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)
(StrictSeq (BabbageTxOut ConwayEra)
 -> Identity (StrictSeq (BabbageTxOut ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL
                ((StrictSeq (BabbageTxOut ConwayEra)
  -> Identity (StrictSeq (BabbageTxOut ConwayEra)))
 -> Tx ConwayEra -> Identity (Tx ConwayEra))
-> StrictSeq (BabbageTxOut ConwayEra)
-> Tx ConwayEra
-> Tx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [BabbageTxOut ConwayEra] -> StrictSeq (BabbageTxOut 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
MaryValue
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
MaryValue
forall a. Monoid a => a
mempty
                  ]
              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 (BabbageTxOut ConwayEra)
     -> Identity (StrictMaybe (BabbageTxOut ConwayEra)))
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (StrictMaybe (BabbageTxOut ConwayEra)
    -> Identity (StrictMaybe (BabbageTxOut 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)
(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 (Tx ConwayEra))
-> StrictMaybe (BabbageTxOut ConwayEra)
-> Tx ConwayEra
-> Tx 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 (BabbageTxOut ConwayEra)
     -> Identity (StrictMaybe (BabbageTxOut ConwayEra)))
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (StrictMaybe (BabbageTxOut ConwayEra)
    -> Identity (StrictMaybe (BabbageTxOut 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)
(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 (Tx ConwayEra))
-> StrictMaybe (BabbageTxOut ConwayEra)
-> Tx ConwayEra
-> Tx 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
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)
(AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ConwayEra) (TxWits ConwayEra)
witsTxL ((AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
 -> Tx ConwayEra -> Identity (Tx ConwayEra))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits 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)
(Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits 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), Tx ConwayEra)
  (Tx ConwayEra)
res <-
          String
-> ImpM
     (LedgerSpec ConwayEra)
     (Either
        (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
        (Tx ConwayEra))
-> ImpM
     (LedgerSpec ConwayEra)
     (Either
        (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
        (Tx 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), Tx ConwayEra)
      (Tx ConwayEra))
 -> ImpM
      (LedgerSpec ConwayEra)
      (Either
         (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
         (Tx ConwayEra)))
-> ImpM
     (LedgerSpec ConwayEra)
     (Either
        (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
        (Tx ConwayEra))
-> ImpM
     (LedgerSpec ConwayEra)
     (Either
        (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
        (Tx ConwayEra))
forall a b. (a -> b) -> a -> b
$
            (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra))
-> ImpM
     (LedgerSpec ConwayEra)
     (Either
        (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
        (Tx ConwayEra))
-> ImpM
     (LedgerSpec ConwayEra)
     (Either
        (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
        (Tx ConwayEra))
forall era a.
(Tx era -> ImpTestM era (Tx era))
-> ImpTestM era a -> ImpTestM era a
withPostFixup (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra)
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
updateAddrTxWits (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra))
-> (Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra))
-> Tx ConwayEra
-> ImpTestM ConwayEra (Tx 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), Tx ConwayEra)
      (Tx ConwayEra))
 -> ImpM
      (LedgerSpec ConwayEra)
      (Either
         (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
         (Tx ConwayEra)))
-> ImpM
     (LedgerSpec ConwayEra)
     (Either
        (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
        (Tx ConwayEra))
-> ImpM
     (LedgerSpec ConwayEra)
     (Either
        (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
        (Tx 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 -> 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))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx ConwayEra
-> Identity (Tx 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 (Tx ConwayEra))
-> Set TxIn -> Tx ConwayEra -> Tx 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
lockedTx) (TxIx -> TxIn) -> TxIx -> TxIn
forall a b. (a -> b) -> a -> b
$ Word16 -> TxIx
TxIx Word16
0)
        (NonEmpty (ConwayLedgerPredFailure ConwayEra)
pFailure, Tx ConwayEra
_) <- String
-> ImpM
     (LedgerSpec ConwayEra)
     (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
-> ImpM
     (LedgerSpec ConwayEra)
     (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Expecting failure" (ImpM
   (LedgerSpec ConwayEra)
   (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
 -> ImpM
      (LedgerSpec ConwayEra)
      (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra))
-> ImpM
     (LedgerSpec ConwayEra)
     (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
-> ImpM
     (LedgerSpec ConwayEra)
     (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
forall a b. (a -> b) -> a -> b
$ Either
  (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
  (Tx ConwayEra)
-> ImpM
     (LedgerSpec ConwayEra)
     (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
forall b a (m :: * -> *).
(HasCallStack, ToExpr b, NFData a, MonadIO m) =>
Either a b -> m a
expectLeftDeepExpr Either
  (NonEmpty (ConwayLedgerPredFailure ConwayEra), Tx ConwayEra)
  (Tx 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