{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Cardano.Ledger.State.Account (
CanGetAccounts (..),
CanSetAccounts (..),
EraAccounts (..),
lookupAccountState,
lookupAccountStateIntern,
lookupAccountDeposit,
updateLookupAccountState,
isAccountRegistered,
adjustAccountState,
lookupStakePoolDelegation,
sumBalancesAccounts,
sumDepositsAccounts,
addToBalanceAccounts,
withdrawalsThatDoNotDrainAccounts,
withdrawalsThatExceedAccountBalance,
drainAccounts,
applyWithdrawals,
applyDirectDeposits,
directDepositsMissingAccounts,
removeStakePoolDelegations,
) where
import Cardano.Ledger.Address (DirectDeposits (..))
import Cardano.Ledger.BaseTypes (Mismatch (..), Network, Relation (..))
import Cardano.Ledger.Binary
import Cardano.Ledger.Coin
import Cardano.Ledger.Compactible
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Control.DeepSeq (NFData)
import Control.Exception (assert)
import Data.Aeson (ToJSON)
import Data.Bifunctor (Bifunctor (..))
import Data.Default (Default)
import Data.Foldable (foldMap')
import Data.Kind (Type)
import qualified Data.Map.Merge.Strict as Map
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras (lookupInternMap)
import Data.Set (Set)
import Lens.Micro
import NoThunks.Class (NoThunks)
class CanGetAccounts t where
accountsG :: SimpleGetter (t era) (Accounts era)
default accountsG :: CanSetAccounts t => SimpleGetter (t era) (Accounts era)
accountsG = (Accounts era -> Const r (Accounts era))
-> t era -> Const r (t era)
forall era. Lens' (t era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
{-# INLINE accountsG #-}
class CanGetAccounts t => CanSetAccounts t where
accountsL :: Lens' (t era) (Accounts era)
class
( Era era
, Eq (Accounts era)
, Show (Accounts era)
, Default (Accounts era)
, EncCBOR (Accounts era)
, DecShareCBOR (Accounts era)
, Share (Accounts era)
~ ( Interns (Credential Staking)
, Interns (KeyHash StakePool)
, Interns (Credential DRepRole)
)
, ToJSON (Accounts era)
, NFData (Accounts era)
, NoThunks (Accounts era)
, Eq (AccountState era)
, Show (AccountState era)
, NFData (AccountState era)
, NoThunks (AccountState era)
) =>
EraAccounts era
where
type AccountState era = (r :: Type) | r -> era
type Accounts era = (r :: Type) | r -> era
addAccountState :: Credential Staking -> AccountState era -> Accounts era -> Accounts era
accountsMapL :: Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
balanceAccountStateL :: Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL :: Lens' (AccountState era) (CompactForm Coin)
stakePoolDelegationAccountStateL :: Lens' (AccountState era) (Maybe (KeyHash StakePool))
unregisterAccount ::
Credential Staking ->
Accounts era ->
(Maybe (AccountState era), Accounts era)
sumBalancesAccounts :: EraAccounts era => Accounts era -> Coin
sumBalancesAccounts :: forall era. EraAccounts era => Accounts era -> Coin
sumBalancesAccounts Accounts era
accounts =
CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin) -> CompactForm Coin -> Coin
forall a b. (a -> b) -> a -> b
$ (AccountState era -> CompactForm Coin)
-> Map (Credential Staking) (AccountState era) -> CompactForm Coin
forall m a. Monoid m => (a -> m) -> Map (Credential Staking) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL) (Map (Credential Staking) (AccountState era) -> CompactForm Coin)
-> Map (Credential Staking) (AccountState era) -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ Accounts era
accounts Accounts era
-> Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL
sumDepositsAccounts :: EraAccounts era => Accounts era -> Coin
sumDepositsAccounts :: forall era. EraAccounts era => Accounts era -> Coin
sumDepositsAccounts Accounts era
accounts =
CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin) -> CompactForm Coin -> Coin
forall a b. (a -> b) -> a -> b
$ (AccountState era -> CompactForm Coin)
-> Map (Credential Staking) (AccountState era) -> CompactForm Coin
forall m a. Monoid m => (a -> m) -> Map (Credential Staking) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL) (Map (Credential Staking) (AccountState era) -> CompactForm Coin)
-> Map (Credential Staking) (AccountState era) -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ Accounts era
accounts Accounts era
-> Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL
addToBalanceAccounts ::
EraAccounts era =>
Map (Credential Staking) (CompactForm Coin) ->
Accounts era ->
Accounts era
addToBalanceAccounts :: forall era.
EraAccounts era =>
Map (Credential Staking) (CompactForm Coin)
-> Accounts era -> Accounts era
addToBalanceAccounts Map (Credential Staking) (CompactForm Coin)
addBalanceMap Accounts era
accounts =
Accounts era
accounts
Accounts era -> (Accounts era -> Accounts era) -> Accounts era
forall a b. a -> (a -> b) -> b
& (Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL
((Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> (Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era))
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SimpleWhenMissing
(Credential Staking) (CompactForm Coin) (AccountState era)
-> SimpleWhenMissing
(Credential Staking) (AccountState era) (AccountState era)
-> SimpleWhenMatched
(Credential Staking)
(CompactForm Coin)
(AccountState era)
(AccountState era)
-> Map (Credential Staking) (CompactForm Coin)
-> Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era)
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
((Credential Staking
-> CompactForm Coin -> Maybe (AccountState era))
-> SimpleWhenMissing
(Credential Staking) (CompactForm Coin) (AccountState era)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
Map.mapMaybeMissing (\Credential Staking
_ CompactForm Coin
_ -> Bool -> Maybe (AccountState era) -> Maybe (AccountState era)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False Maybe (AccountState era)
forall a. Maybe a
Nothing))
SimpleWhenMissing
(Credential Staking) (AccountState era) (AccountState era)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
((Credential Staking
-> CompactForm Coin -> AccountState era -> AccountState era)
-> SimpleWhenMatched
(Credential Staking)
(CompactForm Coin)
(AccountState era)
(AccountState era)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\Credential Staking
_ CompactForm Coin
balanceToAdd -> (CompactForm Coin -> Identity (CompactForm Coin))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL ((CompactForm Coin -> Identity (CompactForm Coin))
-> AccountState era -> Identity (AccountState era))
-> CompactForm Coin -> AccountState era -> AccountState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ CompactForm Coin
balanceToAdd))
Map (Credential Staking) (CompactForm Coin)
addBalanceMap
lookupAccountState ::
EraAccounts era => Credential Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState :: forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential Staking
cred Accounts era
accounts = Credential Staking
-> Map (Credential Staking) (AccountState era)
-> Maybe (AccountState era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential Staking
cred (Accounts era
accounts Accounts era
-> Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL)
lookupAccountStateIntern ::
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe (Credential Staking, AccountState era)
lookupAccountStateIntern :: forall era.
EraAccounts era =>
Credential Staking
-> Accounts era -> Maybe (Credential Staking, AccountState era)
lookupAccountStateIntern Credential Staking
cred Accounts era
accounts =
Credential Staking
-> Map (Credential Staking) (AccountState era)
-> Maybe (Credential Staking, AccountState era)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupInternMap Credential Staking
cred (Accounts era
accounts Accounts era
-> Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL)
lookupAccountDeposit :: EraAccounts era => Credential Staking -> Accounts era -> Maybe Coin
lookupAccountDeposit :: forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe Coin
lookupAccountDeposit Credential Staking
cred Accounts era
accounts =
CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (AccountState era -> CompactForm Coin)
-> AccountState era
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL) (AccountState era -> Coin)
-> Maybe (AccountState era) -> Maybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential Staking
cred Accounts era
accounts
updateLookupAccountState ::
EraAccounts era =>
(AccountState era -> AccountState era) ->
Credential Staking ->
Accounts era ->
(Maybe (AccountState era), Accounts era)
updateLookupAccountState :: forall era.
EraAccounts era =>
(AccountState era -> AccountState era)
-> Credential Staking
-> Accounts era
-> (Maybe (AccountState era), Accounts era)
updateLookupAccountState AccountState era -> AccountState era
f Credential Staking
cred Accounts era
accounts =
case (Credential Staking
-> AccountState era -> Maybe (AccountState era))
-> Credential Staking
-> Map (Credential Staking) (AccountState era)
-> (Maybe (AccountState era),
Map (Credential Staking) (AccountState era))
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\Credential Staking
_ -> AccountState era -> Maybe (AccountState era)
forall a. a -> Maybe a
Just (AccountState era -> Maybe (AccountState era))
-> (AccountState era -> AccountState era)
-> AccountState era
-> Maybe (AccountState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountState era -> AccountState era
f) Credential Staking
cred (Accounts era
accounts Accounts era
-> Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL) of
(Maybe (AccountState era)
res, Map (Credential Staking) (AccountState era)
accountsMap) -> (Maybe (AccountState era)
res, Accounts era
accounts Accounts era -> (Accounts era -> Accounts era) -> Accounts era
forall a b. a -> (a -> b) -> b
& (Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL ((Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> Map (Credential Staking) (AccountState era)
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Credential Staking) (AccountState era)
accountsMap)
isAccountRegistered :: EraAccounts era => Credential Staking -> Accounts era -> Bool
isAccountRegistered :: forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Bool
isAccountRegistered Credential Staking
cred Accounts era
accounts = Credential Staking
-> Map (Credential Staking) (AccountState era) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential Staking
cred (Accounts era
accounts Accounts era
-> Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
(Map (Credential Staking) (AccountState era))
(Accounts era)
(Map (Credential Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL)
adjustAccountState ::
EraAccounts era =>
(AccountState era -> AccountState era) -> Credential Staking -> Accounts era -> Accounts era
adjustAccountState :: forall era.
EraAccounts era =>
(AccountState era -> AccountState era)
-> Credential Staking -> Accounts era -> Accounts era
adjustAccountState AccountState era -> AccountState era
f Credential Staking
cred = (Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL ((Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> (Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era))
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AccountState era -> AccountState era)
-> Credential Staking
-> Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust AccountState era -> AccountState era
f Credential Staking
cred
lookupStakePoolDelegation ::
EraAccounts era =>
Credential Staking ->
Accounts era ->
Maybe (KeyHash StakePool)
lookupStakePoolDelegation :: forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe (KeyHash StakePool)
lookupStakePoolDelegation Credential Staking
cred Accounts era
accounts =
Credential Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential Staking
cred Accounts era
accounts
Maybe (AccountState era)
-> (AccountState era -> Maybe (KeyHash StakePool))
-> Maybe (KeyHash StakePool)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AccountState era
-> Getting
(Maybe (KeyHash StakePool))
(AccountState era)
(Maybe (KeyHash StakePool))
-> Maybe (KeyHash StakePool)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (KeyHash StakePool))
(AccountState era)
(Maybe (KeyHash StakePool))
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash StakePool))
Lens' (AccountState era) (Maybe (KeyHash StakePool))
stakePoolDelegationAccountStateL)
withdrawalsThatDoNotDrainAccounts ::
EraAccounts era =>
Withdrawals ->
Network ->
Accounts era ->
Maybe (Withdrawals, Map AccountAddress (Mismatch RelEQ Coin))
withdrawalsThatDoNotDrainAccounts :: forall era.
EraAccounts era =>
Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch RelEQ Coin))
withdrawalsThatDoNotDrainAccounts =
(Coin -> AccountState era -> Bool)
-> Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch RelEQ Coin))
forall era (r :: Relation).
EraAccounts era =>
(Coin -> AccountState era -> Bool)
-> Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch r Coin))
categorizeWithdrawals
( \Coin
withdrawalAmount AccountState era
account ->
Coin
withdrawalAmount Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (AccountState era
account AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL)
)
withdrawalsThatExceedAccountBalance ::
EraAccounts era =>
Withdrawals ->
Network ->
Accounts era ->
Maybe (Withdrawals, Map AccountAddress (Mismatch RelLTEQ Coin))
withdrawalsThatExceedAccountBalance :: forall era.
EraAccounts era =>
Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch RelLTEQ Coin))
withdrawalsThatExceedAccountBalance =
(Coin -> AccountState era -> Bool)
-> Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch RelLTEQ Coin))
forall era (r :: Relation).
EraAccounts era =>
(Coin -> AccountState era -> Bool)
-> Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch r Coin))
categorizeWithdrawals
( \Coin
withdrawalAmount AccountState era
account ->
Coin
withdrawalAmount Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (AccountState era
account AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL)
)
categorizeWithdrawals ::
EraAccounts era =>
(Coin -> AccountState era -> Bool) ->
Withdrawals ->
Network ->
Accounts era ->
Maybe (Withdrawals, Map AccountAddress (Mismatch r Coin))
categorizeWithdrawals :: forall era (r :: Relation).
EraAccounts era =>
(Coin -> AccountState era -> Bool)
-> Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch r Coin))
categorizeWithdrawals Coin -> AccountState era -> Bool
amountAcceptable (Withdrawals Map AccountAddress Coin
withdrawals) Network
networkId Accounts era
accounts
| (AccountAddress -> Coin -> Bool -> Bool)
-> Bool -> Map AccountAddress Coin -> Bool
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' AccountAddress -> Coin -> Bool -> Bool
checkBadWithdrawals Bool
True Map AccountAddress Coin
withdrawals = Maybe (Withdrawals, Map AccountAddress (Mismatch r Coin))
forall a. Maybe a
Nothing
| Bool
otherwise =
(Withdrawals, Map AccountAddress (Mismatch r Coin))
-> Maybe (Withdrawals, Map AccountAddress (Mismatch r Coin))
forall a. a -> Maybe a
Just ((Withdrawals, Map AccountAddress (Mismatch r Coin))
-> Maybe (Withdrawals, Map AccountAddress (Mismatch r Coin)))
-> (Withdrawals, Map AccountAddress (Mismatch r Coin))
-> Maybe (Withdrawals, Map AccountAddress (Mismatch r Coin))
forall a b. (a -> b) -> a -> b
$
(Map AccountAddress Coin -> Withdrawals)
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> (Withdrawals, Map AccountAddress (Mismatch r Coin))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Map AccountAddress Coin -> Withdrawals
Withdrawals ((Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> (Withdrawals, Map AccountAddress (Mismatch r Coin)))
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> (Withdrawals, Map AccountAddress (Mismatch r Coin))
forall a b. (a -> b) -> a -> b
$
(AccountAddress
-> Coin
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin)))
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> Map AccountAddress Coin
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' AccountAddress
-> Coin
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
collectBadWithdrawals (Map AccountAddress Coin
forall k a. Map k a
Map.empty, Map AccountAddress (Mismatch r Coin)
forall k a. Map k a
Map.empty) Map AccountAddress Coin
withdrawals
where
checkBadWithdrawals :: AccountAddress -> Coin -> Bool -> Bool
checkBadWithdrawals AccountAddress
accountAddress Coin
withdrawalAmount Bool
noBadWithdrawals =
Bool
noBadWithdrawals Bool -> Bool -> Bool
&& AccountAddress -> Coin -> Bool
isGoodWithdrawal AccountAddress
accountAddress Coin
withdrawalAmount
isGoodWithdrawal :: AccountAddress -> Coin -> Bool
isGoodWithdrawal AccountAddress
accountAddress Coin
withdrawalAmount =
Bool
-> (AccountState era -> Bool) -> Maybe (AccountState era) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Coin -> AccountState era -> Bool
amountAcceptable Coin
withdrawalAmount) (AccountAddress -> Maybe (AccountState era)
lookupAccount AccountAddress
accountAddress)
collectBadWithdrawals :: AccountAddress
-> Coin
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
collectBadWithdrawals AccountAddress
accountAddress Coin
withdrawalAmount accum :: (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
accum@(!Map AccountAddress Coin
_, !Map AccountAddress (Mismatch r Coin)
_) =
case AccountAddress -> Maybe (AccountState era)
lookupAccount AccountAddress
accountAddress of
Maybe (AccountState era)
Nothing -> (Map AccountAddress Coin -> Map AccountAddress Coin)
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (AccountAddress
-> Coin -> Map AccountAddress Coin -> Map AccountAddress Coin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AccountAddress
accountAddress Coin
withdrawalAmount) (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
accum
Just AccountState era
account
| Coin -> AccountState era -> Bool
amountAcceptable Coin
withdrawalAmount AccountState era
account -> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
accum
| Bool
otherwise ->
(Map AccountAddress (Mismatch r Coin)
-> Map AccountAddress (Mismatch r Coin))
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
-> (Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second
( AccountAddress
-> Mismatch r Coin
-> Map AccountAddress (Mismatch r Coin)
-> Map AccountAddress (Mismatch r Coin)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
AccountAddress
accountAddress
(Mismatch r Coin
-> Map AccountAddress (Mismatch r Coin)
-> Map AccountAddress (Mismatch r Coin))
-> Mismatch r Coin
-> Map AccountAddress (Mismatch r Coin)
-> Map AccountAddress (Mismatch r Coin)
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch r Coin
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch Coin
withdrawalAmount (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin) -> CompactForm Coin -> Coin
forall a b. (a -> b) -> a -> b
$ AccountState era
account AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL)
)
(Map AccountAddress Coin, Map AccountAddress (Mismatch r Coin))
accum
lookupAccount :: AccountAddress -> Maybe (AccountState era)
lookupAccount (AccountAddress Network
aaNetworkId (AccountId Credential Staking
credential))
| Network
aaNetworkId Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
networkId = Credential Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential Staking
credential Accounts era
accounts
| Bool
otherwise = Maybe (AccountState era)
forall a. Maybe a
Nothing
{-# INLINE categorizeWithdrawals #-}
drainAccounts ::
EraAccounts era =>
Withdrawals ->
Accounts era ->
Accounts era
drainAccounts :: forall era.
EraAccounts era =>
Withdrawals -> Accounts era -> Accounts era
drainAccounts (Withdrawals Map AccountAddress Coin
wdrls) = (CompactForm Coin -> AccountState era -> CompactForm Coin)
-> Map AccountAddress Coin -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
(CompactForm Coin -> AccountState era -> CompactForm Coin)
-> Map AccountAddress Coin -> Accounts era -> Accounts era
updateAccountBalances (\CompactForm Coin
_ AccountState era
_ -> CompactForm Coin
forall a. Monoid a => a
mempty) Map AccountAddress Coin
wdrls
applyWithdrawals ::
EraAccounts era =>
Withdrawals ->
Accounts era ->
Accounts era
applyWithdrawals :: forall era.
EraAccounts era =>
Withdrawals -> Accounts era -> Accounts era
applyWithdrawals (Withdrawals Map AccountAddress Coin
wdrls) =
(CompactForm Coin -> AccountState era -> CompactForm Coin)
-> Map AccountAddress Coin -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
(CompactForm Coin -> AccountState era -> CompactForm Coin)
-> Map AccountAddress Coin -> Accounts era -> Accounts era
updateAccountBalances
(\CompactForm Coin
amount AccountState era
account -> CompactForm Coin -> CompactForm Coin -> CompactForm Coin
subtractCompactCoin CompactForm Coin
amount (AccountState era
account AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL))
Map AccountAddress Coin
wdrls
applyDirectDeposits ::
EraAccounts era =>
DirectDeposits ->
Accounts era ->
Accounts era
applyDirectDeposits :: forall era.
EraAccounts era =>
DirectDeposits -> Accounts era -> Accounts era
applyDirectDeposits (DirectDeposits Map AccountAddress Coin
dd) =
(CompactForm Coin -> AccountState era -> CompactForm Coin)
-> Map AccountAddress Coin -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
(CompactForm Coin -> AccountState era -> CompactForm Coin)
-> Map AccountAddress Coin -> Accounts era -> Accounts era
updateAccountBalances
(\CompactForm Coin
amount AccountState era
account -> CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompactCoin CompactForm Coin
amount (AccountState era
account AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL))
Map AccountAddress Coin
dd
updateAccountBalances ::
EraAccounts era =>
(CompactForm Coin -> AccountState era -> CompactForm Coin) ->
Map AccountAddress Coin ->
Accounts era ->
Accounts era
updateAccountBalances :: forall era.
EraAccounts era =>
(CompactForm Coin -> AccountState era -> CompactForm Coin)
-> Map AccountAddress Coin -> Accounts era -> Accounts era
updateAccountBalances CompactForm Coin -> AccountState era -> CompactForm Coin
updateBalance Map AccountAddress Coin
balanceMap =
(Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL ((Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> (Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era))
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Map (Credential Staking) (AccountState era)
accountsMap ->
(AccountAddress
-> Coin
-> Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
-> Map AccountAddress Coin
-> Map (Credential Staking) (AccountState era)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey'
( \(AccountAddress Network
_ (AccountId Credential Staking
credential)) Coin
amount ->
(AccountState era -> AccountState era)
-> Credential Staking
-> Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
( \AccountState era
account ->
AccountState era
account AccountState era
-> (AccountState era -> AccountState era) -> AccountState era
forall a b. a -> (a -> b) -> b
& (CompactForm Coin -> Identity (CompactForm Coin))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL ((CompactForm Coin -> Identity (CompactForm Coin))
-> AccountState era -> Identity (AccountState era))
-> CompactForm Coin -> AccountState era -> AccountState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CompactForm Coin -> AccountState era -> CompactForm Coin
updateBalance ((?callStack::CallStack) => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
amount) AccountState era
account
)
Credential Staking
credential
)
Map (Credential Staking) (AccountState era)
accountsMap
Map AccountAddress Coin
balanceMap
{-# INLINE updateAccountBalances #-}
directDepositsMissingAccounts ::
EraAccounts era =>
DirectDeposits ->
Accounts era ->
Maybe DirectDeposits
directDepositsMissingAccounts :: forall era.
EraAccounts era =>
DirectDeposits -> Accounts era -> Maybe DirectDeposits
directDepositsMissingAccounts (DirectDeposits Map AccountAddress Coin
dds) Accounts era
accounts
| (AccountAddress -> Coin -> Bool -> Bool)
-> Bool -> Map AccountAddress Coin -> Bool
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' AccountAddress -> Coin -> Bool -> Bool
checkRegistered Bool
True Map AccountAddress Coin
dds = Maybe DirectDeposits
forall a. Maybe a
Nothing
| Bool
otherwise = DirectDeposits -> Maybe DirectDeposits
forall a. a -> Maybe a
Just (DirectDeposits -> Maybe DirectDeposits)
-> DirectDeposits -> Maybe DirectDeposits
forall a b. (a -> b) -> a -> b
$ Map AccountAddress Coin -> DirectDeposits
DirectDeposits (Map AccountAddress Coin -> DirectDeposits)
-> Map AccountAddress Coin -> DirectDeposits
forall a b. (a -> b) -> a -> b
$ (AccountAddress
-> Coin -> Map AccountAddress Coin -> Map AccountAddress Coin)
-> Map AccountAddress Coin
-> Map AccountAddress Coin
-> Map AccountAddress Coin
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' AccountAddress
-> Coin -> Map AccountAddress Coin -> Map AccountAddress Coin
collectMissing Map AccountAddress Coin
forall k a. Map k a
Map.empty Map AccountAddress Coin
dds
where
isRegistered :: AccountAddress -> Bool
isRegistered (AccountAddress Network
_ (AccountId Credential Staking
credential)) =
Credential Staking -> Accounts era -> Bool
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Bool
isAccountRegistered Credential Staking
credential Accounts era
accounts
checkRegistered :: AccountAddress -> Coin -> Bool -> Bool
checkRegistered AccountAddress
addr Coin
_ Bool
acc = Bool
acc Bool -> Bool -> Bool
&& AccountAddress -> Bool
isRegistered AccountAddress
addr
collectMissing :: AccountAddress
-> Coin -> Map AccountAddress Coin -> Map AccountAddress Coin
collectMissing AccountAddress
addr Coin
amount Map AccountAddress Coin
acc
| AccountAddress -> Bool
isRegistered AccountAddress
addr = Map AccountAddress Coin
acc
| Bool
otherwise = AccountAddress
-> Coin -> Map AccountAddress Coin -> Map AccountAddress Coin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AccountAddress
addr Coin
amount Map AccountAddress Coin
acc
removeStakePoolDelegations ::
EraAccounts era => Set (Credential Staking) -> Accounts era -> Accounts era
removeStakePoolDelegations :: forall era.
EraAccounts era =>
Set (Credential Staking) -> Accounts era -> Accounts era
removeStakePoolDelegations Set (Credential Staking)
creds Accounts era
accounts =
Accounts era
accounts
Accounts era -> (Accounts era -> Accounts era) -> Accounts era
forall a b. a -> (a -> b) -> b
& (Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL
((Map (Credential Staking) (AccountState era)
-> Identity (Map (Credential Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> (Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era))
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \Map (Credential Staking) (AccountState era)
accountsMap ->
(Credential Staking
-> Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
-> Set (Credential Staking)
-> Map (Credential Staking) (AccountState era)
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
((AccountState era -> AccountState era)
-> Credential Staking
-> Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) (AccountState era)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Maybe (KeyHash StakePool) -> Identity (Maybe (KeyHash StakePool)))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash StakePool))
Lens' (AccountState era) (Maybe (KeyHash StakePool))
stakePoolDelegationAccountStateL ((Maybe (KeyHash StakePool)
-> Identity (Maybe (KeyHash StakePool)))
-> AccountState era -> Identity (AccountState era))
-> Maybe (KeyHash StakePool)
-> AccountState era
-> AccountState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (KeyHash StakePool)
forall a. Maybe a
Nothing))
Map (Credential Staking) (AccountState era)
accountsMap
Set (Credential Staking)
creds
)