{-# 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.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
"Direct deposit in a sub-transaction, with nothing withdrawn in the batch" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    let depositsOnly :: Bool -> ImpM (LedgerSpec era) ()
depositsOnly Bool
legacyMode = do
          (acct, balance, kh) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
          deposit <- genDeposit
          let tx = [Tx SubTx era] -> Tx TopTx era
forall era. DijkstraEraImp era => [Tx SubTx era] -> Tx TopTx era
mkTopTxWithSubTxs [(TxBody SubTx era -> TxBody SubTx era) -> Tx SubTx era
subTx (AccountAddress -> Coin -> TxBody SubTx era -> TxBody SubTx era
forall (l :: TxLevel).
AccountAddress -> Coin -> TxBody l era -> TxBody l era
depositsTo AccountAddress
acct Coin
deposit)]
          submitTx_ =<< if legacyMode then switchTxToLegacyMode tx else pure tx
          getBalance (KeyHashObj kh) `shouldReturn` (balance <+> deposit)
    Bool -> ImpM (LedgerSpec era) ()
depositsOnly Bool
False
    Bool -> ImpM (LedgerSpec era) ()
depositsOnly Bool
True

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Balances adjusted by withdrawals and direct deposits on distinct accounts" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    (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
"Balances adjusted by 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
    String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"withdrawn from at the top level and by several sub-transactions" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      (acct, balance, kh) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
      -- a third of the balance each, so the three withdrawals stay within it
      let genWithdrawal = Integer -> Coin
Coin (Integer -> Coin)
-> ImpM (LedgerSpec era) Integer -> ImpM (LedgerSpec era) Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> ImpM (LedgerSpec era) Integer
forall a. Random a => (a, a) -> ImpM (LedgerSpec era) a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Integer
1, Coin -> Integer
unCoin Coin
balance Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
3)
      topWithdrawal <- genWithdrawal
      subWithdrawal1 <- genWithdrawal
      subWithdrawal2 <- genWithdrawal
      topTx <-
        mkTopTxWithDistinctSubTxs
          [ subTx (withdrawsFrom acct subWithdrawal1)
          , subTx (withdrawsFrom acct subWithdrawal2)
          ]
      submitTx_ $ topTx & bodyTxL %~ withdrawsFrom acct topWithdrawal
      getBalance (KeyHashObj kh)
        `shouldReturn` (balance <-> topWithdrawal <-> subWithdrawal1 <-> subWithdrawal2)

    String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"deposited into at the top level and by several sub-transactions" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      (acct, balance, kh) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
      topDeposit <- genDeposit
      subDeposit1 <- genDeposit
      subDeposit2 <- genDeposit
      topTx <-
        mkTopTxWithDistinctSubTxs
          [ subTx (depositsTo acct subDeposit1)
          , subTx (depositsTo acct subDeposit2)
          ]
      submitTx_ $ topTx & bodyTxL %~ depositsTo acct topDeposit
      getBalance (KeyHashObj kh)
        `shouldReturn` (balance <+> topDeposit <+> subDeposit1 <+> subDeposit2)

    String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"one sub-transaction both withdraws from and deposits into the account" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      -- the account is not in the top-level withdrawals, so legacy mode imposes no
      -- requirement on it either
      let withdrawsAndDeposits :: Bool -> ImpM (LedgerSpec era) ()
withdrawsAndDeposits Bool
legacyMode = do
            (acct, balance, kh) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
            withdrawal <- Coin <$> choose (1, unCoin balance)
            deposit <- genDeposit
            let tx =
                  [Tx SubTx era] -> Tx TopTx era
forall era. DijkstraEraImp era => [Tx SubTx era] -> Tx TopTx era
mkTopTxWithSubTxs
                    [(TxBody SubTx era -> TxBody SubTx era) -> Tx SubTx era
subTx (AccountAddress -> Coin -> TxBody SubTx era -> TxBody SubTx era
forall (l :: TxLevel).
AccountAddress -> Coin -> TxBody l era -> TxBody l era
withdrawsFrom AccountAddress
acct Coin
withdrawal (TxBody SubTx era -> TxBody SubTx era)
-> (TxBody SubTx era -> TxBody SubTx era)
-> TxBody SubTx era
-> TxBody SubTx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountAddress -> Coin -> TxBody SubTx era -> TxBody SubTx era
forall (l :: TxLevel).
AccountAddress -> Coin -> TxBody l era -> TxBody l era
depositsTo AccountAddress
acct Coin
deposit)]
            submitTx_ =<< if legacyMode then switchTxToLegacyMode tx else pure tx
            getBalance (KeyHashObj kh) `shouldReturn` (balance <-> withdrawal <+> deposit)
      Bool -> ImpM (LedgerSpec era) ()
withdrawsAndDeposits Bool
False
      Bool -> ImpM (LedgerSpec era) ()
withdrawsAndDeposits Bool
True

    String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"a sub-transaction deposits, the top withdraws within the original balance" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      (acct, balance, kh) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
      deposit <- genDeposit
      withdrawal <- Coin <$> choose (1, unCoin balance)
      submitTx_ $
        mkTopTxWithSubTxs [subTx (depositsTo acct deposit)]
          & bodyTxL %~ withdrawsFrom acct withdrawal
      getBalance (KeyHashObj kh) `shouldReturn` (balance <-> withdrawal <+> deposit)

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Withdrawal amounts for one account" (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
"Top takes exactly the balance left by the 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
$ do
      let drainsAfterSubTx :: Bool -> ImpM (LedgerSpec era) ()
drainsAfterSubTx Bool
legacyMode = do
            (acct, balance, kh) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
            subAmount <- Coin <$> choose (1, unCoin balance `div` 2)
            tx <-
              mkTxWithBatchWithdrawals
                (Withdrawals [(acct, balance <-> subAmount)])
                [Withdrawals [(acct, subAmount)]]
            submitTx_ =<< if legacyMode then switchTxToLegacyMode tx else pure tx
            getBalance (KeyHashObj kh) `shouldReturn` zero
      Bool -> ImpM (LedgerSpec era) ()
drainsAfterSubTx Bool
False
      Bool -> ImpM (LedgerSpec era) ()
drainsAfterSubTx Bool
True

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Top takes less than the balance left by the 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
$ do
      let doesNotDrainAfterSubTx :: Bool -> ImpM (LedgerSpec era) ()
doesNotDrainAfterSubTx Bool
legacyMode = do
            (acct, balance, kh) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
            subAmount <- Coin <$> choose (1, unCoin balance `div` 2)
            let remainder = Coin
balance Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
subAmount
            topAmount <- Coin <$> choose (1, unCoin remainder - 1)
            tx <-
              mkTxWithBatchWithdrawals
                (Withdrawals [(acct, topAmount)])
                [Withdrawals [(acct, subAmount)]]
            if legacyMode
              then do
                legacyTx <- switchTxToLegacyMode tx
                submitFailingTx
                  legacyTx
                  [ injectFailure . WithdrawalAmountsInexactInLegacyMode @era $
                      NEM.singleton acct $
                        Mismatch topAmount remainder
                  ]
              else do
                submitTx_ tx
                getBalance (KeyHashObj kh) `shouldReturn` (remainder <-> topAmount)
      Bool -> ImpM (LedgerSpec era) ()
doesNotDrainAfterSubTx Bool
False
      Bool -> ImpM (LedgerSpec era) ()
doesNotDrainAfterSubTx Bool
True

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Only the sub-transaction withdraws, taking the whole balance, 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
      (acct, balance, kh) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
      submitTx_
        =<< switchTxToLegacyMode
        =<< mkTxWithBatchWithdrawals (Withdrawals mempty) [Withdrawals [(acct, balance)]]
      getBalance (KeyHashObj kh) `shouldReturn` zero

    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
      (account1, balance1, kh1) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
      (account2, balance2, kh2) <- setupAccountAddress
      lessThanBalance1 <- Coin <$> choose (1, unCoin balance1 - 1)
      lessThanBalance2 <- Coin <$> choose (1, unCoin balance2 - 1)
      let freshTx =
            Withdrawals
-> [Withdrawals] -> ImpM (LedgerSpec era) (Tx TopTx era)
mkTxWithBatchWithdrawals
              (Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account1, Coin
lessThanBalance1)])
              [Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account2, Coin
lessThanBalance2)]]
      submitTx_ =<< freshTx
      getBalance (KeyHashObj kh1) `shouldReturn` (balance1 <-> lessThanBalance1)
      getBalance (KeyHashObj kh2) `shouldReturn` (balance2 <-> lessThanBalance2)

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

      -- drain top withdrawal
      submitTx_
        =<< switchTxToLegacyMode
        =<< mkTxWithBatchWithdrawals
          (Withdrawals [(account1, balance1)])
          [Withdrawals [(account2, lessThanBalance2)]]

      getBalance (KeyHashObj kh1) `shouldReturn` zero
      getBalance (KeyHashObj kh2) `shouldReturn` (balance2 <-> lessThanBalance2)

    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
      (account, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
      (topAmount, subAmount) <- genCoinPairExceeding balance
      tx <-
        mkTxWithBatchWithdrawals
          (Withdrawals [(account, topAmount)])
          [Withdrawals [(account, 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
      (account, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
      (subAmount1, subAmount2) <- genCoinPairExceeding balance
      (subAmount1 <+> subAmount2) `shouldSatisfy` (> balance)

      tx <-
        mkTxWithBatchWithdrawals
          (Withdrawals [(account, zero)])
          [Withdrawals [(account, subAmount1)], Withdrawals [(account, 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
      (account, balance, _) <- ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddress
      atMostBalance <- Coin <$> choose (1, unCoin balance)
      moreThanBalance <- (balance <>) . succ <$> arbitrary

      -- A sub-transaction overdraws
      subTxOverdraws <-
        mkTxWithBatchWithdrawals
          (Withdrawals [(account, atMostBalance)])
          [Withdrawals [(account, 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
      topTxOverdraws <-
        mkTxWithBatchWithdrawals
          (Withdrawals [(account, moreThanBalance)])
          [Withdrawals [(account, 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
"Only the top level withdraws, taking more than the 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
      let topOverdraws :: Bool -> ImpM (LedgerSpec era) ()
topOverdraws Bool
legacyMode = do
            (acct, balance, _) <- Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking))
-> ImpM (LedgerSpec era) Coin
-> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) Coin
genAccountBalance
            moreThanBalance <- (balance <>) . succ <$> arbitrary
            tx <- mkTxWithBatchWithdrawals (Withdrawals [(acct, moreThanBalance)]) []
            if legacyMode
              then do
                legacyTx <- switchTxToLegacyMode tx
                submitFailingTx
                  legacyTx
                  [ injectFailure . WithdrawalAmountsInexactInLegacyMode @era $
                      NEM.singleton acct $
                        Mismatch moreThanBalance balance
                  ]
              else
                submitFailingTx
                  tx
                  [ injectFailure . WithdrawalAmountsExceedingOriginalBalance @era . fromJust $
                      NEM.fromMap [(acct, Mismatch moreThanBalance balance)]
                  ]
      Bool -> ImpM (LedgerSpec era) ()
topOverdraws Bool
False
      Bool -> ImpM (LedgerSpec era) ()
topOverdraws Bool
True

  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
    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 <- succ <$> 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 <- succ <$> 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
"Withdrawals from an account unregistered by an earlier 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
$ do
    stakingCred <- KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> ImpM (LedgerSpec era) (KeyHash Staking)
-> ImpM (LedgerSpec era) (Credential Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    keyDeposit <- getsPParams ppKeyDepositL
    account <- registerStakeCredential stakingCred
    let subUnregister =
          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
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> StrictSeq (TxCert era) -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential Staking
stakingCred Coin
keyDeposit]
        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
forall t. Val t => t
zero)]
        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
subUnregister, Item (OMap TxId (Tx SubTx era))
Tx SubTx era
subWithdraw]

    -- the account is still present in the original accounts, so only the check
    -- against the updated accounts fails
    submitFailingTx
      tx
      [ injectFailure . SubWithdrawalAccountsMissing @era $
          Withdrawals [(account, zero)]
      ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Top-level withdrawal from an account unregistered by a 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
$ do
    stakingCred <- KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> ImpM (LedgerSpec era) (KeyHash Staking)
-> ImpM (LedgerSpec era) (Credential Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    keyDeposit <- getsPParams ppKeyDepositL
    account <- registerStakeCredential stakingCred
    let subUnregister =
          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
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> StrictSeq (TxCert era) -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential Staking
stakingCred Coin
keyDeposit]
        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
forall t. Val t => t
zero)]
              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
subUnregister]
        accountMissing =
          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)
-> (Withdrawals -> EntitiesPredFailure era)
-> Withdrawals
-> EraRuleFailure "LEDGER" era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Withdrawals -> EntitiesPredFailure era
WithdrawalAccountsMissing @era (Withdrawals -> EraRuleFailure "LEDGER" era)
-> Withdrawals -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
            Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
forall t. Val t => t
zero)]

    -- the aggregate check against the original accounts passes, since the account
    -- is still there with a zero balance
    submitFailingTx tx [accountMissing]

    legacyTx <- switchTxToLegacyMode tx
    submitFailingTx legacyTx [accountMissing]

  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 <- succ <$> 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 <- succ <$> arbitrary
    amountZ <- succ <$> 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
"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 <- succ <$> 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
"Direct deposits cannot fund withdrawals from an account registered in the same batch" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    stakingCred <- KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> ImpM (LedgerSpec era) (KeyHash Staking)
-> ImpM (LedgerSpec era) (Credential Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    account <- getAccountAddressFor stakingCred
    keyDeposit <- getsPParams ppKeyDepositL
    depositAmount <- succ <$> arbitrary
    let subRegisterAndDeposit =
          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
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> StrictSeq (TxCert era) -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential Staking -> Coin -> TxCert era
RegDepositTxCert Credential Staking
stakingCred Coin
keyDeposit]
              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
subRegisterAndDeposit, Item (OMap TxId (Tx SubTx era))
Tx SubTx era
subWithdraw]
        missingFromOriginal =
          SubEntitiesPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (SubEntitiesPredFailure era -> EraRuleFailure "LEDGER" era)
-> (Withdrawals -> SubEntitiesPredFailure era)
-> Withdrawals
-> EraRuleFailure "LEDGER" era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Withdrawals -> SubEntitiesPredFailure era
SubWithdrawalAccountsMissingFromOriginal @era (Withdrawals -> EraRuleFailure "LEDGER" era)
-> Withdrawals -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
            Map AccountAddress Coin -> Withdrawals
Withdrawals [(AccountAddress
account, Coin
depositAmount)]

    submitFailingTx tx [missingFromOriginal]

    legacyTx <- switchTxToLegacyMode tx
    submitFailingTx legacyTx [missingFromOriginal]

  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 <- succ <$> 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
-> 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 registered by a sub-transaction, 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
      keyDeposit <- Lens' (PParams era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (Coin -> f Coin) -> PParams era -> f (PParams era)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
      let drainsInLegacyMode Coin
amount = do
            stakingCred <- KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> ImpM (LedgerSpec era) (KeyHash Staking)
-> ImpM (LedgerSpec era) (Credential Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            account <- getAccountAddressFor stakingCred
            let subRegisterAndFund =
                  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
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> StrictSeq (TxCert era) -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential Staking -> Coin -> TxCert era
RegDepositTxCert Credential Staking
stakingCred Coin
keyDeposit]
                      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
amount)]
                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
amount)]
                      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
subRegisterAndFund]

            -- in normal mode the account must already be present in the original accounts
            submitFailingTx
              tx
              [ injectFailure . WithdrawalAccountsMissingFromOriginal @era $
                  Withdrawals [(account, amount)]
              ]

            submitTx_ =<< switchTxToLegacyMode tx
            expectStakeCredRegistered stakingCred
            getBalance stakingCred `shouldReturn` zero

      -- withdrawing zero from an account the batch itself registered
      drainsInLegacyMode zero
      -- withdrawing exactly what the same sub-transaction direct-deposited
      depositAmount <- succ <$> arbitrary
      drainsInLegacyMode depositAmount

  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 <- freshUnregisteredAccount
      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 = Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith (Integer -> Coin
Coin Integer
1_000_000)

    -- \| Register a fresh stake credential and fund it by direct deposit with the
    -- given balance.
    setupAccountAddressWith :: Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
    setupAccountAddressWith :: Coin -> ImpTestM era (AccountAddress, Coin, KeyHash Staking)
setupAccountAddressWith Coin
balance = 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
      submitTx_ $
        mkBasicTx $
          mkBasicTxBody & directDepositsTxBodyL .~ DirectDeposits [(ra, balance)]
      pure (ra, balance, kh)

    genAccountBalance :: ImpTestM era Coin
    genAccountBalance :: ImpM (LedgerSpec era) Coin
genAccountBalance = Integer -> Coin
Coin (Integer -> Coin)
-> ImpM (LedgerSpec era) Integer -> ImpM (LedgerSpec era) Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> ImpM (LedgerSpec era) Integer
forall a. Random a => (a, a) -> ImpM (LedgerSpec era) a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Integer
1_000, Integer
1_000_000)

    genDeposit :: ImpTestM era Coin
    genDeposit :: ImpM (LedgerSpec era) Coin
genDeposit = Coin -> Coin
forall a. Enum a => a -> a
succ (Coin -> Coin)
-> ImpM (LedgerSpec era) Coin -> ImpM (LedgerSpec era) Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) Coin
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary

    mkTxWithBatchWithdrawals :: Withdrawals -> [Withdrawals] -> ImpTestM era (Tx TopTx era)
    mkTxWithBatchWithdrawals :: Withdrawals
-> [Withdrawals] -> ImpM (LedgerSpec era) (Tx TopTx era)
mkTxWithBatchWithdrawals Withdrawals
topWdrls [Withdrawals]
subs = do
      topTx <- [Tx SubTx era] -> ImpM (LedgerSpec era) (Tx TopTx era)
forall era.
DijkstraEraImp era =>
[Tx SubTx era] -> ImpTestM era (Tx TopTx era)
mkTopTxWithDistinctSubTxs ((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)
      pure $ topTx & bodyTxL . withdrawalsTxBodyL .~ topWdrls
      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)

    withdrawsFrom :: forall l. AccountAddress -> Coin -> TxBody l era -> TxBody l era
    withdrawsFrom :: forall (l :: TxLevel).
AccountAddress -> Coin -> TxBody l era -> TxBody l era
withdrawsFrom AccountAddress
acct Coin
amount = (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
acct, Coin
amount)]

    depositsTo :: forall l. AccountAddress -> Coin -> TxBody l era -> TxBody l era
    depositsTo :: forall (l :: TxLevel).
AccountAddress -> Coin -> TxBody l era -> TxBody l era
depositsTo AccountAddress
acct Coin
amount = (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
acct, Coin
amount)]

    subTx :: (TxBody SubTx era -> TxBody SubTx era) -> Tx SubTx era
    subTx :: (TxBody SubTx era -> TxBody SubTx era) -> Tx SubTx era
subTx TxBody SubTx era -> TxBody SubTx era
modifyBody = 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
& TxBody SubTx era -> TxBody SubTx era
modifyBody)

    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)

    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 <- freshUnregisteredAccount
      submitFailing
        (AccountBalanceIntervals [(unregistered, violated)])
        (mkMissingAccounts (NEM.singleton unregistered violated))
      submitFailing
        (AccountBalanceIntervals [(accountAddr, violated)])
        (mkBalancesOutside (NEM.singleton accountAddr (balance, violated)))