{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
-- TODO: submit a ghc bug report
-- some GHC bug wrongfully complains about CanGetInstantStake constraint being redundant.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Cardano.Ledger.State.Stake (
  Stake (..),
  sumAllStake,
  sumAllStakeCompact,
  sumCredentialsCompactStake,
  StakeWithDelegation (..),
  ActiveStake (..),
  sumAllActiveStake,
  sumCredentialsCompactActiveStake,
  EraStake (..),
  CanGetInstantStake (..),
  CanSetInstantStake (..),
  resolveActiveInstantStakeCredentials,
) where

import Cardano.Ledger.BaseTypes (
  NonZero (..),
  nonZero,
  nonZeroOr,
  unsafeNonZero,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  Interns,
  decodeRecordNamed,
  encodeListLen,
 )
import Cardano.Ledger.Coin
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.State.Account
import Cardano.Ledger.State.UTxO
import Control.DeepSeq (NFData)
import Data.Aeson (ToJSON)
import Data.Default (Default)
import Data.Foldable (foldMap')
import Data.Functor.Identity
import Data.Kind (Type)
import qualified Data.Map.Merge.Strict as Map
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.VMap (VB, VMap, VP)
import qualified Data.VMap as VMap
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks)

-- | Type of stake as map from staking credential to coins associated. Any staking credential that
-- has no stake will not appear in this Map, even if it is registered. For this reason, this data
-- type should not be used for infering whether credential is registered or not.
newtype Stake = Stake
  { Stake -> VMap VB VP (Credential Staking) (CompactForm Coin)
unStake :: VMap VB VP (Credential Staking) (CompactForm Coin)
  }
  deriving (Int -> Stake -> ShowS
[Stake] -> ShowS
Stake -> String
(Int -> Stake -> ShowS)
-> (Stake -> String) -> ([Stake] -> ShowS) -> Show Stake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stake -> ShowS
showsPrec :: Int -> Stake -> ShowS
$cshow :: Stake -> String
show :: Stake -> String
$cshowList :: [Stake] -> ShowS
showList :: [Stake] -> ShowS
Show, Stake -> Stake -> Bool
(Stake -> Stake -> Bool) -> (Stake -> Stake -> Bool) -> Eq Stake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stake -> Stake -> Bool
== :: Stake -> Stake -> Bool
$c/= :: Stake -> Stake -> Bool
/= :: Stake -> Stake -> Bool
Eq, Stake -> ()
(Stake -> ()) -> NFData Stake
forall a. (a -> ()) -> NFData a
$crnf :: Stake -> ()
rnf :: Stake -> ()
NFData, (forall x. Stake -> Rep Stake x)
-> (forall x. Rep Stake x -> Stake) -> Generic Stake
forall x. Rep Stake x -> Stake
forall x. Stake -> Rep Stake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Stake -> Rep Stake x
from :: forall x. Stake -> Rep Stake x
$cto :: forall x. Rep Stake x -> Stake
to :: forall x. Rep Stake x -> Stake
Generic, [Stake] -> Value
[Stake] -> Encoding
Stake -> Bool
Stake -> Value
Stake -> Encoding
(Stake -> Value)
-> (Stake -> Encoding)
-> ([Stake] -> Value)
-> ([Stake] -> Encoding)
-> (Stake -> Bool)
-> ToJSON Stake
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Stake -> Value
toJSON :: Stake -> Value
$ctoEncoding :: Stake -> Encoding
toEncoding :: Stake -> Encoding
$ctoJSONList :: [Stake] -> Value
toJSONList :: [Stake] -> Value
$ctoEncodingList :: [Stake] -> Encoding
toEncodingList :: [Stake] -> Encoding
$comitField :: Stake -> Bool
omitField :: Stake -> Bool
ToJSON, Context -> Stake -> IO (Maybe ThunkInfo)
Proxy Stake -> String
(Context -> Stake -> IO (Maybe ThunkInfo))
-> (Context -> Stake -> IO (Maybe ThunkInfo))
-> (Proxy Stake -> String)
-> NoThunks Stake
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Stake -> IO (Maybe ThunkInfo)
noThunks :: Context -> Stake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Stake -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Stake -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Stake -> String
showTypeOf :: Proxy Stake -> String
NoThunks, Stake -> Encoding
(Stake -> Encoding) -> EncCBOR Stake
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: Stake -> Encoding
encCBOR :: Stake -> Encoding
EncCBOR)

instance Monoid Stake where
  mempty :: Stake
mempty = VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
Stake VMap VB VP (Credential Staking) (CompactForm Coin)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v
VMap.empty

instance Semigroup Stake where
  Stake VMap VB VP (Credential Staking) (CompactForm Coin)
s1 <> :: Stake -> Stake -> Stake
<> Stake VMap VB VP (Credential Staking) (CompactForm Coin)
s2 = VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
Stake (VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake)
-> VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
forall a b. (a -> b) -> a -> b
$ (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> VMap VB VP (Credential Staking) (CompactForm Coin)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
(v -> v -> v) -> VMap kv vv k v -> VMap kv vv k v -> VMap kv vv k v
VMap.unionWith CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a. Semigroup a => a -> a -> a
(<>) VMap VB VP (Credential Staking) (CompactForm Coin)
s1 VMap VB VP (Credential Staking) (CompactForm Coin)
s2

instance DecShareCBOR Stake where
  type Share Stake = Share (VMap VB VP (Credential Staking) (CompactForm Coin))
  getShare :: Stake -> Share Stake
getShare = VMap VB VP (Credential Staking) (CompactForm Coin)
-> Share (VMap VB VP (Credential Staking) (CompactForm Coin))
VMap VB VP (Credential Staking) (CompactForm Coin)
-> Interns (Credential Staking)
forall a. DecShareCBOR a => a -> Share a
getShare (VMap VB VP (Credential Staking) (CompactForm Coin)
 -> Interns (Credential Staking))
-> (Stake -> VMap VB VP (Credential Staking) (CompactForm Coin))
-> Stake
-> Interns (Credential Staking)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake -> VMap VB VP (Credential Staking) (CompactForm Coin)
unStake
  decShareCBOR :: forall s. Share Stake -> Decoder s Stake
decShareCBOR = (VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake)
-> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
-> Decoder s Stake
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
Stake (Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
 -> Decoder s Stake)
-> (Interns (Credential Staking)
    -> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin)))
-> Interns (Credential Staking)
-> Decoder s Stake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Share (VMap VB VP (Credential Staking) (CompactForm Coin))
-> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
Interns (Credential Staking)
-> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (VMap VB VP (Credential Staking) (CompactForm Coin))
-> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
decShareCBOR

sumAllStake :: Stake -> Coin
sumAllStake :: Stake -> Coin
sumAllStake = CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (Stake -> CompactForm Coin) -> Stake -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake -> CompactForm Coin
sumAllStakeCompact
{-# INLINE sumAllStake #-}

sumAllStakeCompact :: Stake -> CompactForm Coin
sumAllStakeCompact :: Stake -> CompactForm Coin
sumAllStakeCompact = (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> CompactForm Coin
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> CompactForm Coin
forall (vv :: * -> *) v a (kv :: * -> *) k.
Vector vv v =>
(a -> v -> a) -> a -> VMap kv vv k v -> a
VMap.foldl CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a. Semigroup a => a -> a -> a
(<>) CompactForm Coin
forall a. Monoid a => a
mempty (VMap VB VP (Credential Staking) (CompactForm Coin)
 -> CompactForm Coin)
-> (Stake -> VMap VB VP (Credential Staking) (CompactForm Coin))
-> Stake
-> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake -> VMap VB VP (Credential Staking) (CompactForm Coin)
unStake
{-# INLINE sumAllStakeCompact #-}

sumCredentialsCompactStake :: Foldable f => Stake -> f (Credential Staking) -> CompactForm Coin
sumCredentialsCompactStake :: forall (f :: * -> *).
Foldable f =>
Stake -> f (Credential Staking) -> CompactForm Coin
sumCredentialsCompactStake (Stake VMap VB VP (Credential Staking) (CompactForm Coin)
stake) = (Credential Staking -> CompactForm Coin)
-> f (Credential Staking) -> CompactForm Coin
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (CompactForm Coin -> Maybe (CompactForm Coin) -> CompactForm Coin
forall a. a -> Maybe a -> a
fromMaybe CompactForm Coin
forall a. Monoid a => a
mempty (Maybe (CompactForm Coin) -> CompactForm Coin)
-> (Credential Staking -> Maybe (CompactForm Coin))
-> Credential Staking
-> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Credential Staking
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
`VMap.lookup` VMap VB VP (Credential Staking) (CompactForm Coin)
stake))
{-# INLINE sumCredentialsCompactStake #-}

-- | Combination of non-zero stake with the pool delegation for a single credential.
data StakeWithDelegation = StakeWithDelegation
  { StakeWithDelegation -> NonZero (CompactForm Coin)
swdStake :: {-# UNPACK #-} !(NonZero (CompactForm Coin))
  , StakeWithDelegation -> KeyHash StakePool
swdDelegation :: !(KeyHash StakePool)
  }
  deriving (StakeWithDelegation -> StakeWithDelegation -> Bool
(StakeWithDelegation -> StakeWithDelegation -> Bool)
-> (StakeWithDelegation -> StakeWithDelegation -> Bool)
-> Eq StakeWithDelegation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakeWithDelegation -> StakeWithDelegation -> Bool
== :: StakeWithDelegation -> StakeWithDelegation -> Bool
$c/= :: StakeWithDelegation -> StakeWithDelegation -> Bool
/= :: StakeWithDelegation -> StakeWithDelegation -> Bool
Eq, Int -> StakeWithDelegation -> ShowS
[StakeWithDelegation] -> ShowS
StakeWithDelegation -> String
(Int -> StakeWithDelegation -> ShowS)
-> (StakeWithDelegation -> String)
-> ([StakeWithDelegation] -> ShowS)
-> Show StakeWithDelegation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakeWithDelegation -> ShowS
showsPrec :: Int -> StakeWithDelegation -> ShowS
$cshow :: StakeWithDelegation -> String
show :: StakeWithDelegation -> String
$cshowList :: [StakeWithDelegation] -> ShowS
showList :: [StakeWithDelegation] -> ShowS
Show, (forall x. StakeWithDelegation -> Rep StakeWithDelegation x)
-> (forall x. Rep StakeWithDelegation x -> StakeWithDelegation)
-> Generic StakeWithDelegation
forall x. Rep StakeWithDelegation x -> StakeWithDelegation
forall x. StakeWithDelegation -> Rep StakeWithDelegation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakeWithDelegation -> Rep StakeWithDelegation x
from :: forall x. StakeWithDelegation -> Rep StakeWithDelegation x
$cto :: forall x. Rep StakeWithDelegation x -> StakeWithDelegation
to :: forall x. Rep StakeWithDelegation x -> StakeWithDelegation
Generic)

instance NoThunks StakeWithDelegation

instance NFData StakeWithDelegation

instance ToJSON StakeWithDelegation

instance EncCBOR StakeWithDelegation where
  encCBOR :: StakeWithDelegation -> Encoding
encCBOR (StakeWithDelegation NonZero (CompactForm Coin)
s KeyHash StakePool
d) = Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonZero (CompactForm Coin) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR NonZero (CompactForm Coin)
s Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash StakePool
d

instance DecCBOR StakeWithDelegation where
  decCBOR :: forall s. Decoder s StakeWithDelegation
decCBOR =
    Text
-> (StakeWithDelegation -> Int)
-> Decoder s StakeWithDelegation
-> Decoder s StakeWithDelegation
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"SnapShot" (Int -> StakeWithDelegation -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s StakeWithDelegation -> Decoder s StakeWithDelegation)
-> Decoder s StakeWithDelegation -> Decoder s StakeWithDelegation
forall a b. (a -> b) -> a -> b
$
      NonZero (CompactForm Coin)
-> KeyHash StakePool -> StakeWithDelegation
StakeWithDelegation (NonZero (CompactForm Coin)
 -> KeyHash StakePool -> StakeWithDelegation)
-> Decoder s (NonZero (CompactForm Coin))
-> Decoder s (KeyHash StakePool -> StakeWithDelegation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (NonZero (CompactForm Coin))
forall s. Decoder s (NonZero (CompactForm Coin))
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (KeyHash StakePool -> StakeWithDelegation)
-> Decoder s (KeyHash StakePool) -> Decoder s StakeWithDelegation
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (KeyHash StakePool)
forall s. Decoder s (KeyHash StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR

instance DecShareCBOR StakeWithDelegation where
  type Share StakeWithDelegation = Interns (Credential Staking)
  decShareCBOR :: forall s.
Share StakeWithDelegation -> Decoder s StakeWithDelegation
decShareCBOR Share StakeWithDelegation
_si = Decoder s StakeWithDelegation
forall s. Decoder s StakeWithDelegation
forall a s. DecCBOR a => Decoder s a
decCBOR

-- | Active stake: maps staking credentials to their non-zero stake paired with delegation.
-- Only credentials that are registered, delegated, and have non-zero stake appear here.
newtype ActiveStake = ActiveStake
  { ActiveStake -> VMap VB VB (Credential Staking) StakeWithDelegation
unActiveStake :: VMap VB VB (Credential Staking) StakeWithDelegation
  }
  deriving (Int -> ActiveStake -> ShowS
[ActiveStake] -> ShowS
ActiveStake -> String
(Int -> ActiveStake -> ShowS)
-> (ActiveStake -> String)
-> ([ActiveStake] -> ShowS)
-> Show ActiveStake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveStake -> ShowS
showsPrec :: Int -> ActiveStake -> ShowS
$cshow :: ActiveStake -> String
show :: ActiveStake -> String
$cshowList :: [ActiveStake] -> ShowS
showList :: [ActiveStake] -> ShowS
Show, ActiveStake -> ActiveStake -> Bool
(ActiveStake -> ActiveStake -> Bool)
-> (ActiveStake -> ActiveStake -> Bool) -> Eq ActiveStake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveStake -> ActiveStake -> Bool
== :: ActiveStake -> ActiveStake -> Bool
$c/= :: ActiveStake -> ActiveStake -> Bool
/= :: ActiveStake -> ActiveStake -> Bool
Eq, ActiveStake -> ()
(ActiveStake -> ()) -> NFData ActiveStake
forall a. (a -> ()) -> NFData a
$crnf :: ActiveStake -> ()
rnf :: ActiveStake -> ()
NFData, (forall x. ActiveStake -> Rep ActiveStake x)
-> (forall x. Rep ActiveStake x -> ActiveStake)
-> Generic ActiveStake
forall x. Rep ActiveStake x -> ActiveStake
forall x. ActiveStake -> Rep ActiveStake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActiveStake -> Rep ActiveStake x
from :: forall x. ActiveStake -> Rep ActiveStake x
$cto :: forall x. Rep ActiveStake x -> ActiveStake
to :: forall x. Rep ActiveStake x -> ActiveStake
Generic, [ActiveStake] -> Value
[ActiveStake] -> Encoding
ActiveStake -> Bool
ActiveStake -> Value
ActiveStake -> Encoding
(ActiveStake -> Value)
-> (ActiveStake -> Encoding)
-> ([ActiveStake] -> Value)
-> ([ActiveStake] -> Encoding)
-> (ActiveStake -> Bool)
-> ToJSON ActiveStake
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ActiveStake -> Value
toJSON :: ActiveStake -> Value
$ctoEncoding :: ActiveStake -> Encoding
toEncoding :: ActiveStake -> Encoding
$ctoJSONList :: [ActiveStake] -> Value
toJSONList :: [ActiveStake] -> Value
$ctoEncodingList :: [ActiveStake] -> Encoding
toEncodingList :: [ActiveStake] -> Encoding
$comitField :: ActiveStake -> Bool
omitField :: ActiveStake -> Bool
ToJSON, Context -> ActiveStake -> IO (Maybe ThunkInfo)
Proxy ActiveStake -> String
(Context -> ActiveStake -> IO (Maybe ThunkInfo))
-> (Context -> ActiveStake -> IO (Maybe ThunkInfo))
-> (Proxy ActiveStake -> String)
-> NoThunks ActiveStake
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ActiveStake -> IO (Maybe ThunkInfo)
noThunks :: Context -> ActiveStake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ActiveStake -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ActiveStake -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ActiveStake -> String
showTypeOf :: Proxy ActiveStake -> String
NoThunks, ActiveStake -> Encoding
(ActiveStake -> Encoding) -> EncCBOR ActiveStake
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: ActiveStake -> Encoding
encCBOR :: ActiveStake -> Encoding
EncCBOR)

instance DecShareCBOR ActiveStake where
  type Share ActiveStake = Interns (Credential Staking)
  getShare :: ActiveStake -> Share ActiveStake
getShare (ActiveStake VMap VB VB (Credential Staking) StakeWithDelegation
m) = (Interns (Credential Staking), Interns StakeWithDelegation)
-> Interns (Credential Staking)
forall a b. (a, b) -> a
fst (VMap VB VB (Credential Staking) StakeWithDelegation
-> Share (VMap VB VB (Credential Staking) StakeWithDelegation)
forall a. DecShareCBOR a => a -> Share a
getShare VMap VB VB (Credential Staking) StakeWithDelegation
m)
  decShareCBOR :: forall s. Share ActiveStake -> Decoder s ActiveStake
decShareCBOR Share ActiveStake
si = VMap VB VB (Credential Staking) StakeWithDelegation -> ActiveStake
ActiveStake (VMap VB VB (Credential Staking) StakeWithDelegation
 -> ActiveStake)
-> Decoder s (VMap VB VB (Credential Staking) StakeWithDelegation)
-> Decoder s ActiveStake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Share (VMap VB VB (Credential Staking) StakeWithDelegation)
-> Decoder s (VMap VB VB (Credential Staking) StakeWithDelegation)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (VMap VB VB (Credential Staking) StakeWithDelegation)
-> Decoder s (VMap VB VB (Credential Staking) StakeWithDelegation)
decShareCBOR (Share ActiveStake
Interns (Credential Staking)
si, Interns StakeWithDelegation
forall a. Monoid a => a
mempty)

-- | Sum all active stake. Returns @NonZero Coin@, defaulting to 1 lovelace if empty.
sumAllActiveStake :: ActiveStake -> NonZero Coin
sumAllActiveStake :: ActiveStake -> NonZero Coin
sumAllActiveStake (ActiveStake VMap VB VB (Credential Staking) StakeWithDelegation
m) =
  (StakeWithDelegation -> Coin)
-> VMap VB VB (Credential Staking) StakeWithDelegation -> Coin
forall (vv :: * -> *) v m (kv :: * -> *) k.
(Vector vv v, Monoid m) =>
(v -> m) -> VMap kv vv k v -> m
VMap.foldMap (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (StakeWithDelegation -> CompactForm Coin)
-> StakeWithDelegation
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero (CompactForm Coin) -> CompactForm Coin
forall a. NonZero a -> a
unNonZero (NonZero (CompactForm Coin) -> CompactForm Coin)
-> (StakeWithDelegation -> NonZero (CompactForm Coin))
-> StakeWithDelegation
-> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeWithDelegation -> NonZero (CompactForm Coin)
swdStake) VMap VB VB (Credential Staking) StakeWithDelegation
m Coin -> NonZero Coin -> NonZero Coin
forall a. HasZero a => a -> NonZero a -> NonZero a
`nonZeroOr` forall (n :: Natural). (KnownNat n, 1 <= n) => NonZero Coin
knownNonZeroCoin @1
{-# INLINE sumAllActiveStake #-}

-- | Sum the compact stake for a set of credentials from an @ActiveStake@.
sumCredentialsCompactActiveStake ::
  Foldable f => ActiveStake -> f (Credential Staking) -> CompactForm Coin
sumCredentialsCompactActiveStake :: forall (f :: * -> *).
Foldable f =>
ActiveStake -> f (Credential Staking) -> CompactForm Coin
sumCredentialsCompactActiveStake (ActiveStake VMap VB VB (Credential Staking) StakeWithDelegation
m) =
  (Credential Staking -> CompactForm Coin)
-> f (Credential Staking) -> CompactForm Coin
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (\Credential Staking
cred -> CompactForm Coin
-> (StakeWithDelegation -> CompactForm Coin)
-> Maybe StakeWithDelegation
-> CompactForm Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CompactForm Coin
forall a. Monoid a => a
mempty (NonZero (CompactForm Coin) -> CompactForm Coin
forall a. NonZero a -> a
unNonZero (NonZero (CompactForm Coin) -> CompactForm Coin)
-> (StakeWithDelegation -> NonZero (CompactForm Coin))
-> StakeWithDelegation
-> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeWithDelegation -> NonZero (CompactForm Coin)
swdStake) (Credential Staking
-> VMap VB VB (Credential Staking) StakeWithDelegation
-> Maybe StakeWithDelegation
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup Credential Staking
cred VMap VB VB (Credential Staking) StakeWithDelegation
m))
{-# INLINE sumCredentialsCompactActiveStake #-}

class
  ( EraAccounts era
  , Eq (InstantStake era)
  , Show (InstantStake era)
  , Monoid (InstantStake era)
  , Default (InstantStake era)
  , NFData (InstantStake era)
  , NoThunks (InstantStake era)
  , ToJSON (InstantStake era)
  , EncCBOR (InstantStake era)
  , DecShareCBOR (InstantStake era)
  , Share (InstantStake era) ~ Interns (Credential Staking)
  ) =>
  EraStake era
  where
  -- | This is the current stake in the system. The important part of this stake is that not all of
  -- it is active. Any stake credential that is not registred will not contribute to the active
  -- stake, however it will be part of the instant stake. Throughout an epoch it is not relevant
  -- which part of the stake is active, because it is only when we take the snaphot that we resolve
  -- all the active stake.
  type InstantStake era = (r :: Type) | r -> era

  instantStakeCredentialsL :: Lens' (InstantStake era) (Map (Credential Staking) (CompactForm Coin))

  -- | Add new UTxO to the `InstantStake`. This is invoked for every new TxOut that is added to the
  -- ledger state
  addInstantStake :: UTxO era -> InstantStake era -> InstantStake era

  -- | Delete spent UTxO from the `InstantStake`. This is invoked for every TxOut that is removed
  -- from the ledger state
  deleteInstantStake :: UTxO era -> InstantStake era -> InstantStake era

  -- TODO: This functionality will be removed and switched to use a pulser

  -- | Using known stake credential registrations and delegations resolve the instant stake into
  -- `ActiveStake` that will be used for `SnapShot` creation by
  -- `Cardano.Ledger.State.snapShotFromInstantStake`.
  resolveInstantStake :: InstantStake era -> Accounts era -> ActiveStake

class CanGetInstantStake t where
  instantStakeG :: SimpleGetter (t era) (InstantStake era)
  default instantStakeG :: CanSetInstantStake t => SimpleGetter (t era) (InstantStake era)
  instantStakeG = (InstantStake era -> Const r (InstantStake era))
-> t era -> Const r (t era)
forall era. Lens' (t era) (InstantStake era)
forall (t :: * -> *) era.
CanSetInstantStake t =>
Lens' (t era) (InstantStake era)
instantStakeL
  {-# INLINE instantStakeG #-}

class CanGetInstantStake t => CanSetInstantStake t where
  instantStakeL :: Lens' (t era) (InstantStake era)

-- | This is the total active stake including the rewards, but ignoring all the stake coming from
-- the pointers. Where "active" stake means any stake credential that is registered and delegated to
-- a stake pool.
resolveActiveInstantStakeCredentials ::
  EraStake era =>
  InstantStake era ->
  Accounts era ->
  Map (Credential Staking) StakeWithDelegation
resolveActiveInstantStakeCredentials :: forall era.
EraStake era =>
InstantStake era
-> Accounts era -> Map (Credential Staking) StakeWithDelegation
resolveActiveInstantStakeCredentials InstantStake era
instantStake Accounts era
accounts =
  SimpleWhenMissing
  (Credential Staking) (CompactForm Coin) StakeWithDelegation
-> SimpleWhenMissing
     (Credential Staking) (AccountState era) StakeWithDelegation
-> SimpleWhenMatched
     (Credential Staking)
     (CompactForm Coin)
     (AccountState era)
     StakeWithDelegation
-> Map (Credential Staking) (CompactForm Coin)
-> Map (Credential Staking) (AccountState era)
-> Map (Credential Staking) StakeWithDelegation
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
    SimpleWhenMissing
  (Credential Staking) (CompactForm Coin) StakeWithDelegation
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing -- ignore non-registered stake credentials
    ((Credential Staking
 -> AccountState era -> Maybe StakeWithDelegation)
-> SimpleWhenMissing
     (Credential Staking) (AccountState era) StakeWithDelegation
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
Map.mapMaybeMissing ((AccountState era -> Maybe StakeWithDelegation)
-> Credential Staking
-> AccountState era
-> Maybe StakeWithDelegation
forall a b. a -> b -> a
const AccountState era -> Maybe StakeWithDelegation
forall {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 ...),
 EraAccounts era) =>
AccountState era -> Maybe StakeWithDelegation
getNonZeroActiveStakeWithDelegation)) -- use the account balance, unless it is zero
    ((Credential Staking
 -> CompactForm Coin
 -> AccountState era
 -> Identity (Maybe StakeWithDelegation))
-> SimpleWhenMatched
     (Credential Staking)
     (CompactForm Coin)
     (AccountState era)
     StakeWithDelegation
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
Map.zipWithMaybeAMatched Credential Staking
-> CompactForm Coin
-> AccountState era
-> Identity (Maybe StakeWithDelegation)
forall {era} {p}.
(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 ...),
 EraAccounts era) =>
p
-> CompactForm Coin
-> AccountState era
-> Identity (Maybe StakeWithDelegation)
addInstantActiveStakeWithDelegation) -- combine the stake with the account balance
    (InstantStake era
instantStake InstantStake era
-> Getting
     (Map (Credential Staking) (CompactForm Coin))
     (InstantStake era)
     (Map (Credential Staking) (CompactForm Coin))
-> Map (Credential Staking) (CompactForm Coin)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential Staking) (CompactForm Coin))
  (InstantStake era)
  (Map (Credential Staking) (CompactForm Coin))
forall era.
EraStake era =>
Lens'
  (InstantStake era) (Map (Credential Staking) (CompactForm Coin))
Lens'
  (InstantStake era) (Map (Credential Staking) (CompactForm Coin))
instantStakeCredentialsL)
    (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)
  where
    -- Only return non-zero balance bundled with delegation for active accounts.
    getNonZeroActiveStakeWithDelegation :: AccountState era -> Maybe StakeWithDelegation
getNonZeroActiveStakeWithDelegation AccountState era
accountState = do
      poolId <- AccountState era
accountState 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
      nzBalance <- nonZero $ accountState ^. balanceAccountStateL
      pure $! StakeWithDelegation nzBalance poolId
    {-# INLINE getNonZeroActiveStakeWithDelegation #-}
    -- Adds instant stake to any active staking credential, bundling with delegation
    addInstantActiveStakeWithDelegation :: p
-> CompactForm Coin
-> AccountState era
-> Identity (Maybe StakeWithDelegation)
addInstantActiveStakeWithDelegation p
_ CompactForm Coin
stake AccountState era
accountState = Maybe StakeWithDelegation -> Identity (Maybe StakeWithDelegation)
forall a. a -> Identity a
Identity (Maybe StakeWithDelegation -> Identity (Maybe StakeWithDelegation))
-> Maybe StakeWithDelegation
-> Identity (Maybe StakeWithDelegation)
forall a b. (a -> b) -> a -> b
$ do
      poolId <- AccountState era
accountState 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
      let balance = AccountState era
accountState 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
      -- instant stake is guaranteed to be non-zero due to minUTxO, so no need to guard against mempty
      pure $! StakeWithDelegation (unsafeNonZero $ stake <> balance) poolId
    {-# INLINE addInstantActiveStakeWithDelegation #-}
{-# INLINEABLE resolveActiveInstantStakeCredentials #-}