{-# 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 (..))
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
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
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
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
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
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
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
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
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