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

module Test.Cardano.Ledger.Conway.Imp.UtxoSpec (spec) where

import Cardano.Ledger.Address
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext (..))
import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..))
import Cardano.Ledger.Alonzo.Rules (AlonzoUtxosPredFailure (..))
import Cardano.Ledger.Alonzo.Scripts
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.PParams (ppMinFeeRefScriptCostPerByteL)
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Conway.TxInfo (ConwayContextError (..))
import Cardano.Ledger.Credential
import Cardano.Ledger.Plutus.Language (
  SLanguage (..),
  hashPlutusScript,
 )
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Scripts (
  pattern RequireSignature,
 )
import Cardano.Ledger.Shelley.UTxO (getShelleyMinFeeTxUtxo)
import Cardano.Ledger.State hiding (balance)
import Cardano.Ledger.Val
import qualified Data.List.NonEmpty as NE
import qualified Data.Sequence.Strict as SSeq
import Lens.Micro ((&), (.~), (^.))
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Core.Rational ((%!))
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsNoDatum, inputsOverlapsWithRefInputs)

spec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" BabbageUtxoPredFailure era
  , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" BabbageUtxoPredFailure era,
 InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era,
 Inject (ConwayContextError era) (ContextError era)) =>
SpecWith (ImpInit (LedgerSpec era))
spec = do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Certificates" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Reg/UnReg collect and refund correct amounts" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      UTxO era
utxoStart <- ImpTestM era (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
      Coin
accountDeposit <- Lens' (PParams era) Coin -> ImpTestM era Coin
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (Coin -> f Coin) -> PParams era -> f (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
      Coin
stakePoolDeposit <- Lens' (PParams era) Coin -> ImpTestM era Coin
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (Coin -> f Coin) -> PParams era -> f (PParams era)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL
      Coin
dRepDeposit <- Lens' (PParams era) Coin -> ImpTestM era Coin
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (Coin -> f Coin) -> PParams era -> f (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppDRepDepositL
      Credential 'Staking
cred0 <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash @'Staking
      Credential 'Staking
cred1 <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash @'Staking
      Credential 'Staking
cred2 <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash @'Staking
      Credential 'Staking
cred3 <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash @'Staking
      Credential 'Staking
cred4 <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash @'Staking
      KeyHash 'StakePool
poolId <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      PoolParams
poolParams <- KeyHash 'StakePool -> RewardAccount -> ImpTestM era PoolParams
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> RewardAccount -> ImpTestM era PoolParams
freshPoolParams KeyHash 'StakePool
poolId (Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet Credential 'Staking
cred0)
      Credential 'DRepRole
dRepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash @'DRepRole
      let delegatee :: Delegatee
delegatee = KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
poolId (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
dRepCred)
      StrictMaybe Anchor
anchor <- ImpM (LedgerSpec era) (StrictMaybe Anchor)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      Tx era
txRegister <-
        Tx era -> ImpTestM era (Tx era)
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
submitTx (Tx era -> ImpTestM era (Tx era))
-> Tx era -> ImpTestM era (Tx era)
forall a b. (a -> b) -> a -> b
$
          TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
            Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList
                [ PoolParams -> TxCert era
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
poolParams
                , Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
RegDRepTxCert Credential 'DRepRole
dRepCred Coin
dRepDeposit StrictMaybe Anchor
anchor
                , Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert Credential 'Staking
cred0 Delegatee
delegatee Coin
accountDeposit
                , Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
cred1
                , Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred2 Coin
accountDeposit
                , Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred3 Coin
accountDeposit
                , Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
cred2
                , Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred1 Coin
accountDeposit
                , Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred4 Coin
accountDeposit
                ]
      UTxO era
utxoAfterRegister <- ImpTestM era (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
      -- Overwrite deposit protocol parameters in order to ensure they does not affect refunds
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams
        ( \PParams era
pp ->
            PParams era
pp
              PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1
              PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
2
              PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppDRepDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
3
        )
      (UTxO era -> Value era
forall era. EraTxOut era => UTxO era -> Value era
sumUTxO UTxO era
utxoStart MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<-> UTxO era -> Value era
forall era. EraTxOut era => UTxO era -> Value era
sumUTxO UTxO era
utxoAfterRegister)
        MaryValue -> MaryValue -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin -> MaryValue
forall t s. Inject t s => t -> s
inject
          ( (Tx era
txRegister Tx era -> Getting Coin (Tx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const Coin (TxBody era))
-> Tx era -> Const Coin (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const Coin (TxBody era))
 -> Tx era -> Const Coin (Tx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody era -> Const Coin (TxBody era))
-> Getting Coin (Tx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin) -> TxBody era -> Const Coin (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL)
              Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> ((Int
3 :: Int) Int -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> Coin
accountDeposit) -- Only three accounts retained that are still registered
              Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
stakePoolDeposit
              Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
dRepDeposit
          )
      EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
      Tx era
txUnRegister <-
        Tx era -> ImpTestM era (Tx era)
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
submitTx (Tx era -> ImpTestM era (Tx era))
-> Tx era -> ImpTestM era (Tx era)
forall a b. (a -> b) -> a -> b
$
          TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
            Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList
                [ KeyHash 'StakePool -> EpochNo -> TxCert era
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolId (EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
curEpochNo)
                , Credential 'DRepRole -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
dRepCred Coin
dRepDeposit
                , Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
cred3
                , Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred4 Coin
accountDeposit
                ]
      UTxO era
utxoAfterUnRegister <- ImpTestM era (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
      let totalFees :: Coin
totalFees = (Tx era
txRegister Tx era -> Getting Coin (Tx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const Coin (TxBody era))
-> Tx era -> Const Coin (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const Coin (TxBody era))
 -> Tx era -> Const Coin (Tx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody era -> Const Coin (TxBody era))
-> Getting Coin (Tx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin) -> TxBody era -> Const Coin (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (Tx era
txUnRegister Tx era -> Getting Coin (Tx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const Coin (TxBody era))
-> Tx era -> Const Coin (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const Coin (TxBody era))
 -> Tx era -> Const Coin (Tx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody era -> Const Coin (TxBody era))
-> Getting Coin (Tx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin) -> TxBody era -> Const Coin (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL)
      Coin
fees <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin)
    -> LedgerState era -> Const r (LedgerState era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Const r (UTxOState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Const r (UTxOState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Coin -> Const r Coin)
    -> UTxOState era -> Const r (UTxOState era))
-> (Coin -> Const r Coin)
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> UTxOState era -> Const r (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosFeesL)
      Coin
totalFees Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
fees
      -- only deposits for stake pool and its account are not refunded at this point
      (UTxO era -> Value era
forall era. EraTxOut era => UTxO era -> Value era
sumUTxO UTxO era
utxoStart MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<-> UTxO era -> Value era
forall era. EraTxOut era => UTxO era -> Value era
sumUTxO UTxO era
utxoAfterUnRegister)
        MaryValue -> MaryValue -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (Coin
totalFees Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
stakePoolDeposit Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
accountDeposit)
      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      -- Check for successfull pool refund
      Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getBalance Credential 'Staking
cred0 ImpTestM era Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
stakePoolDeposit
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Reference scripts" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    let
      nativeScript :: ImpM (LedgerSpec era) (Timelock era)
nativeScript = forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature @era (KeyHash 'Witness -> Timelock era)
-> ImpM (LedgerSpec era) (KeyHash 'Witness)
-> ImpM (LedgerSpec era) (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Witness)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      checkMinFeeUsingRefScripts :: [AlonzoScript era] -> ImpM (LedgerSpec era) ()
checkMinFeeUsingRefScripts [AlonzoScript era]
refScripts = do
        (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((NonNegativeInterval -> Identity NonNegativeInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL ((NonNegativeInterval -> Identity NonNegativeInterval)
 -> PParams era -> Identity (PParams era))
-> NonNegativeInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Integer
10 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1))
        TxIn
scriptTxIn <- ImpM (LedgerSpec era) (Timelock era)
nativeScript ImpM (LedgerSpec era) (Timelock era)
-> (Timelock era -> ImpM (LedgerSpec era) ScriptHash)
-> ImpM (LedgerSpec era) ScriptHash
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Timelock era -> ImpM (LedgerSpec era) ScriptHash
NativeScript era -> ImpM (LedgerSpec era) ScriptHash
forall era.
EraScript era =>
NativeScript era -> ImpTestM era ScriptHash
impAddNativeScript ImpM (LedgerSpec era) ScriptHash
-> (ScriptHash -> ImpM (LedgerSpec era) TxIn)
-> ImpM (LedgerSpec era) TxIn
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScriptHash -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript
        NonEmpty TxIn
refIns <- NonEmpty (Script era) -> ImpTestM era (NonEmpty TxIn)
forall era.
(ShelleyEraImp era, BabbageEraTxOut era) =>
NonEmpty (Script era) -> ImpTestM era (NonEmpty TxIn)
produceRefScripts ([AlonzoScript era] -> NonEmpty (AlonzoScript era)
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [AlonzoScript era]
refScripts)
        Tx era
tx <- TxIn -> NonEmpty TxIn -> ImpTestM era (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> ImpTestM era (Tx era)
submitTxWithRefInputs TxIn
scriptTxIn NonEmpty TxIn
refIns
        Coin
minFeeDiff <- do
          UTxO era
utxo <- ImpTestM era (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
          PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
          Coin -> ImpTestM era Coin
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Coin -> ImpTestM era Coin) -> Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ PParams era -> Tx era -> UTxO era -> Coin
forall era.
EraUTxO era =>
PParams era -> Tx era -> UTxO era -> Coin
getMinFeeTxUtxo PParams era
pp Tx era
tx UTxO era
utxo Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> PParams era -> Tx era -> Coin
forall era. EraTx era => PParams era -> Tx era -> Coin
getShelleyMinFeeTxUtxo PParams era
pp Tx era
tx
        NonNegativeInterval
refScriptFee <- Lens' (PParams era) NonNegativeInterval
-> ImpTestM era NonNegativeInterval
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (NonNegativeInterval -> f NonNegativeInterval)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL
        -- we check that the difference between conway and shelleyMinFee computation is exactly
        -- the size of the sizes of the reference scripts
        Coin
minFeeDiff
          Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Integer -> Coin
Coin
            ( Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$
                forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Rational ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ AlonzoScript era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize (AlonzoScript era -> Int) -> [AlonzoScript era] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AlonzoScript era]
refScripts)
                  Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational NonNegativeInterval
refScriptFee
            )
      distinctScripts :: ImpM (LedgerSpec era) [AlonzoScript era]
distinctScripts = do
        [AlonzoScript era]
nativeScripts <- Int
-> ImpM (LedgerSpec era) (AlonzoScript era)
-> ImpM (LedgerSpec era) [AlonzoScript era]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (Timelock era -> AlonzoScript era
NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (Timelock era -> AlonzoScript era)
-> ImpM (LedgerSpec era) (Timelock era)
-> ImpM (LedgerSpec era) (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (Timelock era)
nativeScript)
        Just PlutusScript era
plutusScriptV2 <- Maybe (PlutusScript era)
-> ImpM (LedgerSpec era) (Maybe (PlutusScript era))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PlutusScript era)
 -> ImpM (LedgerSpec era) (Maybe (PlutusScript era)))
-> Maybe (PlutusScript era)
-> ImpM (LedgerSpec era) (Maybe (PlutusScript era))
forall a b. (a -> b) -> a -> b
$ forall era (l :: Language) (m :: * -> *).
(AlonzoEraScript era, PlutusLanguage l, MonadFail m) =>
Plutus l -> m (PlutusScript era)
mkPlutusScript @era (Plutus 'PlutusV2 -> Maybe (PlutusScript era))
-> Plutus 'PlutusV2 -> Maybe (PlutusScript era)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV2 -> Plutus 'PlutusV2
forall (l :: Language). SLanguage l -> Plutus l
alwaysSucceedsNoDatum SLanguage 'PlutusV2
SPlutusV2
        Just PlutusScript era
plutusScriptV3 <- Maybe (PlutusScript era)
-> ImpM (LedgerSpec era) (Maybe (PlutusScript era))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PlutusScript era)
 -> ImpM (LedgerSpec era) (Maybe (PlutusScript era)))
-> Maybe (PlutusScript era)
-> ImpM (LedgerSpec era) (Maybe (PlutusScript era))
forall a b. (a -> b) -> a -> b
$ forall era (l :: Language) (m :: * -> *).
(AlonzoEraScript era, PlutusLanguage l, MonadFail m) =>
Plutus l -> m (PlutusScript era)
mkPlutusScript @era (Plutus 'PlutusV3 -> Maybe (PlutusScript era))
-> Plutus 'PlutusV3 -> Maybe (PlutusScript era)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV3 -> Plutus 'PlutusV3
forall (l :: Language). SLanguage l -> Plutus l
alwaysSucceedsNoDatum SLanguage 'PlutusV3
SPlutusV3
        [AlonzoScript era] -> ImpM (LedgerSpec era) [AlonzoScript era]
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AlonzoScript era] -> ImpM (LedgerSpec era) [AlonzoScript era])
-> [AlonzoScript era] -> ImpM (LedgerSpec era) [AlonzoScript era]
forall a b. (a -> b) -> a -> b
$ [AlonzoScript era]
nativeScripts [AlonzoScript era] -> [AlonzoScript era] -> [AlonzoScript era]
forall a. [a] -> [a] -> [a]
++ [PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript PlutusScript era
plutusScriptV2, PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript PlutusScript era
plutusScriptV3]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"required reference script counts towards the minFee calculation" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Timelock era
spendingScript <- ImpM (LedgerSpec era) (Timelock era)
nativeScript
      [AlonzoScript era] -> ImpM (LedgerSpec era) ()
checkMinFeeUsingRefScripts [NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript Timelock era
NativeScript era
spendingScript]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"reference scripts not required for spending the input count towards the minFee calculation" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Timelock era
spendingScript <- ImpM (LedgerSpec era) (Timelock era)
nativeScript
      [AlonzoScript era]
extraScripts <- ImpM (LedgerSpec era) [AlonzoScript era]
distinctScripts
      [AlonzoScript era] -> ImpM (LedgerSpec era) ()
checkMinFeeUsingRefScripts ([AlonzoScript era] -> ImpM (LedgerSpec era) ())
-> [AlonzoScript era] -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript Timelock era
NativeScript era
spendingScript AlonzoScript era -> [AlonzoScript era] -> [AlonzoScript era]
forall a. a -> [a] -> [a]
: [AlonzoScript era]
extraScripts

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a scripts referenced several times counts for each reference towards the minFee calculation" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Timelock era
spendingScript <- ImpM (LedgerSpec era) (Timelock era)
nativeScript
      [AlonzoScript era]
extraScripts <- ImpM (LedgerSpec era) [AlonzoScript era]
distinctScripts
      [AlonzoScript era] -> ImpM (LedgerSpec era) ()
checkMinFeeUsingRefScripts ([AlonzoScript era] -> ImpM (LedgerSpec era) ())
-> [AlonzoScript era] -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        [NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript Timelock era
NativeScript era
spendingScript, NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript Timelock era
NativeScript era
spendingScript]
          [AlonzoScript era] -> [AlonzoScript era] -> [AlonzoScript era]
forall a. [a] -> [a] -> [a]
++ [AlonzoScript era]
extraScripts
          [AlonzoScript era] -> [AlonzoScript era] -> [AlonzoScript era]
forall a. [a] -> [a] -> [a]
++ [AlonzoScript era]
extraScripts

    let scriptHash :: SLanguage l -> ScriptHash
scriptHash SLanguage l
lang = Plutus l -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript (Plutus l -> ScriptHash) -> Plutus l -> ScriptHash
forall a b. (a -> b) -> a -> b
$ SLanguage l -> Plutus l
forall (l :: Language). SLanguage l -> Plutus l
inputsOverlapsWithRefInputs SLanguage l
lang
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Cannot run scripts that expect inputs and refInputs to overlap (PV 9/10)" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      forall (v :: Natural) era.
(EraGov era, KnownNat v, MinVersion <= v, v <= MaxVersion) =>
ImpTestM era () -> ImpTestM era ()
whenMajorVersionAtMost @10 (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        TxIn
txIn <- ScriptHash -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript (ScriptHash -> ImpM (LedgerSpec era) TxIn)
-> ScriptHash -> ImpM (LedgerSpec era) TxIn
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV3 -> ScriptHash
forall {l :: Language}.
PlutusLanguage l =>
SLanguage l -> ScriptHash
scriptHash SLanguage 'PlutusV3
SPlutusV3
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx @era
          (TxIn -> NonEmpty TxIn -> Tx era
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> Tx era
mkTxWithRefInputs TxIn
txIn ([TxIn] -> NonEmpty TxIn
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Item [TxIn]
TxIn
txIn]))
          [ BabbageUtxoPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (BabbageUtxoPredFailure era -> EraRuleFailure "LEDGER" era)
-> BabbageUtxoPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ NonEmpty TxIn -> BabbageUtxoPredFailure era
forall era. NonEmpty TxIn -> BabbageUtxoPredFailure era
BabbageNonDisjointRefInputs [Item (NonEmpty TxIn)
TxIn
txIn]
          ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Same script cannot appear in regular and reference inputs in PlutusV3 (PV 11)" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ forall (v :: Natural) era.
(EraGov era, KnownNat v, MinVersion <= v, v <= MaxVersion) =>
ImpTestM era () -> ImpTestM era ()
whenMajorVersionAtLeast @11 (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      TxIn
txIn <- ScriptHash -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript (ScriptHash -> ImpM (LedgerSpec era) TxIn)
-> ScriptHash -> ImpM (LedgerSpec era) TxIn
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV3 -> ScriptHash
forall {l :: Language}.
PlutusLanguage l =>
SLanguage l -> ScriptHash
scriptHash SLanguage 'PlutusV3
SPlutusV3
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx @era
        (TxIn -> NonEmpty TxIn -> Tx era
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> Tx era
mkTxWithRefInputs TxIn
txIn ([TxIn] -> NonEmpty TxIn
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Item [TxIn]
TxIn
txIn]))
        [ AlonzoUtxosPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (AlonzoUtxosPredFailure era -> EraRuleFailure "LEDGER" era)
-> AlonzoUtxosPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
            [CollectError era] -> AlonzoUtxosPredFailure era
forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors [ContextError era -> Item [CollectError era]
ContextError era -> CollectError era
forall era. ContextError era -> CollectError era
BadTranslation (ContextError era -> Item [CollectError era])
-> (ConwayContextError era -> ContextError era)
-> ConwayContextError era
-> Item [CollectError era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> Item [CollectError era])
-> ConwayContextError era -> Item [CollectError era]
forall a b. (a -> b) -> a -> b
$ forall era. NonEmpty TxIn -> ConwayContextError era
ReferenceInputsNotDisjointFromInputs @era [Item (NonEmpty TxIn)
TxIn
txIn]]
        ]