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

module Shelley.Spec.Ledger.API.Wallet
  ( getNonMyopicMemberRewards,
    getUTxO,
    getFilteredUTxO,
    getLeaderSchedule,
    getPoolParameters,
    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.Constraints (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 (..),
    PState (..),
    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 (Crypto era)
snap@(EB.SnapShot Stake (Crypto era)
stake Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
_ Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
_) = NewEpochState era -> SnapShot (Crypto era)
forall era.
ShelleyBased era =>
NewEpochState era -> SnapShot (Crypto 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 (Crypto era)) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Credential 'Staking (Crypto era)) Coin -> Coin)
-> (Stake (Crypto era)
    -> Map (Credential 'Staking (Crypto era)) Coin)
-> Stake (Crypto era)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake (Crypto era) -> Map (Credential 'Staking (Crypto era)) Coin
forall crypto.
Stake crypto -> Map (Credential 'Staking crypto) Coin
EB.unStake (Stake (Crypto era) -> Coin) -> Stake (Crypto era) -> Coin
forall a b. (a -> b) -> a -> b
$ Stake (Crypto 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 (Crypto era) -> PoolDistr (Crypto era)
forall crypto. SnapShot crypto -> PoolDistr crypto
calculatePoolDistr SnapShot (Crypto 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 (Crypto era))) ->
  Map (Either Coin (Credential 'Staking (Crypto era))) (Map (KeyHash 'StakePool (Crypto era)) Coin)
getNonMyopicMemberRewards :: Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking (Crypto era)))
-> Map
     (Either Coin (Credential 'Staking (Crypto era)))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
getNonMyopicMemberRewards Globals
globals NewEpochState era
ss Set (Either Coin (Credential 'Staking (Crypto era)))
creds =
  [(Either Coin (Credential 'Staking (Crypto era)),
  Map (KeyHash 'StakePool (Crypto era)) Coin)]
-> Map
     (Either Coin (Credential 'Staking (Crypto era)))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Either Coin (Credential 'Staking (Crypto era)),
   Map (KeyHash 'StakePool (Crypto era)) Coin)]
 -> Map
      (Either Coin (Credential 'Staking (Crypto era)))
      (Map (KeyHash 'StakePool (Crypto era)) Coin))
-> [(Either Coin (Credential 'Staking (Crypto era)),
     Map (KeyHash 'StakePool (Crypto era)) Coin)]
-> Map
     (Either Coin (Credential 'Staking (Crypto era)))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
forall a b. (a -> b) -> a -> b
$
    (Either Coin (Credential 'Staking (Crypto era))
 -> (Either Coin (Credential 'Staking (Crypto era)),
     Map (KeyHash 'StakePool (Crypto era)) Coin))
-> [Either Coin (Credential 'Staking (Crypto era))]
-> [(Either Coin (Credential 'Staking (Crypto era)),
     Map (KeyHash 'StakePool (Crypto era)) Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\Either Coin (Credential 'Staking (Crypto era))
cred -> (Either Coin (Credential 'Staking (Crypto era))
cred, ((PerformanceEstimate, PoolParams (Crypto era), StakeShare)
 -> Coin)
-> Map
     (KeyHash 'StakePool (Crypto era))
     (PerformanceEstimate, PoolParams (Crypto 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 (Crypto era), StakeShare)
-> Coin
mkNMMRewards (StakeShare
 -> (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
 -> Coin)
-> StakeShare
-> (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
-> Coin
forall a b. (a -> b) -> a -> b
$ Either Coin (Credential 'Staking (Crypto era)) -> StakeShare
memShare Either Coin (Credential 'Staking (Crypto era))
cred) Map
  (KeyHash 'StakePool (Crypto era))
  (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
poolData))
      (Set (Either Coin (Credential 'Staking (Crypto era)))
-> [Either Coin (Credential 'Staking (Crypto era))]
forall a. Set a -> [a]
Set.toList Set (Either Coin (Credential 'Staking (Crypto 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 (Crypto era)) -> StakeShare
memShare (Right Credential 'Staking (Crypto era)
cred) = Coin -> StakeShare
toShare (Coin -> StakeShare) -> Coin -> StakeShare
forall a b. (a -> b) -> a -> b
$ Coin
-> Credential 'Staking (Crypto era)
-> Map (Credential 'Staking (Crypto era)) Coin
-> Coin
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Integer -> Coin
Coin Integer
0) Credential 'Staking (Crypto era)
cred (Stake (Crypto era) -> Map (Credential 'Staking (Crypto era)) Coin
forall crypto.
Stake crypto -> Map (Credential 'Staking crypto) Coin
EB.unStake Stake (Crypto 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 crypto.
NonMyopic crypto -> Map (KeyHash 'StakePool crypto) Likelihood
likelihoodsNM = Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls,
        rewardPotNM :: forall crypto. NonMyopic crypto -> Coin
rewardPotNM = Coin
rPot
      } = EpochState era -> NonMyopic (Crypto era)
forall era. EpochState era -> NonMyopic (Crypto era)
esNonMyopic EpochState era
es
    EB.SnapShot Stake (Crypto era)
stake Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams = NewEpochState era -> SnapShot (Crypto era)
forall era.
ShelleyBased era =>
NewEpochState era -> SnapShot (Crypto era)
currentSnapshot NewEpochState era
ss
    poolData :: Map
  (KeyHash 'StakePool (Crypto era))
  (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
poolData =
      (KeyHash 'StakePool (Crypto era)
 -> PoolParams (Crypto era)
 -> (PerformanceEstimate, PoolParams (Crypto era), StakeShare))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Map
     (KeyHash 'StakePool (Crypto era))
     (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
        ( \KeyHash 'StakePool (Crypto era)
k PoolParams (Crypto era)
p ->
            ( Likelihood -> PerformanceEstimate
percentile' (KeyHash 'StakePool (Crypto era) -> Likelihood
histLookup KeyHash 'StakePool (Crypto era)
k),
              PoolParams (Crypto era)
p,
              Coin -> StakeShare
toShare (Coin -> StakeShare)
-> (Stake (Crypto era) -> Coin) -> Stake (Crypto era) -> StakeShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Credential 'Staking (Crypto era)) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
                (Map (Credential 'Staking (Crypto era)) Coin -> Coin)
-> (Stake (Crypto era)
    -> Map (Credential 'Staking (Crypto era)) Coin)
-> Stake (Crypto era)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake (Crypto era) -> Map (Credential 'Staking (Crypto era)) Coin
forall crypto.
Stake crypto -> Map (Credential 'Staking crypto) Coin
EB.unStake
                (Stake (Crypto era) -> StakeShare)
-> Stake (Crypto era) -> StakeShare
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool (Crypto era)
-> Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Stake (Crypto era)
-> Stake (Crypto era)
forall crypto.
KeyHash 'StakePool crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
EB.poolStake KeyHash 'StakePool (Crypto era)
k Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs Stake (Crypto era)
stake
            )
        )
        Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto 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 (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) PerformanceEstimate
-> Set (KeyHash 'StakePool (Crypto era))
forall era.
Coin
-> Coin
-> PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto 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 (Crypto 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 (Crypto era), StakeShare)
-> Coin
mkNMMRewards StakeShare
t (PerformanceEstimate
hitRateEst, PoolParams (Crypto era)
poolp, StakeShare
sigma) =
      if PoolParams (Crypto era) -> Bool
checkPledge PoolParams (Crypto era)
poolp
        then PParams era
-> Coin
-> PoolParams (Crypto era)
-> StakeShare
-> StakeShare
-> StakeShare
-> Set (KeyHash 'StakePool (Crypto era))
-> PerformanceEstimate
-> Coin
forall era.
PParams era
-> Coin
-> PoolParams (Crypto era)
-> StakeShare
-> StakeShare
-> StakeShare
-> Set (KeyHash 'StakePool (Crypto era))
-> PerformanceEstimate
-> Coin
nonMyopicMemberRew PParams era
pp Coin
rPot PoolParams (Crypto 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 (Crypto era) -> Coin)
-> PoolParams (Crypto era)
-> StakeShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge) PoolParams (Crypto era)
poolp
        checkPledge :: PoolParams (Crypto era) -> Bool
checkPledge PoolParams (Crypto 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 (Crypto era)
-> Map (Credential 'Staking (Crypto era)) Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (KeyHash 'Staking (Crypto era) -> Credential 'Staking (Crypto era)
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj KeyHash 'Staking (Crypto era)
o) (Stake (Crypto era) -> Map (Credential 'Staking (Crypto era)) Coin
forall crypto.
Stake crypto -> Map (Credential 'Staking crypto) Coin
EB.unStake Stake (Crypto era)
stake)
                           )
                  )
                  Coin
forall a. Monoid a => a
mempty
                  (PoolParams (Crypto era) -> Set (KeyHash 'Staking (Crypto era))
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners PoolParams (Crypto era)
pool)
           in PoolParams (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge PoolParams (Crypto 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 (Crypto era)
currentSnapshot :: NewEpochState era -> SnapShot (Crypto era)
currentSnapshot NewEpochState era
ss =
  UTxO era
-> DState (Crypto era)
-> PState (Crypto era)
-> SnapShot (Crypto era)
forall era.
ShelleyBased era =>
UTxO era
-> DState (Crypto era)
-> PState (Crypto era)
-> SnapShot (Crypto era)
stakeDistr UTxO era
utxo DState (Crypto era)
dstate PState (Crypto 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 (Crypto era)
dstate = DPState (Crypto era) -> DState (Crypto era)
forall crypto. DPState crypto -> DState crypto
_dstate (DPState (Crypto era) -> DState (Crypto era))
-> (EpochState era -> DPState (Crypto era))
-> EpochState era
-> DState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
_delegationState (LedgerState era -> DPState (Crypto era))
-> (EpochState era -> LedgerState era)
-> EpochState era
-> DPState (Crypto 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 (Crypto era))
-> EpochState era -> DState (Crypto era)
forall a b. (a -> b) -> a -> b
$ EpochState era
es
    pstate :: PState (Crypto era)
pstate = DPState (Crypto era) -> PState (Crypto era)
forall crypto. DPState crypto -> PState crypto
_pstate (DPState (Crypto era) -> PState (Crypto era))
-> (EpochState era -> DPState (Crypto era))
-> EpochState era
-> PState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
_delegationState (LedgerState era -> DPState (Crypto era))
-> (EpochState era -> LedgerState era)
-> EpochState era
-> DPState (Crypto 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 (Crypto era))
-> EpochState era -> PState (Crypto 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 (Crypto era)) ->
  UTxO era
getFilteredUTxO :: NewEpochState era -> Set (Addr (Crypto era)) -> UTxO era
getFilteredUTxO NewEpochState era
ss Set (Addr (Crypto era))
addrs =
  Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
UTxO (Map (TxIn (Crypto era)) (TxOut era) -> UTxO era)
-> Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ (TxOut era -> Bool)
-> Map (TxIn (Crypto era)) (TxOut era)
-> Map (TxIn (Crypto era)) (TxOut era)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(TxOutCompact CompactAddr (Crypto era)
addrSBS CompactForm (Value era)
_) -> CompactAddr (Crypto era)
addrSBS CompactAddr (Crypto era) -> Set (CompactAddr (Crypto era)) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (CompactAddr (Crypto era))
addrSBSs) Map (TxIn (Crypto era)) (TxOut era)
fullUTxO
  where
    UTxO Map (TxIn (Crypto 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 (Crypto era))
addrSBSs = (Addr (Crypto era) -> CompactAddr (Crypto era))
-> Set (Addr (Crypto era)) -> Set (CompactAddr (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Addr (Crypto era) -> CompactAddr (Crypto era)
forall crypto. Addr crypto -> CompactAddr crypto
compactAddr Set (Addr (Crypto 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

-- | Get the registered stake pool parameters for a given ID.
getPoolParameters ::
  NewEpochState era ->
  KeyHash 'StakePool (Crypto era) ->
  Maybe (PoolParams (Crypto era))
getPoolParameters :: NewEpochState era
-> KeyHash 'StakePool (Crypto era)
-> Maybe (PoolParams (Crypto era))
getPoolParameters NewEpochState era
nes KeyHash 'StakePool (Crypto era)
poolId = KeyHash 'StakePool (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Maybe (PoolParams (Crypto era))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool (Crypto era)
poolId (NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall era.
NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
f NewEpochState era
nes)
  where
    f :: NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
f = PState (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall crypto.
PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_pParams (PState (Crypto era)
 -> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
-> (NewEpochState era -> PState (Crypto era))
-> NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPState (Crypto era) -> PState (Crypto era)
forall crypto. DPState crypto -> PState crypto
_pstate (DPState (Crypto era) -> PState (Crypto era))
-> (NewEpochState era -> DPState (Crypto era))
-> NewEpochState era
-> PState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
_delegationState (LedgerState era -> DPState (Crypto era))
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> DPState (Crypto 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