Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1039,6 +1039,8 @@ module Cardano.Api
, queryProposals
, queryCommitteeMembersState
, queryStakeVoteDelegatees
, queryStakePoolDefaultVote
, queryLedgerConfig

-- ** Committee State Query
, MemberStatus (..)
Expand Down
28 changes: 28 additions & 0 deletions cardano-api/src/Cardano/Api/Internal/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -149,6 +149,8 @@ data QueryInMode result where
:: QueryInMode (WithOrigin BlockNo)
QueryChainPoint
:: QueryInMode ChainPoint
QueryLedgerConfig
:: QueryInMode (Consensus.CardanoLedgerConfig StandardCrypto)

instance NodeToClientVersionOf (QueryInMode result) where
nodeToClientVersionOf = \case
Expand All @@ -158,6 +160,7 @@ instance NodeToClientVersionOf (QueryInMode result) where
QuerySystemStart -> NodeToClientV_16
QueryChainBlockNo -> NodeToClientV_16
QueryChainPoint -> NodeToClientV_16
QueryLedgerConfig -> NodeToClientV_20

data EraHistory where
EraHistory
Expand Down Expand Up @@ -298,6 +301,9 @@ data QueryInShelleyBasedEra era result where
-> QueryInShelleyBasedEra era (Seq (L.GovActionState (ShelleyLedgerEra era)))
QueryLedgerPeerSnapshot
:: QueryInShelleyBasedEra era (Serialised LedgerPeerSnapshot)
QueryStakePoolDefaultVote
:: Ledger.KeyHash 'Ledger.StakePool
-> QueryInShelleyBasedEra era L.DefaultVote

-- | Mapping for queries in Shelley-based eras returning minimal node-to-client protocol versions. More
-- information about queries versioning can be found:
Expand Down Expand Up @@ -333,6 +339,7 @@ instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where
nodeToClientVersionOf QueryRatifyState{} = NodeToClientV_17
nodeToClientVersionOf QueryFuturePParams{} = NodeToClientV_18
nodeToClientVersionOf QueryLedgerPeerSnapshot = NodeToClientV_19
nodeToClientVersionOf QueryStakePoolDefaultVote{} = NodeToClientV_20

deriving instance Show (QueryInShelleyBasedEra era result)

Expand Down Expand Up @@ -557,6 +564,7 @@ toConsensusQuery (QueryInEra QueryByronUpdateState) =
Consensus.GetUpdateInterfaceState
toConsensusQuery (QueryInEra (QueryInShelleyBasedEra sbe q)) =
shelleyBasedEraConstraints sbe $ toConsensusQueryShelleyBased sbe q
toConsensusQuery QueryLedgerConfig = Some Consensus.GetLedgerConfig

toConsensusQueryShelleyBased
:: forall era protocol block result
Expand Down Expand Up @@ -709,6 +717,16 @@ toConsensusQueryShelleyBased sbe = \case
sbe
QueryLedgerPeerSnapshot ->
Some (consensusQueryInEraInMode era (Consensus.GetCBOR Consensus.GetBigLedgerPeerSnapshot))
QueryStakePoolDefaultVote govActs ->
caseShelleyToBabbageOrConwayEraOnwards
( const $
error "toConsensusQueryShelleyBased: QueryStakePoolDefaultVote is only available in the Conway era"
)
( const $
Some
(consensusQueryInEraInMode era (Consensus.QueryStakePoolDefaultVote govActs))
)
sbe
where
era = toCardanoEra sbe

Expand Down Expand Up @@ -770,6 +788,11 @@ fromConsensusQueryResult QueryCurrentEra q' r' =
Consensus.BlockQuery (Consensus.QueryHardFork Consensus.GetCurrentEra) ->
fromConsensusEraIndex r'
_ -> fromConsensusQueryResultMismatch
fromConsensusQueryResult QueryLedgerConfig q' r' =
case q' of
Consensus.GetLedgerConfig ->
r'
_ -> fromConsensusQueryResultMismatch
fromConsensusQueryResult (QueryInEra QueryByronUpdateState) q' r' =
case q' of
Consensus.BlockQuery
Expand Down Expand Up @@ -1006,6 +1029,11 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' =
Consensus.GetCBOR Consensus.GetBigLedgerPeerSnapshot ->
r'
_ -> fromConsensusQueryResultMismatch
QueryStakePoolDefaultVote{} ->
case q' of
Consensus.QueryStakePoolDefaultVote{} ->
r'
_ -> fromConsensusQueryResultMismatch

-- | This should /only/ happen if we messed up the mapping in 'toConsensusQuery'
-- and 'fromConsensusQueryResult' so they are inconsistent with each other.
Expand Down
38 changes: 38 additions & 0 deletions cardano-api/src/Cardano/Api/Internal/Query/Expr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,8 @@ module Cardano.Api.Internal.Query.Expr
, queryFuturePParams
, queryStakeVoteDelegatees
, queryProposals
, queryStakePoolDefaultVote
, queryLedgerConfig
)
where

Expand Down Expand Up @@ -67,6 +69,7 @@ import Cardano.Ledger.Hashes hiding (Hash)
import Cardano.Ledger.Keys qualified as L
import Cardano.Ledger.Shelley.LedgerState qualified as L
import Cardano.Slotting.Slot
import Ouroboros.Consensus.Cardano.Block qualified as Consensus
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus
import Ouroboros.Network.Block (Serialised)
import Ouroboros.Network.PeerSelection.LedgerPeers (LedgerPeerSnapshot)
Expand Down Expand Up @@ -94,6 +97,21 @@ queryChainPoint
queryChainPoint =
queryExpr QueryChainPoint

queryLedgerConfig
:: ()
=> LocalStateQueryExpr
block
point
QueryInMode
r
IO
( Either
UnsupportedNtcVersionError
(Consensus.CardanoLedgerConfig Ledger.StandardCrypto)
)
queryLedgerConfig =
queryExpr QueryLedgerConfig

queryCurrentEra
:: ()
=> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError AnyCardanoEra)
Expand Down Expand Up @@ -536,3 +554,23 @@ queryProposals cOnwards govActionIds = do
queryExpr $
QueryInEra . QueryInShelleyBasedEra sbe $
QueryProposals govActionIds

queryStakePoolDefaultVote
:: forall era block point r
. ConwayEraOnwards era
-> L.KeyHash 'L.StakePool
-> LocalStateQueryExpr
block
point
QueryInMode
r
IO
( Either
UnsupportedNtcVersionError
(Either EraMismatch L.DefaultVote)
)
queryStakePoolDefaultVote cOnwards stakePools = do
let sbe = convert cOnwards
queryExpr $
QueryInEra . QueryInShelleyBasedEra sbe $
QueryStakePoolDefaultVote stakePools
Loading