{-# 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,
  conwayEraSpecificSpec,
) where

import Cardano.Ledger.Address
import Cardano.Ledger.Alonzo.Scripts
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.Credential
import Cardano.Ledger.Plutus.Language (SLanguage (..))
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Scripts (
  pattern RequireSignature,
 )
import Cardano.Ledger.Shelley.UTxO (getShelleyMinFeeTxUtxo)
import Cardano.Ledger.State
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)

spec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spec :: forall era. ConwayEraImp 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
      utxoStart <- ImpTestM era (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
      accountDeposit <- getsPParams ppKeyDepositL
      stakePoolDeposit <- getsPParams ppPoolDepositL
      dRepDeposit <- getsPParams ppDRepDepositL
      cred0 <- KeyHashObj <$> freshKeyHash @Staking
      cred1 <- KeyHashObj <$> freshKeyHash @Staking
      cred2 <- KeyHashObj <$> freshKeyHash @Staking
      cred3 <- KeyHashObj <$> freshKeyHash @Staking
      cred4 <- KeyHashObj <$> freshKeyHash @Staking
      poolId <- freshKeyHash
      poolParams <- freshPoolParams poolId (RewardAccount Testnet cred0)
      dRepCred <- KeyHashObj <$> freshKeyHash @DRepRole
      let delegatee = KeyHash StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash StakePool
poolId (Credential DRepRole -> DRep
DRepCredential Credential DRepRole
dRepCred)
      anchor <- arbitrary
      txRegister <-
        submitTx $
          mkBasicTx mkBasicTxBody
            & bodyTxL . certsTxBodyL
              .~ SSeq.fromList
                [ RegPoolTxCert poolParams
                , RegDRepTxCert dRepCred dRepDeposit anchor
                , RegDepositDelegTxCert cred0 delegatee accountDeposit
                , RegDepositTxCert cred1 accountDeposit
                , RegDepositTxCert cred2 accountDeposit
                , RegDepositTxCert cred3 accountDeposit
                , UnRegDepositTxCert cred1 accountDeposit
                , UnRegDepositTxCert cred2 accountDeposit
                , RegDepositTxCert cred4 accountDeposit
                ]
      utxoAfterRegister <- getUTxO
      -- Overwrite deposit protocol parameters in order to ensure they does not affect refunds
      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
        )
      (sumUTxO utxoStart <-> sumUTxO utxoAfterRegister)
        `shouldBe` inject
          ( (txRegister ^. bodyTxL . feeTxBodyL)
              <+> ((3 :: Int) <×> accountDeposit) -- Only three accounts retained that are still registered
              <+> stakePoolDeposit
              <+> dRepDeposit
          )
      curEpochNo <- getsNES nesELL
      txUnRegister <-
        submitTx $
          mkBasicTx mkBasicTxBody
            & bodyTxL . certsTxBodyL
              .~ SSeq.fromList
                [ RetirePoolTxCert poolId (succ curEpochNo)
                , UnRegDRepTxCert dRepCred dRepDeposit
                , UnRegDepositTxCert cred3 accountDeposit
                , UnRegDepositTxCert cred4 accountDeposit
                ]
      utxoAfterUnRegister <- getUTxO
      let totalFees = (Tx TopTx era
txRegister Tx TopTx era -> Getting Coin (Tx TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Tx TopTx era -> Const Coin (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Coin (TxBody TopTx era))
 -> Tx TopTx era -> Const Coin (Tx TopTx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Getting Coin (Tx TopTx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx era -> Const Coin (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (Tx TopTx era
txUnRegister Tx TopTx era -> Getting Coin (Tx TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Tx TopTx era -> Const Coin (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Coin (TxBody TopTx era))
 -> Tx TopTx era -> Const Coin (Tx TopTx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Getting Coin (Tx TopTx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx era -> Const Coin (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL)
      fees <- getsNES (nesEsL . esLStateL . lsUTxOStateL . utxosFeesL)
      totalFees `shouldBe` fees
      -- only deposits for stake pool and its account are not refunded at this point
      (sumUTxO utxoStart <-> sumUTxO utxoAfterUnRegister)
        `shouldBe` inject (totalFees <+> stakePoolDeposit <+> accountDeposit)
      passEpoch
      -- Check for successfull pool refund
      getBalance cred0 `shouldReturn` 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) (NativeScript era)
nativeScript = forall era.
ShelleyEraScript era =>
KeyHash Witness -> NativeScript era
RequireSignature @era (KeyHash Witness -> NativeScript era)
-> ImpM (LedgerSpec era) (KeyHash Witness)
-> ImpM (LedgerSpec era) (NativeScript 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))
        scriptTxIn <- ImpM (LedgerSpec era) (NativeScript era)
nativeScript ImpM (LedgerSpec era) (NativeScript era)
-> (NativeScript 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
>>= 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
        refIns <- produceRefScripts (NE.fromList refScripts)
        tx <- submitTxWithRefInputs scriptTxIn refIns
        minFeeDiff <- do
          utxo <- getUTxO
          pp <- getsNES $ nesEsL . curPParamsEpochStateL
          pure $ getMinFeeTxUtxo pp tx utxo <-> getShelleyMinFeeTxUtxo pp tx
        refScriptFee <- getsPParams ppMinFeeRefScriptCostPerByteL
        -- we check that the difference between conway and shelleyMinFee computation is exactly
        -- the size of the sizes of the reference scripts
        minFeeDiff
          `shouldBe` Coin
            ( floor $
                fromIntegral @Int @Rational (sum $ originalBytesSize <$> refScripts)
                  * unboundRational refScriptFee
            )
      distinctScripts :: ImpM (LedgerSpec era) [AlonzoScript era]
distinctScripts = do
        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 (NativeScript era -> Script era
NativeScript era -> AlonzoScript era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript era -> AlonzoScript era)
-> ImpM (LedgerSpec era) (NativeScript era)
-> ImpM (LedgerSpec era) (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (NativeScript era)
nativeScript)
        Just plutusScriptV2 <- pure $ mkPlutusScript @era $ alwaysSucceedsNoDatum SPlutusV2
        Just plutusScriptV3 <- pure $ mkPlutusScript @era $ alwaysSucceedsNoDatum SPlutusV3
        pure $ nativeScripts ++ [fromPlutusScript plutusScriptV2, fromPlutusScript 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
      spendingScript <- ImpM (LedgerSpec era) (NativeScript era)
nativeScript
      checkMinFeeUsingRefScripts [fromNativeScript 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
      spendingScript <- ImpM (LedgerSpec era) (NativeScript era)
nativeScript
      extraScripts <- distinctScripts
      checkMinFeeUsingRefScripts $ fromNativeScript spendingScript : 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
      spendingScript <- ImpM (LedgerSpec era) (NativeScript era)
nativeScript
      extraScripts <- distinctScripts
      checkMinFeeUsingRefScripts $
        [fromNativeScript spendingScript, fromNativeScript spendingScript]
          ++ extraScripts
          ++ extraScripts

conwayEraSpecificSpec ::
  forall era.
  ( ConwayEraImp era
  , ShelleyEraTxCert era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
conwayEraSpecificSpec :: forall era.
(ConwayEraImp era, ShelleyEraTxCert era) =>
SpecWith (ImpInit (LedgerSpec era))
conwayEraSpecificSpec = 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
      utxoStart <- ImpTestM era (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
      accountDeposit <- getsPParams ppKeyDepositL
      stakePoolDeposit <- getsPParams ppPoolDepositL
      dRepDeposit <- getsPParams ppDRepDepositL
      cred0 <- KeyHashObj <$> freshKeyHash @Staking
      cred1 <- KeyHashObj <$> freshKeyHash @Staking
      cred2 <- KeyHashObj <$> freshKeyHash @Staking
      cred3 <- KeyHashObj <$> freshKeyHash @Staking
      cred4 <- KeyHashObj <$> freshKeyHash @Staking
      poolId <- freshKeyHash
      poolParams <- freshPoolParams poolId (RewardAccount Testnet cred0)
      dRepCred <- KeyHashObj <$> freshKeyHash @DRepRole
      let delegatee = KeyHash StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash StakePool
poolId (Credential DRepRole -> DRep
DRepCredential Credential DRepRole
dRepCred)
      anchor <- arbitrary
      txRegister <-
        submitTx $
          mkBasicTx mkBasicTxBody
            & bodyTxL . certsTxBodyL
              .~ SSeq.fromList
                [ RegPoolTxCert poolParams
                , RegDRepTxCert dRepCred dRepDeposit anchor
                , RegDepositDelegTxCert cred0 delegatee accountDeposit
                , RegTxCert cred1
                , RegDepositTxCert cred2 accountDeposit
                , RegDepositTxCert cred3 accountDeposit
                , UnRegTxCert cred2
                , UnRegDepositTxCert cred1 accountDeposit
                , RegDepositTxCert cred4 accountDeposit
                ]
      utxoAfterRegister <- getUTxO
      -- Overwrite deposit protocol parameters in order to ensure they does not affect refunds
      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
        )
      (sumUTxO utxoStart <-> sumUTxO utxoAfterRegister)
        `shouldBe` inject
          ( (txRegister ^. bodyTxL . feeTxBodyL)
              <+> ((3 :: Int) <×> accountDeposit) -- Only three accounts retained that are still registered
              <+> stakePoolDeposit
              <+> dRepDeposit
          )
      curEpochNo <- getsNES nesELL
      txUnRegister <-
        submitTx $
          mkBasicTx mkBasicTxBody
            & bodyTxL . certsTxBodyL
              .~ SSeq.fromList
                [ RetirePoolTxCert poolId (succ curEpochNo)
                , UnRegDRepTxCert dRepCred dRepDeposit
                , UnRegTxCert cred3
                , UnRegDepositTxCert cred4 accountDeposit
                ]
      utxoAfterUnRegister <- getUTxO
      let totalFees = (Tx TopTx era
txRegister Tx TopTx era -> Getting Coin (Tx TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Tx TopTx era -> Const Coin (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Coin (TxBody TopTx era))
 -> Tx TopTx era -> Const Coin (Tx TopTx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Getting Coin (Tx TopTx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx era -> Const Coin (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (Tx TopTx era
txUnRegister Tx TopTx era -> Getting Coin (Tx TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Tx TopTx era -> Const Coin (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Coin (TxBody TopTx era))
 -> Tx TopTx era -> Const Coin (Tx TopTx era))
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx era -> Const Coin (TxBody TopTx era))
-> Getting Coin (Tx TopTx era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx era -> Const Coin (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL)
      fees <- getsNES (nesEsL . esLStateL . lsUTxOStateL . utxosFeesL)
      totalFees `shouldBe` fees
      -- only deposits for stake pool and its account are not refunded at this point
      (sumUTxO utxoStart <-> sumUTxO utxoAfterUnRegister)
        `shouldBe` inject (totalFees <+> stakePoolDeposit <+> accountDeposit)
      passEpoch
      -- Check for successfull pool refund
      getBalance cred0 `shouldReturn` stakePoolDeposit