diff --git a/cardano-api/internal/Cardano/Api/Convenience/Query.hs b/cardano-api/internal/Cardano/Api/Convenience/Query.hs index dabcda0029..6d87015b82 100644 --- a/cardano-api/internal/Cardano/Api/Convenience/Query.hs +++ b/cardano-api/internal/Cardano/Api/Convenience/Query.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | Convenience query functions @@ -18,7 +17,6 @@ module Cardano.Api.Convenience.Query ( import Cardano.Api.Address import Cardano.Api.Certificate -import Cardano.Api.Eon.ConwayEraOnwards (ConwayEraOnwards) import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras import Cardano.Api.IO @@ -113,14 +111,15 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do & onLeft (left . QueryEraMismatch) stakeDelegDeposits <- - lift (queryStakeDelegDeposits sbe stakeCreds) - & onLeft (left . QceUnsupportedNtcVersion) - & onLeft (left . QueryEraMismatch) + monoidForEraInEonA era $ \beo -> + lift (queryStakeDelegDeposits beo stakeCreds) + & onLeft (left . QceUnsupportedNtcVersion) + & onLeft (left . QueryEraMismatch) drepDelegDeposits <- - forEraInEon @ConwayEraOnwards era (pure mempty) $ \_ -> + monoidForEraInEonA era $ \con -> Map.map (fromShelleyLovelace . drepDeposit) <$> - (lift (queryDRepState sbe drepCreds) + (lift (queryDRepState con drepCreds) & onLeft (left . QceUnsupportedNtcVersion) & onLeft (left . QueryEraMismatch)) diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs index 3a7a9ec13e..eaf32492a7 100644 --- a/cardano-api/internal/Cardano/Api/Query.hs +++ b/cardano-api/internal/Cardano/Api/Query.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -325,6 +324,10 @@ data QueryInShelleyBasedEra era result where -> QueryInShelleyBasedEra era (Map StakeCredential (Ledger.DRep StandardCrypto)) +-- | Mapping for queries in Shelley-based eras returning minimal node-to-client protocol versions. More +-- information about queries versioning can be found: +-- * https://input-output-hk.github.io/ouroboros-network/ouroboros-network/Ouroboros-Network-NodeToClient.html#t:NodeToClientVersion +-- * https://input-output-hk.github.io/ouroboros-consensus/docs/for-developers/QueryVersioning/#implementation instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where nodeToClientVersionOf QueryEpoch = NodeToClientV_9 nodeToClientVersionOf QueryGenesisParameters = NodeToClientV_9 @@ -338,10 +341,12 @@ instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where nodeToClientVersionOf QueryDebugLedgerState = NodeToClientV_9 nodeToClientVersionOf QueryProtocolState = NodeToClientV_9 nodeToClientVersionOf QueryCurrentEpochState = NodeToClientV_9 + -- Babbage >= v13 nodeToClientVersionOf (QueryPoolState _) = NodeToClientV_14 nodeToClientVersionOf (QueryPoolDistribution _) = NodeToClientV_14 nodeToClientVersionOf (QueryStakeSnapshot _) = NodeToClientV_14 nodeToClientVersionOf (QueryStakeDelegDeposits _) = NodeToClientV_15 + -- Conway >= v16 nodeToClientVersionOf QueryConstitution = NodeToClientV_16 nodeToClientVersionOf QueryGovState = NodeToClientV_16 nodeToClientVersionOf QueryDRepState{} = NodeToClientV_16 diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs index 92fdc92944..870a30c514 100644 --- a/cardano-api/internal/Cardano/Api/Query/Expr.hs +++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs @@ -37,6 +37,8 @@ module Cardano.Api.Query.Expr import Cardano.Api.Address import Cardano.Api.Block import Cardano.Api.Certificate +import Cardano.Api.Eon.BabbageEraOnwards +import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras import Cardano.Api.GenesisParameters @@ -108,17 +110,19 @@ queryGenesisParameters sbe = queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryGenesisParameters queryPoolDistribution :: () - => ShelleyBasedEra era + => BabbageEraOnwards era -> Maybe (Set PoolId) -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolDistribution era))) -queryPoolDistribution sbe mPoolIds = +queryPoolDistribution era mPoolIds = do + let sbe = babbageEraOnwardsToShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryPoolDistribution mPoolIds queryPoolState :: () - => ShelleyBasedEra era + => BabbageEraOnwards era -> Maybe (Set PoolId) -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolState era))) -queryPoolState sbe mPoolIds = +queryPoolState era mPoolIds = do + let sbe = babbageEraOnwardsToShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryPoolState mPoolIds queryProtocolParameters :: () @@ -155,12 +159,14 @@ queryStakeAddresses sbe stakeCredentials networkId = queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeAddresses stakeCredentials networkId queryStakeDelegDeposits :: () - => ShelleyBasedEra era + => BabbageEraOnwards era -> Set StakeCredential -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either Consensus.EraMismatch (Map StakeCredential Lovelace))) -queryStakeDelegDeposits sbe stakeCreds +queryStakeDelegDeposits era stakeCreds | S.null stakeCreds = pure . pure $ pure mempty - | otherwise = queryExpr $ QueryInEra . QueryInShelleyBasedEra sbe $ QueryStakeDelegDeposits stakeCreds + | otherwise = do + let sbe = babbageEraOnwardsToShelleyBasedEra era + queryExpr $ QueryInEra . QueryInShelleyBasedEra sbe $ QueryStakeDelegDeposits stakeCreds queryStakeDistribution :: () => ShelleyBasedEra era @@ -183,10 +189,11 @@ queryStakePools sbe = queryExpr $ QueryInEra . QueryInShelleyBasedEra sbe $ QueryStakePools queryStakeSnapshot :: () - => ShelleyBasedEra era + => BabbageEraOnwards era -> Maybe (Set PoolId) -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedStakeSnapshots era))) -queryStakeSnapshot sbe mPoolIds = +queryStakeSnapshot era mPoolIds = do + let sbe = babbageEraOnwardsToShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeSnapshot mPoolIds querySystemStart :: () @@ -202,45 +209,53 @@ queryUtxo sbe utxoFilter = queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryUTxO utxoFilter queryConstitution :: () - => ShelleyBasedEra era + => ConwayEraOnwards era -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Maybe (L.Constitution (ShelleyLedgerEra era))))) -queryConstitution sbe = +queryConstitution era = do + let sbe = conwayEraOnwardsToShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryConstitution queryGovState :: () - => ShelleyBasedEra era + => ConwayEraOnwards era -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.GovState (ShelleyLedgerEra era)))) -queryGovState sbe = +queryGovState era = do + let sbe = conwayEraOnwardsToShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryGovState queryDRepState :: () - => ShelleyBasedEra era + => ConwayEraOnwards era -> Set (L.Credential L.DRepRole L.StandardCrypto) -- ^ An empty credentials set means that states for all DReps will be returned -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Map (L.Credential L.DRepRole L.StandardCrypto) (L.DRepState L.StandardCrypto)))) -queryDRepState sbe drepCreds = queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryDRepState drepCreds +queryDRepState era drepCreds = do + let sbe = conwayEraOnwardsToShelleyBasedEra era + queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryDRepState drepCreds queryDRepStakeDistribution :: () - => ShelleyBasedEra era + => ConwayEraOnwards era -> Set (L.DRep L.StandardCrypto) -- ^ An empty DRep set means that distributions for all DReps will be returned -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Map (L.DRep L.StandardCrypto) Lovelace))) -queryDRepStakeDistribution sbe dreps = queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryDRepStakeDistr dreps +queryDRepStakeDistribution era dreps = do + let sbe = conwayEraOnwardsToShelleyBasedEra era + queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryDRepStakeDistr dreps -- | Returns info about committee members filtered by: cold credentials, hot credentials and statuses. -- If empty sets are passed as filters, then no filtering is done. queryCommitteeMembersState :: () - => ShelleyBasedEra era + => ConwayEraOnwards era -> Set (L.Credential L.ColdCommitteeRole L.StandardCrypto) -> Set (L.Credential L.HotCommitteeRole L.StandardCrypto) -> Set L.MemberStatus -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Maybe (L.CommitteeMembersState L.StandardCrypto)))) -queryCommitteeMembersState sbe coldCreds hotCreds statuses = +queryCommitteeMembersState era coldCreds hotCreds statuses = do + let sbe = conwayEraOnwardsToShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe (QueryCommitteeMembersState coldCreds hotCreds statuses) queryStakeVoteDelegatees :: () - => ShelleyBasedEra era + => ConwayEraOnwards era -> Set StakeCredential -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Map StakeCredential (L.DRep L.StandardCrypto)))) -queryStakeVoteDelegatees sbe stakeCredentials = +queryStakeVoteDelegatees era stakeCredentials = do + let sbe = conwayEraOnwardsToShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeVoteDelegatees stakeCredentials