Skip to content

Commit 2be07bb

Browse files
Merge #4170
4170: New query pool-state command r=newhoggy a=newhoggy This obsoletes `query pool-params`. The command runs sub-second (rather than the `1m30s` the old command takes. It also allows multiple stake pools to be queried at a time. * Requires IntersectMBO/ouroboros-network#3890 * Requires IntersectMBO/cardano-ledger#2908 Co-authored-by: John Ky <[email protected]>
2 parents c33c06f + f0475c9 commit 2be07bb

File tree

9 files changed

+140
-102
lines changed

9 files changed

+140
-102
lines changed

cabal.project

+6-6
Original file line numberDiff line numberDiff line change
@@ -197,8 +197,8 @@ source-repository-package
197197
source-repository-package
198198
type: git
199199
location: https://github.com/input-output-hk/cardano-ledger
200-
tag: 65292694de72f137e6b90c5f361ae7646b48775f
201-
--sha256: 05m1c7v8a2797675gkagpzl6bcjnj7w6lnx5x7hf90847ap88b05
200+
tag: f49879a79098d9372d63baa13b94a941a56eda34
201+
--sha256: 0i9x66yqkrvx2w79dy6lzlya82yxc8567rgjj828vc2d46d6nvx6
202202
subdir:
203203
eras/alonzo/impl
204204
eras/alonzo/test-suite
@@ -227,8 +227,8 @@ source-repository-package
227227
source-repository-package
228228
type: git
229229
location: https://github.com/input-output-hk/cardano-prelude
230-
tag: c7fc9fba236972c27a55e0f3d34c2758cf616bfc
231-
--sha256: 0sg1hhnifqxfc5n5f9ikbxyrjlg77hynbhsql0h4smqniw29dbwk
230+
tag: 6ea36cf2247ac0bc33e08c327abec34dfd05bd99
231+
--sha256: 0z2y3wzppc12bpn9bl48776ms3nszw8j58xfsdxf97nzjgrmd62g
232232
subdir:
233233
cardano-prelude
234234
cardano-prelude-test
@@ -263,8 +263,8 @@ source-repository-package
263263
source-repository-package
264264
type: git
265265
location: https://github.com/input-output-hk/ouroboros-network
266-
tag: 69b748ea07ffbaf9c7868645f9f8ca9b58f658b5
267-
--sha256: 0yfici9p5gbj7gzpbk19izwsksagzc8fjls3cax291128jyvpi7w
266+
tag: c764553561bed8978d2c6753d1608dc65449617a
267+
--sha256: 0hdh7xdrvxw943r6qr0xr4kwszindh5mnsn1lww6qdnxnmn7wcsc
268268
subdir:
269269
monoidal-synchronisation
270270
network-mux

cardano-api/src/Cardano/Api/Query.hs

+59-30
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,10 @@ module Cardano.Api.Query (
4343
CurrentEpochState(..),
4444
decodeCurrentEpochState,
4545

46+
SerialisedPoolState(..),
47+
PoolState(..),
48+
decodePoolState,
49+
4650
EraHistory(..),
4751
SystemStart(..),
4852

@@ -70,10 +74,10 @@ import qualified Data.HashMap.Strict as HMS
7074
import Data.Map (Map)
7175
import qualified Data.Map as Map
7276
import Data.Maybe (mapMaybe)
73-
import Data.SOP.Strict (SListI)
7477
import Data.Set (Set)
7578
import qualified Data.Set as Set
7679
import Data.Sharing (FromSharedCBOR, Interns, Share)
80+
import Data.SOP.Strict (SListI)
7781
import Data.Text (Text)
7882
import Data.Typeable
7983
import Prelude
@@ -189,51 +193,54 @@ deriving instance Show (QueryInEra era result)
189193

190194

191195
data QueryInShelleyBasedEra era result where
192-
QueryEpoch
193-
:: QueryInShelleyBasedEra era EpochNo
196+
QueryEpoch
197+
:: QueryInShelleyBasedEra era EpochNo
194198

195-
QueryGenesisParameters
196-
:: QueryInShelleyBasedEra era GenesisParameters
199+
QueryGenesisParameters
200+
:: QueryInShelleyBasedEra era GenesisParameters
197201

198-
QueryProtocolParameters
199-
:: QueryInShelleyBasedEra era ProtocolParameters
202+
QueryProtocolParameters
203+
:: QueryInShelleyBasedEra era ProtocolParameters
200204

201-
QueryProtocolParametersUpdate
202-
:: QueryInShelleyBasedEra era
205+
QueryProtocolParametersUpdate
206+
:: QueryInShelleyBasedEra era
203207
(Map (Hash GenesisKey) ProtocolParametersUpdate)
204208

205-
QueryStakeDistribution
206-
:: QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
209+
QueryStakeDistribution
210+
:: QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
207211

208-
QueryUTxO
209-
:: QueryUTxOFilter
210-
-> QueryInShelleyBasedEra era (UTxO era)
212+
QueryUTxO
213+
:: QueryUTxOFilter
214+
-> QueryInShelleyBasedEra era (UTxO era)
211215

212-
QueryStakeAddresses
213-
:: Set StakeCredential
214-
-> NetworkId
215-
-> QueryInShelleyBasedEra era (Map StakeAddress Lovelace,
216-
Map StakeAddress PoolId)
216+
QueryStakeAddresses
217+
:: Set StakeCredential
218+
-> NetworkId
219+
-> QueryInShelleyBasedEra era (Map StakeAddress Lovelace, Map StakeAddress PoolId)
217220

218-
QueryStakePools
219-
:: QueryInShelleyBasedEra era (Set PoolId)
221+
QueryStakePools
222+
:: QueryInShelleyBasedEra era (Set PoolId)
220223

221-
QueryStakePoolParameters
222-
:: Set PoolId
223-
-> QueryInShelleyBasedEra era (Map PoolId StakePoolParameters)
224+
QueryStakePoolParameters
225+
:: Set PoolId
226+
-> QueryInShelleyBasedEra era (Map PoolId StakePoolParameters)
224227

225228
-- TODO: add support for RewardProvenance
226229
-- QueryPoolRanking
227230
-- :: QueryInShelleyBasedEra era RewardProvenance
228231

229-
QueryDebugLedgerState
230-
:: QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
232+
QueryDebugLedgerState
233+
:: QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
231234

232-
QueryProtocolState
233-
:: QueryInShelleyBasedEra era (ProtocolState era)
235+
QueryProtocolState
236+
:: QueryInShelleyBasedEra era (ProtocolState era)
234237

235-
QueryCurrentEpochState
236-
:: QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
238+
QueryCurrentEpochState
239+
:: QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
240+
241+
QueryPoolState
242+
:: Maybe (Set PoolId)
243+
-> QueryInShelleyBasedEra era (SerialisedPoolState era)
237244

238245
deriving instance Show (QueryInShelleyBasedEra era result)
239246

@@ -358,6 +365,18 @@ decodeCurrentEpochState
358365
-> Either DecoderError (CurrentEpochState era)
359366
decodeCurrentEpochState (SerialisedCurrentEpochState (Serialised ls)) = CurrentEpochState <$> decodeFull ls
360367

368+
newtype SerialisedPoolState era
369+
= SerialisedPoolState (Serialised (Shelley.PState (Ledger.Crypto (ShelleyLedgerEra era))))
370+
371+
newtype PoolState era = PoolState (Shelley.PState (Ledger.Crypto (ShelleyLedgerEra era)))
372+
373+
decodePoolState
374+
:: forall era. ()
375+
=> FromCBOR (Shelley.PState (Ledger.Crypto (ShelleyLedgerEra era)))
376+
=> SerialisedPoolState era
377+
-> Either DecoderError (PoolState era)
378+
decodePoolState (SerialisedPoolState (Serialised ls)) = PoolState <$> decodeFull ls
379+
361380
toShelleyAddrSet :: CardanoEra era
362381
-> Set AddressAny
363382
-> Set (Shelley.Addr Consensus.StandardCrypto)
@@ -537,6 +556,11 @@ toConsensusQueryShelleyBased erainmode QueryProtocolState =
537556
toConsensusQueryShelleyBased erainmode QueryCurrentEpochState =
538557
Some (consensusQueryInEraInMode erainmode (Consensus.GetCBOR Consensus.DebugEpochState))
539558

559+
toConsensusQueryShelleyBased erainmode (QueryPoolState poolIds) =
560+
Some (consensusQueryInEraInMode erainmode (Consensus.GetCBOR (Consensus.GetPoolState (getPoolIds <$> poolIds))))
561+
where
562+
getPoolIds :: Set PoolId -> Set (Shelley.KeyHash Shelley.StakePool Consensus.StandardCrypto)
563+
getPoolIds = Set.map (\(StakePoolKeyHash kh) -> kh)
540564

541565
consensusQueryInEraInMode
542566
:: forall era mode erablock modeblock result result' xs.
@@ -768,6 +792,11 @@ fromConsensusQueryResultShelleyBased _ QueryCurrentEpochState q' r' =
768792
Consensus.GetCBOR Consensus.DebugEpochState -> SerialisedCurrentEpochState r'
769793
_ -> fromConsensusQueryResultMismatch
770794

795+
fromConsensusQueryResultShelleyBased _ QueryPoolState{} q' r' =
796+
case q' of
797+
Consensus.GetCBOR Consensus.GetPoolState {} -> SerialisedPoolState r'
798+
_ -> fromConsensusQueryResultMismatch
799+
771800
-- | This should /only/ happen if we messed up the mapping in 'toConsensusQuery'
772801
-- and 'fromConsensusQueryResult' so they are inconsistent with each other.
773802
--

cardano-api/src/Cardano/Api/Shelley.hs

+6-2
Original file line numberDiff line numberDiff line change
@@ -204,8 +204,12 @@ module Cardano.Api.Shelley
204204
ProtocolState(..),
205205
decodeProtocolState,
206206
SerialisedDebugLedgerState(..),
207+
CurrentEpochState(..),
207208
SerialisedCurrentEpochState(..),
208209
decodeCurrentEpochState,
210+
PoolState(..),
211+
SerialisedPoolState(..),
212+
decodePoolState,
209213
UTxO(..),
210214

211215
-- ** Various calculations
@@ -228,10 +232,10 @@ import Cardano.Api.Address
228232
import Cardano.Api.Block
229233
import Cardano.Api.Certificate
230234
import Cardano.Api.Eras
231-
import Cardano.Api.IPC
232235
import Cardano.Api.InMode
233-
import Cardano.Api.KeysPraos
236+
import Cardano.Api.IPC
234237
import Cardano.Api.KeysByron
238+
import Cardano.Api.KeysPraos
235239
import Cardano.Api.KeysShelley
236240
import Cardano.Api.LedgerState
237241
import Cardano.Api.NetworkId

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -368,13 +368,13 @@ data QueryCmd =
368368
| QueryDebugLedgerState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
369369
| QueryProtocolState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
370370
| QueryStakeSnapshot' AnyConsensusModeParams NetworkId (Hash StakePoolKey)
371-
| QueryPoolParams' AnyConsensusModeParams NetworkId (Hash StakePoolKey)
372371
| QueryKesPeriodInfo
373372
AnyConsensusModeParams
374373
NetworkId
375374
FilePath
376375
-- ^ Node operational certificate
377376
(Maybe OutputFile)
377+
| QueryPoolState' AnyConsensusModeParams NetworkId [Hash StakePoolKey]
378378
deriving Show
379379

380380
renderQueryCmd :: QueryCmd -> Text
@@ -390,8 +390,8 @@ renderQueryCmd cmd =
390390
QueryDebugLedgerState' {} -> "query ledger-state"
391391
QueryProtocolState' {} -> "query protocol-state"
392392
QueryStakeSnapshot' {} -> "query stake-snapshot"
393-
QueryPoolParams' {} -> "query pool-params"
394393
QueryKesPeriodInfo {} -> "query kes-period-info"
394+
QueryPoolState' {} -> "query pool-state"
395395

396396
data GovernanceCmd
397397
= GovernanceMIRPayStakeAddressesCertificate

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

+13-7
Original file line numberDiff line numberDiff line change
@@ -35,8 +35,8 @@ import Options.Applicative hiding (help, str)
3535
import qualified Options.Applicative as Opt
3636
import qualified Options.Applicative.Help as H
3737
import Prettyprinter (line, pretty)
38-
import Text.Parsec ((<?>))
3938
import qualified Text.Parsec as Parsec
39+
import Text.Parsec ((<?>))
4040
import qualified Text.Parsec.Error as Parsec
4141
import qualified Text.Parsec.Language as Parsec
4242
import qualified Text.Parsec.String as Parsec
@@ -49,12 +49,12 @@ import Ouroboros.Consensus.BlockchainTime (SystemStart (..))
4949
import Cardano.Api
5050
import Cardano.Api.Shelley
5151

52+
import Cardano.Chain.Common (BlockCount (BlockCount))
5253
import Cardano.CLI.Shelley.Commands
5354
import Cardano.CLI.Shelley.Key (InputFormat (..), PaymentVerifier (..),
5455
StakeVerifier (..), VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..),
5556
VerificationKeyTextOrFile (..), deserialiseInput, renderInputDecodeError)
5657
import Cardano.CLI.Types
57-
import Cardano.Chain.Common (BlockCount (BlockCount))
5858

5959
{- HLINT ignore "Use <$>" -}
6060

@@ -934,12 +934,14 @@ pQueryCmd =
934934
(Opt.info pQueryProtocolState $ Opt.progDesc "Dump the current protocol state of the node (Ledger.ChainDepState -- advanced command)")
935935
, subParser "stake-snapshot"
936936
(Opt.info pQueryStakeSnapshot $ Opt.progDesc "Obtain the three stake snapshots for a pool, plus the total active stake (advanced command)")
937-
, subParser "pool-params"
938-
(Opt.info pQueryPoolParams $ Opt.progDesc "Dump the pool parameters (Ledger.NewEpochState.esLState._delegationState._pState._pParams -- advanced command)")
937+
, hiddenSubParser "pool-params"
938+
(Opt.info pQueryPoolState $ Opt.progDesc "DEPRECATED. Use query pool-state instead. Dump the pool parameters (Ledger.NewEpochState.esLState._delegationState._pState._pParams -- advanced command)")
939939
, subParser "leadership-schedule"
940940
(Opt.info pLeadershipSchedule $ Opt.progDesc "Get the slots the node is expected to mint a block in (advanced command)")
941941
, subParser "kes-period-info"
942942
(Opt.info pKesPeriodInfo $ Opt.progDesc "Get information about the current KES period and your node's operational certificate.")
943+
, subParser "pool-state"
944+
(Opt.info pQueryPoolState $ Opt.progDesc "Dump the pool state")
943945
]
944946
where
945947
pQueryProtocolParameters :: Parser QueryCmd
@@ -1003,11 +1005,11 @@ pQueryCmd =
10031005
<*> pNetworkId
10041006
<*> pStakePoolVerificationKeyHash
10051007

1006-
pQueryPoolParams :: Parser QueryCmd
1007-
pQueryPoolParams = QueryPoolParams'
1008+
pQueryPoolState :: Parser QueryCmd
1009+
pQueryPoolState = QueryPoolState'
10081010
<$> pConsensusModeParams
10091011
<*> pNetworkId
1010-
<*> pStakePoolVerificationKeyHash
1012+
<*> many pStakePoolVerificationKeyHash
10111013

10121014
pLeadershipSchedule :: Parser QueryCmd
10131015
pLeadershipSchedule = QueryLeadershipSchedule
@@ -3311,3 +3313,7 @@ readerFromParsecParser p =
33113313
subParser :: String -> ParserInfo a -> Parser a
33123314
subParser availableCommand pInfo =
33133315
Opt.hsubparser $ Opt.command availableCommand pInfo <> Opt.metavar availableCommand
3316+
3317+
hiddenSubParser :: String -> ParserInfo a -> Parser a
3318+
hiddenSubParser availableCommand pInfo =
3319+
Opt.hsubparser $ Opt.command availableCommand pInfo <> Opt.metavar availableCommand <> Opt.hidden

0 commit comments

Comments
 (0)