Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Small improvements to queries #559

Merged
merged 1 commit into from
Jun 25, 2024
Merged

Small improvements to queries #559

Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
247 changes: 120 additions & 127 deletions cardano-api/internal/Cardano/Api/Query.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -831,6 +831,9 @@ fromConsensusQueryResult (QueryInEra (QueryInShelleyBasedEra ShelleyBasedEraConw
r'
_ -> fromConsensusQueryResultMismatch

-- This function is written like this so that we have exhaustive pattern checking
-- on the @QueryInShelleyBasedEra era result@ value. Don't change the top-level
-- @case sbeQuery of ...@!
fromConsensusQueryResultShelleyBased
:: forall era ledgerera protocol result result'.
HasCallStack
Expand All @@ -842,133 +845,123 @@ fromConsensusQueryResultShelleyBased
-> Consensus.BlockQuery (Consensus.ShelleyBlock protocol ledgerera) result'
-> result'
-> result
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

👍

fromConsensusQueryResultShelleyBased _ QueryEpoch q' epoch =
case q' of
Consensus.GetEpochNo -> epoch
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryConstitution q' mConstitution =
case q' of
Consensus.GetConstitution -> mConstitution
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryGenesisParameters q' r' =
case q' of
Consensus.GetGenesisConfig -> fromShelleyGenesis
(Consensus.getCompactGenesis r')
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryProtocolParameters q' r' =
case q' of
Consensus.GetCurrentPParams -> r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased sbe QueryProtocolParametersUpdate q' r' =
case q' of
Consensus.GetProposedPParamsUpdates -> fromLedgerProposedPPUpdates sbe r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryStakeDistribution q' r' =
case q' of
Consensus.GetStakeDistribution -> fromShelleyPoolDistr r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased sbe (QueryUTxO QueryUTxOWhole) q' utxo' =
case q' of
Consensus.GetUTxOWhole -> fromLedgerUTxO sbe utxo'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased sbe (QueryUTxO QueryUTxOByAddress{}) q' utxo' =
case q' of
Consensus.GetUTxOByAddress{} -> fromLedgerUTxO sbe utxo'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased sbe (QueryUTxO QueryUTxOByTxIn{}) q' utxo' =
case q' of
Consensus.GetUTxOByTxIn{} -> fromLedgerUTxO sbe utxo'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ (QueryStakeAddresses _ nId) q' r' =
case q' of
Consensus.GetFilteredDelegationsAndRewardAccounts{}
-> let (delegs, rwaccs) = r'
in ( Map.mapKeys (makeStakeAddress nId) $ fromShelleyRewardAccounts rwaccs
, Map.mapKeys (makeStakeAddress nId) $ fromShelleyDelegations delegs
)
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryStakePools q' poolids' =
case q' of
Consensus.GetStakePools -> Set.map StakePoolKeyHash poolids'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryStakePoolParameters{} q' poolparams' =
case q' of
Consensus.GetStakePoolParams{} -> Map.map fromShelleyPoolParams
. Map.mapKeysMonotonic StakePoolKeyHash
$ poolparams'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryDebugLedgerState{} q' r' =
case q' of
Consensus.GetCBOR Consensus.DebugNewEpochState -> SerialisedDebugLedgerState r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryProtocolState q' r' =
case q' of
Consensus.GetCBOR Consensus.DebugChainDepState -> ProtocolState r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryCurrentEpochState q' r' =
case q' of
Consensus.GetCBOR Consensus.DebugEpochState -> SerialisedCurrentEpochState r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryPoolState{} q' r' =
case q' of
Consensus.GetCBOR Consensus.GetPoolState {} -> SerialisedPoolState r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryPoolDistribution{} q' r' =
case q' of
Consensus.GetCBOR Consensus.GetPoolDistr {} -> SerialisedPoolDistribution r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryStakeSnapshot{} q' r' =
case q' of
Consensus.GetCBOR Consensus.GetStakeSnapshots {} -> SerialisedStakeSnapshots r'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryStakeDelegDeposits{} q' stakeCreds' =
case q' of
Consensus.GetStakeDelegDeposits{} -> Map.mapKeysMonotonic fromShelleyStakeCredential stakeCreds'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryGovState{} q' govState' =
case q' of
Consensus.GetGovState{} -> govState'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryDRepState{} q' drepState' =
case q' of
Consensus.GetDRepState{} -> drepState'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryDRepStakeDistr{} q' stakeDistr' =
case q' of
Consensus.GetDRepStakeDistr{} -> stakeDistr'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryCommitteeMembersState{} q' committeeMembersState' =
case q' of
Consensus.GetCommitteeMembersState{} -> committeeMembersState'
_ -> fromConsensusQueryResultMismatch

fromConsensusQueryResultShelleyBased _ QueryStakeVoteDelegatees{} q' delegs' =
case q' of
Consensus.GetFilteredVoteDelegatees {}
-> Map.mapKeys fromShelleyStakeCredential delegs'
_ -> fromConsensusQueryResultMismatch
fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' =
case sbeQuery of
QueryEpoch ->
case q' of
Consensus.GetEpochNo -> r'
_ -> fromConsensusQueryResultMismatch
QueryConstitution ->
case q' of
Consensus.GetConstitution -> r'
_ -> fromConsensusQueryResultMismatch
QueryGenesisParameters ->
case q' of
Consensus.GetGenesisConfig -> fromShelleyGenesis (Consensus.getCompactGenesis r')
_ -> fromConsensusQueryResultMismatch
QueryProtocolParameters ->
case q' of
Consensus.GetCurrentPParams -> r'
_ -> fromConsensusQueryResultMismatch
QueryProtocolParametersUpdate ->
case q' of
Consensus.GetProposedPParamsUpdates -> fromLedgerProposedPPUpdates sbe r'
_ -> fromConsensusQueryResultMismatch
QueryStakeDistribution ->
case q' of
Consensus.GetStakeDistribution -> fromShelleyPoolDistr r'
_ -> fromConsensusQueryResultMismatch
QueryUTxO QueryUTxOWhole ->
case q' of
Consensus.GetUTxOWhole -> fromLedgerUTxO sbe r'
_ -> fromConsensusQueryResultMismatch
QueryUTxO QueryUTxOByAddress{} ->
case q' of
Consensus.GetUTxOByAddress{} -> fromLedgerUTxO sbe r'
_ -> fromConsensusQueryResultMismatch
QueryUTxO QueryUTxOByTxIn{} ->
case q' of
Consensus.GetUTxOByTxIn{} -> fromLedgerUTxO sbe r'
_ -> fromConsensusQueryResultMismatch
QueryStakeAddresses _ nId ->
case q' of
Consensus.GetFilteredDelegationsAndRewardAccounts{} ->
let (delegs, rwaccs) = r'
in ( Map.mapKeys (makeStakeAddress nId) $ fromShelleyRewardAccounts rwaccs
, Map.mapKeys (makeStakeAddress nId) $ fromShelleyDelegations delegs
)
_ -> fromConsensusQueryResultMismatch
QueryStakePools ->
case q' of
Consensus.GetStakePools -> Set.map StakePoolKeyHash r'
_ -> fromConsensusQueryResultMismatch
QueryStakePoolParameters{} ->
case q' of
Consensus.GetStakePoolParams{} ->
Map.map fromShelleyPoolParams
. Map.mapKeysMonotonic StakePoolKeyHash
$ r'
_ -> fromConsensusQueryResultMismatch
QueryDebugLedgerState{} ->
case q' of
Consensus.GetCBOR Consensus.DebugNewEpochState ->
SerialisedDebugLedgerState r'
_ -> fromConsensusQueryResultMismatch
QueryProtocolState ->
case q' of
Consensus.GetCBOR Consensus.DebugChainDepState ->
ProtocolState r'
_ -> fromConsensusQueryResultMismatch
QueryCurrentEpochState ->
case q' of
Consensus.GetCBOR Consensus.DebugEpochState ->
SerialisedCurrentEpochState r'
_ -> fromConsensusQueryResultMismatch
QueryPoolState{} ->
case q' of
Consensus.GetCBOR Consensus.GetPoolState {} ->
SerialisedPoolState r'
_ -> fromConsensusQueryResultMismatch
QueryPoolDistribution{} ->
case q' of
Consensus.GetCBOR Consensus.GetPoolDistr {} ->
SerialisedPoolDistribution r'
_ -> fromConsensusQueryResultMismatch
QueryStakeSnapshot{} ->
case q' of
Consensus.GetCBOR Consensus.GetStakeSnapshots {} ->
SerialisedStakeSnapshots r'
_ -> fromConsensusQueryResultMismatch
QueryStakeDelegDeposits{} ->
case q' of
Consensus.GetStakeDelegDeposits{} ->
Map.mapKeysMonotonic fromShelleyStakeCredential r'
_ -> fromConsensusQueryResultMismatch
QueryGovState{} ->
case q' of
Consensus.GetGovState{} ->
r'
_ -> fromConsensusQueryResultMismatch
QueryDRepState{} ->
case q' of
Consensus.GetDRepState{} ->
r'
_ -> fromConsensusQueryResultMismatch
QueryDRepStakeDistr{} ->
case q' of
Consensus.GetDRepStakeDistr{} ->
r'
_ -> fromConsensusQueryResultMismatch
QueryCommitteeMembersState{} ->
case q' of
Consensus.GetCommitteeMembersState{} ->
r'
_ -> fromConsensusQueryResultMismatch
QueryStakeVoteDelegatees{} ->
case q' of
Consensus.GetFilteredVoteDelegatees {} ->
Map.mapKeys fromShelleyStakeCredential 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
Loading