{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Dijkstra.Imp.EntitiesSpec (spec) where

import Cardano.Base.Typeable (Typeable)
import Cardano.Ledger.Address
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Rules (
  EntitiesPredFailure (..),
  SubEntitiesPredFailure (..),
 )
import Cardano.Ledger.Dijkstra.Scripts (AccountBalanceInterval (..), AccountBalanceIntervals (..))
import Cardano.Ledger.Val (Val (..))
import qualified Data.Map.NonEmpty as NEM
import Data.Maybe (fromJust)
import qualified Data.OMap.Strict as OMap
import qualified Data.Set.NonEmpty as NES
import Lens.Micro
import Test.Cardano.Ledger.Dijkstra.ImpTest
import Test.Cardano.Ledger.Imp.Common

spec :: forall era. DijkstraEraImp era => SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
DijkstraEraImp era =>
SpecWith (ImpInit (LedgerSpec era))
spec = String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ENTITIES" (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
"Batch with successful withdrawals and direct deposits" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
    (acc1, balance1, kh1) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
    (acc2, balance2, kh2) <- setupAccountAddress
    (acc3, balance3, kh3) <- setupAccountAddress

    let depositAmount = Integer -> Coin
Coin Integer
50
        partialWithdrawal = Coin
balance3 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
10
        subDeposit =
          TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
            TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (DirectDeposits -> Identity DirectDeposits)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> DirectDeposits -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> DirectDeposits
DirectDeposits [(AccountAddress
acc1, Coin
depositAmount)]
        subWithdraw =
          TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
            TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> Withdrawals -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
acc2, Coin
balance2)]
        topTx =
          TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
            TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Withdrawals -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
acc3, Coin
partialWithdrawal)]
              TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OMap TxId (Tx SubTx era))
Tx SubTx era
subDeposit, Item (OMap TxId (Tx SubTx era))
Tx SubTx era
subWithdraw]
    submitTx_ topTx

    finalBalance1 <- getBalance (KeyHashObj kh1)
    finalBalance2 <- getBalance (KeyHashObj kh2)
    finalBalanceD <- getBalance (KeyHashObj kh3)

    finalBalance1 `shouldBe` balance1 <+> depositAmount
    finalBalance2 `shouldBe` mempty
    finalBalanceD `shouldBe` (balance3 <-> partialWithdrawal)

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Partial withdrawals" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2

    (account1, balance1, kh1) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
    (account2, balance2, kh2) <- setupAccountAddress
    lessThanBalance1 <- Coin <$> choose (1, unCoin balance1 - 1)
    atMostBalance2 <- Coin <$> choose (1, unCoin balance2)
    let tx =
          Withdrawals -> [Withdrawals] -> Tx TopTx era
mkTxWithBatchWithdrawals
            (Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account1, Coin
lessThanBalance1)])
            [Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account2, Coin
atMostBalance2)]]
    submitTx_ tx
    getBalance (KeyHashObj kh1) `shouldReturn` (balance1 <-> lessThanBalance1)
    getBalance (KeyHashObj kh2) `shouldReturn` (balance2 <-> atMostBalance2)

    -- restore balances, to test legacy mode
    submitTx_ $
      mkBasicTx $
        mkBasicTxBody
          & directDepositsTxBodyL .~ DirectDeposits [(account1, lessThanBalance1), (account2, atMostBalance2)]
    legacyTx <- switchTxToLegacyMode tx
    submitFailingTx
      legacyTx
      [ injectFailure . WithdrawalAmountsInexactInLegacyMode @era $
          NEM.singleton account1 $
            Mismatch lessThanBalance1 balance1
      ]

    -- drain top withdrawal
    submitTx_
      =<< switchTxToLegacyMode
        ( mkTxWithBatchWithdrawals
            (Withdrawals [(account1, balance1)])
            [Withdrawals [(account2, atMostBalance2)]]
        )
    getBalance (KeyHashObj kh1) `shouldReturn` zero
    getBalance (KeyHashObj kh2) `shouldReturn` (balance2 <-> atMostBalance2)

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Withdrawals from an unregistered staking address" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2

    account1 <- ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash Staking)
-> (KeyHash Staking -> ImpM (LedgerSpec era) AccountAddress)
-> ImpM (LedgerSpec era) AccountAddress
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
>>= Credential Staking -> ImpM (LedgerSpec era) AccountAddress
forall era. Credential Staking -> ImpTestM era AccountAddress
getAccountAddressFor (Credential Staking -> ImpM (LedgerSpec era) AccountAddress)
-> (KeyHash Staking -> Credential Staking)
-> KeyHash Staking
-> ImpM (LedgerSpec era) AccountAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
    account2 <- freshKeyHash >>= getAccountAddressFor . KeyHashObj
    amountX <- Coin . getPositive <$> arbitrary
    let
      txBody :: forall l. Typeable l => TxBody l era
      txBody =
        TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
          TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody l era -> Identity (TxBody l era))
-> Withdrawals -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account1, Coin
amountX), (AccountAddress
account2, Coin
forall t. Val t => t
zero)]
    submitFailingTx
      (mkBasicTx txBody)
      [ injectFailure . WithdrawalAccountsMissingFromOriginal @era $
          Withdrawals [(account1, amountX), (account2, zero)]
      ]

    account3 <- freshKeyHash >>= getAccountAddressFor . KeyHashObj
    amountY <- Coin . getPositive <$> arbitrary
    let subTxOnlyWithdrawal =
          TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
            TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> Withdrawals -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account3, Coin
amountY)]
    submitFailingTx
      (mkBasicTx $ txBody & subTransactionsTxBodyL .~ [mkBasicTx txBody, subTxOnlyWithdrawal])
      [ injectFailure . WithdrawalAccountsMissingFromOriginal @era $
          Withdrawals [(account1, amountX), (account2, zero)]
      , injectFailure . SubWithdrawalAccountsMissingFromOriginal @era $
          Withdrawals [(account1, amountX), (account2, zero)]
      , injectFailure . SubWithdrawalAccountsMissing @era $
          Withdrawals [(account1, amountX), (account2, zero)]
      , injectFailure . SubWithdrawalAccountsMissingFromOriginal @era $
          Withdrawals [(account3, amountY)]
      , injectFailure . SubWithdrawalAccountsMissing @era $
          Withdrawals [(account3, amountY)]
      ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Direct deposits to an unregistered account" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    account <- ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash Staking)
-> (KeyHash Staking -> ImpM (LedgerSpec era) AccountAddress)
-> ImpM (LedgerSpec era) AccountAddress
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
>>= Credential Staking -> ImpM (LedgerSpec era) AccountAddress
forall era. Credential Staking -> ImpTestM era AccountAddress
getAccountAddressFor (Credential Staking -> ImpM (LedgerSpec era) AccountAddress)
-> (KeyHash Staking -> Credential Staking)
-> KeyHash Staking
-> ImpM (LedgerSpec era) AccountAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
    amountX <- Coin . getPositive <$> arbitrary
    let
      txBody :: forall l. Typeable l => TxBody l era
      txBody = TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (DirectDeposits -> Identity DirectDeposits)
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody l era -> Identity (TxBody l era))
-> DirectDeposits -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> DirectDeposits
DirectDeposits [(AccountAddress
account, Coin
amountX)]
    submitFailingTx
      (mkBasicTx txBody)
      [ injectFailure . DirectDepositAccountsMissing @era $
          DirectDeposits [(account, amountX)]
      ]

    account2 <- freshKeyHash >>= getAccountAddressFor . KeyHashObj
    amountY <- Coin . getPositive <$> arbitrary
    amountZ <- Coin . getPositive <$> arbitrary
    let subTxOnlyDirectDeposit =
          TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
            TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (DirectDeposits -> Identity DirectDeposits)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> DirectDeposits -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> DirectDeposits
DirectDeposits [(AccountAddress
account, Coin
amountY), (AccountAddress
account2, Coin
amountZ)]
    submitFailingTx
      (mkBasicTx $ txBody & subTransactionsTxBodyL .~ [mkBasicTx txBody, subTxOnlyDirectDeposit])
      [ injectFailure . DirectDepositAccountsMissing @era $
          DirectDeposits [(account, amountX)]
      , injectFailure . SubDirectDepositAccountsMissing @era $
          DirectDeposits [(account, amountX)]
      , injectFailure . SubDirectDepositAccountsMissing @era $
          DirectDeposits [(account, amountY), (account2, amountZ)]
      ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Withdrawals and direct deposits with wrong network id" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    stakeKey <- ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    accountAddress <- registerStakeCredential (KeyHashObj stakeKey)
    let wrongNetworkAccount = AccountAddress
accountAddress AccountAddress
-> (AccountAddress -> AccountAddress) -> AccountAddress
forall a b. a -> (a -> b) -> b
& (Network -> Identity Network)
-> AccountAddress -> Identity AccountAddress
Lens' AccountAddress Network
accountAddressNetworkIdL ((Network -> Identity Network)
 -> AccountAddress -> Identity AccountAddress)
-> Network -> AccountAddress -> AccountAddress
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Network
Mainnet
    let dd = Map AccountAddress Coin -> DirectDeposits
DirectDeposits [(AccountAddress
wrongNetworkAccount, Integer -> Coin
Coin Integer
50)]
    let txBody :: forall l. Typeable l => TxBody l era
        txBody =
          TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
            TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL
              ((Withdrawals -> Identity Withdrawals)
 -> TxBody l era -> Identity (TxBody l era))
-> Withdrawals -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
wrongNetworkAccount, Coin
forall a. Monoid a => a
mempty)]
            TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (DirectDeposits -> Identity DirectDeposits)
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody l era -> Identity (TxBody l era))
-> DirectDeposits -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DirectDeposits
dd

    submitFailingTx
      (mkBasicTx txBody)
      [ injectFailure . WithdrawalAddressesWithWrongNetwork @era Testnet $ NES.singleton wrongNetworkAccount
      , injectFailure . DirectDepositAddressesWithWrongNetwork @era Testnet $
          NES.singleton wrongNetworkAccount
      , injectFailure . WithdrawalAccountsMissingFromOriginal @era $
          Withdrawals [(wrongNetworkAccount, mempty)]
      , injectFailure . DirectDepositAccountsMissing @era $ dd
      ]

    submitFailingTx
      (mkBasicTx $ txBody & subTransactionsTxBodyL .~ [mkBasicTx txBody])
      [ injectFailure . WithdrawalAddressesWithWrongNetwork @era Testnet $
          NES.singleton wrongNetworkAccount
      , injectFailure . DirectDepositAddressesWithWrongNetwork @era Testnet $
          NES.singleton wrongNetworkAccount
      , injectFailure . WithdrawalAccountsMissingFromOriginal @era $
          Withdrawals [(wrongNetworkAccount, mempty)]
      , injectFailure . DirectDepositAccountsMissing @era $ dd
      , injectFailure . SubWithdrawalAddressesWithWrongNetwork @era Testnet $
          NES.singleton wrongNetworkAccount
      , injectFailure . SubDirectDepositAddressesWithWrongNetwork @era Testnet $
          NES.singleton wrongNetworkAccount
      , injectFailure . SubWithdrawalAccountsMissingFromOriginal @era $
          Withdrawals [(wrongNetworkAccount, mempty)]
      , injectFailure . SubWithdrawalAccountsMissing @era $
          Withdrawals [(wrongNetworkAccount, mempty)]
      , injectFailure . SubDirectDepositAccountsMissing @era $ dd
      ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Aggregate of top and sub withdrawals exceeds account balance" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
    (account, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
    (topAmount, subAmount) <- genCoinPairExceeding balance
    let tx =
          Withdrawals -> [Withdrawals] -> Tx TopTx era
mkTxWithBatchWithdrawals
            (Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
topAmount)])
            [Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
subAmount)]]
    submitFailingTx
      tx
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap [(account, Mismatch (topAmount <+> subAmount) balance)]
      ]
    -- legacy mode
    legacyTx <- switchTxToLegacyMode tx
    submitFailingTx
      legacyTx
      [ injectFailure . WithdrawalAmountsInexactInLegacyMode @era $
          NEM.singleton account $
            Mismatch topAmount (balance <-> subAmount)
      ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Aggregate of sub withdrawals exceeds account balance" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
    (account, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
    (subAmount1, subAmount2) <- genCoinPairExceeding balance
    (subAmount1 <+> subAmount2) `shouldSatisfy` (> balance)

    let tx =
          Withdrawals -> [Withdrawals] -> Tx TopTx era
mkTxWithBatchWithdrawals
            (Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
forall t. Val t => t
zero)])
            [Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
subAmount1)], Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
subAmount2)]]
    submitFailingTx
      tx
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap [(account, Mismatch (subAmount1 <+> subAmount2) balance)]
      ]
    legacyTx <- switchTxToLegacyMode tx
    submitFailingTx
      legacyTx
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap [(account, Mismatch (subAmount1 <+> subAmount2) balance)]
      ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Individual withdrawal exceeds account balance" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
    (account, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
    atMostBalance <- Coin <$> choose (1, unCoin balance)
    moreThanBalance <- (balance <+>) . Coin . getPositive <$> arbitrary

    -- A sub-transaction overdraws
    let subTxOverdraws =
          Withdrawals -> [Withdrawals] -> Tx TopTx era
mkTxWithBatchWithdrawals
            (Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
atMostBalance)])
            [Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
moreThanBalance)]]
    submitFailingTx
      subTxOverdraws
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap [(account, Mismatch (atMostBalance <+> moreThanBalance) balance)]
      ]

    legacySubTxOverdraws <- switchTxToLegacyMode subTxOverdraws

    submitFailingTx
      legacySubTxOverdraws
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap [(account, Mismatch moreThanBalance balance)]
      ]

    -- The top transaction overdraws
    let topTxOverdraws =
          Withdrawals -> [Withdrawals] -> Tx TopTx era
mkTxWithBatchWithdrawals
            (Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
moreThanBalance)])
            [Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
atMostBalance)]]
    submitFailingTx
      topTxOverdraws
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap
                [(account, Mismatch (atMostBalance <+> moreThanBalance) balance)]
      ]
    legacyTopTxOverdraws <- switchTxToLegacyMode topTxOverdraws
    submitFailingTx
      legacyTopTxOverdraws
      [ injectFailure . WithdrawalAmountsInexactInLegacyMode @era $
          NEM.singleton account $
            Mismatch moreThanBalance (balance <-> atMostBalance)
      ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Direct deposits cannot fund withdrawals in subsequent sub-transactions" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    account <- Credential Staking -> ImpM (LedgerSpec era) AccountAddress
forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential Staking -> ImpTestM era AccountAddress
registerStakeCredential (Credential Staking -> ImpM (LedgerSpec era) AccountAddress)
-> (KeyHash Staking -> Credential Staking)
-> KeyHash Staking
-> ImpM (LedgerSpec era) AccountAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> ImpM (LedgerSpec era) AccountAddress)
-> ImpM (LedgerSpec era) (KeyHash Staking)
-> ImpM (LedgerSpec era) AccountAddress
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    depositAmount <- Coin . getPositive <$> arbitrary
    let subDeposit =
          TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
            TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (DirectDeposits -> Identity DirectDeposits)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL
                ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> DirectDeposits -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> DirectDeposits
DirectDeposits [(AccountAddress
account, Coin
depositAmount)]
        subWithdraw =
          TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
            TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL
                ((Withdrawals -> Identity Withdrawals)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> Withdrawals -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
depositAmount)]
        tx =
          TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
            TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OMap TxId (Tx SubTx era))
Tx SubTx era
subDeposit, Item (OMap TxId (Tx SubTx era))
Tx SubTx era
subWithdraw]

    submitFailingTx
      tx
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap [(account, Mismatch depositAmount zero)]
      ]

    legacyTx <- switchTxToLegacyMode tx
    submitFailingTx
      legacyTx
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap [(account, Mismatch depositAmount zero)]
      ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Top transaction can drain an account funded by a sub-transaction direct deposit, in legacy mode" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    account <- Credential Staking -> ImpM (LedgerSpec era) AccountAddress
forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential Staking -> ImpTestM era AccountAddress
registerStakeCredential (Credential Staking -> ImpM (LedgerSpec era) AccountAddress)
-> (KeyHash Staking -> Credential Staking)
-> KeyHash Staking
-> ImpM (LedgerSpec era) AccountAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> ImpM (LedgerSpec era) AccountAddress)
-> ImpM (LedgerSpec era) (KeyHash Staking)
-> ImpM (LedgerSpec era) AccountAddress
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    depositAmount <- Coin . getPositive <$> arbitrary
    let subDeposit =
          TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
            TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (DirectDeposits -> Identity DirectDeposits)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> DirectDeposits -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> DirectDeposits
DirectDeposits [(AccountAddress
account, Coin
depositAmount)]
        tx =
          TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
            TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
              TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Withdrawals -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
depositAmount)]
              TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OMap TxId (Tx SubTx era))
Tx SubTx era
subDeposit]

    submitFailingTx
      tx
      [ injectFailure $
          WithdrawalAmountsExceedingOriginalBalance @era $
            fromJust $
              NEM.fromMap [(account, Mismatch depositAmount zero)]
      ]

    legacyTx <- switchTxToLegacyMode tx
    submitTx_ legacyTx
    getBalance (account ^. accountAddressCredentialL) `shouldReturn` zero

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Account balance intervals" (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
"Account balance intervals for the top-level transaction" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$
      (AccountBalanceIntervals era
 -> EntitiesPredFailure era -> ImpM (LedgerSpec era) ())
-> (Network
    -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> (NonEmptyMap AccountAddress (AccountBalanceInterval era)
    -> EntitiesPredFailure era)
-> (NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
    -> EntitiesPredFailure era)
-> ImpM (LedgerSpec era) ()
forall (t :: * -> *).
(AccountBalanceIntervals era -> t era -> ImpM (LedgerSpec era) ())
-> (Network -> NonEmptySet AccountAddress -> t era)
-> (NonEmptyMap AccountAddress (AccountBalanceInterval era)
    -> t era)
-> (NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
    -> t era)
-> ImpM (LedgerSpec era) ()
accountBalanceIntervalCases
        ((TxBody TopTx era -> TxBody TopTx era)
-> EntitiesPredFailure era -> ImpM (LedgerSpec era) ()
forall {era} {era} {t :: * -> *} {l :: TxLevel}.
(Event (EraRule "LEDGER" era) ~ EraRuleEvent "LEDGER" era,
 Event (EraRule "TICK" era) ~ EraRuleEvent "TICK" era,
 PredicateFailure (EraRule "BBODY" era)
 ~ EraRuleFailure "BBODY" era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ EraRuleFailure "LEDGER" era,
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, ToExpr (EraRuleFailure "BBODY" era),
 ToExpr (EraRuleFailure "LEDGER" era),
 InjectRuleFailure "LEDGER" t era, EraTxBody era,
 EncCBOR (EraRuleFailure "BBODY" era),
 EncCBOR (EraRuleFailure "LEDGER" era),
 Ord (EraRuleFailure "BBODY" era),
 Ord (EraRuleFailure "LEDGER" era),
 NFData (EraRuleFailure "BBODY" era),
 NFData (EraRuleFailure "LEDGER" era),
 Show (EraRuleFailure "BBODY" era),
 Show (EraRuleFailure "LEDGER" era),
 DecCBOR (EraRuleFailure "BBODY" era),
 DecCBOR (EraRuleFailure "LEDGER" era), Typeable l) =>
(TxBody l era -> TxBody TopTx era) -> t era -> ImpTestM era ()
submitFailingTopTxBody ((TxBody TopTx era -> TxBody TopTx era)
 -> EntitiesPredFailure era -> ImpM (LedgerSpec era) ())
-> (AccountBalanceIntervals era
    -> TxBody TopTx era -> TxBody TopTx era)
-> AccountBalanceIntervals era
-> EntitiesPredFailure era
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (AccountBalanceIntervals era)
forall (l :: TxLevel).
Lens' (TxBody l era) (AccountBalanceIntervals era)
accountBalanceIntervalsTxBodyL ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> AccountBalanceIntervals era
-> TxBody TopTx era
-> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~))
        Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
WrongNetworkInAccountBalanceIntervals
        NonEmptyMap AccountAddress (AccountBalanceInterval era)
-> EntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (AccountBalanceInterval era)
-> EntitiesPredFailure era
MissingAccountsInAccountBalanceIntervals
        NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> EntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> EntitiesPredFailure era
BalancesOutsideAccountBalanceIntervals

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Account balance intervals within each sub-transaction" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$
      (AccountBalanceIntervals era
 -> SubEntitiesPredFailure era -> ImpM (LedgerSpec era) ())
-> (Network
    -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> (NonEmptyMap AccountAddress (AccountBalanceInterval era)
    -> SubEntitiesPredFailure era)
-> (NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
    -> SubEntitiesPredFailure era)
-> ImpM (LedgerSpec era) ()
forall (t :: * -> *).
(AccountBalanceIntervals era -> t era -> ImpM (LedgerSpec era) ())
-> (Network -> NonEmptySet AccountAddress -> t era)
-> (NonEmptyMap AccountAddress (AccountBalanceInterval era)
    -> t era)
-> (NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
    -> t era)
-> ImpM (LedgerSpec era) ()
accountBalanceIntervalCases
        ((TxBody SubTx era -> TxBody SubTx era)
-> SubEntitiesPredFailure era -> ImpM (LedgerSpec era) ()
forall {era} {era} {t :: * -> *} {l :: TxLevel}.
(Event (EraRule "LEDGER" era) ~ EraRuleEvent "LEDGER" era,
 Event (EraRule "TICK" era) ~ EraRuleEvent "TICK" era,
 PredicateFailure (EraRule "BBODY" era)
 ~ EraRuleFailure "BBODY" era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ EraRuleFailure "LEDGER" era,
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, DijkstraEraTxBody era, EraTxBody era,
 ToExpr (EraRuleFailure "BBODY" era),
 ToExpr (EraRuleFailure "LEDGER" era),
 InjectRuleFailure "LEDGER" t era,
 EncCBOR (EraRuleFailure "BBODY" era),
 EncCBOR (EraRuleFailure "LEDGER" era),
 Ord (EraRuleFailure "BBODY" era),
 Ord (EraRuleFailure "LEDGER" era),
 NFData (EraRuleFailure "BBODY" era),
 NFData (EraRuleFailure "LEDGER" era),
 Show (EraRuleFailure "BBODY" era),
 Show (EraRuleFailure "LEDGER" era),
 DecCBOR (EraRuleFailure "BBODY" era),
 DecCBOR (EraRuleFailure "LEDGER" era), Typeable l) =>
(TxBody l era -> TxBody SubTx era) -> t era -> ImpTestM era ()
submitFailingSubTxBody ((TxBody SubTx era -> TxBody SubTx era)
 -> SubEntitiesPredFailure era -> ImpM (LedgerSpec era) ())
-> (AccountBalanceIntervals era
    -> TxBody SubTx era -> TxBody SubTx era)
-> AccountBalanceIntervals era
-> SubEntitiesPredFailure era
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (AccountBalanceIntervals era)
forall (l :: TxLevel).
Lens' (TxBody l era) (AccountBalanceIntervals era)
accountBalanceIntervalsTxBodyL ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> AccountBalanceIntervals era
-> TxBody SubTx era
-> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~))
        Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
SubWrongNetworkInAccountBalanceIntervals
        NonEmptyMap AccountAddress (AccountBalanceInterval era)
-> SubEntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (AccountBalanceInterval era)
-> SubEntitiesPredFailure era
SubMissingAccountsInAccountBalanceIntervals
        NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> SubEntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> SubEntitiesPredFailure era
SubBalancesOutsideAccountBalanceIntervals

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Starting account balance intervals for the top-level transaction" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$
      (AccountBalanceIntervals era
 -> EntitiesPredFailure era -> ImpM (LedgerSpec era) ())
-> (Network
    -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> (NonEmptyMap AccountAddress (AccountBalanceInterval era)
    -> EntitiesPredFailure era)
-> (NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
    -> EntitiesPredFailure era)
-> ImpM (LedgerSpec era) ()
forall (t :: * -> *).
(AccountBalanceIntervals era -> t era -> ImpM (LedgerSpec era) ())
-> (Network -> NonEmptySet AccountAddress -> t era)
-> (NonEmptyMap AccountAddress (AccountBalanceInterval era)
    -> t era)
-> (NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
    -> t era)
-> ImpM (LedgerSpec era) ()
accountBalanceIntervalCases
        ((TxBody TopTx era -> TxBody TopTx era)
-> EntitiesPredFailure era -> ImpM (LedgerSpec era) ()
forall {era} {era} {t :: * -> *} {l :: TxLevel}.
(Event (EraRule "LEDGER" era) ~ EraRuleEvent "LEDGER" era,
 Event (EraRule "TICK" era) ~ EraRuleEvent "TICK" era,
 PredicateFailure (EraRule "BBODY" era)
 ~ EraRuleFailure "BBODY" era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ EraRuleFailure "LEDGER" era,
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, ToExpr (EraRuleFailure "BBODY" era),
 ToExpr (EraRuleFailure "LEDGER" era),
 InjectRuleFailure "LEDGER" t era, EraTxBody era,
 EncCBOR (EraRuleFailure "BBODY" era),
 EncCBOR (EraRuleFailure "LEDGER" era),
 Ord (EraRuleFailure "BBODY" era),
 Ord (EraRuleFailure "LEDGER" era),
 NFData (EraRuleFailure "BBODY" era),
 NFData (EraRuleFailure "LEDGER" era),
 Show (EraRuleFailure "BBODY" era),
 Show (EraRuleFailure "LEDGER" era),
 DecCBOR (EraRuleFailure "BBODY" era),
 DecCBOR (EraRuleFailure "LEDGER" era), Typeable l) =>
(TxBody l era -> TxBody TopTx era) -> t era -> ImpTestM era ()
submitFailingTopTxBody ((TxBody TopTx era -> TxBody TopTx era)
 -> EntitiesPredFailure era -> ImpM (LedgerSpec era) ())
-> (AccountBalanceIntervals era
    -> TxBody TopTx era -> TxBody TopTx era)
-> AccountBalanceIntervals era
-> EntitiesPredFailure era
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (AccountBalanceIntervals era)
Lens' (TxBody TopTx era) (AccountBalanceIntervals era)
startingAccountBalanceIntervalsTxBodyL ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> AccountBalanceIntervals era
-> TxBody TopTx era
-> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~))
        Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
WrongNetworkInStartingAccountBalanceIntervals
        NonEmptyMap AccountAddress (AccountBalanceInterval era)
-> EntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (AccountBalanceInterval era)
-> EntitiesPredFailure era
MissingAccountsInStartingAccountBalanceIntervals
        NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> EntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> EntitiesPredFailure era
BalancesOutsideStartingAccountBalanceIntervals

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Satisfied intervals are accepted at every level" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (accountAddr, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
      let intervals = Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall era.
Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
AccountBalanceIntervals [(AccountAddress
accountAddr, Coin -> AccountBalanceInterval era
forall era. Coin -> AccountBalanceInterval era
AccountBalanceExact Coin
balance)]
      submitTx_ $ mkBasicTx $ mkBasicTxBody & accountBalanceIntervalsTxBodyL .~ intervals
      submitTx_ $ mkBasicTx $ mkBasicTxBody & startingAccountBalanceIntervalsTxBodyL .~ intervals
      submitTx_ $
        mkBasicTx $
          mkBasicTxBody
            & subTransactionsTxBodyL
              .~ [mkBasicTx $ mkBasicTxBody & accountBalanceIntervalsTxBodyL .~ intervals]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Every violating entry of a single interval map is reported" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (accountAddr, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
      unregistered <- unregisteredAccount
      let onWrongNetwork = AccountAddress
accountAddr AccountAddress
-> (AccountAddress -> AccountAddress) -> AccountAddress
forall a b. a -> (a -> b) -> b
& (Network -> Identity Network)
-> AccountAddress -> Identity AccountAddress
Lens' AccountAddress Network
accountAddressNetworkIdL ((Network -> Identity Network)
 -> AccountAddress -> Identity AccountAddress)
-> Network -> AccountAddress -> AccountAddress
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Network
Mainnet
          violated = Coin -> AccountBalanceInterval era
forall era. Coin -> AccountBalanceInterval era
AccountBalanceExact (Coin
balance Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
1)
      submitFailingTx
        ( mkBasicTx $
            mkBasicTxBody
              & accountBalanceIntervalsTxBodyL
                .~ AccountBalanceIntervals
                  [ (onWrongNetwork, violated)
                  , (unregistered, violated)
                  , (accountAddr, violated)
                  ]
        )
        [ injectFailure $
            WrongNetworkInAccountBalanceIntervals @era Testnet (NES.singleton onWrongNetwork)
        , injectFailure $
            MissingAccountsInAccountBalanceIntervals @era (NEM.singleton unregistered violated)
        , injectFailure $
            BalancesOutsideAccountBalanceIntervals @era
              (NEM.singleton accountAddr (balance, violated))
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
      String
"Intervals are checked before the withdrawals and direct deposits of their own transaction are applied"
      (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        (accountAddr, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
        let deposit = Integer -> Coin
Coin Integer
1_000_000
            txWith TxBody l era -> TxBody l era
modifyBody AccountBalanceInterval era
interval =
              TxBody l era -> Tx l era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody l era -> Tx l era) -> TxBody l era -> Tx l era
forall a b. (a -> b) -> a -> b
$
                TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                  TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (AccountBalanceIntervals era)
forall (l :: TxLevel).
Lens' (TxBody l era) (AccountBalanceIntervals era)
accountBalanceIntervalsTxBodyL ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody l era -> Identity (TxBody l era))
-> AccountBalanceIntervals era -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall era.
Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
AccountBalanceIntervals [(AccountAddress
accountAddr, AccountBalanceInterval era
interval)]
                  TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& TxBody l era -> TxBody l era
modifyBody
            drains = (Withdrawals -> Identity Withdrawals)
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody l era -> Identity (TxBody l era))
-> Withdrawals -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
accountAddr, Coin
balance)]
            deposits = (DirectDeposits -> Identity DirectDeposits)
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody l era -> Identity (TxBody l era))
-> DirectDeposits -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> DirectDeposits
DirectDeposits [(AccountAddress
accountAddr, Coin
deposit)]
            expectOutside TxBody l era -> TxBody TopTx era
modifyBody AccountBalanceInterval era
interval =
              Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
                ((TxBody l era -> TxBody TopTx era)
-> AccountBalanceInterval era -> Tx TopTx era
forall {era} {era} {l :: TxLevel} {l :: TxLevel}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraTx era, DijkstraEraTxBody era, Typeable l) =>
(TxBody l era -> TxBody l era)
-> AccountBalanceInterval era -> Tx l era
txWith TxBody l era -> TxBody TopTx era
modifyBody AccountBalanceInterval era
interval)
                [ EntitiesPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (EntitiesPredFailure era -> EraRuleFailure "LEDGER" era)
-> EntitiesPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
                    forall era.
NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> EntitiesPredFailure era
BalancesOutsideAccountBalanceIntervals @era
                      (AccountAddress
-> (Coin, AccountBalanceInterval era)
-> NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
forall k v. k -> v -> NonEmptyMap k v
NEM.singleton AccountAddress
accountAddr (Coin
balance, AccountBalanceInterval era
interval))
                ]
        expectOutside drains (AccountBalanceExact zero)
        expectOutside deposits (AccountBalanceExact (balance <+> deposit))
        submitFailingTx
          ( mkBasicTx $
              mkBasicTxBody
                & subTransactionsTxBodyL
                  .~ [ mkBasicTx $
                         mkBasicTxBody
                           & withdrawalsTxBodyL .~ Withdrawals [(accountAddr, balance)]
                           & accountBalanceIntervalsTxBodyL
                             .~ AccountBalanceIntervals [(accountAddr, AccountBalanceExact zero)]
                     ]
          )
          [ injectFailure $
              SubBalancesOutsideAccountBalanceIntervals @era
                (NEM.singleton accountAddr (balance, AccountBalanceExact zero))
          ]
        submitTx_ $ txWith drains (AccountBalanceExact balance)

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Interval bounds are checked at their boundaries" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (accountAddr, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
      let withInterval AccountBalanceInterval era
interval =
            TxBody l era -> Tx l era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody l era -> Tx l era) -> TxBody l era -> Tx l era
forall a b. (a -> b) -> a -> b
$
              TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (AccountBalanceIntervals era)
forall (l :: TxLevel).
Lens' (TxBody l era) (AccountBalanceIntervals era)
accountBalanceIntervalsTxBodyL ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody l era -> Identity (TxBody l era))
-> AccountBalanceIntervals era -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall era.
Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
AccountBalanceIntervals [(AccountAddress
accountAddr, AccountBalanceInterval era
interval)]
          intervalHolds = Tx TopTx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era -> ImpTestM era ()
submitTx_ (Tx TopTx era -> ImpM (LedgerSpec era) ())
-> (AccountBalanceInterval era -> Tx TopTx era)
-> AccountBalanceInterval era
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountBalanceInterval era -> Tx TopTx era
forall {era} {l :: TxLevel}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraTx era, DijkstraEraTxBody era, Typeable l) =>
AccountBalanceInterval era -> Tx l era
withInterval
          intervalViolated AccountBalanceInterval era
interval =
            Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
              (AccountBalanceInterval era -> Tx TopTx era
forall {era} {l :: TxLevel}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraTx era, DijkstraEraTxBody era, Typeable l) =>
AccountBalanceInterval era -> Tx l era
withInterval AccountBalanceInterval era
interval)
              [ EntitiesPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (EntitiesPredFailure era -> EraRuleFailure "LEDGER" era)
-> EntitiesPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
                  forall era.
NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> EntitiesPredFailure era
BalancesOutsideAccountBalanceIntervals @era
                    (AccountAddress
-> (Coin, AccountBalanceInterval era)
-> NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
forall k v. k -> v -> NonEmptyMap k v
NEM.singleton AccountAddress
accountAddr (Coin
balance, AccountBalanceInterval era
interval))
              ]
      intervalHolds $ AccountBalanceExact balance
      intervalViolated $ AccountBalanceExact (balance <+> Coin 1)
      intervalHolds $ AccountBalanceLowerBound (Inclusive balance)
      intervalViolated $ AccountBalanceLowerBound (Inclusive (balance <+> Coin 1))
      intervalHolds $ AccountBalanceUpperBound (Exclusive (balance <+> Coin 1))
      intervalViolated $ AccountBalanceUpperBound (Exclusive balance)
      intervalHolds $ AccountBalanceBothBounds (Inclusive balance) (Exclusive (balance <+> Coin 1))
      intervalViolated $
        AccountBalanceBothBounds (Inclusive (balance <+> Coin 1)) (Exclusive (balance <+> Coin 2))

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
      String
"Starting intervals see the pre-transaction balance, account balance intervals see the post-sub-transaction balance"
      (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        (accountAddr, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
        let drainingSubTx :: Tx SubTx era
            drainingSubTx =
              TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$ TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> Withdrawals -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
accountAddr, Coin
balance)]
            txWithIntervals AccountBalanceInterval era
starting AccountBalanceInterval era
current =
              TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
                TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                  TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OMap TxId (Tx SubTx era))
Tx SubTx era
drainingSubTx]
                  TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (AccountBalanceIntervals era)
Lens' (TxBody TopTx era) (AccountBalanceIntervals era)
startingAccountBalanceIntervalsTxBodyL
                    ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> AccountBalanceIntervals era
-> TxBody TopTx era
-> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall era.
Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
AccountBalanceIntervals [(AccountAddress
accountAddr, AccountBalanceInterval era
starting)]
                  TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (AccountBalanceIntervals era)
forall (l :: TxLevel).
Lens' (TxBody l era) (AccountBalanceIntervals era)
accountBalanceIntervalsTxBodyL
                    ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> AccountBalanceIntervals era
-> TxBody TopTx era
-> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall era.
Map AccountAddress (AccountBalanceInterval era)
-> AccountBalanceIntervals era
AccountBalanceIntervals [(AccountAddress
accountAddr, AccountBalanceInterval era
current)]
            original = Coin -> AccountBalanceInterval era
forall era. Coin -> AccountBalanceInterval era
AccountBalanceExact Coin
balance
            drained = Coin -> AccountBalanceInterval era
forall era. Coin -> AccountBalanceInterval era
AccountBalanceExact Coin
forall t. Val t => t
zero
        submitFailingTx
          (txWithIntervals drained original)
          [ injectFailure $
              BalancesOutsideAccountBalanceIntervals @era (NEM.singleton accountAddr (zero, original))
          , injectFailure $
              BalancesOutsideStartingAccountBalanceIntervals @era
                (NEM.singleton accountAddr (balance, drained))
          ]
        submitTx_ $ txWithIntervals original drained
  where
    setupAccountAddress :: ImpTestM era (AccountAddress, Coin, KeyHash Staking)
    setupAccountAddress :: ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress = do
      kh <- ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let cred = KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
kh
      ra <- registerStakeCredential cred
      submitAndExpireProposalToMakeReward cred
      b <- getBalance cred
      pure (ra, b, kh)

    mkTxWithBatchWithdrawals :: Withdrawals -> [Withdrawals] -> Tx TopTx era
    mkTxWithBatchWithdrawals :: Withdrawals -> [Withdrawals] -> Tx TopTx era
mkTxWithBatchWithdrawals Withdrawals
topWdrls [Withdrawals]
subs =
      TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
        TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
          TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Withdrawals -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
topWdrls
          TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Tx SubTx era] -> OMap TxId (Tx SubTx era)
forall (f :: * -> *) k v.
(Foldable f, HasOKey k v) =>
f v -> OMap k v
OMap.fromFoldable ((Withdrawals -> Tx SubTx era) -> [Withdrawals] -> [Tx SubTx era]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Withdrawals -> Tx SubTx era
mkSubTx [Withdrawals]
subs)
      where
        mkSubTx :: Withdrawals -> Tx SubTx era
        mkSubTx :: Withdrawals -> Tx SubTx era
mkSubTx Withdrawals
w = TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> Withdrawals -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
w)

    genCoinPairExceeding :: Coin -> m (Coin, Coin)
genCoinPairExceeding (Coin Integer
maxSum) = do
      a <- (Integer, Integer) -> m Integer
forall a. Random a => (a, a) -> m a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Integer
1, Integer
maxSum)
      b <- choose (maxSum - a + 1, maxSum)
      pure (Coin a, Coin b)

    unregisteredAccount :: ImpTestM era AccountAddress
    unregisteredAccount :: ImpM (LedgerSpec era) AccountAddress
unregisteredAccount = ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash Staking)
-> (KeyHash Staking -> ImpM (LedgerSpec era) AccountAddress)
-> ImpM (LedgerSpec era) AccountAddress
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
>>= Credential Staking -> ImpM (LedgerSpec era) AccountAddress
forall era. Credential Staking -> ImpTestM era AccountAddress
getAccountAddressFor (Credential Staking -> ImpM (LedgerSpec era) AccountAddress)
-> (KeyHash Staking -> Credential Staking)
-> KeyHash Staking
-> ImpM (LedgerSpec era) AccountAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj

    submitFailingTopTxBody :: (TxBody l era -> TxBody TopTx era) -> t era -> ImpTestM era ()
submitFailingTopTxBody TxBody l era -> TxBody TopTx era
modifyBody t era
failure =
      Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx (TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody l era
-> (TxBody l era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& TxBody l era -> TxBody TopTx era
modifyBody)) [t era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure t era
failure]

    submitFailingSubTxBody :: (TxBody l era -> TxBody SubTx era) -> t era -> ImpTestM era ()
submitFailingSubTxBody TxBody l era -> TxBody SubTx era
modifyBody t era
failure =
      Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        (TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody l era
-> (TxBody l era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& TxBody l era -> TxBody SubTx era
modifyBody)]))
        [t era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure t era
failure]

    accountBalanceIntervalCases ::
      (AccountBalanceIntervals era -> t era -> ImpTestM era ()) ->
      (Network -> NES.NonEmptySet AccountAddress -> t era) ->
      (NEM.NonEmptyMap AccountAddress (AccountBalanceInterval era) -> t era) ->
      (NEM.NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era) -> t era) ->
      ImpTestM era ()
    accountBalanceIntervalCases :: forall (t :: * -> *).
(AccountBalanceIntervals era -> t era -> ImpM (LedgerSpec era) ())
-> (Network -> NonEmptySet AccountAddress -> t era)
-> (NonEmptyMap AccountAddress (AccountBalanceInterval era)
    -> t era)
-> (NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
    -> t era)
-> ImpM (LedgerSpec era) ()
accountBalanceIntervalCases AccountBalanceIntervals era -> t era -> ImpM (LedgerSpec era) ()
submitFailing Network -> NonEmptySet AccountAddress -> t era
mkWrongNetwork NonEmptyMap AccountAddress (AccountBalanceInterval era) -> t era
mkMissingAccounts NonEmptyMap AccountAddress (Coin, AccountBalanceInterval era)
-> t era
mkBalancesOutside = do
      (accountAddr, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
      let onWrongNetwork = AccountAddress
accountAddr AccountAddress
-> (AccountAddress -> AccountAddress) -> AccountAddress
forall a b. a -> (a -> b) -> b
& (Network -> Identity Network)
-> AccountAddress -> Identity AccountAddress
Lens' AccountAddress Network
accountAddressNetworkIdL ((Network -> Identity Network)
 -> AccountAddress -> Identity AccountAddress)
-> Network -> AccountAddress -> AccountAddress
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Network
Mainnet
          violated = Coin -> AccountBalanceInterval era
forall era. Coin -> AccountBalanceInterval era
AccountBalanceExact (Coin
balance Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
1)
      submitFailing
        (AccountBalanceIntervals [(onWrongNetwork, violated)])
        (mkWrongNetwork Testnet (NES.singleton onWrongNetwork))
      unregistered <- unregisteredAccount
      submitFailing
        (AccountBalanceIntervals [(unregistered, violated)])
        (mkMissingAccounts (NEM.singleton unregistered violated))
      submitFailing
        (AccountBalanceIntervals [(accountAddr, violated)])
        (mkBalancesOutside (NEM.singleton accountAddr (balance, violated)))