stuff

IntersectMBO · Aug 1, 2022 · a38ad48 · a38ad48
1 parent 4ef18c9
commit a38ad48
Show file tree

Hide file tree

Showing 4 changed files with 18 additions and 26 deletions.
diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -106,8 +105,9 @@ import           Cardano.Api.Modes (CardanoMode, EpochSlots (..))
 import qualified Cardano.Api.Modes as Api
 import           Cardano.Api.NetworkId (NetworkId (..), NetworkMagic (NetworkMagic))
 import           Cardano.Api.ProtocolParameters
-import           Cardano.Api.Query (CurrentEpochState (..), ProtocolState,
-                   SerialisedCurrentEpochState (..), decodeCurrentEpochState, decodeProtocolState)
+import           Cardano.Api.Query (CurrentEpochState (..), PoolDistr (unPoolDistr), ProtocolState,
+                   SerialisedCurrentEpochState (..), SerialisedPoolDistr, decodeCurrentEpochState,
+                   decodePoolDistr, decodeProtocolState)
 import           Cardano.Binary (DecoderError, FromCBOR)
 import qualified Cardano.Chain.Genesis
 import qualified Cardano.Chain.Update
@@ -169,8 +169,6 @@ import qualified Ouroboros.Network.Protocol.ChainSync.Client as CS
 import qualified Ouroboros.Network.Protocol.ChainSync.ClientPipelined as CSP
 import           Ouroboros.Network.Protocol.ChainSync.PipelineDecision
 
-import           Debug.Trace
-
 data InitialLedgerStateError
   = ILSEConfigFile Text
   -- ^ Failed to read or parse the network config file.
@@ -1514,10 +1512,10 @@ currentEpochEligibleLeadershipSlots :: forall era ledgerera. ()
   -> ProtocolState era
   -> PoolId
   -> SigningKey VrfKey
-  -> SerialisedCurrentEpochState era
+  -> SerialisedPoolDistr era
   -> EpochNo -- ^ Current EpochInfo
   -> Either LeadershipError (Set SlotNo)
-currentEpochEligibleLeadershipSlots sbe sGen eInfo pParams ptclState poolid (VrfSigningKey vrkSkey) serCurrEpochState currentEpoch = do
+currentEpochEligibleLeadershipSlots sbe sGen eInfo pParams ptclState poolid (VrfSigningKey vrkSkey) serPoolDistr currentEpoch = do
 
   chainDepState :: ChainDepState (Api.ConsensusProtocol era) <-
     first LeaderErrDecodeProtocolStateFailure $ decodeProtocolState ptclState
@@ -1530,21 +1528,10 @@ currentEpochEligibleLeadershipSlots sbe sGen eInfo pParams ptclState poolid (Vrf
   (firstSlotOfEpoch, lastSlotofEpoch) :: (SlotNo, SlotNo) <- first LeaderErrSlotRangeCalculationFailure
     $ Slot.epochInfoRange eInfo currentEpoch
 
-  let !_ = traceId "[a]"
-
-  CurrentEpochState (cEstate :: ShelleyAPI.EpochState (ShelleyLedgerEra era)) <-
-    first LeaderErrDecodeProtocolEpochStateFailure
+  setSnapshotPoolDistr <-
+    first LeaderErrDecodeProtocolEpochStateFailure . fmap (SL.unPoolDistr . unPoolDistr)
       $ obtainDecodeEpochStateConstraints sbe
-      $ decodeCurrentEpochState serCurrEpochState
-
-  -- We need the "set" stake distribution (distribution of the previous epoch)
-  -- in order to calculate the leadership schedule of the current epoch.
-  let snapshot :: ShelleyAPI.SnapShot Shelley.StandardCrypto
-      snapshot = ShelleyAPI._pstakeSet . obtainIsStandardCrypto sbe $ ShelleyAPI.esSnapshots cEstate
-      setSnapshotPoolDistr :: Map (SL.KeyHash 'SL.StakePool Shelley.StandardCrypto) (SL.IndividualPoolStake Shelley.StandardCrypto)
-      setSnapshotPoolDistr = ShelleyAPI.unPoolDistr . ShelleyAPI.calculatePoolDistr $ snapshot
-
-  let !_ = traceId $ "[b]" <> show setSnapshotPoolDistr
+      $ decodePoolDistr serPoolDistr
 
   let slotRangeOfInterest = Set.filter
         (not . Ledger.isOverlaySlot firstSlotOfEpoch (getField @"_d" (toLedgerPParams sbe pParams)))

diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs
@@ -414,7 +414,9 @@ decodePoolState (SerialisedPoolState (Serialised ls)) = PoolState <$> decodeFull
 newtype SerialisedPoolDistr era
   = SerialisedPoolDistr (Serialised (Shelley.PoolDistr (Ledger.Crypto (ShelleyLedgerEra era))))
 
-newtype PoolDistr era = PoolDistr (Shelley.PoolDistr (Ledger.Crypto (ShelleyLedgerEra era)))
+newtype PoolDistr era = PoolDistr
+  { unPoolDistr :: Shelley.PoolDistr (Ledger.Crypto (ShelleyLedgerEra era))
+  }
 
 decodePoolDistr
   :: forall era. ()

diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs
@@ -210,6 +210,9 @@ module Cardano.Api.Shelley
     PoolState(..),
     SerialisedPoolState(..),
     decodePoolState,
+    PoolDistr(..),
+    SerialisedPoolDistr(..),
+    decodePoolDistr,
     UTxO(..),
     AcquireFailure(..),
     SystemStart(..),
@@ -235,8 +238,8 @@ import           Cardano.Api.Address
 import           Cardano.Api.Block
 import           Cardano.Api.Certificate
 import           Cardano.Api.Eras
-import           Cardano.Api.IPC
 import           Cardano.Api.InMode
+import           Cardano.Api.IPC
 import           Cardano.Api.KeysByron
 import           Cardano.Api.KeysPraos
 import           Cardano.Api.KeysShelley

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -1181,9 +1181,9 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
       schedule :: Set SlotNo
         <- case whichSchedule of
              CurrentEpoch -> do
-               let currentEpochStateQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryCurrentEpochState
-                   currentEpochQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryEpoch
-               serCurrentEpochState <- executeQuery era cModeParams localNodeConnInfo currentEpochStateQuery
+               let currentEpochQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryEpoch
+               serCurrentEpochState <- executeQuery era cModeParams localNodeConnInfo $
+                QueryInEra eInMode $ QueryInShelleyBasedEra sbe (QueryPoolDistr (Just (Set.singleton poolid)))
                curentEpoch <- executeQuery era cModeParams localNodeConnInfo currentEpochQuery
                firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither
                 $ eligibleLeaderSlotsConstaints sbe