{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Shelley.Spec.Ledger.API.Wallet
  ( getNonMyopicMemberRewards,
    getUTxO,
    getFilteredUTxO,
    getLeaderSchedule,
    getTotalStake,
    poolsByTotalStakeFraction,
  )
where

import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.Crypto (VRF)
import Cardano.Ledger.Era (Crypto, Era)
import Cardano.Ledger.Shelley (ShelleyBased)
import Cardano.Slotting.EpochInfo (epochInfoRange)
import Cardano.Slotting.Slot (SlotNo)
import Data.Foldable (fold)
import Data.Functor.Identity (runIdentity)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Ratio ((%))
import Data.Set (Set)
import qualified Data.Set as Set
import Shelley.Spec.Ledger.API.Protocol (ChainDepState (..))
import Shelley.Spec.Ledger.Address (Addr (..))
import Shelley.Spec.Ledger.BaseTypes (Globals (..), Seed)
import Shelley.Spec.Ledger.BlockChain (checkLeaderValue, mkSeed, seedL)
import Shelley.Spec.Ledger.Coin (Coin (..))
import Shelley.Spec.Ledger.CompactAddr (compactAddr)
import Shelley.Spec.Ledger.Credential (Credential (..))
import Shelley.Spec.Ledger.Delegation.Certificates (IndividualPoolStake (..), PoolDistr (..))
import qualified Shelley.Spec.Ledger.EpochBoundary as EB
import Shelley.Spec.Ledger.Keys (KeyHash, KeyRole (..), SignKeyVRF)
import Shelley.Spec.Ledger.LedgerState
  ( DPState (..),
    EpochState (..),
    LedgerState (..),
    NewEpochState (..),
    UTxOState (..),
    circulation,
    stakeDistr,
  )
import Shelley.Spec.Ledger.OverlaySchedule (isOverlaySlot)
import Shelley.Spec.Ledger.PParams (PParams, PParams' (..))
import Shelley.Spec.Ledger.Rewards
  ( NonMyopic (..),
    StakeShare (..),
    getTopRankedPools,
    nonMyopicMemberRew,
    percentile',
  )
import Shelley.Spec.Ledger.STS.NewEpoch (calculatePoolDistr)
import Shelley.Spec.Ledger.STS.Tickn (TicknState (..))
import Shelley.Spec.Ledger.TxBody (PoolParams (..), TxOut (..))
import Shelley.Spec.Ledger.UTxO (UTxO (..))

-- | Get pool sizes, but in terms of total stake
--
-- The stake distribution uses active stake (so that the leader schedule is not
-- affected by undelegated stake), but the wallet wants to display pool
-- saturation for rewards purposes. For that, it needs the fraction of total
-- stake.
--
-- This is not based on any snapshot, but uses the current ledger state.
poolsByTotalStakeFraction ::
  forall era.
  ShelleyBased era =>
  Globals ->
  NewEpochState era ->
  PoolDistr (Crypto era)
poolsByTotalStakeFraction :: Globals -> NewEpochState era -> PoolDistr (Crypto era)
poolsByTotalStakeFraction Globals
globals NewEpochState era
ss =
  Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
-> PoolDistr (Crypto era)
forall crypto.
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
PoolDistr Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolsByTotalStake
  where
    snap :: SnapShot era
snap@(EB.SnapShot Stake era
stake Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
_ Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
_) = NewEpochState era -> SnapShot era
forall era. ShelleyBased era => NewEpochState era -> SnapShot era
currentSnapshot NewEpochState era
ss
    Coin Integer
totalStake = Globals -> NewEpochState era -> Coin
forall era. Globals -> NewEpochState era -> Coin
getTotalStake Globals
globals NewEpochState era
ss
    Coin Integer
activeStake = Map (Credential 'Staking era) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Credential 'Staking era) Coin -> Coin)
-> (Stake era -> Map (Credential 'Staking era) Coin)
-> Stake era
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake era -> Map (Credential 'Staking era) Coin
forall era. Stake era -> Map (Credential 'Staking era) Coin
EB.unStake (Stake era -> Coin) -> Stake era -> Coin
forall a b. (a -> b) -> a -> b
$ Stake era
stake
    stakeRatio :: Ratio Integer
stakeRatio = Integer
activeStake Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
totalStake
    PoolDistr Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolsByActiveStake = SnapShot era -> PoolDistr (Crypto era)
forall era. SnapShot era -> PoolDistr (Crypto era)
calculatePoolDistr SnapShot era
snap
    poolsByTotalStake :: Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolsByTotalStake = (IndividualPoolStake (Crypto era)
 -> IndividualPoolStake (Crypto era))
-> Map
     (KeyHash 'StakePool (Crypto era))
     (IndividualPoolStake (Crypto era))
-> Map
     (KeyHash 'StakePool (Crypto era))
     (IndividualPoolStake (Crypto era))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map IndividualPoolStake (Crypto era)
-> IndividualPoolStake (Crypto era)
toTotalStakeFrac Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolsByActiveStake
    toTotalStakeFrac :: IndividualPoolStake (Crypto era) -> IndividualPoolStake (Crypto era)
    toTotalStakeFrac :: IndividualPoolStake (Crypto era)
-> IndividualPoolStake (Crypto era)
toTotalStakeFrac (IndividualPoolStake Ratio Integer
s Hash (Crypto era) (VerKeyVRF (Crypto era))
vrf) =
      Ratio Integer
-> Hash (Crypto era) (VerKeyVRF (Crypto era))
-> IndividualPoolStake (Crypto era)
forall crypto.
Ratio Integer
-> Hash crypto (VerKeyVRF crypto) -> IndividualPoolStake crypto
IndividualPoolStake (Ratio Integer
s Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
stakeRatio) Hash (Crypto era) (VerKeyVRF (Crypto era))
vrf

-- | Calculate the current total stake.
getTotalStake :: Globals -> NewEpochState era -> Coin
getTotalStake :: Globals -> NewEpochState era -> Coin
getTotalStake Globals
globals NewEpochState era
ss =
  let supply :: Coin
supply = Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Coin) -> Word64 -> Coin
forall a b. (a -> b) -> a -> b
$ Globals -> Word64
maxLovelaceSupply Globals
globals
      es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
   in EpochState era -> Coin -> Coin
forall era. EpochState era -> Coin -> Coin
circulation EpochState era
es Coin
supply

-- | Calculate the Non-Myopic Pool Member Rewards for a set of credentials.
-- For each given credential, this function returns a map from each stake
-- pool (identified by the key hash of the pool operator) to the
-- non-myopic pool member reward for that stake pool.
--
-- This is not based on any snapshot, but uses the current ledger state.
getNonMyopicMemberRewards ::
  ShelleyBased era =>
  Globals ->
  NewEpochState era ->
  Set (Either Coin (Credential 'Staking era)) ->
  Map (Either Coin (Credential 'Staking era)) (Map (KeyHash 'StakePool (Crypto era)) Coin)
getNonMyopicMemberRewards :: Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking era))
-> Map
     (Either Coin (Credential 'Staking era))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
getNonMyopicMemberRewards Globals
globals NewEpochState era
ss Set (Either Coin (Credential 'Staking era))
creds =
  [(Either Coin (Credential 'Staking era),
  Map (KeyHash 'StakePool (Crypto era)) Coin)]
-> Map
     (Either Coin (Credential 'Staking era))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Either Coin (Credential 'Staking era),
   Map (KeyHash 'StakePool (Crypto era)) Coin)]
 -> Map
      (Either Coin (Credential 'Staking era))
      (Map (KeyHash 'StakePool (Crypto era)) Coin))
-> [(Either Coin (Credential 'Staking era),
     Map (KeyHash 'StakePool (Crypto era)) Coin)]
-> Map
     (Either Coin (Credential 'Staking era))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
forall a b. (a -> b) -> a -> b
$
    (Either Coin (Credential 'Staking era)
 -> (Either Coin (Credential 'Staking era),
     Map (KeyHash 'StakePool (Crypto era)) Coin))
-> [Either Coin (Credential 'Staking era)]
-> [(Either Coin (Credential 'Staking era),
     Map (KeyHash 'StakePool (Crypto era)) Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\Either Coin (Credential 'Staking era)
cred -> (Either Coin (Credential 'Staking era)
cred, ((PerformanceEstimate, PoolParams era, StakeShare) -> Coin)
-> Map
     (KeyHash 'StakePool (Crypto era))
     (PerformanceEstimate, PoolParams era, StakeShare)
-> Map (KeyHash 'StakePool (Crypto era)) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (StakeShare
-> (PerformanceEstimate, PoolParams era, StakeShare) -> Coin
mkNMMRewards (StakeShare
 -> (PerformanceEstimate, PoolParams era, StakeShare) -> Coin)
-> StakeShare
-> (PerformanceEstimate, PoolParams era, StakeShare)
-> Coin
forall a b. (a -> b) -> a -> b
$ Either Coin (Credential 'Staking era) -> StakeShare
memShare Either Coin (Credential 'Staking era)
cred) Map
  (KeyHash 'StakePool (Crypto era))
  (PerformanceEstimate, PoolParams era, StakeShare)
poolData))
      (Set (Either Coin (Credential 'Staking era))
-> [Either Coin (Credential 'Staking era)]
forall a. Set a -> [a]
Set.toList Set (Either Coin (Credential 'Staking era))
creds)
  where
    maxSupply :: Coin
maxSupply = Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Coin) -> Word64 -> Coin
forall a b. (a -> b) -> a -> b
$ Globals -> Word64
maxLovelaceSupply Globals
globals
    Coin Integer
totalStake = EpochState era -> Coin -> Coin
forall era. EpochState era -> Coin -> Coin
circulation EpochState era
es Coin
maxSupply
    toShare :: Coin -> StakeShare
toShare (Coin Integer
x) = Ratio Integer -> StakeShare
StakeShare (Integer
x Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
totalStake)
    memShare :: Either Coin (Credential 'Staking era) -> StakeShare
memShare (Right Credential 'Staking era
cred) = Coin -> StakeShare
toShare (Coin -> StakeShare) -> Coin -> StakeShare
forall a b. (a -> b) -> a -> b
$ Coin
-> Credential 'Staking era
-> Map (Credential 'Staking era) Coin
-> Coin
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Integer -> Coin
Coin Integer
0) Credential 'Staking era
cred (Stake era -> Map (Credential 'Staking era) Coin
forall era. Stake era -> Map (Credential 'Staking era) Coin
EB.unStake Stake era
stake)
    memShare (Left Coin
coin) = Coin -> StakeShare
toShare Coin
coin
    es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
    pp :: PParams era
pp = EpochState era -> PParams era
forall era. EpochState era -> PParams era
esPp EpochState era
es
    NonMyopic
      { likelihoodsNM :: forall era.
NonMyopic era -> Map (KeyHash 'StakePool (Crypto era)) Likelihood
likelihoodsNM = Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls,
        rewardPotNM :: forall era. NonMyopic era -> Coin
rewardPotNM = Coin
rPot
      } = EpochState era -> NonMyopic era
forall era. EpochState era -> NonMyopic era
esNonMyopic EpochState era
es
    EB.SnapShot Stake era
stake Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
delegs Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
poolParams = NewEpochState era -> SnapShot era
forall era. ShelleyBased era => NewEpochState era -> SnapShot era
currentSnapshot NewEpochState era
ss
    poolData :: Map
  (KeyHash 'StakePool (Crypto era))
  (PerformanceEstimate, PoolParams era, StakeShare)
poolData =
      (KeyHash 'StakePool (Crypto era)
 -> PoolParams era
 -> (PerformanceEstimate, PoolParams era, StakeShare))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> Map
     (KeyHash 'StakePool (Crypto era))
     (PerformanceEstimate, PoolParams era, StakeShare)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
        ( \KeyHash 'StakePool (Crypto era)
k PoolParams era
p ->
            ( Likelihood -> PerformanceEstimate
percentile' (KeyHash 'StakePool (Crypto era) -> Likelihood
histLookup KeyHash 'StakePool (Crypto era)
k),
              PoolParams era
p,
              Coin -> StakeShare
toShare (Coin -> StakeShare)
-> (Stake era -> Coin) -> Stake era -> StakeShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Credential 'Staking era) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
                (Map (Credential 'Staking era) Coin -> Coin)
-> (Stake era -> Map (Credential 'Staking era) Coin)
-> Stake era
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake era -> Map (Credential 'Staking era) Coin
forall era. Stake era -> Map (Credential 'Staking era) Coin
EB.unStake
                (Stake era -> StakeShare) -> Stake era -> StakeShare
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool (Crypto era)
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Stake era
-> Stake era
forall era.
KeyHash 'StakePool (Crypto era)
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Stake era
-> Stake era
EB.poolStake KeyHash 'StakePool (Crypto era)
k Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
delegs Stake era
stake
            )
        )
        Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
poolParams
    histLookup :: KeyHash 'StakePool (Crypto era) -> Likelihood
histLookup KeyHash 'StakePool (Crypto era)
k = Likelihood -> Maybe Likelihood -> Likelihood
forall a. a -> Maybe a -> a
fromMaybe Likelihood
forall a. Monoid a => a
mempty (KeyHash 'StakePool (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) Likelihood
-> Maybe Likelihood
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool (Crypto era)
k Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls)
    topPools :: Set (KeyHash 'StakePool (Crypto era))
topPools = Coin
-> Coin
-> PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> Map (KeyHash 'StakePool (Crypto era)) PerformanceEstimate
-> Set (KeyHash 'StakePool (Crypto era))
forall era.
Coin
-> Coin
-> PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> Map (KeyHash 'StakePool (Crypto era)) PerformanceEstimate
-> Set (KeyHash 'StakePool (Crypto era))
getTopRankedPools Coin
rPot (Integer -> Coin
Coin Integer
totalStake) PParams era
pp Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
poolParams ((Likelihood -> PerformanceEstimate)
-> Map (KeyHash 'StakePool (Crypto era)) Likelihood
-> Map (KeyHash 'StakePool (Crypto era)) PerformanceEstimate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Likelihood -> PerformanceEstimate
percentile' Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls)
    mkNMMRewards :: StakeShare
-> (PerformanceEstimate, PoolParams era, StakeShare) -> Coin
mkNMMRewards StakeShare
t (PerformanceEstimate
hitRateEst, PoolParams era
poolp, StakeShare
sigma) =
      if PoolParams era -> Bool
checkPledge PoolParams era
poolp
        then PParams era
-> Coin
-> PoolParams era
-> StakeShare
-> StakeShare
-> StakeShare
-> Set (KeyHash 'StakePool (Crypto era))
-> PerformanceEstimate
-> Coin
forall era.
PParams era
-> Coin
-> PoolParams era
-> StakeShare
-> StakeShare
-> StakeShare
-> Set (KeyHash 'StakePool (Crypto era))
-> PerformanceEstimate
-> Coin
nonMyopicMemberRew PParams era
pp Coin
rPot PoolParams era
poolp StakeShare
s StakeShare
sigma StakeShare
t Set (KeyHash 'StakePool (Crypto era))
topPools PerformanceEstimate
hitRateEst
        else Coin
forall a. Monoid a => a
mempty
      where
        s :: StakeShare
s = (Coin -> StakeShare
toShare (Coin -> StakeShare)
-> (PoolParams era -> Coin) -> PoolParams era -> StakeShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams era -> Coin
forall era. PoolParams era -> Coin
_poolPledge) PoolParams era
poolp
        checkPledge :: PoolParams era -> Bool
checkPledge PoolParams era
pool =
          let ostake :: Coin
ostake =
                (Coin -> KeyHash 'Staking (Crypto era) -> Coin)
-> Coin -> Set (KeyHash 'Staking (Crypto era)) -> Coin
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl'
                  ( \Coin
c KeyHash 'Staking (Crypto era)
o ->
                      Coin
c
                        Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> ( Coin -> Maybe Coin -> Coin
forall a. a -> Maybe a -> a
fromMaybe Coin
forall a. Monoid a => a
mempty (Maybe Coin -> Coin) -> Maybe Coin -> Coin
forall a b. (a -> b) -> a -> b
$
                               Credential 'Staking era
-> Map (Credential 'Staking era) Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (KeyHash 'Staking (Crypto era) -> Credential 'Staking era
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
KeyHashObj KeyHash 'Staking (Crypto era)
o) (Stake era -> Map (Credential 'Staking era) Coin
forall era. Stake era -> Map (Credential 'Staking era) Coin
EB.unStake Stake era
stake)
                           )
                  )
                  Coin
forall a. Monoid a => a
mempty
                  (PoolParams era -> Set (KeyHash 'Staking (Crypto era))
forall era. PoolParams era -> Set (KeyHash 'Staking (Crypto era))
_poolOwners PoolParams era
pool)
           in PoolParams era -> Coin
forall era. PoolParams era -> Coin
_poolPledge PoolParams era
poolp Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
ostake

-- | Create a current snapshot of the ledger state.
--
-- When ranking pools, and reporting their saturation level, in the wallet, we
-- do not want to use one of the regular snapshots, but rather the most recent
-- ledger state.
currentSnapshot :: ShelleyBased era => NewEpochState era -> EB.SnapShot era
currentSnapshot :: NewEpochState era -> SnapShot era
currentSnapshot NewEpochState era
ss =
  UTxO era -> DState era -> PState era -> SnapShot era
forall era.
ShelleyBased era =>
UTxO era -> DState era -> PState era -> SnapShot era
stakeDistr UTxO era
utxo DState era
dstate PState era
pstate
  where
    es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
    utxo :: UTxO era
utxo = UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
_utxo (UTxOState era -> UTxO era)
-> (EpochState era -> UTxOState era) -> EpochState era -> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
_utxoState (LedgerState era -> UTxOState era)
-> (EpochState era -> LedgerState era)
-> EpochState era
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> UTxO era) -> EpochState era -> UTxO era
forall a b. (a -> b) -> a -> b
$ EpochState era
es
    dstate :: DState era
dstate = DPState era -> DState era
forall era. DPState era -> DState era
_dstate (DPState era -> DState era)
-> (EpochState era -> DPState era) -> EpochState era -> DState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState era
forall era. LedgerState era -> DPState era
_delegationState (LedgerState era -> DPState era)
-> (EpochState era -> LedgerState era)
-> EpochState era
-> DPState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> DState era) -> EpochState era -> DState era
forall a b. (a -> b) -> a -> b
$ EpochState era
es
    pstate :: PState era
pstate = DPState era -> PState era
forall era. DPState era -> PState era
_pstate (DPState era -> PState era)
-> (EpochState era -> DPState era) -> EpochState era -> PState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState era
forall era. LedgerState era -> DPState era
_delegationState (LedgerState era -> DPState era)
-> (EpochState era -> LedgerState era)
-> EpochState era
-> DPState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> PState era) -> EpochState era -> PState era
forall a b. (a -> b) -> a -> b
$ EpochState era
es

-- | Get the full UTxO.
getUTxO ::
  NewEpochState era ->
  UTxO era
getUTxO :: NewEpochState era -> UTxO era
getUTxO = UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
_utxo (UTxOState era -> UTxO era)
-> (NewEpochState era -> UTxOState era)
-> NewEpochState era
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
_utxoState (LedgerState era -> UTxOState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs

-- | Get the UTxO filtered by address.
getFilteredUTxO ::
  NewEpochState era ->
  Set (Addr era) ->
  UTxO era
getFilteredUTxO :: NewEpochState era -> Set (Addr era) -> UTxO era
getFilteredUTxO NewEpochState era
ss Set (Addr era)
addrs =
  Map (TxIn era) (TxOut era) -> UTxO era
forall era. Map (TxIn era) (TxOut era) -> UTxO era
UTxO (Map (TxIn era) (TxOut era) -> UTxO era)
-> Map (TxIn era) (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ (TxOut era -> Bool)
-> Map (TxIn era) (TxOut era) -> Map (TxIn era) (TxOut era)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(TxOutCompact CompactAddr era
addrSBS CompactForm (Value era)
_) -> CompactAddr era
addrSBS CompactAddr era -> Set (CompactAddr era) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (CompactAddr era)
addrSBSs) Map (TxIn era) (TxOut era)
fullUTxO
  where
    UTxO Map (TxIn era) (TxOut era)
fullUTxO = NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
getUTxO NewEpochState era
ss
    -- Instead of decompacting each address in the huge UTxO, compact each
    -- address in the small set of address.
    addrSBSs :: Set (CompactAddr era)
addrSBSs = (Addr era -> CompactAddr era)
-> Set (Addr era) -> Set (CompactAddr era)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Addr era -> CompactAddr era
forall era. Addr era -> CompactAddr era
compactAddr Set (Addr era)
addrs

-- | Get the (private) leader schedule for this epoch.
--
--   Given a private VRF key, returns the set of slots in which this node is
--   eligible to lead.
getLeaderSchedule ::
  ( Era era,
    VRF.Signable
      (VRF (Crypto era))
      Seed
  ) =>
  Globals ->
  NewEpochState era ->
  ChainDepState (Crypto era) ->
  KeyHash 'StakePool (Crypto era) ->
  SignKeyVRF (Crypto era) ->
  PParams era ->
  Set SlotNo
getLeaderSchedule :: Globals
-> NewEpochState era
-> ChainDepState (Crypto era)
-> KeyHash 'StakePool (Crypto era)
-> SignKeyVRF (Crypto era)
-> PParams era
-> Set SlotNo
getLeaderSchedule Globals
globals NewEpochState era
ss ChainDepState (Crypto era)
cds KeyHash 'StakePool (Crypto era)
poolHash SignKeyVRF (Crypto era)
key PParams era
pp = (SlotNo -> Bool) -> Set SlotNo -> Set SlotNo
forall a. (a -> Bool) -> Set a -> Set a
Set.filter SlotNo -> Bool
isLeader Set SlotNo
epochSlots
  where
    isLeader :: SlotNo -> Bool
isLeader SlotNo
slotNo =
      let y :: CertifiedVRF (VRF (Crypto era)) Seed
y = ContextVRF (VRF (Crypto era))
-> Seed
-> SignKeyVRF (Crypto era)
-> CertifiedVRF (VRF (Crypto era)) Seed
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () (Nonce -> SlotNo -> Nonce -> Seed
mkSeed Nonce
seedL SlotNo
slotNo Nonce
epochNonce) SignKeyVRF (Crypto era)
key
       in Bool -> Bool
not (SlotNo -> UnitInterval -> SlotNo -> Bool
isOverlaySlot SlotNo
a (PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParams era
pp) SlotNo
slotNo)
            Bool -> Bool -> Bool
&& OutputVRF (VRF (Crypto era))
-> Ratio Integer -> ActiveSlotCoeff -> Bool
forall v.
VRFAlgorithm v =>
OutputVRF v -> Ratio Integer -> ActiveSlotCoeff -> Bool
checkLeaderValue (CertifiedVRF (VRF (Crypto era)) Seed
-> OutputVRF (VRF (Crypto era))
forall v a. CertifiedVRF v a -> OutputVRF v
VRF.certifiedOutput CertifiedVRF (VRF (Crypto era)) Seed
y) Ratio Integer
stake ActiveSlotCoeff
f
    stake :: Ratio Integer
stake = Ratio Integer
-> (IndividualPoolStake (Crypto era) -> Ratio Integer)
-> Maybe (IndividualPoolStake (Crypto era))
-> Ratio Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ratio Integer
0 IndividualPoolStake (Crypto era) -> Ratio Integer
forall crypto. IndividualPoolStake crypto -> Ratio Integer
individualPoolStake (Maybe (IndividualPoolStake (Crypto era)) -> Ratio Integer)
-> Maybe (IndividualPoolStake (Crypto era)) -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool (Crypto era)
-> Map
     (KeyHash 'StakePool (Crypto era))
     (IndividualPoolStake (Crypto era))
-> Maybe (IndividualPoolStake (Crypto era))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool (Crypto era)
poolHash Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolDistr
    poolDistr :: Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolDistr = PoolDistr (Crypto era)
-> Map
     (KeyHash 'StakePool (Crypto era))
     (IndividualPoolStake (Crypto era))
forall crypto.
PoolDistr crypto
-> Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
unPoolDistr (PoolDistr (Crypto era)
 -> Map
      (KeyHash 'StakePool (Crypto era))
      (IndividualPoolStake (Crypto era)))
-> PoolDistr (Crypto era)
-> Map
     (KeyHash 'StakePool (Crypto era))
     (IndividualPoolStake (Crypto era))
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> PoolDistr (Crypto era)
forall era. NewEpochState era -> PoolDistr (Crypto era)
nesPd NewEpochState era
ss
    TicknState Nonce
epochNonce Nonce
_ = ChainDepState (Crypto era) -> TicknState
forall crypto. ChainDepState crypto -> TicknState
csTickn ChainDepState (Crypto era)
cds
    currentEpoch :: EpochNo
currentEpoch = NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState era
ss
    ei :: EpochInfo Identity
ei = Globals -> EpochInfo Identity
epochInfo Globals
globals
    f :: ActiveSlotCoeff
f = Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
globals
    epochSlots :: Set SlotNo
epochSlots = [SlotNo] -> Set SlotNo
forall a. Ord a => [a] -> Set a
Set.fromList [SlotNo
a .. SlotNo
b]
    (SlotNo
a, SlotNo
b) = Identity (SlotNo, SlotNo) -> (SlotNo, SlotNo)
forall a. Identity a -> a
runIdentity (Identity (SlotNo, SlotNo) -> (SlotNo, SlotNo))
-> Identity (SlotNo, SlotNo) -> (SlotNo, SlotNo)
forall a b. (a -> b) -> a -> b
$ EpochInfo Identity -> EpochNo -> Identity (SlotNo, SlotNo)
forall (m :: * -> *).
Monad m =>
EpochInfo m -> EpochNo -> m (SlotNo, SlotNo)
epochInfoRange EpochInfo Identity
ei EpochNo
currentEpoch