From 4543704f9665c01254866e5eead88335fa6678e9 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 11 Jan 2022 11:35:22 -0400 Subject: [PATCH] Implement nextEpochEligibleLeadershipSlots Update leadership-schedule command to calculate the following epoch's leadership schedule for a given stake pool --- cardano-api/src/Cardano/Api/LedgerState.hs | 178 +++++++++++++++++- cardano-api/src/Cardano/Api/Shelley.hs | 1 + .../src/Cardano/CLI/Shelley/Parsers.hs | 9 +- .../src/Cardano/CLI/Shelley/Run/Query.hs | 14 ++ cardano-cli/src/Cardano/CLI/Types.hs | 1 + 5 files changed, 199 insertions(+), 4 deletions(-) diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 096b1b2acd0..0cc68ae49ff 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -45,6 +45,7 @@ module Cardano.Api.LedgerState , LeadershipError(..) , constructGlobals , currentEpochEligibleLeadershipSlots + , nextEpochEligibleLeadershipSlots ) where @@ -63,12 +64,16 @@ import Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import Data.ByteString.Short as BSS import Data.Foldable +import Data.Functor.Identity import Data.IORef +import qualified Data.Map.Strict as Map import Data.Maybe (mapMaybe) import Data.SOP.Strict (NP (..)) import Data.Sequence (Seq) import qualified Data.Sequence as Seq import Data.Set (Set) +import qualified Data.Set as Set +import Data.Sharing (FromSharedCBOR, Interns, Share) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text @@ -91,8 +96,9 @@ import Cardano.Api.LedgerEvent (LedgerEvent, toLedgerEvent) import Cardano.Api.Modes (CardanoMode, EpochSlots (..)) import Cardano.Api.NetworkId (NetworkId (..), NetworkMagic (NetworkMagic)) import Cardano.Api.ProtocolParameters -import Cardano.Api.Query (DebugLedgerState (..), ProtocolState, - SerialisedDebugLedgerState, decodeDebugLedgerState, decodeProtocolState) +import Cardano.Api.Query (CurrentEpochState (..), DebugLedgerState (..), ProtocolState, + SerialisedCurrentEpochState (..), SerialisedDebugLedgerState, + decodeCurrentEpochState, decodeDebugLedgerState, decodeProtocolState) import Cardano.Binary (FromCBOR) import qualified Cardano.Chain.Genesis import qualified Cardano.Chain.Update @@ -103,6 +109,7 @@ import qualified Cardano.Crypto.Hashing import qualified Cardano.Crypto.ProtocolMagic import qualified Cardano.Crypto.VRF as Crypto import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) +import qualified Cardano.Ledger.BHeaderView as Ledger import Cardano.Ledger.BaseTypes (Globals (..), UnitInterval) import qualified Cardano.Ledger.BaseTypes as Shelley.Spec import qualified Cardano.Ledger.Core as Core @@ -110,11 +117,17 @@ import qualified Cardano.Ledger.Credential as Shelley.Spec import qualified Cardano.Ledger.Crypto as Crypto import qualified Cardano.Ledger.Era as Ledger import qualified Cardano.Ledger.Keys as Shelley.Spec +import qualified Cardano.Ledger.Shelley.API as ShelleyAPI import qualified Cardano.Ledger.Shelley.API.Protocol as TPraos import qualified Cardano.Ledger.Shelley.Genesis as Shelley.Spec -import Cardano.Slotting.EpochInfo (EpochInfo) +import qualified Cardano.Protocol.TPraos.BHeader as TPraos +import qualified Cardano.Protocol.TPraos.Rules.Tickn as Tick +import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo, generalizeEpochInfo) +import qualified Cardano.Slotting.EpochInfo.API as Slot import Cardano.Slotting.Slot (WithOrigin (At, Origin)) import qualified Cardano.Slotting.Slot as Slot +import Cardano.Slotting.Time (mkSlotLength) +import Control.State.Transition import Network.TypedProtocol.Pipelined (Nat (..)) import qualified Ouroboros.Consensus.Block.Abstract as Consensus import qualified Ouroboros.Consensus.Byron.Ledger.Block as Byron @@ -1243,6 +1256,15 @@ data LeadershipError = LeaderErrDecodeLedgerStateFailure | LeaderErrDecodeProtocolEpochStateFailure | LeaderErrGenesisSlot | LeaderErrStakePoolHasNoStake PoolId + | LeaderErrStakeDistribUnstable + SlotNo + -- ^ Current slot + SlotNo + -- ^ Stable after + SlotNo + -- ^ Stability window size + SlotNo + -- ^ Predicted last slot of the epoch deriving Show instance Error LeadershipError where @@ -1256,6 +1278,156 @@ instance Error LeadershipError where "The stake pool: " <> show poolId <> " has no stake" displayError LeaderErrDecodeProtocolEpochStateFailure = "Failed to successfully decode the current epoch state" + displayError (LeaderErrStakeDistribUnstable curSlot stableAfterSlot stabWindow predictedLastSlot) = + "The current stake distribution is currently unstable and therefore we cannot predict " <> + "the following epoch's leadership schedule. Please wait until : " <> show stableAfterSlot <> + " before running the leadership-schedule command again. \nCurrent slot: " <> show curSlot <> + " \nStability window: " <> show stabWindow <> + " \nPredicted last slow: " <> show predictedLastSlot + +nextEpochEligibleLeadershipSlots + :: HasField "_d" (Core.PParams (ShelleyLedgerEra era)) UnitInterval + => Ledger.Era (ShelleyLedgerEra era) + => Share (Core.TxOut (ShelleyLedgerEra era)) ~ Interns (Shelley.Spec.Credential 'Shelley.Spec.Staking (Ledger.Crypto (ShelleyLedgerEra era))) + => ShelleyBasedEra era + -> ShelleyGenesis Shelley.StandardShelley + -> SerialisedCurrentEpochState era + -- ^ We need the mark stake distribution in order to predict + -- the following epoch's leadership schedule + -> ProtocolState era + -> PoolId + -- ^ Potential slot leading stake pool + -> SigningKey VrfKey + -- ^ VRF signing key of the stake pool + -> ProtocolParameters + -> (ChainTip, EpochNo) + -> Either LeadershipError (Set SlotNo) +nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState + poolid@(StakePoolKeyHash poolHash) (VrfSigningKey vrfSkey) pParams + (cTip, currentEpoch) = do + -- First we check if we are within 3k/f slots of the end of the current epoch + -- k is the security parameter + -- f is the active slot coefficient + let stabilityWindowR :: Rational + stabilityWindowR = fromIntegral (3 * sgSecurityParam sGen) / Shelley.Spec.unboundRational (sgActiveSlotsCoeff sGen) + stabilityWindowSlots :: SlotNo + stabilityWindowSlots = fromIntegral @Word64 $ floor $ fromRational @Double stabilityWindowR + stableStakeDistribSlot = currentEpochLastSlot - stabilityWindowSlots + + + case cTip of + ChainTipAtGenesis -> Left LeaderErrGenesisSlot + ChainTip tip _ _ -> + if tip > stableStakeDistribSlot + then return () + else Left $ LeaderErrStakeDistribUnstable tip stableStakeDistribSlot stabilityWindowSlots currentEpochLastSlot + + + -- Then we get the "mark" snapshot. This snapshot will be used for the next + -- epoch's leadership schedule. + CurrentEpochState cEstate <- first (const LeaderErrDecodeProtocolEpochStateFailure) + $ obtainDecodeEpochStateConstraints sbe + $ decodeCurrentEpochState serCurrEpochState + let markSnapshotPoolDistr = ShelleyAPI.unPoolDistr . ShelleyAPI.calculatePoolDistr . ShelleyAPI._pstakeMark + $ obtainIsStandardCrypto sbe $ ShelleyAPI.esSnapshots cEstate + + + relativeStake <- maybe (Left $ LeaderErrStakePoolHasNoStake poolid) + (Right . ShelleyAPI.individualPoolStake) $ Map.lookup poolHash markSnapshotPoolDistr + + + + let isLeader :: Consensus.Nonce -> SlotNo -> Bool + isLeader eNonce slotNo = isSlotLeader sbe eNonce nextEpochFirstSlot pParams vrfSkey relativeStake f slotNo + + + chainDepState <- first (const LeaderErrDecodeProtocolStateFailure) + $ decodeProtocolState ptclState + + + let Tick.TicknState epochNonce _ = TPraos.csTickn chainDepState + + + return $ Set.filter (isLeader epochNonce) nextEpochSlotRange + where + globals = constructGlobals sGen epochInfoConstantEither pParams + + + -- This allows us to calculate the slot range of the next epoch + epochInfoConstant :: EpochInfo Identity + epochInfoConstant = fixedEpochInfo (sgEpochLength sGen) + (mkSlotLength $ sgSlotLength sGen) + + + epochInfoConstantEither :: EpochInfo (Either Text) + epochInfoConstantEither = generalizeEpochInfo epochInfoConstant + + + f :: Shelley.Spec.ActiveSlotCoeff + f = activeSlotCoeff globals + + + nextEpochSlotRange :: Set SlotNo + nextEpochSlotRange = Set.fromList [nextEpochFirstSlot .. nextEpochlastSlot] + + + (nextEpochFirstSlot, nextEpochlastSlot) = + runIdentity $ Slot.epochInfoRange epochInfoConstant (currentEpoch + 1) + + + (_, currentEpochLastSlot) = + runIdentity $ Slot.epochInfoRange epochInfoConstant currentEpoch + + + +-- | Check if a stake pool is a slot leader for a particular slot +isSlotLeader + :: Crypto.Signable v Shelley.Spec.Seed + => Crypto.VRFAlgorithm v + => Crypto.ContextVRF v ~ () + => HasField "_d" (Core.PParams (ShelleyLedgerEra era)) UnitInterval + => ShelleyBasedEra era + -> Consensus.Nonce + -> SlotNo -- ^ Epoch's first slot + -> ProtocolParameters + -> Crypto.SignKeyVRF v + -> Rational -- ^ Stake pool relative stake + -> Shelley.Spec.ActiveSlotCoeff + -> SlotNo -- ^ Potential leadership slot for the stake pool. + -> Bool +isSlotLeader sbe eNonce epochStartSlot pParams vrfSkey + stakePoolStake activeSlotCoeff' slotNo = + let certified = Crypto.evalCertified () + (TPraos.mkSeed TPraos.seedL slotNo eNonce) vrfSkey + pp = toLedgerPParams sbe pParams + in not (Ledger.isOverlaySlot epochStartSlot (getField @"_d" pp) slotNo) + && TPraos.checkLeaderValue (Crypto.certifiedOutput certified) + stakePoolStake activeSlotCoeff' + + +obtainIsStandardCrypto + :: ShelleyLedgerEra era ~ ledgerera + => ShelleyBasedEra era + -> (Ledger.Crypto ledgerera ~ Shelley.StandardCrypto => a) + -> a +obtainIsStandardCrypto ShelleyBasedEraShelley f = f +obtainIsStandardCrypto ShelleyBasedEraAllegra f = f +obtainIsStandardCrypto ShelleyBasedEraMary f = f +obtainIsStandardCrypto ShelleyBasedEraAlonzo f = f + + +obtainDecodeEpochStateConstraints + :: ShelleyLedgerEra era ~ ledgerera + => ShelleyBasedEra era + -> (( FromCBOR (Core.PParams ledgerera) + , FromCBOR (State (Core.EraRule "PPUP" ledgerera)) + , FromCBOR (Core.Value ledgerera) + , FromSharedCBOR (Core.TxOut ledgerera) + ) => a) -> a +obtainDecodeEpochStateConstraints ShelleyBasedEraShelley f = f +obtainDecodeEpochStateConstraints ShelleyBasedEraAllegra f = f +obtainDecodeEpochStateConstraints ShelleyBasedEraMary f = f +obtainDecodeEpochStateConstraints ShelleyBasedEraAlonzo f = f -- | Return the slots at which a particular stake pool operator is -- expected to mint a block. diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index bd54fbeea66..a124b1f8304 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -190,6 +190,7 @@ module Cardano.Api.Shelley -- ** Various calculations LeadershipError(..), currentEpochEligibleLeadershipSlots, + nextEpochEligibleLeadershipSlots, -- ** Conversions shelleyPayAddrToPlutusPubKHash, --TODO: arrange not to export these diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index ec2e94ff012..d2bf42cd758 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -1474,7 +1474,7 @@ pVrfSigningKeyFile = ) pWhichLeadershipSchedule :: Parser EpochLeadershipSchedule -pWhichLeadershipSchedule = pCurrent +pWhichLeadershipSchedule = pCurrent <|> pNext where pCurrent :: Parser EpochLeadershipSchedule pCurrent = @@ -1483,6 +1483,13 @@ pWhichLeadershipSchedule = pCurrent <> Opt.help "Get the leadership schedule for the current epoch." ) + pNext :: Parser EpochLeadershipSchedule + pNext = + Opt.flag' NextEpoch + ( Opt.long "next" + <> Opt.help "Get the leadership schedule for the following epoch." + ) + pSomeWitnessSigningData :: Parser [WitnessSigningData] pSomeWitnessSigningData = some $ diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index ca4370cc06f..fb7aea95f3c 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -920,6 +920,20 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network $ currentEpochEligibleLeadershipSlots sbe shelleyGenesis eInfo pparams serDebugLedState ptclState poolid vrkSkey + NextEpoch -> do + let currentEpochStateQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryCurrentEpochState + currentEpochQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryEpoch + tip <- liftIO $ getLocalChainTip localNodeConnInfo + + curentEpoch <- executeQuery era cModeParams localNodeConnInfo currentEpochQuery + serCurrentEpochState <- executeQuery era cModeParams localNodeConnInfo currentEpochStateQuery + + firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither + $ eligibleLeaderSlotsConstaints sbe + $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis + serCurrentEpochState ptclState poolid vrkSkey pparams + (tip, curentEpoch) + liftIO $ printLeadershipSchedule schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode where diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs index 0f8fc3ca95b..e4967b1ae62 100644 --- a/cardano-cli/src/Cardano/CLI/Types.hs +++ b/cardano-cli/src/Cardano/CLI/Types.hs @@ -228,5 +228,6 @@ data RequiredSigner -- TODO: Implement Previous and Next epochs data EpochLeadershipSchedule = CurrentEpoch + | NextEpoch deriving Show